Add get_config([PREFIX]) method, taken from current gitweb, which
parses whole (or selected part) config file into hash (reading
"git config -z -l" output). This means that we do not have to call
one git command per config variable... but it also means that
conversion to boolean, to integer, or to color must be done from
within Perl; you can use config_val_to_* functions for that.
NOTE: Currently config_val_to_color and config_val_to_colorbool
are lacking; error checking is more relaxed in config_val_to_bool().
One advantage of ->get_config() over ->config(VARIABLE) is that it can
deal correctly with "no value" variables: they are !defined(), but
they do exists().
Tests are included; while at it add some more tests for generic
->config*() methods.
Signed-off-by: Jakub Narebski <jnareb@xxxxxxxxx>
---
Cc-ed Petr "Pasky" Baudis, who is author of Git.pm, and Lea Wiemann,
who is author of Git.pm test t/t9700-perl-git.sh. Lea is also
working on object interface to git in Perl (Git::Repo etc.); I hope
I am not repeating her work.
This is WIP (Work In Progress) as much as an RFC (Request For Comments)
patch, as there are a few things which are not finished or not cleaned
up:
* there is no config_val_to_*() equivalent of ->get_colorbool() and
->get_color() methods to convert config values to ANSI color escape
sequences.
* config_val_to_bool() and config_val_to_int() does not error out
on values which are not boolean or not integer, contrary to what
usage of "git config --bool" and "git config --int" does in
->config_bool() and ->config_int() methods, respectively.
This should be fairly easy to add by manually throwing Error...
the minor trouble would be to follow what ->config_bool etc. does.
* neither config_val_to_bool nor config_val_to_int are exported.
* tests contain some cruft in 'set up test repository' stage, which
was inspected manually that is correct (by examining Data::Dumper
output of new ->get_config() method against tested config file),
but for which actual tests were written.
There are also a few things which I'd like some comments about:
* Do config_val_to_bool and config_val_to_int should be exported
by default?
* Should config_val_to_bool and config_val_to_int throw error or
just return 'undef' on invalid values? One can check if variable
is defined using "exists($config_hash{'varname'})".
* How config_val_to_bool etc. should be named? Perhaps just
config_to_bool, like in gitweb?
* Is "return wantarray ? %config : \%config;" DWIM-mery good style?
I am _not_ a Perl hacker...
* Should ->get_config() use ->command_output_pipe, or simpler
->command() method, reading whole config into array?
* What should ->get_config() method be named? ->get_config()
or perhaps ->config_hash(), or ->config_hashref()?
* What should ->get_config() have as an optional parameter:
PREFIX (/^$prefix/o), or simply SECTION (/^(?:$section)\./o)?
* Should config_val_to_* be tested against ->config_* output?
* Should we perltie hash?
As this is an RFC I have not checked if manpage (generated from
embedded POD documentation) renders correctly.
perl/Git.pm | 107 +++++++++++++++++++++++++++++++++++++++++++++++++++
t/t9700-perl-git.sh | 10 ++++-
t/t9700/test.pl | 32 +++++++++++++++
3 files changed, 148 insertions(+), 1 deletions(-)
diff --git a/perl/Git.pm b/perl/Git.pm
index 97e61ef..2f4a306 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -668,6 +668,113 @@ sub get_color {
return $color;
}
+=item get_config ( [ PREFIX ] )
+
+Return hash (in list context) or hashref of the whole configuration,
+in the similar manner that C<config --list>, optionally limited
+to config entries which fully qualified key (variable) name begins
+with C<PREFIX> (usually name of section).
+
+The keys of returned hash are fully qualified value names (section,
+optional subsection, and variable name joined using '.'). If variable
+is set only once its value is used as hash value, if variable is set
+multiple times array reference of all values is used as hash value
+for given key.
+
+Please remember that section names and key names in config hash keys
+(in fully qualified config variable name) are normalized, which means
+that they are in lowercase.
+
+=cut
+
+sub get_config {
+ my ($self, $prefix) = _maybe_self(@_);
+
+ my @cmd = ('config');
+ unshift @cmd, $self if $self;
+ my ($fh, $ctx) = command_output_pipe(@cmd, '-z', '--list');
+
+ my %config;
+ local $/ = "\0";
+ $prefix = quotemeta($prefix) if defined($prefix);
+ while (my $keyval = <$fh>) {
+ chomp $keyval;
+ my ($key, $value) = split(/\n/, $keyval, 2);
+
+ if (!defined $prefix || $key =~ /^$prefix/o) {
+ # store multiple values for single key as anonymous array reference
+ # single values stored directly in the hash, not as [ <value> ]
+ if (!exists $config{$key}) {
+ $config{$key} = $value;
+ } elsif (!ref $config{$key}) {
+ $config{$key} = [ $config{$key}, $value ];
+ } else {
+ push @{$config{$key}}, $value;
+ }
+ }
+ }
+ my @ctx = ($fh, $ctx);
+ unshift @ctx, $self if $self;
+ command_close_pipe(@ctx);
+
+ return wantarray ? %config : \%config;
+}
+
+=item config_val_to_bool ( VALUE )
+
+Convert config value C<VALUE> to boolean; no value, number > 0, 'true'
+and 'yes' values are true, rest of values are treated as false (never
+as error, at least for now).
+
+This function is meant to be used on values in hash returned by
+C<get_config>.
+
+=cut
+
+sub config_val_to_bool {
+ my $val = shift;
+
+ # strip leading and trailing whitespace
+ $val =~ s/^\s+//;
+ $val =~ s/\s+$//;
+
+ return (!defined $val || # section.key
+ ($val =~ /^\d+$/ && $val) || # section.key = 1
+ ($val =~ /^(?:true|yes)$/i)); # section.key = true
+}
+
+=item config_val_to_int ( VALUE )
+
+Convert config value C<VALUE> to simple decimal number; an optional
+value suffix of 'k', 'm', or 'g' will cause the value to be multiplied
+by 1024, 1048576 (1024 x 1024), or 1073741824 (1024 x 1024 x 1024),
+respectively (unknown unit is treated as 1, at least for now).
+
+It does not throw error on argument which is not integer.
+
+This function is meant to be used on values in hash returned by
+C<get_config>.
+
+=cut
+
+sub config_val_to_int {
+ my $val = shift;
+
+ # strip leading and trailing whitespace
+ $val =~ s/^\s+//;
+ $val =~ s/\s+$//;
+
+ if (my ($num, $unit) = ($val =~ /^([0-9]*)([kmg])$/i)) {
+ $unit = lc($unit);
+ # unknown unit is treated as 1
+ return $num * ($unit eq 'g' ? 1073741824 :
+ $unit eq 'm' ? 1048576 :
+ $unit eq 'k' ? 1024 : 1);
+ }
+ return $val;
+}
+
+
=item ident ( TYPE | IDENTSTR )
=item ident_person ( TYPE | IDENTSTR | IDENTARRAY )
diff --git a/t/t9700-perl-git.sh b/t/t9700-perl-git.sh
index 9706ee5..af6ac58 100755
--- a/t/t9700-perl-git.sh
+++ b/t/t9700-perl-git.sh
@@ -34,9 +34,17 @@ test_expect_success \
git-config --add test.booltrue true &&
git-config --add test.boolfalse no &&
git-config --add test.boolother other &&
- git-config --add test.int 2k
+ git-config --add test.int 2k &&
+ git-config --add teSt.duP val1 &&
+ git-config --add tesT.Dup val2 &&
+ git-config --add test.subsection.noDup val &&
+ git-config --add test.subSection.nodup val &&
+ git-config --add "test.sub # \\ \" '\'' section.key" val &&
+ echo "[test] noval" >> .git/config
'
+test_debug 'cat .git/config'
+
test_external_without_stderr \
'Perl API' \
perl ../t9700/test.pl
diff --git a/t/t9700/test.pl b/t/t9700/test.pl
index 4d23125..4dd8bbf 100755
--- a/t/t9700/test.pl
+++ b/t/t9700/test.pl
@@ -11,6 +11,8 @@ use Cwd;
use File::Basename;
use File::Temp;
+use Data::Dumper;
+
BEGIN { use_ok('Git') }
# set up
@@ -30,11 +32,36 @@ is($r->config_int("test.int"), 2048, "config_int: integer");
is($r->config_int("test.nonexistent"), undef, "config_int: nonexistent");
ok($r->config_bool("test.booltrue"), "config_bool: true");
ok(!$r->config_bool("test.boolfalse"), "config_bool: false");
+ok($r->config_bool("test.noval"), "config_bool: true (noval)");
our $ansi_green = "\x1b[32m";
is($r->get_color("color.test.slot1", "red"), $ansi_green, "get_color");
# Cannot test $r->get_colorbool("color.foo")) because we do not
# control whether our STDOUT is a terminal.
+# testing get_config() and related functions/subroutines/methods
+is_deeply(scalar($r->get_config('color.')), {'color.test.slot1' => 'green'},
+ "get_config('color.')");
+my %config;
+ok(%config = $r->get_config(), "get_config(): list context");
+is($config{"test.string"}, "value",
+ "\%config scalar: string");
+is_deeply($config{"test.dupstring"}, ["value1", "value2"],
+ "\%config array: string");
+is($config{"test.nonexistent"}, undef,
+ "\%config scalar: nonexistent (undef)");
+ok(!exists($config{"test.nonexistent"}),
+ "\%config scalar: nonexistent (!exists)");
+is(Git::config_val_to_int($config{"test.int"}), 2048,
+ "config_val_to_int: integer");
+is(Git::config_val_to_int($config{"test.nonexistent"}), undef,
+ "config_val_to_int: nonexistent");
+ok( Git::config_val_to_bool($config{"test.booltrue"}),
+ "config_val_to_bool: true");
+ok(!Git::config_val_to_bool($config{"test.boolfalse"}),
+ "config_val_to_bool: false");
+ok( Git::config_val_to_bool($config{"test.noval"}),
+ "config_val_to_bool: true (noval)");
+
# Failure cases for config:
# Save and restore STDERR; we will probably extract this into a
# "dies_ok" method and possibly move the STDERR handling to Git.pm.
@@ -43,6 +70,11 @@ eval { $r->config("test.dupstring") };
ok($@, "config: duplicate entry in scalar context fails");
eval { $r->config_bool("test.boolother") };
ok($@, "config_bool: non-boolean values fail");
+TODO: {
+ $TODO = "config_val_to_bool returns false on non-bool values";
+ eval { Git::config_val_to_bool($config{"test.boolother"}) };
+ ok($@, "config_val_to_bool: non-boolean values fail");
+}
open STDERR, ">&", $tmpstderr or die "cannot restore STDERR";
# ident
--
1.5.6.1
--
To unsubscribe from this list: send the line "unsubscribe git" in
the body of a message to majordomo@xxxxxxxxxxxxxxx
More majordomo info at http://vger.kernel.org/majordomo-info.html
