[Bps-public-commit] Config-GitLike branch, master, updated. 9787096ee4f6d9669bf16e6f8ad18b384a310231
spang at bestpractical.com
spang at bestpractical.com
Wed Jun 10 07:46:40 EDT 2009
The branch, master has been updated
via 9787096ee4f6d9669bf16e6f8ad18b384a310231 (commit)
via 7e9f53a1aff64b09a40716b1b768d6e95c1ede4a (commit)
via b6a7884b993a4e2a0639fee2a878e0dffd167029 (commit)
from 3df0a00ef787e9cc52850eeef9258124edd8a8d8 (commit)
Summary of changes:
lib/Config/GitLike.pm | 205 ++++++++++++++++++++++++++++++++++---------------
t/t1300-repo-config.t | 207 +++++++++++++++++++++----------------------------
2 files changed, 231 insertions(+), 181 deletions(-)
- Log -----------------------------------------------------------------
commit b6a7884b993a4e2a0639fee2a878e0dffd167029
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 9 15:30:44 2009 +0300
filter for set
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 6cc592c..6dab4f1 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -781,7 +781,9 @@ sub set {
$new = $got{offset} + $got{length};
return unless defined $got{name};
push @replace, {offset => $got{offset}, length => $got{length}}
- if lc $key eq lc $got{name};
+ if lc $key eq lc $got{name}
+ && (!defined($args{filter}) ||
+ $got{value} =~ /$args{filter}/i);
},
error => sub {
die "Error parsing $args{filename}, near:\n at _\n";
@@ -791,6 +793,8 @@ sub set {
if ($args{multiple}) {
die "!!!"; # Unimplemented yet
} else {
+ # use Data::Dumper;
+ # warn Dumper(@replace);
die "Multiple occurrences of non-multiple key?"
if @replace > 1;
if (defined $args{value}) {
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index bf8b02b..4ed2680 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -96,16 +96,14 @@ EOF
is(slurp($config_filename), $expect, 'similar section');
# set returns nothing on success
-lives_ok { $config->set(key => 'core.penguin', value => 'kingpin', filter => qr/!blue/,
- 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 =>
- qr/!kingpin/, filename => $config_filename) } 'replace with non-match';
+ qr/^(?!kingpin).*$/, filename => $config_filename) } 'replace with non-match';
-TODO: {
- local $TODO = 'Multiple values are not yet implemented.';
-
- $expect = <<'EOF'
+$expect = <<'EOF'
[core]
penguin = very blue
Movie = BadPhysics
@@ -116,8 +114,7 @@ TODO: {
EOF
;
- is(slurp($config_filename), $expect, 'non-match result');
-}
+is(slurp($config_filename), $expect, 'non-match result');
burp($config_filename,
'[alpha]
commit 7e9f53a1aff64b09a40716b1b768d6e95c1ede4a
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 9 17:23:11 2009 +0300
multiple unset
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 6dab4f1..4d8031c 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -737,6 +737,7 @@ sub set {
filename => undef,
filter => undef,
as => undef,
+ multiple => 0,
@_
);
@@ -769,6 +770,8 @@ sub set {
return;
}
+ # returns if the file can't be opened, since that means nothing to
+ # set/unset
my $c = $self->_read_config($args{filename});
my $new;
@@ -790,61 +793,82 @@ sub set {
},
);
- if ($args{multiple}) {
- die "!!!"; # Unimplemented yet
- } else {
- # use Data::Dumper;
- # warn Dumper(@replace);
- die "Multiple occurrences of non-multiple key?"
- if @replace > 1;
- if (defined $args{value}) {
- if (@replace) {
- # Replacing an existing value
- substr(
- $c,
- $replace[0]{offset},
- $replace[0]{length},
+ die "Multiple occurrences of non-multiple key?"
+ if @replace > 1 && !$args{multiple};
+
+ if (defined $args{value}) {
+ if (@replace && !$args{multiple}) {
+ # Replacing existing value(s)
+
+ # if the string we're replacing with is not the same length as
+ # what's being replaced, any offsets following will be wrong. save
+ # the difference between the lengths here and add it to any offsets
+ # that follow.
+ my $difference = 0;
+
+ for my $var (@replace) {
+ my $replace_with =
$self->format_definition(
key => $key,
value => $args{value},
bare => 1,
- )
- );
- } elsif (defined $new) {
- # Adding a new value to the end of an existing block
+ );
substr(
$c,
- index($c, "\n", $new)+1,
- 0,
- $self->format_definition(
- key => $key,
- value => $args{value}
- )
- );
- } else {
- # Adding a new section
- $c .= $self->format_section( section => $section );
- $c .= $self->format_definition( key => $key, value => $args{value} );
+ $var->{offset}+$difference,
+ $var->{length},
+ $replace_with,
+ );
+ $difference += (length($replace_with) - $var->{length});
}
+ } elsif (defined $new) {
+ # Adding a new value to the end of an existing block
+ substr(
+ $c,
+ index($c, "\n", $new)+1,
+ 0,
+ $self->format_definition(
+ key => $key,
+ value => $args{value}
+ )
+ );
} else {
- # Removing an existing value
- die "No occurrence of $args{key} found to unset in $args{filename}\n"
- unless @replace;
+ # Adding a new section
+ $c .= $self->format_section( section => $section );
+ $c .= $self->format_definition( key => $key, value => $args{value} );
+ }
+ } else {
+ # Removing an existing value
+ die "No occurrence of $args{key} found to unset in $args{filename}\n"
+ unless @replace;
+
+ my $difference = 0;
+
+ for my $var (@replace) {
+ # start from either the last newline or the last section
+ # close bracket, since variable definitions can occur
+ # immediately following a section header without a \n
+ my $newline = rindex($c, "\n", $var->{offset}-$difference);
+ my $bracket = rindex($c, ']', $var->{offset}-$difference);
+ my $start = $newline > $bracket ? $newline : $bracket;
+
+ my $length =
+ index($c, "\n", $var->{offset}-$difference+$var->{length})-$start;
- my $start = rindex($c, "\n", $replace[0]{offset});
substr(
$c,
$start,
- index($c, "\n", $replace[0]{offset}+$replace[0]{length})-$start,
- ""
+ $length,
+ '',
);
+ $difference += $length;
}
}
return $self->_write_config($args{filename}, $c);
}
-# according to git test suite, keys cannot start with a number
+# according to the git test suite, keys cannot start with a number
sub _invalid_key {
my $self = shift;
my $key = shift;
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 4ed2680..85b2da2 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 => 83;
+use Test::More tests => 84;
use Test::Exception;
use File::Spec;
use File::Temp;
@@ -140,31 +140,31 @@ burp($config_filename,
'[beta] ; silly comment # another comment
noIndent= sillyValue ; \'nother silly comment
+# empty line
; comment
haha = hello
haha = bello
[nextSection] noNewline = ouch
');
-# my $config2_filename = File::Spec->catfile($config_dir, '.config2');
-#
-# copy($config_filename, $config2_filename) or die "File cannot be copied: $!";
-# XXX TODO unset-all not implemented yet in Config::GitLike interface
-# test_expect_success 'multiple unset' \
-# 'git config --unset-all beta.haha'
-#
-# $expect = <<'EOF'
-# [beta] ; silly comment # another comment
-# noIndent= sillyValue ; 'nother silly comment
-#
-# ; comment
-# [nextSection] noNewline = ouch
-# EOF
-#
-#
-# is(slurp($config_filename), $expect, 'multiple unset is correct');
+my $config2_filename = File::Spec->catfile($config_dir, '.config2');
+
+copy($config_filename, $config2_filename) or die "File cannot be copied: $!";
+
+$config->set( key => 'beta.haha', filename => $config_filename, multiple => 1 );
+$expect = <<'EOF'
+[beta] ; silly comment # another comment
+noIndent= sillyValue ; 'nother silly comment
+
+# empty line
+ ; comment
+[nextSection] noNewline = ouch
+EOF
+;
+
+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: $!";
# XXX TODO I don't think replace/replace-all works either (what's it supposed to do?)
# test_expect_success '--replace-all missing value' '
commit 9787096ee4f6d9669bf16e6f8ad18b384a310231
Author: Christine Spang <spang at mit.edu>
Date: Wed Jun 10 14:36:27 2009 +0300
multivar support
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 4d8031c..703bd0e 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -416,6 +416,9 @@ 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}) {
+ $self->set_multiple($key);
+ $self->data->{$key} = [$self->data->{$key}, $args{value}];
} else {
$self->data->{$key} = $args{value};
}
@@ -504,7 +507,7 @@ sub cast {
}
}
-=head2 get( key => 'sect.subsect.key', as => 'int', filter => qr/regex$/ )
+=head2 get( key => 'sect.subsect.key', as => 'int', filter => '!foo' )
Retrieve the config value associated with C<key> cast as an C<as>.
@@ -524,7 +527,9 @@ 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.
-TODO implement filter (multiple values)
+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
@@ -534,6 +539,7 @@ sub get {
key => undef,
as => undef,
human => undef,
+ filter => '',
@_,
);
$self->load unless $self->is_loaded;
@@ -543,11 +549,19 @@ sub get {
return undef unless exists $self->data->{$args{key}};
my $v = $self->data->{$args{key}};
if (ref $v) {
- die "Multiple values";
- } else {
- return $self->cast( value => $v, as => $args{as},
- human => $args{human} );
+ my @results;
+ if (defined $args{filter}) {
+ if ($args{filter} =~ s/^!//) {
+ @results = grep { !/$args{filter}/i } @{$v};
+ } else {
+ @results = grep { m/$args{filter}/i } @{$v};
+ }
+ }
+ die "Multiple values" unless @results <= 1;
+ $v = $results[0];
}
+ return $self->cast( value => $v, as => $args{as},
+ human => $args{human} );
}
# I'm pretty sure that someone can come up with an edge case where stripping
@@ -564,14 +578,13 @@ sub _remove_balanced_quotes {
return $key;
}
-=head2 get_all( key => 'foo', filter => qr/regex$/, as => 'bool' )
+=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, cast as C<as> if C<as> is specified.
-
-TODO implement filter
+Returns a list of values, narrowed by C<filter> and cast as C<as> if these
+options are specified.
=cut
@@ -588,6 +601,15 @@ sub get_all {
return undef unless exists $self->data->{$args{key}};
my $v = $self->data->{$args{key}};
my @v = ref $v ? @{$v} : ($v);
+
+ if (defined $args{filter}) {
+ if ($args{filter} =~ s/^!//) {
+ @v = grep { !/$args{filter}/i } @v;
+ } else {
+ @v = grep { m/$args{filter}/i } @v;
+ }
+ }
+
return map {$self->cast( value => $_, as => $args{as} )} @v;
}
@@ -595,10 +617,8 @@ sub get_all {
Similar to C<get_all>, but searches for values based on a key regex.
-Returns a hash of name/value pairs, with values cast as C<as> if C<as> is
-specified.
-
-TODO implement filter
+Returns a hash of name/value pairs, with values filtered by C<filter> and cast
+as C<as> if specified.
=cut
@@ -620,6 +640,17 @@ sub get_regexp {
$results{$key} = $self->data->{$key}
if lc $key =~ $args{key};
}
+
+ if (defined $args{filter}) {
+ if ($args{filter} =~ s/^!//) {
+ my @keys = grep { $results{$_} !~ m/$args{filter}/i } keys %results;
+ @results{@keys} = @results{@keys};
+ } else {
+ my @keys = grep { $results{$_} =~ m/$args{filter}/i } keys %results;
+ @results{@keys} = @results{@keys};
+ }
+ }
+
return map { ($_, $self->cast( value => $results{$_}, as => $args{as} )) }
keys %results;
}
@@ -705,7 +736,7 @@ sub format_definition {
return $ret;
}
-=head2 set( key => "section.foo", value => "bar", filename => File::Spec->catfile(qw/home user/, "." . $config->confname, filter => qr/regex/, as => 'bool' )
+=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
@@ -724,9 +755,6 @@ thrown otherwise.
Returns true on success, false if the filename was unopenable and thus no
set was performed.
-TODO The filter arg is for multiple value support (see value_regex in git help config
-for details).
-
=cut
sub set {
@@ -737,7 +765,7 @@ sub set {
filename => undef,
filter => undef,
as => undef,
- multiple => 0,
+ multiple => undef,
@_
);
@@ -783,10 +811,24 @@ sub set {
return unless lc($got{section}) eq lc($section);
$new = $got{offset} + $got{length};
return unless defined $got{name};
+
+ my $matched = 0;
+ if (lc $key eq lc $got{name}) {
+ if (defined $args{filter}) {
+ if ($args{filter} =~ /^!/) {
+ my $filter = $args{filter};
+ $filter =~ s/^!//;
+ $matched = 1 if ($got{value} !~ m/$filter/i);
+ } elsif ($got{value} =~ m/$args{filter}/i) {
+ $matched = 1;
+ }
+ } else {
+ $matched = 1;
+ }
+ }
+
push @replace, {offset => $got{offset}, length => $got{length}}
- if lc $key eq lc $got{name}
- && (!defined($args{filter}) ||
- $got{value} =~ /$args{filter}/i);
+ if $matched;
},
error => sub {
die "Error parsing $args{filename}, near:\n at _\n";
@@ -797,7 +839,7 @@ sub set {
if @replace > 1 && !$args{multiple};
if (defined $args{value}) {
- if (@replace && !$args{multiple}) {
+ if (@replace && (!$args{multiple} || $args{replace_all})) {
# Replacing existing value(s)
# if the string we're replacing with is not the same length as
@@ -806,21 +848,25 @@ sub set {
# that follow.
my $difference = 0;
- for my $var (@replace) {
- my $replace_with =
- $self->format_definition(
- key => $key,
- value => $args{value},
- bare => 1,
- );
- substr(
- $c,
- $var->{offset}+$difference,
- $var->{length},
- $replace_with,
- );
- $difference += (length($replace_with) - $var->{length});
- }
+ # when replacing multiple values, we combine them all into one,
+ # which is kept at the position of the last one
+ my $last = pop @replace;
+
+ # kill all values that are not last
+ ($c, $difference) = $self->_unset_variables(\@replace, $c,
+ $difference);
+
+ # substitute the last occurrence with the new value
+ substr(
+ $c,
+ $last->{offset}-$difference,
+ $last->{length},
+ $self->format_definition(
+ key => $key,
+ value => $args{value},
+ bare => 1,
+ ),
+ );
} elsif (defined $new) {
# Adding a new value to the end of an existing block
substr(
@@ -838,34 +884,41 @@ sub set {
$c .= $self->format_definition( key => $key, value => $args{value} );
}
} else {
- # Removing an existing value
+ # Removing an existing value (unset / unset-all)
die "No occurrence of $args{key} found to unset in $args{filename}\n"
unless @replace;
- my $difference = 0;
+ ($c, undef) = $self->_unset_variables(\@replace, $c, 0);
+ }
+
+ return $self->_write_config($args{filename}, $c);
+}
- for my $var (@replace) {
- # start from either the last newline or the last section
- # close bracket, since variable definitions can occur
- # immediately following a section header without a \n
- my $newline = rindex($c, "\n", $var->{offset}-$difference);
- my $bracket = rindex($c, ']', $var->{offset}-$difference);
- my $start = $newline > $bracket ? $newline : $bracket;
+sub _unset_variables {
+ my ($self, $variables, $c, $difference) = @_;
- my $length =
- index($c, "\n", $var->{offset}-$difference+$var->{length})-$start;
+ for my $var (@{$variables}) {
+ # start from either the last newline or the last section
+ # close bracket, since variable definitions can occur
+ # immediately following a section header without a \n
+ my $newline = rindex($c, "\n", $var->{offset}-$difference);
+ # need to add 1 here to not kill the ] too
+ my $bracket = rindex($c, ']', $var->{offset}-$difference) + 1;
+ my $start = $newline > $bracket ? $newline : $bracket;
- substr(
- $c,
- $start,
- $length,
- '',
- );
- $difference += $length;
- }
+ my $length =
+ index($c, "\n", $var->{offset}-$difference+$var->{length})-$start;
+
+ substr(
+ $c,
+ $start,
+ $length,
+ '',
+ );
+ $difference += $length;
}
- return $self->_write_config($args{filename}, $c);
+ return ($c, $difference);
}
# according to the git test suite, keys cannot start with a number
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 85b2da2..48f0253 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 => 84;
+use Test::More tests => 86;
use Test::Exception;
use File::Spec;
use File::Temp;
@@ -101,7 +101,7 @@ lives_ok { $config->set(key => 'core.penguin', value => 'kingpin',
'replace with non-match';
lives_ok { $config->set(key => 'core.penguin', value => 'very blue', filter =>
- qr/^(?!kingpin).*$/, filename => $config_filename) } 'replace with non-match';
+ '!kingpin', filename => $config_filename) } 'replace with non-match';
$expect = <<'EOF'
[core]
@@ -166,38 +166,23 @@ is(slurp($config_filename), $expect, 'multiple unset is correct');
copy($config2_filename, $config_filename) or die "File cannot be copied: $!";
-# XXX TODO I don't think replace/replace-all works either (what's it supposed to do?)
-# test_expect_success '--replace-all missing value' '
-# test_must_fail git config --replace-all beta.haha &&
-# test_cmp .git/config2 .git/config
-# '
-#
-# unlink $config2_filename;
-#
-# test_expect_success '--replace-all' \
-# 'git config --replace-all beta.haha gamma'
-#
-# $expect = <<'EOF'
-# [beta] ; silly comment # another comment
-# noIndent= sillyValue ; 'nother silly comment
-#
-# ; comment
-# haha = gamma
-# [nextSection] noNewline = ouch
-# EOF
-#
-# is(slurp($config_filename), $expect, 'all replaced');
+unlink $config2_filename;
-# XXX remove this burp after fixing the replace/unset all stuff above (just
-# using it to bootstrap the rest of the tests)
-burp($config_filename,
-'[beta] ; silly comment # another comment
-noIndent= sillyValue ; \'nother silly comment
+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
+noIndent= sillyValue ; 'nother silly comment
+# empty line
; comment
haha = gamma
[nextSection] noNewline = ouch
-');
+EOF
+;
+
+is(slurp($config_filename), $expect, 'all replaced');
$config->set(key => 'beta.haha', value => 'alpha', filename => $config_filename);
@@ -205,6 +190,7 @@ $expect = <<'EOF'
[beta] ; silly comment # another comment
noIndent= sillyValue ; 'nother silly comment
+# empty line
; comment
haha = alpha
[nextSection] noNewline = ouch
@@ -224,6 +210,7 @@ $expect = <<'EOF'
[beta] ; silly comment # another comment
noIndent= sillyValue ; 'nother silly comment
+# empty line
; comment
haha = alpha
[nextSection] nonewline = wow
@@ -242,6 +229,7 @@ $expect = <<'EOF'
[beta] ; silly comment # another comment
noIndent= sillyValue ; 'nother silly comment
+# empty line
; comment
[nextSection] nonewline = wow
EOF
@@ -249,90 +237,78 @@ EOF
is(slurp($config_filename), $expect, 'unset');
-TODO: {
- local $TODO = "multivar not yet implemented";
-
- $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'
+$expect = <<'EOF'
[beta] ; silly comment # another comment
noIndent= sillyValue ; 'nother silly comment
+# empty line
; 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 => qr/!for/) }
- 'non-match';
+$config->load;
+lives_ok { $config->get(key => 'nextsection.nonewline',
+ filter => '!for') } 'non-match';
- is($config->get(key => 'nextsection.nonewline', filter => qr/!for/), 'wow',
- 'non-match value');
+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';
+# must use get_all to get multiple values
+throws_ok { $config->get( key => 'nextsection.nonewline' ) }
+ qr/multiple values/i, 'ambiguous get';
- is($config->get_all(key => 'nextsection.nonewline'), ['wow', 'wow2 for me'],
- 'get multivar');
+my @results = $config->get_all(key => 'nextsection.nonewline');
+is_deeply(\@results, ['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'
+$expect = <<'EOF'
[beta] ; silly comment # another comment
noIndent= sillyValue ; 'nother silly comment
- ; comment
+# empty line
+ ; comment
[nextSection] nonewline = wow3
- NoNewLine = wow2 for me
+ 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/ambiguous unset/i, 'ambiguous unset';
+$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 => '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";
+lives_ok { $config->set(key => 'nextsection.nonewline',
+ filter => qr/wow3$/, filename => $config_filename) }
+ "multivar unset doesn't crash";
- $expect = <<'EOF'
+$expect = <<'EOF'
[beta] ; silly comment # another comment
noIndent= sillyValue ; 'nother silly comment
+# empty line
; comment
[nextSection]
NoNewLine = wow2 for me
EOF
- ;
-
- is(slurp($config_filename), $expect, 'multivar unset');
-}
-
-# XXX remove this burp after fixing the replace/unset all stuff above (just
-# using it to bootstrap the rest of the tests)
-burp($config_filename,
-'[beta] ; silly comment # another comment
-noIndent= sillyValue ; \'nother silly comment
+;
- ; comment
-[nextSection]
- NoNewLine = wow2 for me
-');
+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';
@@ -347,6 +323,7 @@ $expect = <<'EOF'
[beta] ; silly comment # another comment
noIndent= sillyValue ; 'nother silly comment
+# empty line
; comment
[nextSection]
NoNewLine = wow2 for me
@@ -379,21 +356,16 @@ my %results = $config->get_regexp( key => 'in' );
lives_and { is_deeply(\%results, $expect) } '--get-regexp';
-TODO: {
- local $TODO = 'cannot set multiple values yet';
+$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);
+$config->load;
- $expect = <<'EOF'
-wow2 for me
-wow4 for you
-EOF
- ;
+$expect = ['wow2 for me', 'wow4 for you'];
- $config->load;
- is($config->get_all(key => 'nextsection.nonewline'), $expect, '--add');
-}
+$config->load;
+my @result = $config->get_all(key => 'nextsection.nonewline');
+is_deeply(\@result, $expect, '--add');
burp($config_filename,
'[novalue]
@@ -592,7 +564,7 @@ for my $key (keys %pairs) {
}
$config->load;
-my @results = ();
+ at results = ();
for my $i (1..4) {
push(@results, $config->get( key => "bool.true$i", as => 'bool' ) eq 1,
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list