[Bps-public-commit] Config-GitLike branch, master, updated. 1.08-11-g6fe9ebb
Alex Vandiver
alexmv at bestpractical.com
Tue May 8 04:20:58 EDT 2012
The branch, master has been updated
via 6fe9ebb1b00c7a329f7f901e2955d08953a28ece (commit)
via 1d75f553dcd4e592151f39b43104365b3d3b90ee (commit)
via bbd087588587a7100977533510cebd8771aa7766 (commit)
via c56ca6f690cb42a05bf5e542ab2386766c3a212b (commit)
via d56214fcaa02cd49fad0ca9e95ad6f7585de2c19 (commit)
via cdc083f7266c49cb41511eb1d174ad3495501abb (commit)
via 6205a12bddc1e73d128b3a8fdfcd3922a1d02175 (commit)
via e7da0d4d978df885bcf9c13ddfe2becf07d53033 (commit)
via 609204e0a655803d2d1225870439b1576d6d8c52 (commit)
via dd313985c7118f85fe47a6cd18cd0815c3ba03e5 (commit)
via baf2fc2dc985ef33037fc5acd6d72810c78e6077 (commit)
from 5999047542be3bd7d3cc49657ea6912e6df25817 (commit)
Summary of changes:
lib/Config/GitLike.pm | 183 +++++++++++++++++++++++++++--------------
t/comment.t | 79 ++++++++++++++++++
xt/release/99-pod-coverage.t | 2 +-
3 files changed, 200 insertions(+), 64 deletions(-)
create mode 100644 t/comment.t
- Log -----------------------------------------------------------------
commit baf2fc2dc985ef33037fc5acd6d72810c78e6077
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue Apr 24 00:30:55 2012 -0400
Apply filter even on single values
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 6052901..eeb8f69 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -513,20 +513,18 @@ sub get {
return undef unless exists $self->data->{$args{key}};
my $v = $self->data->{$args{key}};
- if (ref $v) {
- my @results;
- if (defined $args{filter}) {
- if ($args{filter} =~ s/^!//) {
- @results = grep { !/$args{filter}/i } @{$v};
- }
- else {
- @results = grep { m/$args{filter}/i } @{$v};
- }
+ my @values = ref $v ? @{$v} : ($v);
+ if (defined $args{filter}) {
+ if ($args{filter} =~ s/^!//) {
+ @values = grep { !/$args{filter}/i } @values;
+ }
+ else {
+ @values = grep { m/$args{filter}/i } @values;
}
- die "Multiple values" unless @results <= 1;
- $v = $results[0];
}
- return $self->cast( value => $v, as => $args{as},
+ die "Multiple values" unless @values <= 1;
+
+ return $self->cast( value => $values[0], as => $args{as},
human => $args{human} );
}
commit dd313985c7118f85fe47a6cd18cd0815c3ba03e5
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue May 8 02:33:51 2012 -0400
Don't apply filter unless it has content; this avoids =~ // bugs
If the filter is empty, it causes the regex to become m//i, which has
special meaning:
If the PATTERN evaluates to the empty string, the last successfully
matched regular expression is used instead. [...] If no match has
previously succeeded, this will (silently) act instead as a genuine
empty pattern (which will always match).
Because its default filter value was '', this caused ->get()'s behavior
with multiple-result keys but not filter to be unexpected, as it
silently used the previous successful regex match as the filter.
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index eeb8f69..bfe991c 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -514,7 +514,7 @@ sub get {
return undef unless exists $self->data->{$args{key}};
my $v = $self->data->{$args{key}};
my @values = ref $v ? @{$v} : ($v);
- if (defined $args{filter}) {
+ if (defined $args{filter} and length $args{filter}) {
if ($args{filter} =~ s/^!//) {
@values = grep { !/$args{filter}/i } @values;
}
@@ -558,7 +558,7 @@ sub get_all {
my $v = $self->data->{$args{key}};
my @v = ref $v ? @{$v} : ($v);
- if (defined $args{filter}) {
+ if (defined $args{filter} and length $args{filter}) {
if ($args{filter} =~ s/^!//) {
@v = grep { !/$args{filter}/i } @v;
}
@@ -590,7 +590,7 @@ sub get_regexp {
$results{$key} = $self->data->{$key} if lc $key =~ m/$args{key}/i;
}
- if (defined $args{filter}) {
+ if (defined $args{filter} and length $args{filter}) {
if ($args{filter} =~ s/^!//) {
map { delete $results{$_} if $results{$_} =~ m/$args{filter}/i }
keys %results;
@@ -797,7 +797,7 @@ sub group_set {
my $matched = 0;
# variable names are case-insensitive
if (lc $name eq $got{name}) {
- if (defined $args{filter}) {
+ if (defined $args{filter} and length $args{filter}) {
# copy the filter arg here since this callback may
# be called multiple times and we don't want to
# modify the original value
commit 609204e0a655803d2d1225870439b1576d6d8c52
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue May 8 02:41:35 2012 -0400
Refactor common code from get and get_all
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index bfe991c..47ed6d9 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -495,12 +495,10 @@ sub cast {
}
}
-sub get {
+sub _get {
my $self = shift;
my %args = (
- key => undef,
- as => undef,
- human => undef,
+ key => undef,
filter => '',
@_,
);
@@ -511,7 +509,7 @@ sub get {
grep { defined } (lc $section, $subsection, lc $name),
);
- return undef unless exists $self->data->{$args{key}};
+ return () unless exists $self->data->{$args{key}};
my $v = $self->data->{$args{key}};
my @values = ref $v ? @{$v} : ($v);
if (defined $args{filter} and length $args{filter}) {
@@ -522,10 +520,7 @@ sub get {
@values = grep { m/$args{filter}/i } @values;
}
}
- die "Multiple values" unless @values <= 1;
-
- return $self->cast( value => $values[0], as => $args{as},
- human => $args{human} );
+ return @values;
}
# I'm pretty sure that someone can come up with an edge case where stripping
@@ -541,32 +536,34 @@ sub _remove_balanced_quotes {
return $key;
}
-sub get_all {
+sub get {
my $self = shift;
my %args = (
- key => undef,
- as => undef,
+ key => undef,
+ as => undef,
+ human => undef,
+ filter => '',
@_,
);
- $self->load unless $self->is_loaded;
- my ($section, $subsection, $name) = _split_key($args{key});
- $args{key} = join('.',
- grep { defined } (lc $section, $subsection, lc $name),
- );
- return undef unless exists $self->data->{$args{key}};
- my $v = $self->data->{$args{key}};
- my @v = ref $v ? @{$v} : ($v);
+ my @v = $self->_get( %args );
+ return undef unless @v;
+ die "Multiple values" if @v > 1;
- if (defined $args{filter} and length $args{filter}) {
- if ($args{filter} =~ s/^!//) {
- @v = grep { !/$args{filter}/i } @v;
- }
- else {
- @v = grep { m/$args{filter}/i } @v;
- }
- }
+ return $self->cast( value => $v[0], as => $args{as},
+ human => $args{human} );
+}
+
+sub get_all {
+ my $self = shift;
+ my %args = (
+ key => undef,
+ as => undef,
+ filter => '',
+ @_,
+ );
+ my @v = $self->_get( %args );
@v = map {$self->cast( value => $_, as => $args{as} )} @v;
return wantarray ? @v : \@v;
}
commit e7da0d4d978df885bcf9c13ddfe2becf07d53033
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue May 8 03:20:05 2012 -0400
Deal gracefully with valueless keys (whose value is undef)
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 47ed6d9..9f29cfc 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -514,10 +514,10 @@ sub _get {
my @values = ref $v ? @{$v} : ($v);
if (defined $args{filter} and length $args{filter}) {
if ($args{filter} =~ s/^!//) {
- @values = grep { !/$args{filter}/i } @values;
+ @values = grep { not defined or not m/$args{filter}/i } @values;
}
else {
- @values = grep { m/$args{filter}/i } @values;
+ @values = grep { defined and m/$args{filter}/i } @values;
}
}
return @values;
@@ -589,12 +589,16 @@ sub get_regexp {
if (defined $args{filter} and length $args{filter}) {
if ($args{filter} =~ s/^!//) {
- map { delete $results{$_} if $results{$_} =~ m/$args{filter}/i }
- keys %results;
+ for (keys %results) {
+ delete $results{$_} if defined $results{$_}
+ and $results{$_} =~ m/$args{filter}/i;
+ }
}
else {
- map { delete $results{$_} if $results{$_} !~ m/$args{filter}/i }
- keys %results;
+ for (keys %results) {
+ delete $results{$_} if not defined $results{$_}
+ or $results{$_} !~ m/$args{filter}/i;
+ }
}
}
commit 6205a12bddc1e73d128b3a8fdfcd3922a1d02175
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue May 8 03:39:46 2012 -0400
Special-case the regex "!", which never matches
This resolves a similar m// bug, wherein the "!" filter would only match
results that begin with !, as s/^!// was definitionally always the last
successful regex.
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 9f29cfc..602f255 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -513,7 +513,10 @@ sub _get {
my $v = $self->data->{$args{key}};
my @values = ref $v ? @{$v} : ($v);
if (defined $args{filter} and length $args{filter}) {
- if ($args{filter} =~ s/^!//) {
+ if ($args{filter} eq "!") {
+ @values = ();
+ }
+ elsif ($args{filter} =~ s/^!//) {
@values = grep { not defined or not m/$args{filter}/i } @values;
}
else {
@@ -588,7 +591,10 @@ sub get_regexp {
}
if (defined $args{filter} and length $args{filter}) {
- if ($args{filter} =~ s/^!//) {
+ if ($args{filter} eq "!") {
+ %results = ();
+ }
+ elsif ($args{filter} =~ s/^!//) {
for (keys %results) {
delete $results{$_} if defined $results{$_}
and $results{$_} =~ m/$args{filter}/i;
@@ -803,7 +809,10 @@ sub group_set {
# be called multiple times and we don't want to
# modify the original value
my $filter = $args{filter};
- if ($filter =~ s/^!//) {
+ if ($filter eq "!") {
+ # Never matches
+ }
+ elsif ($filter =~ s/^!//) {
$matched = 1 if ($got{value} !~ m/$filter/i);
}
elsif ($got{value} =~ m/$filter/i) {
commit cdc083f7266c49cb41511eb1d174ad3495501abb
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue May 8 04:13:09 2012 -0400
Avoid a // bug in get_regexp with an empty key
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 602f255..9c8565d 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -584,6 +584,7 @@ sub get_regexp {
$self->load unless $self->is_loaded;
$args{key} = lc $args{key};
+ $args{key} = '.' unless defined $args{key} and length $args{key};
my %results;
for my $key (keys %{$self->data}) {
commit d56214fcaa02cd49fad0ca9e95ad6f7585de2c19
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue May 8 04:13:42 2012 -0400
Doing case manipulation on a regex which will be applied /i is nonsensical
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 9c8565d..e15936f 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -583,12 +583,11 @@ sub get_regexp {
$self->load unless $self->is_loaded;
- $args{key} = lc $args{key};
$args{key} = '.' unless defined $args{key} and length $args{key};
my %results;
for my $key (keys %{$self->data}) {
- $results{$key} = $self->data->{$key} if lc $key =~ m/$args{key}/i;
+ $results{$key} = $self->data->{$key} if $key =~ m/$args{key}/i;
}
if (defined $args{filter} and length $args{filter}) {
commit c56ca6f690cb42a05bf5e542ab2386766c3a212b
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue May 8 02:42:11 2012 -0400
Add "human" argument to get_all and get_regexp, to match get
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index e15936f..fe7bf4e 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -562,12 +562,13 @@ sub get_all {
my %args = (
key => undef,
as => undef,
+ human => undef,
filter => '',
@_,
);
my @v = $self->_get( %args );
- @v = map {$self->cast( value => $_, as => $args{as} )} @v;
+ @v = map {$self->cast( value => $_, as => $args{as}, human => $args{human} )} @v;
return wantarray ? @v : \@v;
}
@@ -575,9 +576,10 @@ sub get_regexp {
my $self = shift;
my %args = (
- key => undef,
- filter => undef,
- as => undef,
+ key => undef,
+ as => undef,
+ human => undef,
+ filter => '',
@_,
);
@@ -611,7 +613,8 @@ sub get_regexp {
@results{keys %results} =
map { $self->cast(
value => $results{$_},
- as => $args{as}
+ as => $args{as},
+ human => $args{human},
); } keys %results;
return wantarray ? %results : \%results;
}
commit bbd087588587a7100977533510cebd8771aa7766
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue May 8 02:48:40 2012 -0400
Update documentation to match get, get_all, and get_regex changes
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index fe7bf4e..62b84cd 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -1359,19 +1359,21 @@ Parameters:
key => 'sect.subsect.key'
as => 'int'
- filter => '!foo
+ human => 1
+ filter => '!foo'
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
-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).
+The C<key> option is required (will return undef if unspecified); the
+C<as> amd C<human> options are not (see L<cast> for their
+meaning). Sections and subsections are specified in the key by
+separating them from the key name with a C<.> 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.)
+If C<key> doesn't exist in the config, or has no values which match the
+filter, undef is returned. Dies with the exception "Multiple values" if
+the given key has more than one value associated with it which match the
+filter. (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
@@ -1383,8 +1385,9 @@ configuration data may not match the configuration variables on-disk.
Parameters:
key => 'section.sub'
- filter => 'regex'
as => 'int'
+ human => 1
+ filter => 'regex'
Like L<"get"> but does not fail if the number of values for the key is not
exactly one.
@@ -1396,8 +1399,9 @@ Returns a list of values (or an arrayref in scalar context).
Parameters:
key => 'regex'
- filter => 'regex'
as => 'bool'
+ human => 1
+ filter => 'regex'
Similar to L<"get_all"> but searches for values based on a key regex.
commit 1d75f553dcd4e592151f39b43104365b3d3b90ee
Author: David E. Wheeler <david at justatheory.com>
Date: Fri Apr 27 11:34:07 2012 -0700
Add `add_comment()`.
Allows coments to be appended to the end of a configuration file.
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 62b84cd..2728a89 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -1131,6 +1131,31 @@ sub remove_section {
$args{filename} );
}
+sub add_comment {
+ my $self = shift;
+ my (%args) = (
+ comment => undef,
+ filename => undef,
+ indented => undef,
+ semicolon => undef,
+ @_
+ );
+
+ my $filename = $args{filename} or die "No filename passed to add_comment()";
+ die "No comment to add\n" unless defined $args{comment};
+
+ # Comment, preserving leading whitespace.
+ my $chars = $args{indented} ? '[[:blank:]]*' : '';
+ my $char = $args{semicolon} ? ';' : '#';
+ (my $comment = $args{comment}) =~ s/^($chars)/$1$char /mg;
+ $comment .= "\n" if $comment !~ /\n\z/;
+
+ my $c = $self->_read_config($filename);
+ $c = '' unless defined $c;
+
+ return $self->_write_config( $filename, $c . $comment );
+}
+
1;
__END__
@@ -1541,6 +1566,23 @@ version of this subroutine.
Returns nothing of note.
+=head2 add_comment
+
+Parameters:
+
+ comment => "Begin editing here\n and then stop",
+ filename => '/file/to/edit'
+ indented => 1,
+ semicolon => 0,
+
+Add a comment to the specified configuration file. The C<comment> and
+C<filename> parameters are required. Comments will be added to the file with
+C<# > at the begnning of each line of the comment. Pass a true value to
+C<semicolon> if you'd rather they start with C<; >. If your comments are
+indented with leading white space, and you want that white space to appear in
+front of the comment character, rather than after, pass a true value to
+C<indented>.
+
=head1 OTHER METHODS
These are mostly used internally in other methods, but could be useful anyway.
diff --git a/t/comment.t b/t/comment.t
new file mode 100644
index 0000000..ef8892c
--- /dev/null
+++ b/t/comment.t
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+
+use Test::More;
+use File::Spec;
+use File::Temp qw/tempdir/;
+use lib 't/lib';
+use TestConfig;
+
+my $config_dirname = tempdir( CLEANUP => !$ENV{CONFIG_GITLIKE_DEBUG} );
+my $config_filename = File::Spec->catfile( $config_dirname, 'config' );
+
+diag "config file is: $config_filename" if $ENV{TEST_VERBOSE};
+
+my $config
+ = TestConfig->new( confname => 'config', tmpdir => $config_dirname );
+$config->load;
+
+# Test add_comment.
+$config->add_comment(
+ filename => $config_filename,
+ comment => 'yo dawg',
+);
+my $expect = "# yo dawg\n";
+is( slurp($config_filename), $expect, 'comment' );
+
+# Make sure leading whitespace is maintained.
+$config->add_comment(
+ filename => $config_filename,
+ comment => ' for you.'
+);
+
+$expect .= "# for you.\n";
+is( slurp($config_filename), $expect, 'comment with ws' );
+
+# Make sure it interacts well with configuration.
+$config->set(
+ key => 'core.penguin',
+ value => 'little blue',
+ filename => $config_filename
+);
+
+$config->add_comment(
+ filename => $config_filename,
+ comment => "this is\n for you\n \n you know",
+ indented => 1,
+);
+
+$expect = <<'EOF'
+# yo dawg
+# for you.
+[core]
+ penguin = little blue
+# this is
+ # for you
+ #
+ # you know
+EOF
+ ;
+is( slurp($config_filename), $expect, 'indented comment with newlines and config' );
+
+$config->add_comment(
+ filename => $config_filename,
+ comment => ' gimme a semicolon',
+ semicolon => 1,
+);
+$expect .= "; gimme a semicolon\n";
+is( slurp($config_filename), $expect, 'comment with semicolon' );
+
+done_testing;
+
+
+
+sub slurp {
+ my $file = shift;
+ local ($/);
+ open( my $fh, $file ) or die "Unable to open file ${file}: $!";
+ return <$fh>;
+}
commit 6fe9ebb1b00c7a329f7f901e2955d08953a28ece
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue May 8 04:20:37 2012 -0400
Accept ALL_CAPS constant subs as documented
diff --git a/xt/release/99-pod-coverage.t b/xt/release/99-pod-coverage.t
index d2da1a2..b2fb400 100644
--- a/xt/release/99-pod-coverage.t
+++ b/xt/release/99-pod-coverage.t
@@ -3,7 +3,7 @@ eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
plan skip_all => "Coverage tests only run for authors" unless ( -d 'inc/.author' );
-all_pod_coverage_ok();
+all_pod_coverage_ok({ also_private => [ qr/^[A-Z_]+$/ ] });
# Workaround for dumb bug (fixed in 5.8.7) where Test::Builder thinks that
# certain "die"s that happen inside evals are not actually inside evals,
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list