[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