[Bps-public-commit] Config-GitLike branch, master, updated. 7a857801d2edf3e7f37a68b52654b9fba36e98c3
spang at bestpractical.com
spang at bestpractical.com
Thu Jun 11 12:36:56 EDT 2009
The branch, master has been updated
via 7a857801d2edf3e7f37a68b52654b9fba36e98c3 (commit)
via c4bc9d9c768072c6251096bca8836f8445327a12 (commit)
via 2136cf41ffdee5f03c5397366322a9a388131e5b (commit)
via ac0ff67b553ea639edccb5a19ad1966001850472 (commit)
via 8600edb52019bc0946c903be8e7875cc5c988ac5 (commit)
via 43986aaa2dc7caa6adc9fd4404755d5ad5005ea7 (commit)
via 1096e5d38789309d9adb994955613fc53a855e2f (commit)
via d72189b9e61b3b7b4c70ac3418e6dbea20996a5e (commit)
via d7d517fe0b5802fbe9641c985c06743fb2647623 (commit)
via 0a5effe1025c0abf7caf51dee11016849c3d98d7 (commit)
via 19000bdf882637ab22408b019521706e7209c600 (commit)
via 70bc22e12056006f2c415d08b64944ca9cc8caa3 (commit)
via 45ebd5f052984954255745aec0e48e5b1be6b804 (commit)
via dbc74aead5abf86636ee6bc34ec2b3ebeca07d1e (commit)
via 6f8bd9349821187be895ef631b312f0e15ea20ef (commit)
via b1d88100dfcce0cd646baadee19f7fcc13cadb37 (commit)
via 18d8095fbbacd30a2cb099c2004c73c412413895 (commit)
via 1165c2eb49bb6af22ba62bb785f549341749d035 (commit)
via e97013eb4b77ac162cb107f31a00a9b8e23271bd (commit)
via fd72efc576263d273bfde14225c0ba778269e722 (commit)
from 9787096ee4f6d9669bf16e6f8ad18b384a310231 (commit)
Summary of changes:
.gitignore | 3 +
Makefile.PL | 1 +
lib/Config/GitLike.pm | 966 +++++++++++++++++++++++++---------------
lib/Config/GitLike/Cascaded.pm | 23 +-
t/00-basic.t | 11 -
t/00_use.t | 8 +
t/t1300-repo-config.t | 938 +++++++++++++++++++++++++++------------
7 files changed, 1293 insertions(+), 657 deletions(-)
delete mode 100644 t/00-basic.t
create mode 100644 t/00_use.t
- Log -----------------------------------------------------------------
commit fd72efc576263d273bfde14225c0ba778269e722
Author: Christine Spang <spang at mit.edu>
Date: Wed Jun 10 17:10:30 2009 +0300
test that stuff like '[section] [section2] a = 1' parses correctly
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 48f0253..3e163e0 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -2,7 +2,7 @@ use strict;
use warnings;
use File::Copy;
-use Test::More tests => 86;
+use Test::More tests => 87;
use Test::Exception;
use File::Spec;
use File::Temp;
@@ -760,3 +760,23 @@ is($notyet->get(key => 'test.frotz'), 'nitfol',
'can get 1st val from symlink');
is($notyet->get(key => 'test.xyzzy'), 'rezrov',
'can get 2nd val from symlink');
+
+### ADDITIONAL TESTS (not from the git test suite, just things that I didn't
+### see tests for and think should be tested)
+
+# weird yet valid edge case
+burp($config_filename,
+'# foo
+[section] [section2] a = 1
+b = 2
+');
+
+$config->load;
+
+$expect = <<'EOF'
+section2.a=1
+section2.b=2
+EOF
+;
+
+is($config->dump, $expect, 'section headers are valid w/out newline');
commit e97013eb4b77ac162cb107f31a00a9b8e23271bd
Author: Christine Spang <spang at mit.edu>
Date: Wed Jun 10 17:11:47 2009 +0300
I think I count as an author at this point
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 703bd0e..b98e4cd 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -1095,6 +1095,7 @@ as Perl 5.8.8.
Copyright 2009 Best Practical Solutions, LLC
-=head1 AUTHOR
+=head1 AUTHORS
Alex Vandiver <alexmv at bestpractical.com>
+Christine Spang <spang at bestpractical.com>
diff --git a/lib/Config/GitLike/Cascaded.pm b/lib/Config/GitLike/Cascaded.pm
index 8cba395..e58506a 100644
--- a/lib/Config/GitLike/Cascaded.pm
+++ b/lib/Config/GitLike/Cascaded.pm
@@ -56,6 +56,7 @@ as Perl 5.8.8.
Copyright 2009 Best Practical Solutions, LLC
-=head1 AUTHOR
+=head1 AUTHORS
Alex Vandiver <alexmv at bestpractical.com>
+Christine Spang <spang at bestpractical.com>
commit 1165c2eb49bb6af22ba62bb785f549341749d035
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 10:00:11 2009 +0300
additional tests for casting/filtering with get_regexp and get_all
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index b98e4cd..c086746 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -627,6 +627,7 @@ sub get_regexp {
my %args = (
key => undef,
+ filter => undef,
as => undef,
@_,
);
@@ -637,22 +638,22 @@ sub get_regexp {
my %results;
for my $key (keys %{$self->data}) {
- $results{$key} = $self->data->{$key}
- if lc $key =~ $args{key};
+ $results{$key} = $self->data->{$key} if lc $key =~ m/$args{key}/i;
}
if (defined $args{filter}) {
if ($args{filter} =~ s/^!//) {
- my @keys = grep { $results{$_} !~ m/$args{filter}/i } keys %results;
- @results{@keys} = @results{@keys};
+ map { delete $results{$_} if $results{$_} =~ m/$args{filter}/i }
+ keys %results;
} else {
- my @keys = grep { $results{$_} =~ m/$args{filter}/i } keys %results;
- @results{@keys} = @results{@keys};
+ map { delete $results{$_} if $results{$_} !~ m/$args{filter}/i }
+ keys %results;
}
}
- return map { ($_, $self->cast( value => $results{$_}, as => $args{as} )) }
- keys %results;
+ @results{keys %results} = map { $self->cast( value => $results{$_}, as =>
+ $args{as} ) } keys %results;
+ return %results;
}
=head2 dump
@@ -815,11 +816,13 @@ sub set {
my $matched = 0;
if (lc $key eq lc $got{name}) {
if (defined $args{filter}) {
- if ($args{filter} =~ /^!/) {
- my $filter = $args{filter};
- $filter =~ s/^!//;
+ # copy the filter arg here since this callback may
+ # be called multiple times and we don't want to
+ # modify the original value
+ my $filter = $args{filter};
+ if ($filter =~ s/^!//) {
$matched = 1 if ($got{value} !~ m/$filter/i);
- } elsif ($got{value} =~ m/$args{filter}/i) {
+ } elsif ($got{value} =~ m/$filter/i) {
$matched = 1;
}
} else {
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 3e163e0..745d425 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -2,7 +2,7 @@ use strict;
use warnings;
use File::Copy;
-use Test::More tests => 87;
+use Test::More tests => 91;
use Test::Exception;
use File::Spec;
use File::Temp;
@@ -391,8 +391,6 @@ lives_and { is_deeply(\%results, { 'novalue.variable' => undef } ) }
lives_and { is_deeply(\%results, { 'emptyvalue.variable' => '' } ) }
'get_regexp variable with empty value';
-# TODO: test get_regexp with casting
-
# should evaluate to a true value
ok($config->get( key => 'novalue.variable', as => 'bool' ),
'get bool variable with no value');
@@ -780,3 +778,30 @@ EOF
;
is($config->dump, $expect, 'section headers are valid w/out newline');
+
+burp($config_filename,
+'# foo
+[section]
+ b = off
+ b = on
+ exact = 0
+ inexact = 01
+ delicieux = true
+');
+
+$config->load;
+
+%results = $config->get_regexp( key => 'x', as => 'bool' );
+is_deeply(\%results, { 'section.exact' => 0, 'section.inexact' => 1,
+ 'section.delicieux' => 1 }, 'get_regexp casting works');
+
+%results = $config->get_regexp( key => 'x', filter => '!0' );
+is_deeply(\%results, { 'section.delicieux' => 'true' },
+ 'get_regexp filter works');
+
+ at results = $config->get_all( key => 'section.b', filter => 'f' );
+is_deeply(\@results, [ 'off' ], 'get_all filter works');
+
+ at results = $config->get_all( key => 'section.b', as => 'bool' );
+is_deeply(\@results, [ 0, 1 ], 'get_all casting works');
+
commit 18d8095fbbacd30a2cb099c2004c73c412413895
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 10:02:07 2009 +0300
split up some long lines
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 745d425..eb09c26 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -683,13 +683,20 @@ $expect = <<'EOF'
EOF
;
-$config->set( key => 'bool.true1', value => 'true', as => 'bool-or-int', filename => $config_filename );
-$config->set( key => 'bool.false1', value => 'false', as => 'bool-or-int', filename => $config_filename );
-$config->set( key => 'bool.true2', value => 'yes', as => 'bool-or-int', filename => $config_filename );
-$config->set( key => 'bool.false2', value => 'no', as => 'bool-or-int', filename => $config_filename );
-$config->set( key => 'int.int1', value => '0', as => 'bool-or-int', filename => $config_filename );
-$config->set( key => 'int.int2', value => '1', as => 'bool-or-int', filename => $config_filename );
-$config->set( key => 'int.int3', value => '-1', as => 'bool-or-int', filename => $config_filename );
+$config->set( key => 'bool.true1', value => 'true', as => 'bool-or-int',
+ filename => $config_filename );
+$config->set( key => 'bool.false1', value => 'false', as => 'bool-or-int',
+ filename => $config_filename );
+$config->set( key => 'bool.true2', value => 'yes', as => 'bool-or-int',
+ filename => $config_filename );
+$config->set( key => 'bool.false2', value => 'no', as => 'bool-or-int',
+ filename => $config_filename );
+$config->set( key => 'int.int1', value => '0', as => 'bool-or-int', filename =>
+ $config_filename );
+$config->set( key => 'int.int2', value => '1', as => 'bool-or-int', filename =>
+ $config_filename );
+$config->set( key => 'int.int3', value => '-1', as => 'bool-or-int',
+ filename => $config_filename );
is(slurp($config_filename), $expect, 'set bool-or-int');
commit b1d88100dfcce0cd646baadee19f7fcc13cadb37
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 11:22:25 2009 +0300
smarter return values based on context for methods that return non-scalars and ->dump now prints rather than returns in void context
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index c086746..4fec650 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -583,8 +583,8 @@ sub _remove_balanced_quotes {
Like C<get>, but does not fail if the number of values for the key is not
exactly one.
-Returns a list of values, narrowed by C<filter> and cast as C<as> if these
-options are specified.
+Returns a list of values (or an arrayref in scalar context), narrowed by
+C<filter> and cast as C<as> if these options are specified.
=cut
@@ -610,15 +610,16 @@ sub get_all {
}
}
- return map {$self->cast( value => $_, as => $args{as} )} @v;
+ @v = map {$self->cast( value => $_, as => $args{as} )} @v;
+ return wantarray ? @v : \@v;
}
=head2 get_regexp( key => 'regex', filter => 'regex', as => 'bool' )
Similar to C<get_all>, but searches for values based on a key regex.
-Returns a hash of name/value pairs, with values filtered by C<filter> and cast
-as C<as> if specified.
+Returns a hash of name/value pairs (or a hashref in scalar context), with
+values filtered by C<filter> and cast as C<as> if specified.
=cut
@@ -653,32 +654,44 @@ sub get_regexp {
@results{keys %results} = map { $self->cast( value => $results{$_}, as =>
$args{as} ) } keys %results;
- return %results;
+ return wantarray ? %results : \%results;
}
=head2 dump
-Return a string containing all configuration data, sorted in ASCII order, in
-the form:
+In scalar context, return a string containing all configuration data, sorted in
+ASCII order, in the form:
section.key=value
section2.key=value
-If you print this string, it is similar to the output of C<git config --list>.
+If called in void context, this string is printed instead.
+
+In list context, return a hash containing all the configuration data.
=cut
sub dump {
my $self = shift;
+
+ return %{$self->data} if wantarray;
+
my $data = '';
for my $key (sort keys %{$self->data}) {
+ my $str;
if (defined $self->data->{$key}) {
- $data .= "$key=".$self->data->{$key}."\n";
+ $str = "$key=".$self->data->{$key}."\n";
} else {
- $data .= "$key\n";
+ $str = "$key\n";
+ }
+ if (!defined wantarray) {
+ print $str;
+ } else {
+ $data .= $str;
}
}
- return $data;
+
+ return $data if defined wantarray;
}
=head2 format_section( section => 'section.subsection', bare => 1 )
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index eb09c26..0581690 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -2,7 +2,7 @@ use strict;
use warnings;
use File::Copy;
-use Test::More tests => 91;
+use Test::More tests => 92;
use Test::Exception;
use File::Spec;
use File::Temp;
@@ -264,8 +264,8 @@ lives_and { is($config->get(key => 'nextsection.nonewline',
throws_ok { $config->get( key => 'nextsection.nonewline' ) }
qr/multiple values/i, 'ambiguous get';
-my @results = $config->get_all(key => 'nextsection.nonewline');
-is_deeply(\@results, ['wow', 'wow2 for me'], 'get multivar');
+is_deeply(scalar $config->get_all(key => 'nextsection.nonewline'), ['wow',
+ 'wow2 for me'], 'get multivar');
$config->set(key => 'nextsection.nonewline', value => 'wow3', filter =>
qr/wow$/, filename => $config_filename);
@@ -316,8 +316,8 @@ throws_ok { $config->set(key => 'inval.2key', value => 'blabla', filename =>
lives_ok { $config->set(key => '123456.a123', value => '987', filename =>
$config_filename) } 'correct key';
-lives_ok { $config->set(key => 'Version.1.2.3eX.Alpha', value => 'beta', filename =>
- $config_filename) } 'correct key';
+lives_ok { $config->set(key => 'Version.1.2.3eX.Alpha', value => 'beta',
+ filename => $config_filename) } 'correct key';
$expect = <<'EOF'
[beta] ; silly comment # another comment
@@ -347,14 +347,20 @@ EOF
$config->load;
is($config->dump, $expect, 'working dump');
+### ADDITIONAL TEST for dump
+
+my %results = $config->dump;
+is_deeply(\%results, { '123456.a123' => '987', 'beta.noindent' => 'sillyValue',
+ 'nextsection.nonewline' => 'wow2 for me',
+ 'version.1.2.3eX.alpha' => 'beta' }, 'dump works in array context');
+
$expect = {'beta.noindent', 'sillyValue', 'nextsection.nonewline',
'wow2 for me'};
# test get_regexp
-my %results = $config->get_regexp( key => 'in' );
-
-lives_and { is_deeply(\%results, $expect) } '--get-regexp';
+lives_and { is_deeply(scalar $config->get_regexp( key => 'in' ), $expect) }
+ '--get-regexp';
$config->set(key => 'nextsection.nonewline', value => 'wow4 for you',
filename => $config_filename, multiple => 1);
@@ -364,8 +370,8 @@ $config->load;
$expect = ['wow2 for me', 'wow4 for you'];
$config->load;
-my @result = $config->get_all(key => 'nextsection.nonewline');
-is_deeply(\@result, $expect, '--add');
+is_deeply(scalar $config->get_all(key => 'nextsection.nonewline'), $expect,
+ '--add');
burp($config_filename,
'[novalue]
@@ -383,13 +389,13 @@ lives_and { is($config->get( key => 'emptyvalue.variable', filter => qr/^$/ ),
# more get_regexp
-%results = $config->get_regexp( key => 'novalue' );
-lives_and { is_deeply(\%results, { 'novalue.variable' => undef } ) }
- 'get_regexp variable with no value';
+lives_and { is_deeply(scalar $config->get_regexp( key => 'novalue' ), {
+ 'novalue.variable' => undef } ) }
+ 'get_regexp variable with no value';
-%results = $config->get_regexp( key => qr/emptyvalue/ );
-lives_and { is_deeply(\%results, { 'emptyvalue.variable' => '' } ) }
- 'get_regexp variable with empty value';
+lives_and { is_deeply(scalar $config->get_regexp( key => qr/emptyvalue/ ), {
+ 'emptyvalue.variable' => '' } ) }
+ 'get_regexp variable with empty value';
# should evaluate to a true value
ok($config->get( key => 'novalue.variable', as => 'bool' ),
@@ -798,17 +804,16 @@ burp($config_filename,
$config->load;
-%results = $config->get_regexp( key => 'x', as => 'bool' );
-is_deeply(\%results, { 'section.exact' => 0, 'section.inexact' => 1,
- 'section.delicieux' => 1 }, 'get_regexp casting works');
+is_deeply(scalar $config->get_regexp( key => 'x', as => 'bool' ), {
+ 'section.exact' => 0, 'section.inexact' => 1, 'section.delicieux' => 1
+ }, 'get_regexp casting works');
-%results = $config->get_regexp( key => 'x', filter => '!0' );
-is_deeply(\%results, { 'section.delicieux' => 'true' },
- 'get_regexp filter works');
+is_deeply(scalar $config->get_regexp( key => 'x', filter => '!0' ), {
+ 'section.delicieux' => 'true' }, 'get_regexp filter works');
- at results = $config->get_all( key => 'section.b', filter => 'f' );
-is_deeply(\@results, [ 'off' ], 'get_all filter works');
+is_deeply(scalar $config->get_all( key => 'section.b', filter => 'f' ),
+ [ 'off' ], 'get_all filter works');
- at results = $config->get_all( key => 'section.b', as => 'bool' );
-is_deeply(\@results, [ 0, 1 ], 'get_all casting works');
+is_deeply(scalar $config->get_all( key => 'section.b', as => 'bool' ),
+ [ 0, 1 ], 'get_all casting works');
commit 6f8bd9349821187be895ef631b312f0e15ea20ef
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 11:23:00 2009 +0300
some small test cleanups
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 0581690..952cba8 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -568,21 +568,20 @@ for my $key (keys %pairs) {
}
$config->load;
- at results = ();
+my @results = ();
for my $i (1..4) {
- push(@results, $config->get( key => "bool.true$i", as => 'bool' ) eq 1,
- $config->get( key => "bool.false$i", as => 'bool' ) eq 1);
+ push(@results, $config->get( key => "bool.true$i", as => 'bool' ),
+ $config->get( key => "bool.false$i", as => 'bool' ));
}
my $b = 1;
- at results = reverse @results;
while (@results) {
if ($b) {
- ok(pop @results, 'correct true bool from get');
+ ok(shift @results, 'correct true bool from get');
} else {
- ok(!pop @results, 'correct false bool from get');
+ ok(!shift @results, 'correct false bool from get');
}
$b = !$b;
}
@@ -615,12 +614,11 @@ for my $i (1..4) {
$b = 1;
- at results = reverse @results;
while (@results) {
if ($b) {
- is(pop @results, 'true', 'correct true bool from set');
+ is(shift @results, 'true', 'correct true bool from set');
} else {
- is(pop @results, 'false', 'correct false bool from set');
+ is(shift @results, 'false', 'correct false bool from set');
}
$b = !$b;
}
commit dbc74aead5abf86636ee6bc34ec2b3ebeca07d1e
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 11:50:37 2009 +0300
perltidy t1300-repo-config.t
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 952cba8..f54e569 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -17,57 +17,67 @@ use TestConfig;
sub slurp {
my $file = shift;
- local( $/ ) ;
+ local ($/);
open( my $fh, $file ) or die "Unable to open file ${file}: $!";
return <$fh>;
}
sub burp {
- my ($file_name, $content, $append) = @_;
+ my ( $file_name, $content, $append ) = @_;
my $mode = $append ? '>>' : '>';
- open( my $fh, $mode, $file_name ) ||
- die "can't open ${file_name}: $!";
+ open( my $fh, $mode, $file_name )
+ || die "can't open ${file_name}: $!";
print $fh $content;
}
# create an empty test directory in /tmp
-my $config_dir = File::Temp->newdir(CLEANUP => !$ENV{CONFIG_GITLIKE_DEBUG});
+my $config_dir = File::Temp->newdir( CLEANUP => !$ENV{CONFIG_GITLIKE_DEBUG} );
my $config_dirname = $config_dir->dirname;
-my $config_filename = File::Spec->catfile($config_dirname, 'config');
+my $config_filename = File::Spec->catfile( $config_dirname, 'config' );
diag "config file is: $config_filename";
-my $config = TestConfig->new(confname => 'config', tmpdir => $config_dirname);
+my $config
+ = TestConfig->new( confname => 'config', tmpdir => $config_dirname );
$config->load;
diag('Test git config in different settings');
-$config->set(key => 'core.penguin', value => 'little blue', filename =>
- $config_filename);
+$config->set(
+ key => 'core.penguin',
+ value => 'little blue',
+ filename => $config_filename
+);
my $expect = <<'EOF'
[core]
penguin = little blue
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'initial');
+is( slurp($config_filename), $expect, 'initial' );
-$config->set(key => 'Core.Movie', value => 'BadPhysics', filename =>
- $config_filename);
+$config->set(
+ key => 'Core.Movie',
+ value => 'BadPhysics',
+ filename => $config_filename
+);
$expect = <<'EOF'
[core]
penguin = little blue
Movie = BadPhysics
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'mixed case');
+is( slurp($config_filename), $expect, 'mixed case' );
-$config->set(key => 'Cores.WhatEver', value => 'Second', filename =>
- $config_filename);
+$config->set(
+ key => 'Cores.WhatEver',
+ value => 'Second',
+ filename => $config_filename
+);
$expect = <<'EOF'
[core]
@@ -76,12 +86,15 @@ $expect = <<'EOF'
[Cores]
WhatEver = Second
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'similar section');
+is( slurp($config_filename), $expect, 'similar section' );
-$config->set(key => 'CORE.UPPERCASE', value => 'true', filename =>
- $config_filename);
+$config->set(
+ key => 'CORE.UPPERCASE',
+ value => 'true',
+ filename => $config_filename
+);
$expect = <<'EOF'
[core]
@@ -91,17 +104,30 @@ $expect = <<'EOF'
[Cores]
WhatEver = Second
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'similar section');
+is( slurp($config_filename), $expect, 'similar section' );
# set returns nothing on success
-lives_ok { $config->set(key => 'core.penguin', value => 'kingpin',
- filter => '!blue', filename => $config_filename) }
- 'replace with non-match';
-
-lives_ok { $config->set(key => 'core.penguin', value => 'very blue', filter =>
- '!kingpin', filename => $config_filename) } 'replace with non-match';
+lives_ok {
+ $config->set(
+ key => 'core.penguin',
+ value => 'kingpin',
+ filter => '!blue',
+ filename => $config_filename
+ );
+}
+'replace with non-match';
+
+lives_ok {
+ $config->set(
+ key => 'core.penguin',
+ value => 'very blue',
+ filter => '!kingpin',
+ filename => $config_filename
+ );
+}
+'replace with non-match';
$expect = <<'EOF'
[core]
@@ -112,32 +138,35 @@ $expect = <<'EOF'
[Cores]
WhatEver = Second
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'non-match result');
+is( slurp($config_filename), $expect, 'non-match result' );
-burp($config_filename,
-'[alpha]
+burp(
+ $config_filename,
+ '[alpha]
bar = foo
[beta]
baz = multiple \
lines
-');
+'
+);
-lives_ok { $config->set(key => 'beta.baz', filename => $config_filename) }
- 'unset with cont. lines';
+lives_ok { $config->set( key => 'beta.baz', filename => $config_filename ) }
+'unset with cont. lines';
$expect = <<'EOF'
[alpha]
bar = foo
[beta]
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'unset with cont. lines is correct');
+is( slurp($config_filename), $expect, 'unset with cont. lines is correct' );
-burp($config_filename,
-'[beta] ; silly comment # another comment
+burp(
+ $config_filename,
+ '[beta] ; silly comment # another comment
noIndent= sillyValue ; \'nother silly comment
# empty line
@@ -145,13 +174,19 @@ noIndent= sillyValue ; \'nother silly comment
haha = hello
haha = bello
[nextSection] noNewline = ouch
-');
+'
+);
-my $config2_filename = File::Spec->catfile($config_dir, '.config2');
+my $config2_filename = File::Spec->catfile( $config_dir, '.config2' );
-copy($config_filename, $config2_filename) or die "File cannot be copied: $!";
+copy( $config_filename, $config2_filename )
+ or die "File cannot be copied: $!";
-$config->set( key => 'beta.haha', filename => $config_filename, multiple => 1 );
+$config->set(
+ key => 'beta.haha',
+ filename => $config_filename,
+ multiple => 1
+);
$expect = <<'EOF'
[beta] ; silly comment # another comment
noIndent= sillyValue ; 'nother silly comment
@@ -160,16 +195,25 @@ noIndent= sillyValue ; 'nother silly comment
; comment
[nextSection] noNewline = ouch
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'multiple unset is correct');
+is( slurp($config_filename), $expect, 'multiple unset is correct' );
-copy($config2_filename, $config_filename) or die "File cannot be copied: $!";
+copy( $config2_filename, $config_filename )
+ or die "File cannot be copied: $!";
unlink $config2_filename;
-lives_ok { $config->set( key => 'beta.haha', value => 'gamma', multiple => 1,
- replace_all => 1, filename => $config_filename ) } 'replace all';
+lives_ok {
+ $config->set(
+ key => 'beta.haha',
+ value => 'gamma',
+ multiple => 1,
+ replace_all => 1,
+ filename => $config_filename
+ );
+}
+'replace all';
$expect = <<'EOF'
[beta] ; silly comment # another comment
@@ -180,11 +224,15 @@ noIndent= sillyValue ; 'nother silly comment
haha = gamma
[nextSection] noNewline = ouch
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'all replaced');
+is( slurp($config_filename), $expect, 'all replaced' );
-$config->set(key => 'beta.haha', value => 'alpha', filename => $config_filename);
+$config->set(
+ key => 'beta.haha',
+ value => 'alpha',
+ filename => $config_filename
+);
$expect = <<'EOF'
[beta] ; silly comment # another comment
@@ -195,12 +243,15 @@ noIndent= sillyValue ; 'nother silly comment
haha = alpha
[nextSection] noNewline = ouch
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'really mean test');
+is( slurp($config_filename), $expect, 'really mean test' );
-$config->set(key => 'nextsection.nonewline', value => 'wow', filename =>
- $config_filename);
+$config->set(
+ key => 'nextsection.nonewline',
+ value => 'wow',
+ filename => $config_filename
+);
# NOTE: git moves the definition of the variable without a newline
# to the next line;
@@ -215,15 +266,15 @@ noIndent= sillyValue ; 'nother silly comment
haha = alpha
[nextSection] nonewline = wow
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'really really mean test');
+is( slurp($config_filename), $expect, 'really really mean test' );
$config->load;
-is($config->get(key => 'beta.haha'), 'alpha', 'get value');
+is( $config->get( key => 'beta.haha' ), 'alpha', 'get value' );
# unset beta.haha (unset accomplished by value = undef)
-$config->set(key => 'beta.haha', filename => $config_filename);
+$config->set( key => 'beta.haha', filename => $config_filename );
$expect = <<'EOF'
[beta] ; silly comment # another comment
@@ -233,12 +284,16 @@ noIndent= sillyValue ; 'nother silly comment
; comment
[nextSection] nonewline = wow
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'unset');
+is( slurp($config_filename), $expect, 'unset' );
-$config->set(key => 'nextsection.NoNewLine', value => 'wow2 for me',
- filter => qr/for me$/, filename => $config_filename);
+$config->set(
+ key => 'nextsection.NoNewLine',
+ value => 'wow2 for me',
+ filter => qr/for me$/,
+ filename => $config_filename
+);
$expect = <<'EOF'
[beta] ; silly comment # another comment
@@ -249,26 +304,45 @@ noIndent= sillyValue ; 'nother silly comment
[nextSection] nonewline = wow
NoNewLine = wow2 for me
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'multivar');
+is( slurp($config_filename), $expect, 'multivar' );
$config->load;
-lives_ok { $config->get(key => 'nextsection.nonewline',
- filter => '!for') } 'non-match';
-
-lives_and { is($config->get(key => 'nextsection.nonewline',
- filter => '!for'), 'wow') } 'non-match value';
+lives_ok {
+ $config->get(
+ key => 'nextsection.nonewline',
+ filter => '!for'
+ );
+}
+'non-match';
+
+lives_and {
+ is( $config->get(
+ key => 'nextsection.nonewline',
+ filter => '!for'
+ ),
+ 'wow'
+ );
+}
+'non-match value';
# must use get_all to get multiple values
throws_ok { $config->get( key => 'nextsection.nonewline' ) }
- qr/multiple values/i, 'ambiguous get';
+qr/multiple values/i, 'ambiguous get';
-is_deeply(scalar $config->get_all(key => 'nextsection.nonewline'), ['wow',
- 'wow2 for me'], 'get multivar');
+is_deeply(
+ scalar $config->get_all( key => 'nextsection.nonewline' ),
+ [ 'wow', 'wow2 for me' ],
+ 'get multivar'
+);
-$config->set(key => 'nextsection.nonewline', value => 'wow3', filter =>
- qr/wow$/, filename => $config_filename);
+$config->set(
+ key => 'nextsection.nonewline',
+ value => 'wow3',
+ filter => qr/wow$/,
+ filename => $config_filename
+);
$expect = <<'EOF'
[beta] ; silly comment # another comment
@@ -279,23 +353,35 @@ noIndent= sillyValue ; 'nother silly comment
[nextSection] nonewline = wow3
NoNewLine = wow2 for me
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'multivar replace');
+is( slurp($config_filename), $expect, 'multivar replace' );
$config->load;
-throws_ok { $config->set(key => 'nextsection.nonewline',
- filename => $config_filename) }
- qr/Multiple occurrences of non-multiple key/i, 'ambiguous unset';
-
-throws_ok { $config->set(key => 'somesection.nonewline',
- filename => $config_filename) }
- qr/No occurrence of somesection.nonewline found to unset/i,
- 'invalid unset';
+throws_ok {
+ $config->set(
+ key => 'nextsection.nonewline',
+ filename => $config_filename
+ );
+}
+qr/Multiple occurrences of non-multiple key/i, 'ambiguous unset';
-lives_ok { $config->set(key => 'nextsection.nonewline',
- filter => qr/wow3$/, filename => $config_filename) }
- "multivar unset doesn't crash";
+throws_ok {
+ $config->set(
+ key => 'somesection.nonewline',
+ filename => $config_filename
+ );
+}
+qr/No occurrence of somesection.nonewline found to unset/i, 'invalid unset';
+
+lives_ok {
+ $config->set(
+ key => 'nextsection.nonewline',
+ filter => qr/wow3$/,
+ filename => $config_filename
+ );
+}
+"multivar unset doesn't crash";
$expect = <<'EOF'
[beta] ; silly comment # another comment
@@ -306,18 +392,36 @@ noIndent= sillyValue ; 'nother silly comment
[nextSection]
NoNewLine = wow2 for me
EOF
-;
-
-is(slurp($config_filename), $expect, 'multivar unset');
+ ;
-throws_ok { $config->set(key => 'inval.2key', value => 'blabla', filename =>
- $config_filename) } qr/invalid key/i, 'invalid key';
+is( slurp($config_filename), $expect, 'multivar unset' );
-lives_ok { $config->set(key => '123456.a123', value => '987', filename =>
- $config_filename) } 'correct key';
-
-lives_ok { $config->set(key => 'Version.1.2.3eX.Alpha', value => 'beta',
- filename => $config_filename) } 'correct key';
+throws_ok {
+ $config->set(
+ key => 'inval.2key',
+ value => 'blabla',
+ filename => $config_filename
+ );
+}
+qr/invalid key/i, 'invalid key';
+
+lives_ok {
+ $config->set(
+ key => '123456.a123',
+ value => '987',
+ filename => $config_filename
+ );
+}
+'correct key';
+
+lives_ok {
+ $config->set(
+ key => 'Version.1.2.3eX.Alpha',
+ value => 'beta',
+ filename => $config_filename
+ );
+}
+'correct key';
$expect = <<'EOF'
[beta] ; silly comment # another comment
@@ -332,9 +436,9 @@ noIndent= sillyValue ; 'nother silly comment
[Version "1.2.3eX"]
Alpha = beta
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'hierarchical section value');
+is( slurp($config_filename), $expect, 'hierarchical section value' );
$expect = <<'EOF'
123456.a123=987
@@ -342,76 +446,98 @@ beta.noindent=sillyValue
nextsection.nonewline=wow2 for me
version.1.2.3eX.alpha=beta
EOF
-;
+ ;
$config->load;
-is($config->dump, $expect, 'working dump');
+is( $config->dump, $expect, 'working dump' );
### ADDITIONAL TEST for dump
my %results = $config->dump;
-is_deeply(\%results, { '123456.a123' => '987', 'beta.noindent' => 'sillyValue',
+is_deeply(
+ \%results,
+ { '123456.a123' => '987',
+ 'beta.noindent' => 'sillyValue',
'nextsection.nonewline' => 'wow2 for me',
- 'version.1.2.3eX.alpha' => 'beta' }, 'dump works in array context');
+ 'version.1.2.3eX.alpha' => 'beta'
+ },
+ 'dump works in array context'
+);
-$expect = {'beta.noindent', 'sillyValue', 'nextsection.nonewline',
- 'wow2 for me'};
+$expect = { 'beta.noindent', 'sillyValue', 'nextsection.nonewline',
+ 'wow2 for me' };
# test get_regexp
-lives_and { is_deeply(scalar $config->get_regexp( key => 'in' ), $expect) }
- '--get-regexp';
+lives_and { is_deeply( scalar $config->get_regexp( key => 'in' ), $expect ) }
+'--get-regexp';
-$config->set(key => 'nextsection.nonewline', value => 'wow4 for you',
- filename => $config_filename, multiple => 1);
+$config->set(
+ key => 'nextsection.nonewline',
+ value => 'wow4 for you',
+ filename => $config_filename,
+ multiple => 1
+);
$config->load;
-$expect = ['wow2 for me', 'wow4 for you'];
+$expect = [ 'wow2 for me', 'wow4 for you' ];
$config->load;
-is_deeply(scalar $config->get_all(key => 'nextsection.nonewline'), $expect,
- '--add');
+is_deeply( scalar $config->get_all( key => 'nextsection.nonewline' ),
+ $expect, '--add' );
-burp($config_filename,
-'[novalue]
+burp(
+ $config_filename,
+ '[novalue]
variable
[emptyvalue]
variable =
-');
+'
+);
$config->load;
-lives_and { is($config->get( key => 'novalue.variable', filter => qr/^$/ ),
- undef) } 'get variable with no value';
+lives_and {
+ is( $config->get( key => 'novalue.variable', filter => qr/^$/ ), undef );
+}
+'get variable with no value';
-lives_and { is($config->get( key => 'emptyvalue.variable', filter => qr/^$/ ),
- '') } 'get variable with empty value';
+lives_and {
+ is( $config->get( key => 'emptyvalue.variable', filter => qr/^$/ ), '' );
+}
+'get variable with empty value';
# more get_regexp
-lives_and { is_deeply(scalar $config->get_regexp( key => 'novalue' ), {
- 'novalue.variable' => undef } ) }
- 'get_regexp variable with no value';
+lives_and {
+ is_deeply( scalar $config->get_regexp( key => 'novalue' ),
+ { 'novalue.variable' => undef } );
+}
+'get_regexp variable with no value';
-lives_and { is_deeply(scalar $config->get_regexp( key => qr/emptyvalue/ ), {
- 'emptyvalue.variable' => '' } ) }
- 'get_regexp variable with empty value';
+lives_and {
+ is_deeply( scalar $config->get_regexp( key => qr/emptyvalue/ ),
+ { 'emptyvalue.variable' => '' } );
+}
+'get_regexp variable with empty value';
# should evaluate to a true value
-ok($config->get( key => 'novalue.variable', as => 'bool' ),
- 'get bool variable with no value');
+ok( $config->get( key => 'novalue.variable', as => 'bool' ),
+ 'get bool variable with no value' );
# should evaluate to a false value
-ok(!$config->get( key => 'emptyvalue.variable', as => 'bool' ),
- 'get bool variable with empty value');
+ok( !$config->get( key => 'emptyvalue.variable', as => 'bool' ),
+ 'get bool variable with empty value' );
# testing alternate subsection notation
-burp($config_filename,
-'[a.b]
+burp(
+ $config_filename,
+ '[a.b]
c = d
-');
+'
+);
-$config->set(key => 'a.x', value => 'y', filename => $config_filename);
+$config->set( key => 'a.x', value => 'y', filename => $config_filename );
$expect = <<'EOF'
[a.b]
@@ -419,12 +545,13 @@ $expect = <<'EOF'
[a]
x = y
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'new section is partial match of another');
+is( slurp($config_filename), $expect,
+ 'new section is partial match of another' );
-$config->set(key => 'b.x', value => 'y', filename => $config_filename);
-$config->set(key => 'a.b', value => 'c', filename => $config_filename);
+$config->set( key => 'b.x', value => 'y', filename => $config_filename );
+$config->set( key => 'a.b', value => 'c', filename => $config_filename );
$config->load;
$expect = <<'EOF'
@@ -436,17 +563,19 @@ $expect = <<'EOF'
[b]
x = y
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'new variable inserts into proper section');
+is( slurp($config_filename), $expect,
+ 'new variable inserts into proper section' );
# testing rename_section
# NOTE: added comment after [branch "1 234 blabl/a"] to check that our
# implementation doesn't blow away trailing text after a rename like
# git-config currently does
-burp($config_filename,
-'# Hallo
+burp(
+ $config_filename,
+ '# Hallo
#Bello
[branch "eins"]
x = 1
@@ -454,10 +583,17 @@ burp($config_filename,
y = 1
[branch "1 234 blabl/a"] ; comment
weird
-');
-
-lives_ok { $config->rename_section( from => 'branch.eins', to => 'branch.zwei',
- filename => $config_filename ) } 'rename_section lives';
+'
+);
+
+lives_ok {
+ $config->rename_section(
+ from => 'branch.eins',
+ to => 'branch.zwei',
+ filename => $config_filename
+ );
+}
+'rename_section lives';
$expect = <<'EOF'
# Hallo
@@ -469,20 +605,30 @@ $expect = <<'EOF'
[branch "1 234 blabl/a"] ; comment
weird
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'rename succeeded');
+is( slurp($config_filename), $expect, 'rename succeeded' );
-throws_ok { $config->rename_section( from => 'branch."world domination"', to =>
- 'branch.drei', filename => $config_filename ) }
- qr/no such section/i, 'rename non-existing section';
+throws_ok {
+ $config->rename_section(
+ from => 'branch."world domination"',
+ to => 'branch.drei',
+ filename => $config_filename
+ );
+}
+qr/no such section/i, 'rename non-existing section';
-is(slurp($config_filename), $expect,
- 'rename non-existing section changes nothing');
+is( slurp($config_filename), $expect,
+ 'rename non-existing section changes nothing' );
-lives_ok { $config->rename_section( from => 'branch."1 234 blabl/a"', to =>
- 'branch.drei', filename => $config_filename ) }
- 'rename another section';
+lives_ok {
+ $config->rename_section(
+ from => 'branch."1 234 blabl/a"',
+ to => 'branch.drei',
+ filename => $config_filename
+ );
+}
+'rename another section';
# NOTE: differs from current git behaviour, because the way that git handles
# renames / variable replacement is buggy (git would write [branch "drei"]
@@ -497,20 +643,27 @@ $expect = <<'EOF'
[branch "drei"] ; comment
weird
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'rename succeeded');
+is( slurp($config_filename), $expect, 'rename succeeded' );
# [branch "vier"] doesn't get interpreted as a real section
# header because the variable definition before it means
# that all the way to the end of that line is a part of
# a's value
-burp($config_filename,
-'[branch "zwei"] a = 1 [branch "vier"]
-', 1);
-
-lives_ok { $config->remove_section( section => 'branch.zwei',
- filename => $config_filename ) } 'remove section';
+burp(
+ $config_filename,
+ '[branch "zwei"] a = 1 [branch "vier"]
+', 1
+);
+
+lives_ok {
+ $config->remove_section(
+ section => 'branch.zwei',
+ filename => $config_filename
+ );
+}
+'remove section';
$expect = <<'EOF'
# Hallo
@@ -518,9 +671,9 @@ $expect = <<'EOF'
[branch "drei"] ; comment
weird
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'section was removed properly');
+is( slurp($config_filename), $expect, 'section was removed properly' );
unlink $config_filename;
@@ -531,94 +684,133 @@ $expect = <<'EOF'
[gitcvs "ext"]
dbname = %Ggitcvs1.%a.%m.sqlite
EOF
-;
-
-$config->set( key => 'gitcvs.enabled', value => 'true',
- filename => $config_filename );
-$config->set( key => 'gitcvs.ext.dbname', value => '%Ggitcvs1.%a.%m.sqlite',
- filename => $config_filename);
-$config->set( key => 'gitcvs.dbname', value => '%Ggitcvs2.%a.%m.sqlite',
- filename => $config_filename );
-is(slurp($config_filename), $expect, 'section ending');
+ ;
+
+$config->set(
+ key => 'gitcvs.enabled',
+ value => 'true',
+ filename => $config_filename
+);
+$config->set(
+ key => 'gitcvs.ext.dbname',
+ value => '%Ggitcvs1.%a.%m.sqlite',
+ filename => $config_filename
+);
+$config->set(
+ key => 'gitcvs.dbname',
+ value => '%Ggitcvs2.%a.%m.sqlite',
+ filename => $config_filename
+);
+is( slurp($config_filename), $expect, 'section ending' );
# testing int casting
-$config->set( key => 'kilo.gram', value => '1k', filename => $config_filename );
-$config->set( key => 'mega.ton', value => '1m', filename => $config_filename );
+$config->set(
+ key => 'kilo.gram',
+ value => '1k',
+ filename => $config_filename
+);
+$config->set(
+ key => 'mega.ton',
+ value => '1m',
+ filename => $config_filename
+);
$config->load;
-is($config->get( key => 'kilo.gram', as => 'int' ), 1024,
- 'numbers: int k interp');
-is($config->get( key => 'mega.ton', as => 'int' ), 1048576,
- 'numbers: int m interp');
+is( $config->get( key => 'kilo.gram', as => 'int' ),
+ 1024, 'numbers: int k interp' );
+is( $config->get( key => 'mega.ton', as => 'int' ),
+ 1048576, 'numbers: int m interp' );
# units that aren't k/m/g should throw an error
-$config->set( key => 'aninvalid.unit', value => '1auto', filename =>
- $config_filename );
+$config->set(
+ key => 'aninvalid.unit',
+ value => '1auto',
+ filename => $config_filename
+);
$config->load;
throws_ok { $config->get( key => 'aninvalid.unit', as => 'int' ) }
- qr/invalid unit/i, 'invalid unit';
+qr/invalid unit/i, 'invalid unit';
-my %pairs = qw( true1 01 true2 -1 true3 YeS true4 true false1 000 false3 nO false4 FALSE);
+my %pairs
+ = qw( true1 01 true2 -1 true3 YeS true4 true false1 000 false3 nO false4 FALSE);
$pairs{false2} = '';
-for my $key (keys %pairs) {
- $config->set( key => "bool.$key", value => $pairs{$key},
- filename => $config_filename );
+for my $key ( keys %pairs ) {
+ $config->set(
+ key => "bool.$key",
+ value => $pairs{$key},
+ filename => $config_filename
+ );
}
$config->load;
my @results = ();
-for my $i (1..4) {
- push(@results, $config->get( key => "bool.true$i", as => 'bool' ),
- $config->get( key => "bool.false$i", as => 'bool' ));
+for my $i ( 1 .. 4 ) {
+ push( @results,
+ $config->get( key => "bool.true$i", as => 'bool' ),
+ $config->get( key => "bool.false$i", as => 'bool' ) );
}
my $b = 1;
while (@results) {
if ($b) {
- ok(shift @results, 'correct true bool from get');
+ ok( shift @results, 'correct true bool from get' );
} else {
- ok(!shift @results, 'correct false bool from get');
+ ok( !shift @results, 'correct false bool from get' );
}
$b = !$b;
}
-$config->set( key => 'bool.nobool', value => 'foobar',
- filename => $config_filename );
+$config->set(
+ key => 'bool.nobool',
+ value => 'foobar',
+ filename => $config_filename
+);
$config->load;
throws_ok { $config->get( key => 'bool.nobool', as => 'bool' ) }
- qr/invalid bool/i, 'invalid bool (get)';
+qr/invalid bool/i, 'invalid bool (get)';
# test casting with set
-throws_ok { $config->set( key => 'bool.nobool', value => 'foobar',
- as => 'bool', filename => $config_filename ) }
- qr/invalid bool/i, 'invalid bool (set)';
+throws_ok {
+ $config->set(
+ key => 'bool.nobool',
+ value => 'foobar',
+ as => 'bool',
+ filename => $config_filename
+ );
+}
+qr/invalid bool/i, 'invalid bool (set)';
unlink $config_filename;
-for my $key (keys %pairs) {
- $config->set( key => "bool.$key", value => $pairs{$key},
- filename => $config_filename, as => 'bool' );
+for my $key ( keys %pairs ) {
+ $config->set(
+ key => "bool.$key",
+ value => $pairs{$key},
+ filename => $config_filename,
+ as => 'bool'
+ );
}
$config->load;
@results = ();
-for my $i (1..4) {
- push(@results, $config->get( key => "bool.true$i" ),
- $config->get( key => "bool.false$i" ));
+for my $i ( 1 .. 4 ) {
+ push( @results,
+ $config->get( key => "bool.true$i" ),
+ $config->get( key => "bool.false$i" ) );
}
$b = 1;
while (@results) {
if ($b) {
- is(shift @results, 'true', 'correct true bool from set');
+ is( shift @results, 'true', 'correct true bool from set' );
} else {
- is(shift @results, 'false', 'correct false bool from set');
+ is( shift @results, 'false', 'correct false bool from set' );
}
$b = !$b;
}
@@ -631,21 +823,34 @@ $expect = <<'EOF'
val2 = -1
val3 = 5242880
EOF
-;
-
-$config->set( key => 'int.val1', value => '01', filename => $config_filename,
- as => 'int' );
-$config->set( key => 'int.val2', value => '-1', filename => $config_filename,
- as => 'int' );
-$config->set( key => 'int.val3', value => '5m', filename => $config_filename,
- as => 'int' );
-
-is(slurp($config_filename), $expect, 'set --int');
+ ;
+
+$config->set(
+ key => 'int.val1',
+ value => '01',
+ filename => $config_filename,
+ as => 'int'
+);
+$config->set(
+ key => 'int.val2',
+ value => '-1',
+ filename => $config_filename,
+ as => 'int'
+);
+$config->set(
+ key => 'int.val3',
+ value => '5m',
+ filename => $config_filename,
+ as => 'int'
+);
+
+is( slurp($config_filename), $expect, 'set --int' );
unlink $config_filename;
-burp($config_filename,
-'[bool]
+burp(
+ $config_filename,
+ '[bool]
true1 = on
true2 = yes
false1 = off
@@ -654,23 +859,24 @@ burp($config_filename,
int1 = 00
int2 = 01
int3 = -01
-');
+'
+);
$config->load;
-is($config->get( key => 'bool.true1', as => 'bool-or-int', human => 1 ),
- 'true', 'get bool-or-int');
-is($config->get( key => 'bool.true2', as => 'bool-or-int', human => 1 ),
- 'true', 'get bool-or-int');
-is($config->get( key => 'bool.false1', as => 'bool-or-int', human => 1 ),
- 'false', 'get bool-or-int');
-is($config->get( key => 'bool.false2', as => 'bool-or-int', human => 1 ),
- 'false', 'get bool-or-int');
-is($config->get( key => 'int.int1', as => 'bool-or-int' ), 0,
- 'get bool-or-int');
-is($config->get( key => 'int.int2', as => 'bool-or-int' ), 1,
- 'get bool-or-int');
-is($config->get( key => 'int.int3', as => 'bool-or-int' ), -1,
- 'get bool-or-int');
+is( $config->get( key => 'bool.true1', as => 'bool-or-int', human => 1 ),
+ 'true', 'get bool-or-int' );
+is( $config->get( key => 'bool.true2', as => 'bool-or-int', human => 1 ),
+ 'true', 'get bool-or-int' );
+is( $config->get( key => 'bool.false1', as => 'bool-or-int', human => 1 ),
+ 'false', 'get bool-or-int' );
+is( $config->get( key => 'bool.false2', as => 'bool-or-int', human => 1 ),
+ 'false', 'get bool-or-int' );
+is( $config->get( key => 'int.int1', as => 'bool-or-int' ),
+ 0, 'get bool-or-int' );
+is( $config->get( key => 'int.int2', as => 'bool-or-int' ),
+ 1, 'get bool-or-int' );
+is( $config->get( key => 'int.int3', as => 'bool-or-int' ),
+ -1, 'get bool-or-int' );
unlink $config_filename;
@@ -685,35 +891,75 @@ $expect = <<'EOF'
int2 = 1
int3 = -1
EOF
-;
-
-$config->set( key => 'bool.true1', value => 'true', as => 'bool-or-int',
- filename => $config_filename );
-$config->set( key => 'bool.false1', value => 'false', as => 'bool-or-int',
- filename => $config_filename );
-$config->set( key => 'bool.true2', value => 'yes', as => 'bool-or-int',
- filename => $config_filename );
-$config->set( key => 'bool.false2', value => 'no', as => 'bool-or-int',
- filename => $config_filename );
-$config->set( key => 'int.int1', value => '0', as => 'bool-or-int', filename =>
- $config_filename );
-$config->set( key => 'int.int2', value => '1', as => 'bool-or-int', filename =>
- $config_filename );
-$config->set( key => 'int.int3', value => '-1', as => 'bool-or-int',
- filename => $config_filename );
-
-is(slurp($config_filename), $expect, 'set bool-or-int');
+ ;
+
+$config->set(
+ key => 'bool.true1',
+ value => 'true',
+ as => 'bool-or-int',
+ filename => $config_filename
+);
+$config->set(
+ key => 'bool.false1',
+ value => 'false',
+ as => 'bool-or-int',
+ filename => $config_filename
+);
+$config->set(
+ key => 'bool.true2',
+ value => 'yes',
+ as => 'bool-or-int',
+ filename => $config_filename
+);
+$config->set(
+ key => 'bool.false2',
+ value => 'no',
+ as => 'bool-or-int',
+ filename => $config_filename
+);
+$config->set(
+ key => 'int.int1',
+ value => '0',
+ as => 'bool-or-int',
+ filename => $config_filename
+);
+$config->set(
+ key => 'int.int2',
+ value => '1',
+ as => 'bool-or-int',
+ filename => $config_filename
+);
+$config->set(
+ key => 'int.int3',
+ value => '-1',
+ as => 'bool-or-int',
+ filename => $config_filename
+);
+
+is( slurp($config_filename), $expect, 'set bool-or-int' );
unlink $config_filename;
-$config->set(key => 'quote.leading', value => ' test', filename =>
- $config_filename);
-$config->set(key => 'quote.ending', value => 'test ', filename =>
- $config_filename);
-$config->set(key => 'quote.semicolon', value => 'test;test', filename =>
- $config_filename);
-$config->set(key => 'quote.hash', value => 'test#test', filename =>
- $config_filename);
+$config->set(
+ key => 'quote.leading',
+ value => ' test',
+ filename => $config_filename
+);
+$config->set(
+ key => 'quote.ending',
+ value => 'test ',
+ filename => $config_filename
+);
+$config->set(
+ key => 'quote.semicolon',
+ value => 'test;test',
+ filename => $config_filename
+);
+$config->set(
+ key => 'quote.hash',
+ value => 'test#test',
+ filename => $config_filename
+);
$expect = <<'EOF'
[quote]
@@ -722,63 +968,89 @@ $expect = <<'EOF'
semicolon = "test;test"
hash = "test#test"
EOF
-;
+ ;
-is(slurp($config_filename), $expect, 'quoting');
+is( slurp($config_filename), $expect, 'quoting' );
-throws_ok { $config->set( key => "key.with\nnewline", value => '123',
- filename => $config_filename ) } qr/invalid key/, 'key with newline';
-
-lives_ok { $config->set( key => 'key.sub', value => "value.with\nnewline",
- filename => $config_filename ) } 'value with newline';
+throws_ok {
+ $config->set(
+ key => "key.with\nnewline",
+ value => '123',
+ filename => $config_filename
+ );
+}
+qr/invalid key/, 'key with newline';
+
+lives_ok {
+ $config->set(
+ key => 'key.sub',
+ value => "value.with\nnewline",
+ filename => $config_filename
+ );
+}
+'value with newline';
-burp($config_filename,
-'[section]
+burp(
+ $config_filename,
+ '[section]
; comment \
continued = cont\
inued
noncont = not continued ; \
quotecont = "cont;\
inued"
-');
+'
+);
$expect = <<'EOF'
section.continued=continued
section.noncont=not continued
section.quotecont=cont;inued
EOF
-;
+ ;
$config->load;
-is($config->dump, $expect, 'value continued on next line');
+is( $config->dump, $expect, 'value continued on next line' );
# testing symlinked configuration
-symlink File::Spec->catfile($config_dir, 'notyet'),
- File::Spec->catfile($config_dir, 'myconfig');
-
-my $myconfig = TestConfig->new(confname => 'myconfig',
- tmpdir => $config_dirname);
-$myconfig->set( key => 'test.frotz', value => 'nitfol',
- filename => File::Spec->catfile($config_dir, 'myconfig'));
-my $notyet = TestConfig->new(confname => 'notyet',
- tmpdir => $config_dirname);
-$notyet->set ( key => 'test.xyzzy', value => 'rezrov',
- filename => File::Spec->catfile($config_dir, 'notyet'));
+symlink File::Spec->catfile( $config_dir, 'notyet' ),
+ File::Spec->catfile( $config_dir, 'myconfig' );
+
+my $myconfig = TestConfig->new(
+ confname => 'myconfig',
+ tmpdir => $config_dirname
+);
+$myconfig->set(
+ key => 'test.frotz',
+ value => 'nitfol',
+ filename => File::Spec->catfile( $config_dir, 'myconfig' )
+);
+my $notyet = TestConfig->new(
+ confname => 'notyet',
+ tmpdir => $config_dirname
+);
+$notyet->set(
+ key => 'test.xyzzy',
+ value => 'rezrov',
+ filename => File::Spec->catfile( $config_dir, 'notyet' )
+);
$notyet->load;
-is($notyet->get(key => 'test.frotz'), 'nitfol',
- 'can get 1st val from symlink');
-is($notyet->get(key => 'test.xyzzy'), 'rezrov',
- 'can get 2nd val from symlink');
+is( $notyet->get( key => 'test.frotz' ),
+ 'nitfol', 'can get 1st val from symlink' );
+is( $notyet->get( key => 'test.xyzzy' ),
+ 'rezrov', 'can get 2nd val from symlink' );
### ADDITIONAL TESTS (not from the git test suite, just things that I didn't
### see tests for and think should be tested)
# weird yet valid edge case
-burp($config_filename,
-'# foo
+burp(
+ $config_filename,
+ '# foo
[section] [section2] a = 1
b = 2
-');
+'
+);
$config->load;
@@ -786,32 +1058,45 @@ $expect = <<'EOF'
section2.a=1
section2.b=2
EOF
-;
+ ;
-is($config->dump, $expect, 'section headers are valid w/out newline');
+is( $config->dump, $expect, 'section headers are valid w/out newline' );
-burp($config_filename,
-'# foo
+burp(
+ $config_filename,
+ '# foo
[section]
b = off
b = on
exact = 0
inexact = 01
delicieux = true
-');
+'
+);
$config->load;
-is_deeply(scalar $config->get_regexp( key => 'x', as => 'bool' ), {
- 'section.exact' => 0, 'section.inexact' => 1, 'section.delicieux' => 1
- }, 'get_regexp casting works');
-
-is_deeply(scalar $config->get_regexp( key => 'x', filter => '!0' ), {
- 'section.delicieux' => 'true' }, 'get_regexp filter works');
-
-is_deeply(scalar $config->get_all( key => 'section.b', filter => 'f' ),
- [ 'off' ], 'get_all filter works');
-
-is_deeply(scalar $config->get_all( key => 'section.b', as => 'bool' ),
- [ 0, 1 ], 'get_all casting works');
+is_deeply(
+ scalar $config->get_regexp( key => 'x', as => 'bool' ),
+ { 'section.exact' => 0,
+ 'section.inexact' => 1,
+ 'section.delicieux' => 1
+ },
+ 'get_regexp casting works'
+);
+
+is_deeply(
+ scalar $config->get_regexp( key => 'x', filter => '!0' ),
+ { 'section.delicieux' => 'true' },
+ 'get_regexp filter works'
+);
+
+is_deeply( scalar $config->get_all( key => 'section.b', filter => 'f' ),
+ ['off'], 'get_all filter works' );
+
+is_deeply(
+ scalar $config->get_all( key => 'section.b', as => 'bool' ),
+ [ 0, 1 ],
+ 'get_all casting works'
+);
commit 45ebd5f052984954255745aec0e48e5b1be6b804
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 11:51:45 2009 +0300
use tests
diff --git a/t/00_use.t b/t/00_use.t
new file mode 100644
index 0000000..45e3fb7
--- /dev/null
+++ b/t/00_use.t
@@ -0,0 +1,8 @@
+use warnings;
+use strict;
+use Test::More tests => 2;
+
+BEGIN {
+ use_ok('Config::GitLike');
+ use_ok('Config::GitLike::Cascaded');
+}
commit 70bc22e12056006f2c415d08b64944ca9cc8caa3
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 11:58:16 2009 +0300
kill t/00-basic.t since it doesn't do anything useful anymore
diff --git a/t/00-basic.t b/t/00-basic.t
deleted file mode 100644
index b9d96ab..0000000
--- a/t/00-basic.t
+++ /dev/null
@@ -1,11 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use lib 'lib';
-use Config::GitLike::Cascaded;
-
-my $config = Config::GitLike::Cascaded->new(confname => "mytest");
-$config->load;
-
-$config->dump;
commit 19000bdf882637ab22408b019521706e7209c600
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 16:20:45 2009 +0300
I'm beginning to agree with PBP in that non-contiguous POD = contorted code, confused docs, or both. Oh hey, and I overhauled most of the doc while I was at it.
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 4fec650..d9708ac 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -17,6 +17,8 @@ has 'confname' => (
isa => 'Str',
);
+# not defaulting to {} allows the predicate is_loaded
+# to determine whether data has been loaded yet or not
has 'data' => (
is => 'rw',
predicate => 'is_loaded',
@@ -29,61 +31,18 @@ has 'multiple' => (
default => sub { +{} },
);
-
-=head1 NAME
-
-Config::GitLike - (mostly) git-compatible config file parsing
-
-=head1 SYNOPSIS
-
- use Config::GitLike;
-
- my $c = Config::GitLike->new(confname => 'config');
- $c->load;
-
- $c->get(
-
-=head1 DESCRIPTION
-
-=head1 METHODS
-
-=head2 set_multiple $name
-
-Mark the key string C<$name> as containing multiple values.
-
-Returns nothing.
-
-=cut
-
sub set_multiple {
my $self = shift;
my ($name, $mult) = @_, 1;
$self->multiple->{$name} = $mult;
}
-=head2 is_multiple $name
-
-Return a true value if the key string C<$name> contains multiple values; false
-otherwise.
-
-=cut
-
sub is_multiple {
my $self = shift;
my $name = shift;
return $self->multiple->{$name};
}
-=head2 load
-
-Load the global, local, and directory configuration file with the filename
-C<confname> into the C<data> attribute (if they exist).
-
-Returns the contents of the C<data> attribute after all configs have been
-loaded.
-
-=cut
-
sub load {
my $self = shift;
my $path = shift || Cwd::cwd;
@@ -91,44 +50,22 @@ sub load {
$self->load_global;
$self->load_user;
$self->load_dirs( $path );
- return $self->data;
+ return wantarray? %{$self->data} : $self->data;
}
-=head2 dir_file
-
-Return a string representing the path to a configuration file with the
-name C<confname> in the current working directory (or a directory higher
-on the directory tree).
-
-Override this method in a subclass if the directory file has a name
-other than C<confname> or is contained in, for example, a subdirectory
-(such as with C<./.git/config> versus C<~/.gitconfig>).
-
-=cut
-
sub dir_file {
my $self = shift;
return "." . $self->confname;
}
-=head2 load_dirs
-
-Load the configuration file in the current working directory into the C<data>
-attribute or, if there is no config matching C<dir_file> in the current working
-directory, walk up the directory tree until one is found. (No error is thrown
-if none is found.)
-
-Returns nothing of note.
-
-=cut
-
sub load_dirs {
my $self = shift;
my $path = shift;
my($vol, $dirs, undef) = File::Spec->splitpath( $path, 1 );
my @dirs = File::Spec->splitdir( $dirs );
while (@dirs) {
- my $path = File::Spec->catpath( $vol, File::Spec->catdir(@dirs), $self->dir_file );
+ my $path = File::Spec->catpath( $vol, File::Spec->catdir(@dirs),
+ $self->dir_file );
if (-f $path) {
$self->load_file( $path );
last;
@@ -137,63 +74,22 @@ sub load_dirs {
}
}
-=head2 global_file
-
-Return a string representing the path to a system-wide configuration file with
-name C<confname> (the L<Config::GitLike> object's C<confname> attribute).
-
-Override this method in a subclass if the global file has a different name
-than C<confname> or is contained in a directory other than C</etc>.
-
-=cut
-
sub global_file {
my $self = shift;
return "/etc/" . $self->confname;
}
-=head2 load_global
-
-If a global configuration file with the name C<confname> exists, load
-its configuration variables into the C<data> attribute.
-
-Returns the current contents of the C<data> attribute after the
-file has been loaded, or undef if no global config file is found.
-
-=cut
-
sub load_global {
my $self = shift;
return unless -f $self->global_file;
return $self->load_file( $self->global_file );
}
-=head2 user_file
-
-Return a string representing the path to a configuration file
-in the current user's home directory with filename C<confname>.
-
-Override this method in a subclass if the user directory file
-does not have the same name as the global config file.
-
-=cut
-
sub user_file {
my $self = shift;
return File::Spec->catfile( File::HomeDir->my_home, "." . $self->confname );
}
-=head2 load_user
-
-If a configuration file with the name C<confname> exists in the current
-user's home directory, load its config variables into the C<data>
-attribute.
-
-Returns the current contents of the C<data> attribute after the file
-has been loaded, or undef if no global config file is found.
-
-=cut
-
sub load_user {
my $self = shift;
return unless -f $self->user_file;
@@ -215,14 +111,6 @@ sub _read_config {
return $c;
}
-=head2 load_file $filename
-
-Takes a string containing the path to a file, opens it if it exists, loads its
-config variables into the C<data> attribute, and returns the current contents
-of the C<data> attribute (a hashref).
-
-=cut
-
sub load_file {
my $self = shift;
my ($filename) = @_;
@@ -240,28 +128,6 @@ sub load_file {
return $self->data;
}
-=head2 parse_content( content => $str, callback => $sub, error => $sub )
-
-Takes arguments consisting of C<content>, a string of the content of the
-configuration file to be parsed, C<callback>, a submethod to run on information
-retrieved from the config file (headers, subheaders, and key/value pairs), and
-C<error>, a submethod to run on malformed content.
-
-Returns undef on success and C<error($content)> on failure.
-
-C<callback> is called like:
-
- callback(section => $str, offset => $num, length => $num, name => $str, value => $str)
-
-C<name> and C<value> may be omitted if the callback is not being called on a
-key/value pair, or if it is being called on a key with no value.
-
-C<error> is called like:
-
- error( content => $content, offset => $offset )
-
-=cut
-
sub parse_content {
my $self = shift;
my %args = (
@@ -392,17 +258,6 @@ sub parse_content {
}
}
-=head2 define( section => 'str, name => 'str', value => 'str' )
-
-Given a section, a key name, and a value¸ store this information
-in memory in the config object. (In the C<data> attribute if you
-must know.)
-
-Returns the value that was just defined on success, or nothing
-if no name is given and thus the key cannot be defined.
-
-=cut
-
sub define {
my $self = shift;
my %args = (
@@ -424,35 +279,6 @@ sub define {
}
}
-=head2 cast( value => 'foo', as => 'int', human => 1 )
-
-Return C<value> cast into the type specified by C<as>.
-
-Valid values for C<as> are C<bool>, C<int>, C<num>, or C<bool-or-int>. For
-C<bool>, C<true>, C<yes>, C<on>, C<1>, and undef are translated into a true
-value (for Perl); anything else is false. Specifying a true value for the
-C<human> arg will get you a human-readable 'true' or 'false' rather than a
-value that plays along with Perl's definition of truthiness.
-
-For C<int>s and C<num>s, if C<value> ends in C<k>, C<m>, or C<g>, it will be
-multiplied by 1024, 1048576, and 1073741824, respectively, before being
-returned.
-
-C<bool-or-int>, as you might have guessed, gives you either
-a bool or an int depending on which one applies.
-
-TODO should numbers be truncated if C<int> is specified?
-
-If C<as> is unspecified, C<value> is returned unchanged.
-
-=cut
-
-use constant {
- BOOL_TRUE_REGEX => qr/^(?:true|yes|on|-?0*1)$/i,
- BOOL_FALSE_REGEX => qr/^(?:false|no|off|0*)$/i,
- NUM_REGEX => qr/^-?[0-9]*\.?[0-9]*[kmg]?$/,
-};
-
sub cast {
my $self = shift;
my %args = (
@@ -462,6 +288,12 @@ sub cast {
@_,
);
+ use constant {
+ BOOL_TRUE_REGEX => qr/^(?:true|yes|on|-?0*1)$/i,
+ BOOL_FALSE_REGEX => qr/^(?:false|no|off|0*)$/i,
+ NUM_REGEX => qr/^-?[0-9]*\.?[0-9]*[kmg]?$/,
+ };
+
if (defined $args{as} && $args{as} eq 'bool-or-int') {
if ( $args{value} =~ NUM_REGEX ) {
$args{as} = 'int';
@@ -503,36 +335,11 @@ sub cast {
$v *= 1024*1024 if $1 eq "m";
$v *= 1024*1024*1024 if $1 eq "g";
}
- return $v + 0;
+
+ return $args{as} eq 'int' ? int $v : $v + 0;
}
}
-=head2 get( key => 'sect.subsect.key', as => 'int', filter => '!foo' )
-
-Retrieve the config value associated with C<key> cast as an C<as>.
-
-The C<key> option is required (will return undef if unspecified); the C<as>
-option is not (will return a string by default). Sections and subsections
-are specified in the key by separating them from the key name with a .
-character. Sections, subsections, and keys may all be quoted (double or
-single quotes).
-
-If C<key> doesn't exist in the config, undef is returned. Dies with
-the exception "Multiple values" if the given key has more than one
-value associated with it. (Use C<get_all to retrieve multiple values.)
-
-Loads the configuration file with name $confname if it hasn't yet been
-loaded. Note that if you've run any C<set> calls to the loaded
-configuration files since the last time they were loaded, you MUST
-call C<load> again before getting, or the returned configuration data
-may not match the configuration variables on-disk.
-
-C<filter> can be given to pick a single result for a variable with
-multiple values. If the regex string begins with a !, negative
-matching rather than positive matching will be used.
-
-=cut
-
sub get {
my $self = shift;
my %args = (
@@ -578,16 +385,6 @@ sub _remove_balanced_quotes {
return $key;
}
-=head2 get_all( key => 'foo', filter => 'regex', as => 'bool' )
-
-Like C<get>, but does not fail if the number of values for the key is not
-exactly one.
-
-Returns a list of values (or an arrayref in scalar context), narrowed by
-C<filter> and cast as C<as> if these options are specified.
-
-=cut
-
sub get_all {
my $self = shift;
my %args = (
@@ -614,15 +411,6 @@ sub get_all {
return wantarray ? @v : \@v;
}
-=head2 get_regexp( key => 'regex', filter => 'regex', as => 'bool' )
-
-Similar to C<get_all>, but searches for values based on a key regex.
-
-Returns a hash of name/value pairs (or a hashref in scalar context), with
-values filtered by C<filter> and cast as C<as> if specified.
-
-=cut
-
sub get_regexp {
my $self = shift;
@@ -657,20 +445,6 @@ sub get_regexp {
return wantarray ? %results : \%results;
}
-=head2 dump
-
-In scalar context, return a string containing all configuration data, sorted in
-ASCII order, in the form:
-
- section.key=value
- section2.key=value
-
-If called in void context, this string is printed instead.
-
-In list context, return a hash containing all the configuration data.
-
-=cut
-
sub dump {
my $self = shift;
@@ -694,14 +468,6 @@ sub dump {
return $data if defined wantarray;
}
-=head2 format_section( section => 'section.subsection', bare => 1 )
-
-Return a string containing the section/subsection header, formatted
-as it should appear in a config file. If C<bare> is true, the returned
-value is not followed be a newline.
-
-=cut
-
sub format_section {
my $self = shift;
@@ -724,14 +490,6 @@ sub format_section {
}
}
-=head2 format_definition( key => 'str', value => 'str', bare => 1 )
-
-Return a string containing the key/value pair as they should be printed in the
-config file. If C<bare> is true, the returned value is not tab-indented nor
-followed by a newline.
-
-=cut
-
sub format_definition {
my $self = shift;
my %args = (
@@ -750,27 +508,6 @@ sub format_definition {
return $ret;
}
-=head2 set( key => "section.foo", value => "bar", filename => File::Spec->catfile(qw/home user/, "." . $config->confname, filter => 'regex$', as => 'bool', replace_all => 1 )
-
-Sets the key C<foo> in the configuration section C<section> to the value C<bar>
-in the given filename. It's necessary to specify the filename since the
-C<confname> attribute is not unambiguous enough to determine where to write to.
-(There may be multiple config files in different directories which inherit.)
-
-Replaces values if C<key> already exists.
-
-To unset a key, pass in C<key> but not C<value>.
-
-If C<as> is specified as C<bool>, 'true' or 'false' will be written to the
-config file if the given value is a valid bool. If C<int> or C<num> are
-specified, only valid ints or nums will be written. An exception is
-thrown otherwise.
-
-Returns true on success, false if the filename was unopenable and thus no
-set was performed.
-
-=cut
-
sub set {
my $self = shift;
my (%args) = (
@@ -959,21 +696,6 @@ sub _write_config {
or die "Can't rename ${filename}.lock to ${filename}: $!\n";
}
-=head2 rename_section( from => 'name.subname', to => 'new.subnew', filename => '/file/to/edit' )
-
-Rename the section existing in C<filename> given by C<from> to the section
-given by C<to>.
-
-Throws an exception C<no such section> if the section in C<from> doesn't exist
-in C<filename>.
-
-If no value is given for C<to>, the section is removed instead of renamed.
-
-Returns true on success, false if C<filename> was un-openable and thus
-the rename did nothing.
-
-=cut
-
sub rename_section {
my $self = shift;
@@ -1070,18 +792,6 @@ sub rename_section {
return $self->_write_config($args{filename}, $c);
}
-=head2 remove_section( section => 'section.subsection', filename => '/file/to/edit/ )
-
-Remove the given section and all key/value pairs in that section from the file
-given by C<filename>.
-
-If C<section> does not exist in C<filename>, an exception is thrown.
-
-Returns true on success, false if C<filename> was un-openable and thus
-the rename did nothing.
-
-=cut
-
sub remove_section {
my $self = shift;
@@ -1102,6 +812,481 @@ sub remove_section {
__END__
+=head1 NAME
+
+Config::GitLike - git-compatible config file parsing
+
+=head1 SYNOPSIS
+
+This module parses git-style config files, which look like this:
+
+ [core]
+ repositoryformatversion = 0
+ filemode = true
+ bare = false
+ logallrefupdates = true
+ [remote "origin"]
+ url = spang.cc:/srv/git/home.git
+ fetch = +refs/heads/*:refs/remotes/origin/*
+ [another-section "subsection"]
+ key = test
+ key = multiple values are OK
+ emptyvalue =
+ novalue
+
+Code that uses this config module might look like:
+
+ use Config::GitLike;
+
+ my $c = Config::GitLike->new(confname => 'config');
+ $c->load;
+
+ $c->get( key => 'section.name' );
+ # make the return value a Perl true/false value
+ $c->get( key => 'core.filemode', as => 'bool' );
+
+ # replace the old value
+ $c->set(
+ key => 'section.name',
+ value => 'val1',
+ filename => '/home/user/.config',
+ );
+
+ # make this key have multiple values rather than replacing the
+ # old value
+ $c->set(
+ key => 'section.name',
+ value => 'val2',
+ filename => '/home/user/.config',
+ multiple => 1,
+ );
+
+ # replace all occurrences of the old value for section.name with a new one
+ $c->set(
+ key => 'section.name',
+ value => 'val3',
+ filename => '/home/user/.config',
+ multiple => 1,
+ replace_all => 1,
+ );
+
+ # get only the value of 'section.name' that matches '2'
+ $c->get( key => 'section.name', filter => '2' );
+ $c->get_all( key => 'section.name' );
+ # prefixing a search regexp with a ! negates it
+ $c->get_regexp( key => '!na' );
+
+ $c->rename_section(
+ from => 'section',
+ to => 'new-section',
+ filename => '/home/user/.config'
+ );
+
+ $c->remove_section(
+ section => 'section',
+ filename => '/home/user/.config'
+ );
+
+ # unsets all instances of the given key
+ $c->set( key => 'section.name', filename => '/home/user/.config' );
+
+ my %config_vals = $config->dump;
+ # string representation of config data
+ my $str = $config->dump;
+ # prints rather than returning
+ $config->dump;
+
+=head1 DESCRIPTION
+
+This module handles interaction with configuration files of the style used
+by the version control system Git. It can both parse and modify these
+files, as well as create entirely new ones.
+
+You only need to know a few things about the configuration format in order
+to use this module. First, a configuration file is made up of key/value
+pairs. Every key must be contained in a section. Sections can have
+subsections, but they don't have to. For the purposes of setting and
+getting configuration variables, we join the section name,
+subsection name, and variable name together with dots to get a key
+name that looks like "section.subsection.variable". These are the
+strings that you'll be passing in to C<key> arguments.
+
+Configuration files inherit from each other. By default, C<Config::GitLike>
+loads data from a system-wide configuration file, a per-user
+configuration file, and a per-directory configuration file, but by
+subclassing and overriding methods you can obtain any combination of
+configuration files. By default, configuration files that don't
+exist are just skipped.
+
+See
+L<http://www.kernel.org/pub/software/scm/git/docs/git-config.html#_configuration_file>
+for details on the syntax of git configuration files. We won't waste pixels
+on the nitty gritty here.
+
+While the behaviour of a couple of this module's methods differ slightly
+from the C<git config> equivalents, this module can read any config file
+written by git, and git can write any config file written by this module.
+
+This is an object-oriented module using L<Any::Moose|Any::Moose>. All
+subroutines are object method calls.
+
+A few methods have arguments that are always used for the same purpose:
+
+=head2 Filenames
+
+All methods that change things in a configuration file require a filename to
+write to, via the C<filename> argument. Since a C<Config::GitLike> object can
+be working with multiple config files that inherit from each other, we don't
+try to figure out which one to write to automatically and let you specify
+instead.
+
+=head2 Casting
+
+All get and set methods can make sure the values they're returning or
+setting are valid values of a certain type: C<bool>, C<int>,
+C<num>, or C<bool-or-int> (or at least as close as Perl can get
+to having these types). Do this by passing one of these types
+in via the C<as> argument. The set method, if told to write
+bools, will always write "true" or "false" (not anything else that
+C<cast> considers a valid bool).
+
+Methods that are told to cast values will throw exceptions if
+the values they're trying to cast aren't valid values of the
+given type.
+
+See the L<cast|/"cast( value =E<gt> 'foo', as => 'int', human =E<gt> 1 )">
+method documentation for more on what is considered valid for
+each type.
+
+=head2 Filtering
+
+All get and set methods can filter what values they return via their
+C<filter> argument, which is expected to be a string that is a valid
+regex. If you want to filter items OUT instead of IN, you can
+prefix your regex with a ! and that'll do the trick.
+
+Now, on the the methods!
+
+=head1 MAIN METHODS
+
+There are the methods you're likely to use the most.
+
+=head2 new( confname => 'config' )
+
+Create a new configuration object with the base config name C<confname>.
+
+C<confname> is used to construct the filenames that will be loaded; by
+default, these are C</etc/confname> (global configuration file),
+C<~/.confname> (user configuration file), and C<<Cwd>/.confname> (directory
+configuration file).
+
+You can override these defaults by subclassing C<Config::GitLike> and
+overriding the methods C<global_file>, C<user_file>, and C<dir_file>. (See
+L<"METHODS YOU MAY WISH TO OVERRIDE"> for details.)
+
+=head2 confname
+
+The configuration filename that you passed in when you created
+the C<Config::GitLike> object. You can change it if you want by
+passing in a new name (and then reloading via L<"load">).
+
+=head2 load
+
+Load the global, local, and directory configuration file with the filename
+C<confname>(if they exist). Configuration variables loaded later
+override those loaded earlier, so variables from the directory
+configuration file have the highest precedence.
+
+Returns a hash of all loaded configuration data stored in the module
+after the files have been loaded, as a reference or a hash depending on
+context.
+
+=head2 get
+
+Params:
+
+ key => 'sect.subsect.key'
+ as => 'int'
+ filter => '!foo
+
+Retrieve the config value associated with C<key> cast as an C<as>.
+
+The C<key> option is required (will return undef if unspecified); the C<as>
+option is not (will return a string by default). Sections and subsections
+are specified in the key by separating them from the key name with a .
+character. Sections, subsections, and keys may all be quoted (double or
+single quotes).
+
+If C<key> doesn't exist in the config, undef is returned. Dies with
+the exception "Multiple values" if the given key has more than one
+value associated with it. (Use L<"get_all"> to retrieve multiple values.)
+
+Calls L<"load"> if it hasn't been done already. Note that if you've run any
+C<set> calls to the loaded configuration files since the last time they were
+loaded, you MUST call L<"load"> again before getting, or the returned
+configuration data may not match the configuration variables on-disk.
+
+=head2 get_all
+
+Params:
+
+ key => 'section.sub'
+ filter => 'regex'
+ as => 'int'
+
+Like L<"get"> but does not fail if the number of values for the key is not
+exactly one.
+
+Returns a list of values (or an arrayref in scalar context).
+
+=head2 get_regexp
+
+Params:
+
+ key => 'regex'
+ filter => 'regex'
+ as => 'bool'
+
+Similar to L<"get_all"> but searches for values based on a key regex.
+
+Returns a hash of name/value pairs (or a hashref in scalar context).
+
+=head2 dump
+
+In scalar context, return a string containing all configuration data, sorted in
+ASCII order, in the form:
+
+ section.key=value
+ section2.key=value
+
+If called in void context, this string is printed instead.
+
+In list context, returns a hash containing all the configuration data.
+
+=head2 set
+
+Params:
+
+ key => 'section.name'
+ value => 'bar'
+ filename => File::Spec->catfile(qw/home user/, '.'.$config->confname)
+ filter => 'regex'
+ as => 'bool'
+ multiple => 1
+ replace_all => 1
+
+Set the key C<foo> in the configuration section C<section> to the value C<bar>
+in the given filename.
+
+Replace C<key>'s value if C<key> already exists.
+
+To unset a key, pass in C<key> but not C<value>.
+
+Returns true on success, undef if the filename was unopenable and thus no
+set was performed.
+
+=head3 multiple values
+
+By default, set will replace the old value rather than giving a key multiple
+values. To override this, pass in C<multiple =E<gt> 1>. If you want to replace
+all instances of a multiple-valued key with a new value, you need to pass
+in C<replace_all =E<gt> 1> as well.
+
+=head2 rename_section
+
+Params:
+
+ from => 'name.subname'
+ to => 'new.subname'
+ filename => '/file/to/edit'
+
+Rename the section existing in C<filename> given by C<from> to the section
+given by C<to>.
+
+Throws an exception C<No such section> if the section in C<from> doesn't exist
+in C<filename>.
+
+If no value is given for C<to>, the section is removed instead of renamed.
+
+Returns true on success, false if C<filename> was un-openable and thus
+the rename did nothing.
+
+=head2 remove_section
+
+Params:
+
+ section => 'section.subsection'
+ filename => '/file/to/edit
+
+Just a convenience wrapper around L<"rename_section"> for readability's sake.
+Removes the given section (which you can do by renaming to nothing as well).
+
+=head1 METHODS YOU MAY WISH TO OVERRIDE
+
+If your configuration layout is different from the default, e.g. if
+your home directory config files are in a directory within the
+home directory (like C<~/.git/config>) instead of just
+dot-prefixed, override these methods to return the right
+directory names. For fancier things like altering precedence,
+you'll need to override L<"load"> as well.
+
+=head2 dir_file
+
+Return a string containing the path to a configuration file with the
+name C<confname> in a directory. The directory isn't specified here.
+
+=head2 global_file
+
+Return a string representing the path to a system-wide configuration file with
+name C<confname>.
+
+=head2 user_file
+
+Return a string containing the path to a configuration file
+in the current user's home directory with filename C<confname>.
+
+=head2 load_dirs
+
+Load the configuration file with the filename L<"dir_file"> in the current
+working directory into the C<data> attribute or, if there is no config
+matching C<dir_file> in the current working directory, walk up the directory
+tree until one is found. (No error is thrown if none is found.)
+
+Returns nothing of note.
+
+=head1 OTHER METHODS
+
+These are mostly used internally, but hey, maybe you'll need them for
+something.
+
+=head2 set_multiple( $name )
+
+Mark the key string C<$name> as containing multiple values.
+
+Returns nothing.
+
+=head2 is_multiple( $name )
+
+Return a true value if the key string C<$name> contains multiple values; false
+otherwise.
+
+=head2 load_global
+
+If a global configuration file with the absolute name given by
+L<"global_file"> exists, load its configuration variables into memory.
+
+Returns the current contents of all the loaded configuration variables
+after the file has been loaded, or undef if no global config file is found.
+
+=head2 load_user
+
+If a configuration file with the absolute name given by
+L<"user_file"> exists, load its config variables into memory.
+
+Returns the current contents of all the loaded configuration variables
+after the file has been loaded, or undef if no user config file is found.
+
+=head2 load_file( $filename )
+
+Takes a string containing the path to a file, opens it if it exists, loads its
+config variables into memory, and returns the currently loaded config
+variables (a hashref).
+
+=head2 parse_content
+
+Parameters:
+
+ content => 'str'
+ callback => sub {}
+ error => sub {}
+
+Takes arguments consisting of C<content>, a string of the content of the
+configuration file to be parsed, C<callback>, a submethod to run on information
+retrieved from the config file (headers, subheaders, and key/value pairs), and
+C<error>, a submethod to run on malformed content. Parses the given content
+and runs callbacks as it finds valid information.
+
+Returns undef on success and C<error($content)> on failure.
+
+C<callback> is called like:
+
+ callback(section => $str, offset => $num, length => $num, name => $str, value => $str)
+
+C<name> and C<value> may be omitted if the callback is not being called on a
+key/value pair, or if it is being called on a key with no value.
+
+C<error> is called like:
+
+ error( content => $content, offset => $offset )
+
+=head2 define
+
+Params:
+
+ section => 'str'
+ name => 'str'
+ value => 'str'
+
+Given a section, a key name, and a value¸ store this information
+in memory in the config object.
+
+Returns the value that was just defined on success, or undef
+if no name is given and thus the key cannot be defined.
+
+=head2 cast
+
+Params:
+
+ value => 'foo'
+ as => 'int'
+ human => 1
+
+Return C<value> cast into the type specified by C<as>.
+
+Valid values for C<as> are C<bool>, C<int>, C<num>, or C<bool-or-num>. For
+C<bool>, C<true>, C<yes>, C<on>, C<1>, and undef are translated into a true
+value (for Perl); anything else is false. Specifying a true value for the
+C<human> arg will get you a human-readable 'true' or 'false' rather than a
+value that plays along with Perl's definition of truthiness (0 or 1).
+
+For C<int>s and C<num>s, if C<value> ends in C<k>, C<m>, or C<g>, it will be
+multiplied by 1024, 1048576, and 1073741824, respectively, before being
+returned. C<int>s are truncated after being multiplied, if they have
+a decimal portion.
+
+C<bool-or-int>, as you might have guessed, gives you either
+a bool or an int depending on which one applies.
+
+If C<as> is unspecified, C<value> is returned unchanged.
+
+=head2 format_section
+
+Params:
+
+ section => 'section.subsection'
+ base => 1
+
+Return a string containing the section/subsection header, formatted
+as it should appear in a config file. If C<bare> is true, the returned
+value is not followed be a newline.
+
+=head2 format_definition
+
+Params:
+
+ key => 'str'
+ value => 'str'
+ bare => 1
+
+Return a string containing the key/value pair as they should be printed in the
+config file. If C<bare> is true, the returned value is not tab-indented nor
+followed by a newline.
+
+=head1 SEE ALSO
+
+L<http://www.kernel.org/pub/software/scm/git/docs/git-config.html#_configuration_file>,
+<Config::GitLike::Cascaded|Config::GitLike::Cascaded>
+
=head1 LICENSE
You may modify and/or redistribute this software under the same terms
diff --git a/lib/Config/GitLike/Cascaded.pm b/lib/Config/GitLike/Cascaded.pm
index e58506a..4eb6b5b 100644
--- a/lib/Config/GitLike/Cascaded.pm
+++ b/lib/Config/GitLike/Cascaded.pm
@@ -15,10 +15,24 @@ Config::GitLike::Cascaded - git-like config file parsing with cascaded inheritan
=head1 SYNOPSIS
+B<Stop!> Do not pass go! Go directly to L<Config::GitLike> and read that
+instead. This is a minor variation on that which changes how the configuration
+loading works. Everything else is exactly the same. Just swap in
+C<Config::GitLike::Cascaded> where it reads C<Config::GitLike>.
+
=head1 DESCRIPTION
+The only difference between this module and C<Config::GitLike> as that
+when it's loading the configuration file in the current directory, it
+keeps walking the directory tree even if it finds a config file,
+whereas C<Config::GitLike> will stop after finding the first.
+
+This allows us to have interesting cascading configuration inheritance.
+
=head1 METHODS
+This module overrides this method from C<Config::GitLike>:
+
=head2 load_dirs
Load the configuration files in the directory tree, starting with the root
@@ -47,6 +61,10 @@ no Moose;
__END__
+=head1 SEE ALSO
+
+<Config::GitLike|Config::GitLike>
+
=head1 LICENSE
You may modify and/or redistribute this software under the same terms
commit 0a5effe1025c0abf7caf51dee11016849c3d98d7
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 18:26:10 2009 +0300
saw something in the git config doc that I thought we should test
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index f54e569..fb1e7b2 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -2,7 +2,7 @@ use strict;
use warnings;
use File::Copy;
-use Test::More tests => 92;
+use Test::More tests => 93;
use Test::Exception;
use File::Spec;
use File::Temp;
@@ -1100,3 +1100,12 @@ is_deeply(
'get_all casting works'
);
+# we don't strip the quotes on this, right?
+$config->set(
+ key => 'test.foo',
+ value => '"ssh" for "kernel.org"',
+ filename => $config_filename,
+);
+$config->load;
+is( $config->get( key => 'test.foo' ), '"ssh" for "kernel.org"',
+ "don't strip quotes contained in value" );
commit d7d517fe0b5802fbe9641c985c06743fb2647623
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 18:27:01 2009 +0300
add version number to Makefile.PL
diff --git a/Makefile.PL b/Makefile.PL
index 6a0fc0b..e662f82 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,5 +1,6 @@
use inc::Module::Install;
license('perl');
+version('1.0');
all_from('lib/Config/GitLike.pm');
commit d72189b9e61b3b7b4c70ac3418e6dbea20996a5e
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 18:27:51 2009 +0300
add some more files to .gitignore
diff --git a/.gitignore b/.gitignore
index 259feb8..b23e3ee 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1 +1,4 @@
pm_to_blib
+Makefile
+Makefile.old
+*.tmp
commit 1096e5d38789309d9adb994955613fc53a855e2f
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 18:31:58 2009 +0300
fix broken pod
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index d9708ac..346510a 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -954,9 +954,8 @@ Methods that are told to cast values will throw exceptions if
the values they're trying to cast aren't valid values of the
given type.
-See the L<cast|/"cast( value =E<gt> 'foo', as => 'int', human =E<gt> 1 )">
-method documentation for more on what is considered valid for
-each type.
+See the L<"cast"> method documentation for more on what is considered valid
+for each type.
=head2 Filtering
commit 43986aaa2dc7caa6adc9fd4404755d5ad5005ea7
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 18:43:50 2009 +0300
not cuddling elsif/else seems to make this look a bit cleaner
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 346510a..1489cfb 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -87,7 +87,8 @@ sub load_global {
sub user_file {
my $self = shift;
- return File::Spec->catfile( File::HomeDir->my_home, "." . $self->confname );
+ return
+ File::Spec->catfile( File::HomeDir->my_home, "." . $self->confname );
}
sub load_user {
@@ -157,7 +158,8 @@ sub parse_content {
# contain any character except newline, " and \ must be escaped
# - rules for subsections with section.subsection alternate syntax:
# same rules as for sections
- } elsif ($c =~ s/\A\[([0-9a-z.-]+)(?:[\t ]*"([^\n]*?)")?\]//im) {
+ }
+ elsif ($c =~ s/\A\[([0-9a-z.-]+)(?:[\t ]*"([^\n]*?)")?\]//im) {
$section = lc $1;
return $args{error}->(
content => $args{content},
@@ -173,7 +175,8 @@ sub parse_content {
);
# keys followed by a unlimited whitespace and (optionally) a comment
# (no value)
- } elsif ($c =~ s/\A([0-9a-z-]+)[\t ]*([#;].*)?$//im) {
+ }
+ elsif ($c =~ s/\A([0-9a-z-]+)[\t ]*([#;].*)?$//im) {
$args{callback}->(
section => $section,
name => $1,
@@ -182,7 +185,8 @@ sub parse_content {
);
# key/value pairs (this particular regex matches only the key part and
# the =, with unlimited whitespace around the =)
- } elsif ($c =~ s/\A([0-9a-z-]+)[\t ]*=[\t ]*//im) {
+ }
+ elsif ($c =~ s/\A([0-9a-z-]+)[\t ]*=[\t ]*//im) {
my $name = $1;
my $value = "";
# parse the value
@@ -190,26 +194,33 @@ sub parse_content {
# comment or no content left on line
if ($c =~ s/\A([ \t]*[#;].*?)?$//im) {
last;
+ }
# any amount of whitespace between words becomes a single space
- } elsif ($c =~ s/\A[\t ]+//im) {
+ elsif ($c =~ s/\A[\t ]+//im) {
$value .= ' ';
+ }
# line continuation (\ character followed by new line)
- } elsif ($c =~ s/\A\\\r?\n//im) {
+ elsif ($c =~ s/\A\\\r?\n//im) {
next;
+ }
# escaped quote characters are part of the value
- } elsif ($c =~ s/\A\\(['"])//im) {
+ elsif ($c =~ s/\A\\(['"])//im) {
$value .= $1;
+ }
# escaped newline in config is translated to actual newline
- } elsif ($c =~ s/\A\\n//im) {
+ elsif ($c =~ s/\A\\n//im) {
$value .= "\n";
+ }
# escaped tab in config is translated to actual tab
- } elsif ($c =~ s/\A\\t//im) {
+ elsif ($c =~ s/\A\\t//im) {
$value .= "\t";
+ }
# escaped backspace in config is translated to actual backspace
- } elsif ($c =~ s/\A\\b//im) {
+ elsif ($c =~ s/\A\\b//im) {
$value .= "\b";
+ }
# quote-delimited value (possibly containing escape codes)
- } elsif ($c =~ s/\A"([^"\\]*(?:(?:\\\n|\\[tbn"\\])[^"\\]*)*)"//im) {
+ elsif ($c =~ s/\A"([^"\\]*(?:(?:\\\n|\\[tbn"\\])[^"\\]*)*)"//im) {
my $v = $1;
# remove all continuations (\ followed by a newline)
$v =~ s/\\\n//g;
@@ -222,11 +233,13 @@ sub parse_content {
# swap escaped \ with actual \
$v =~ s/\\\\/\\/g;
$value .= $v;
+ }
# valid value (no escape codes)
- } elsif ($c =~ s/\A([^\t \\\n]+)//im) {
+ elsif ($c =~ s/\A([^\t \\\n]+)//im) {
$value .= $1;
# unparseable
- } else {
+ }
+ else {
# Note that $args{content} is the _original_
# content, not the nibbled $c, which is the
# remaining unparsed content
@@ -243,11 +256,13 @@ sub parse_content {
offset => $offset,
length => ($length - length($c)) - $offset,
);
+ }
# end of content string; all done now
- } elsif (not length $c) {
+ elsif (not length $c) {
last;
+ }
# unparseable
- } else {
+ else {
# Note that $args{content} is the _original_ content, not
# the nibbled $c, which is the remaining unparsed content
return $args{error}->(
@@ -271,10 +286,12 @@ sub define {
my $key = join(".", grep {defined} @args{qw/section name/});
if ($self->is_multiple($key)) {
push @{$self->data->{$key} ||= []}, $args{value};
- } elsif (exists $self->data->{$key}) {
+ }
+ elsif (exists $self->data->{$key}) {
$self->set_multiple($key);
$self->data->{$key} = [$self->data->{$key}, $args{value}];
- } else {
+ }
+ else {
$self->data->{$key} = $args{value};
}
}
@@ -297,12 +314,15 @@ sub cast {
if (defined $args{as} && $args{as} eq 'bool-or-int') {
if ( $args{value} =~ NUM_REGEX ) {
$args{as} = 'int';
- } elsif ( $args{value} =~ BOOL_TRUE_REGEX ||
+ }
+ elsif ( $args{value} =~ BOOL_TRUE_REGEX ||
$args{value} =~ BOOL_FALSE_REGEX ) {
$args{as} = 'bool';
- } elsif ( !defined $args{value} ) {
+ }
+ elsif ( !defined $args{value} ) {
$args{as} = 'bool';
- } else {
+ }
+ else {
die "Invalid bool-or-int '$args{value}'\n";
}
}
@@ -314,19 +334,24 @@ sub cast {
if ( $v =~ BOOL_TRUE_REGEX ) {
if ( $args{human} ) {
return 'true';
- } else {
+ }
+ else {
return 1;
}
- } elsif ($v =~ BOOL_FALSE_REGEX ) {
+ }
+ elsif ($v =~ BOOL_FALSE_REGEX ) {
if ( $args{human} ) {
return 'false';
- } else {
+ }
+ else {
return 0;
}
- } else {
+ }
+ else {
die "Invalid bool '$args{value}'\n";
}
- } elsif ($args{as} =~ /int|num/) {
+ }
+ elsif ($args{as} =~ /int|num/) {
die "Invalid unit while casting to $args{as}\n"
unless $v =~ NUM_REGEX;
@@ -360,7 +385,8 @@ sub get {
if (defined $args{filter}) {
if ($args{filter} =~ s/^!//) {
@results = grep { !/$args{filter}/i } @{$v};
- } else {
+ }
+ else {
@results = grep { m/$args{filter}/i } @{$v};
}
}
@@ -402,7 +428,8 @@ sub get_all {
if (defined $args{filter}) {
if ($args{filter} =~ s/^!//) {
@v = grep { !/$args{filter}/i } @v;
- } else {
+ }
+ else {
@v = grep { m/$args{filter}/i } @v;
}
}
@@ -434,7 +461,8 @@ sub get_regexp {
if ($args{filter} =~ s/^!//) {
map { delete $results{$_} if $results{$_} =~ m/$args{filter}/i }
keys %results;
- } else {
+ }
+ else {
map { delete $results{$_} if $results{$_} !~ m/$args{filter}/i }
keys %results;
}
@@ -455,12 +483,14 @@ sub dump {
my $str;
if (defined $self->data->{$key}) {
$str = "$key=".$self->data->{$key}."\n";
- } else {
+ }
+ else {
$str = "$key\n";
}
if (!defined wantarray) {
print $str;
- } else {
+ }
+ else {
$data .= $str;
}
}
@@ -483,7 +513,8 @@ sub format_section {
my $ret = qq|[$section "$subsection"]|;
$ret .= "\n" unless $args{bare};
return $ret;
- } else {
+ }
+ else {
my $ret = qq|[$args{section}]|;
$ret .= "\n" unless $args{bare};
return $ret;
@@ -572,10 +603,12 @@ sub set {
my $filter = $args{filter};
if ($filter =~ s/^!//) {
$matched = 1 if ($got{value} !~ m/$filter/i);
- } elsif ($got{value} =~ m/$filter/i) {
+ }
+ elsif ($got{value} =~ m/$filter/i) {
$matched = 1;
}
- } else {
+ }
+ else {
$matched = 1;
}
}
@@ -620,7 +653,8 @@ sub set {
bare => 1,
),
);
- } elsif (defined $new) {
+ }
+ elsif (defined $new) {
# Adding a new value to the end of an existing block
substr(
$c,
@@ -631,12 +665,14 @@ sub set {
value => $args{value}
)
);
- } else {
+ }
+ else {
# Adding a new section
$c .= $self->format_section( section => $section );
$c .= $self->format_definition( key => $key, value => $args{value} );
}
- } else {
+ }
+ else {
# Removing an existing value (unset / unset-all)
die "No occurrence of $args{key} found to unset in $args{filename}\n"
unless @replace;
@@ -735,7 +771,8 @@ sub rename_section {
$replace[-1]->{length} += ($got{offset} + $got{length})
- ($replace[-1]{offset} + $replace[-1]->{length});
}
- } else {
+ }
+ else {
# if we're removing rather than replacing, increase
# the length of the previous match so when it's
# replaced it will kill all the way up to the
@@ -748,7 +785,8 @@ sub rename_section {
$got{length}, section_is_last => 1};
$prev_matched = 1;
}
- } else {
+ }
+ else {
# if we're removing rather than replacing and there was
# a previous section match, increase its length to kill all
# the way up to this non-matching section (takes care
commit 8600edb52019bc0946c903be8e7875cc5c988ac5
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 18:48:44 2009 +0300
comment about killing leading whitespace on section removes
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 1489cfb..a6cb88f 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -776,7 +776,9 @@ sub rename_section {
# if we're removing rather than replacing, increase
# the length of the previous match so when it's
# replaced it will kill all the way up to the
- # beginning of this next section
+ # beginning of this next section (this will kill
+ # any leading whitespace on the line of the
+ # next section, but that's OK)
$replace[-1]->{length} += $got{offset} -
($replace[-1]->{offset} + $replace[-1]->{length})
if @replace && $prev_matched && !defined($args{to});
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index fb1e7b2..e5de39c 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -665,6 +665,9 @@ lives_ok {
}
'remove section';
+# we kill leading whitespace on section removes because it makes
+# the implementation easier (can just kill all the way up to
+# the following section or the end of the file)
$expect = <<'EOF'
# Hallo
#Bello
commit ac0ff67b553ea639edccb5a19ad1966001850472
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 18:50:48 2009 +0300
BUGS section in pod
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index a6cb88f..b5d3f35 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -1321,6 +1321,15 @@ Return a string containing the key/value pair as they should be printed in the
config file. If C<bare> is true, the returned value is not tab-indented nor
followed by a newline.
+=head1 BUGS
+
+If you find any bugs in this module, report them at:
+
+ http://rt.cpan.org/
+
+Include the version of the module you're using and any relevant problematic
+configuration files or code snippets.
+
=head1 SEE ALSO
L<http://www.kernel.org/pub/software/scm/git/docs/git-config.html#_configuration_file>,
commit 2136cf41ffdee5f03c5397366322a9a388131e5b
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 18:53:40 2009 +0300
test int/num casting
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index e5de39c..d460617 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -2,7 +2,7 @@ use strict;
use warnings;
use File::Copy;
-use Test::More tests => 93;
+use Test::More tests => 95;
use Test::Exception;
use File::Spec;
use File::Temp;
@@ -1112,3 +1112,17 @@ $config->set(
$config->load;
is( $config->get( key => 'test.foo' ), '"ssh" for "kernel.org"',
"don't strip quotes contained in value" );
+
+$config->set(
+ key => 'test.foo',
+ value => '1.542',
+ filename => $config_filename,
+);
+$config->load;
+
+# test difference between int/num casting, since git config doesn't
+# do num
+is( $config->get( key => 'test.foo', as => 'int' ), 1,
+ 'int casting truncates');
+is( $config->get( key => 'test.foo', as => 'num' ), 1.542,
+ 'num casting doesn\'t truncate');
commit c4bc9d9c768072c6251096bca8836f8445327a12
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 19:07:04 2009 +0300
minor doc fixes
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index b5d3f35..95c25dd 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -50,7 +50,7 @@ sub load {
$self->load_global;
$self->load_user;
$self->load_dirs( $path );
- return wantarray? %{$self->data} : $self->data;
+ return wantarray ? %{$self->data} : \%{$self->data};
}
sub dir_file {
@@ -580,8 +580,8 @@ sub set {
return;
}
- # returns if the file can't be opened, since that means nothing to
- # set/unset
+ # returns if the file can't be opened, since this just means create a
+ # new file
my $c = $self->_read_config($args{filename});
my $new;
@@ -970,12 +970,12 @@ written by git, and git can write any config file written by this module.
This is an object-oriented module using L<Any::Moose|Any::Moose>. All
subroutines are object method calls.
-A few methods have arguments that are always used for the same purpose:
+A few methods have parameters that are always used for the same purpose:
=head2 Filenames
All methods that change things in a configuration file require a filename to
-write to, via the C<filename> argument. Since a C<Config::GitLike> object can
+write to, via the C<filename> parameter. Since a C<Config::GitLike> object can
be working with multiple config files that inherit from each other, we don't
try to figure out which one to write to automatically and let you specify
instead.
@@ -986,7 +986,7 @@ All get and set methods can make sure the values they're returning or
setting are valid values of a certain type: C<bool>, C<int>,
C<num>, or C<bool-or-int> (or at least as close as Perl can get
to having these types). Do this by passing one of these types
-in via the C<as> argument. The set method, if told to write
+in via the C<as> parameter. The set method, if told to write
bools, will always write "true" or "false" (not anything else that
C<cast> considers a valid bool).
@@ -1000,7 +1000,7 @@ for each type.
=head2 Filtering
All get and set methods can filter what values they return via their
-C<filter> argument, which is expected to be a string that is a valid
+C<filter> parameter, which is expected to be a string that is a valid
regex. If you want to filter items OUT instead of IN, you can
prefix your regex with a ! and that'll do the trick.
@@ -1036,19 +1036,19 @@ C<confname>(if they exist). Configuration variables loaded later
override those loaded earlier, so variables from the directory
configuration file have the highest precedence.
-Returns a hash of all loaded configuration data stored in the module
-after the files have been loaded, as a reference or a hash depending on
-context.
+Returns a hash copy of all loaded configuration data stored in the module
+after the files have been loaded, or a hashref to this hash in
+scalar context.
=head2 get
-Params:
+Parameters:
key => 'sect.subsect.key'
as => 'int'
filter => '!foo
-Retrieve the config value associated with C<key> cast as an C<as>.
+Return the config value associated with C<key> cast as an C<as>.
The C<key> option is required (will return undef if unspecified); the C<as>
option is not (will return a string by default). Sections and subsections
@@ -1067,7 +1067,7 @@ configuration data may not match the configuration variables on-disk.
=head2 get_all
-Params:
+Parameters:
key => 'section.sub'
filter => 'regex'
@@ -1080,7 +1080,7 @@ Returns a list of values (or an arrayref in scalar context).
=head2 get_regexp
-Params:
+Parameters:
key => 'regex'
filter => 'regex'
@@ -1104,7 +1104,7 @@ In list context, returns a hash containing all the configuration data.
=head2 set
-Params:
+Parameters:
key => 'section.name'
value => 'bar'
@@ -1121,8 +1121,7 @@ Replace C<key>'s value if C<key> already exists.
To unset a key, pass in C<key> but not C<value>.
-Returns true on success, undef if the filename was unopenable and thus no
-set was performed.
+Returns true on success.
=head3 multiple values
@@ -1133,7 +1132,7 @@ in C<replace_all =E<gt> 1> as well.
=head2 rename_section
-Params:
+Parameters:
from => 'name.subname'
to => 'new.subname'
@@ -1147,12 +1146,12 @@ in C<filename>.
If no value is given for C<to>, the section is removed instead of renamed.
-Returns true on success, false if C<filename> was un-openable and thus
+Returns true on success, false if C<filename> didn't exist and thus
the rename did nothing.
=head2 remove_section
-Params:
+Parameters:
section => 'section.subsection'
filename => '/file/to/edit
@@ -1162,12 +1161,11 @@ Removes the given section (which you can do by renaming to nothing as well).
=head1 METHODS YOU MAY WISH TO OVERRIDE
-If your configuration layout is different from the default, e.g. if
-your home directory config files are in a directory within the
-home directory (like C<~/.git/config>) instead of just
-dot-prefixed, override these methods to return the right
-directory names. For fancier things like altering precedence,
-you'll need to override L<"load"> as well.
+If your application's configuration layout is different from the default, e.g.
+if its home directory config files are in a directory within the home
+directory (like C<~/.git/config>) instead of just dot-prefixed, override these
+methods to return the right directory names. For fancier things like altering
+precedence, you'll need to override L<"load"> as well.
=head2 dir_file
@@ -1176,8 +1174,8 @@ name C<confname> in a directory. The directory isn't specified here.
=head2 global_file
-Return a string representing the path to a system-wide configuration file with
-name C<confname>.
+Return the string C</etc/confname>, the absolute name of the system-wide
+configuration file with name C<confname>.
=head2 user_file
@@ -1187,27 +1185,15 @@ in the current user's home directory with filename C<confname>.
=head2 load_dirs
Load the configuration file with the filename L<"dir_file"> in the current
-working directory into the C<data> attribute or, if there is no config
-matching C<dir_file> in the current working directory, walk up the directory
-tree until one is found. (No error is thrown if none is found.)
+working directory into the memory or, if there is no config matching
+C<dir_file> in the current working directory, walk up the directory tree until
+one is found. (No error is thrown if none is found.)
Returns nothing of note.
=head1 OTHER METHODS
-These are mostly used internally, but hey, maybe you'll need them for
-something.
-
-=head2 set_multiple( $name )
-
-Mark the key string C<$name> as containing multiple values.
-
-Returns nothing.
-
-=head2 is_multiple( $name )
-
-Return a true value if the key string C<$name> contains multiple values; false
-otherwise.
+These are mostly used internally in other methods, but could be useful anyway.
=head2 load_global
@@ -1239,13 +1225,10 @@ Parameters:
callback => sub {}
error => sub {}
-Takes arguments consisting of C<content>, a string of the content of the
-configuration file to be parsed, C<callback>, a submethod to run on information
-retrieved from the config file (headers, subheaders, and key/value pairs), and
-C<error>, a submethod to run on malformed content. Parses the given content
-and runs callbacks as it finds valid information.
+Parses the given content and runs callbacks as it finds valid information.
-Returns undef on success and C<error($content)> on failure.
+Returns undef on success and C<error($content)> (the original content) on
+failure.
C<callback> is called like:
@@ -1258,9 +1241,22 @@ C<error> is called like:
error( content => $content, offset => $offset )
+Where C<offset> is the point in the content where the parse error occurred.
+
+=head2 set_multiple( $name )
+
+Mark the key string C<$name> as containing multiple values.
+
+Returns nothing.
+
+=head2 is_multiple( $name )
+
+Return a true value if the key string C<$name> contains multiple values; false
+otherwise.
+
=head2 define
-Params:
+Parameters:
section => 'str'
name => 'str'
@@ -1274,7 +1270,7 @@ if no name is given and thus the key cannot be defined.
=head2 cast
-Params:
+Parameters:
value => 'foo'
as => 'int'
@@ -1300,7 +1296,7 @@ If C<as> is unspecified, C<value> is returned unchanged.
=head2 format_section
-Params:
+Parameters:
section => 'section.subsection'
base => 1
@@ -1311,7 +1307,7 @@ value is not followed be a newline.
=head2 format_definition
-Params:
+Parameters:
key => 'str'
value => 'str'
@@ -1333,7 +1329,7 @@ configuration files or code snippets.
=head1 SEE ALSO
L<http://www.kernel.org/pub/software/scm/git/docs/git-config.html#_configuration_file>,
-<Config::GitLike::Cascaded|Config::GitLike::Cascaded>
+L<Config::GitLike::Cascaded|Config::GitLike::Cascaded>
=head1 LICENSE
@@ -1346,5 +1342,5 @@ Copyright 2009 Best Practical Solutions, LLC
=head1 AUTHORS
-Alex Vandiver <alexmv at bestpractical.com>
+Alex Vandiver <alexmv at bestpractical.com>,
Christine Spang <spang at bestpractical.com>
diff --git a/lib/Config/GitLike/Cascaded.pm b/lib/Config/GitLike/Cascaded.pm
index 4eb6b5b..f05936f 100644
--- a/lib/Config/GitLike/Cascaded.pm
+++ b/lib/Config/GitLike/Cascaded.pm
@@ -15,7 +15,7 @@ Config::GitLike::Cascaded - git-like config file parsing with cascaded inheritan
=head1 SYNOPSIS
-B<Stop!> Do not pass go! Go directly to L<Config::GitLike> and read that
+B<Stop!> Do not pass go! Go directly to L<Config::GitLike|Config::GitLike> and read that
instead. This is a minor variation on that which changes how the configuration
loading works. Everything else is exactly the same. Just swap in
C<Config::GitLike::Cascaded> where it reads C<Config::GitLike>.
@@ -63,7 +63,7 @@ __END__
=head1 SEE ALSO
-<Config::GitLike|Config::GitLike>
+L<Config::GitLike|Config::GitLike>
=head1 LICENSE
@@ -76,5 +76,5 @@ Copyright 2009 Best Practical Solutions, LLC
=head1 AUTHORS
-Alex Vandiver <alexmv at bestpractical.com>
+Alex Vandiver <alexmv at bestpractical.com>,
Christine Spang <spang at bestpractical.com>
commit 7a857801d2edf3e7f37a68b52654b9fba36e98c3
Author: Christine Spang <spang at mit.edu>
Date: Thu Jun 11 19:09:14 2009 +0300
point out in the synopsis that you need to ->load before a ->get after a ->set
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 95c25dd..92c0a56 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -910,6 +910,10 @@ Code that uses this config module might look like:
replace_all => 1,
);
+ # make sure to reload the config files before reading if you've set
+ # any variables!
+ $c->load;
+
# get only the value of 'section.name' that matches '2'
$c->get( key => 'section.name', filter => '2' );
$c->get_all( key => 'section.name' );
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list