[Bps-public-commit] Config-GitLike branch, master, updated. d345c6c461e54d9fdc90a5146faaa80eea077b85

spang at bestpractical.com spang at bestpractical.com
Mon Jun 8 09:53:05 EDT 2009


The branch, master has been updated
       via  d345c6c461e54d9fdc90a5146faaa80eea077b85 (commit)
       via  642b9b380a1684e4e08dae6434294db85ef09634 (commit)
       via  0f71b100eb1a704b367290d2d273acab83540861 (commit)
       via  3a89e209b880e9dcfb6048e5159e8f2e344e8bbd (commit)
       via  e5ca8d1cae17602c5e3f8d631a50657291e32fe7 (commit)
      from  db7d1e66ca2fe29f9e4b7d7e2622bbd129684bd3 (commit)

Summary of changes:
 lib/Config/GitLike.pm |  265 +++++++++++++++++++++++++++++++++++++++++++------
 t/t1300-repo-config.t |  106 +++++++++++++-------
 2 files changed, 302 insertions(+), 69 deletions(-)

- Log -----------------------------------------------------------------
commit e5ca8d1cae17602c5e3f8d631a50657291e32fe7
Author: Christine Spang <spang at mit.edu>
Date:   Thu Jun 4 15:39:07 2009 +0300

    un-TODO rename_section tests to prep for implementation

diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 2f11d95..86be865 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -463,14 +463,22 @@ EOF
 
 is(slurp($config_filename), $expect, 'new variable inserts into proper section');
 
-TODO: {
-    local $TODO = 'rename_section is not yet implemented';
+# testing rename_section
+burp($config_filename,
+'# Hallo
+	#Bello
+[branch "eins"]
+	x = 1
+[branch.eins]
+	y = 1
+	[branch "1 234 blabl/a"]
+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'
+$expect = <<'EOF'
 [branch "zwei"]
     x = 1
 [branch "zwei"]
@@ -478,21 +486,22 @@ TODO: {
     [branch "1 234 blabl/a"]
 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 =>
+throws_ok { $config->rename_section( from => 'branch."world domination"', to =>
         'branch.drei', filename => $config_filename ) }
-        qr/rename non-existing section/, 'rename non-existing section';
+    qr/rename non-existing section/, '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 blaba/a"', to =>
-            'branch.drei', filename => $config_filename ) }
-        'rename another section';
+lives_ok { $config->rename_section( from => 'branch."1 234 blaba/a"', to =>
+        'branch.drei', filename => $config_filename ) }
+    'rename another section';
 
-    $expect = <<'EOF'
+$expect = <<'EOF'
 [branch "zwei"]
 	x = 1
 [branch "zwei"]
@@ -500,10 +509,9 @@ EOF
 [branch "drei"]
 weird
 EOF
-    ;
+;
 
-    is(slurp($config_filename), $expect, 'rename succeeded');
-}
+is(slurp($config_filename), $expect, 'rename succeeded');
 
 TODO: {
     local $TODO = 'remove section is not yet implemented';

commit 3a89e209b880e9dcfb6048e5159e8f2e344e8bbd
Author: Christine Spang <spang at mit.edu>
Date:   Thu Jun 4 16:27:29 2009 +0300

    pull config file reading out to _read_config

diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index aef60bf..9a36e62 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -200,6 +200,20 @@ sub load_user {
     return $self->load_file( $self->user_file );
 }
 
+sub _read_config {
+    my $self = shift;
+    my $filename = shift;
+
+    open(my $fh, "<", $filename) or return;
+
+    my $c = do {local $/; <$fh>};
+
+    $c =~ s/\n*$/\n/; # Ensure it ends with a newline
+    close $fh;
+
+    return $c;
+}
+
 =head2 load_file $filename
 
 Takes a string containing the path to a file, opens it if it exists, loads its
@@ -211,9 +225,7 @@ of the C<data> attribute (a hashref).
 sub load_file {
     my $self = shift;
     my ($filename) = @_;
-    open(my $fh, "<", $filename) or return;
-    my $c = do {local $/; <$fh>};
-    close $fh;
+    my $c = $self->_read_config($filename);
 
     $self->parse_content(
         content  => $c,
@@ -616,10 +628,7 @@ sub set {
         return;
     }
 
-    open(my $fh, "<", $args{filename}) or return;
-    my $c = do {local $/; <$fh>};
-    $c =~ s/\n*$/\n/; # Ensure it ends with a newline
-    close $fh;
+    my $c = $self->_read_config($args{filename});
 
     my $new;
     my @replace;

commit 0f71b100eb1a704b367290d2d273acab83540861
Author: Christine Spang <spang at mit.edu>
Date:   Fri Jun 5 16:20:56 2009 +0300

    fix some test bits that the translation script (and/or my manual frobbing) b0rked

diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 86be865..c90f44d 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -479,11 +479,13 @@ lives_ok { $config->rename_section( from => 'branch.eins', to => 'branch.zwei',
         filename => $config_filename ) } 'rename_section lives';
 
 $expect = <<'EOF'
+# Hallo
+	#Bello
 [branch "zwei"]
-    x = 1
+	x = 1
 [branch "zwei"]
-    y = 1
-    [branch "1 234 blabl/a"]
+	y = 1
+	[branch "1 234 blabl/a"]
 weird
 EOF
 ;
@@ -492,16 +494,18 @@ is(slurp($config_filename), $expect, 'rename succeeded');
 
 throws_ok { $config->rename_section( from => 'branch."world domination"', to =>
         'branch.drei', filename => $config_filename ) }
-    qr/rename non-existing section/, 'rename non-existing section';
+    qr/no such section/i, 'rename non-existing section';
 
 is(slurp($config_filename), $expect,
     'rename non-existing section changes nothing');
 
-lives_ok { $config->rename_section( from => 'branch."1 234 blaba/a"', to =>
+lives_ok { $config->rename_section( from => 'branch."1 234 blabl/a"', to =>
         'branch.drei', filename => $config_filename ) }
     'rename another section';
 
 $expect = <<'EOF'
+# Hallo
+	#Bello
 [branch "zwei"]
 	x = 1
 [branch "zwei"]
@@ -524,6 +528,8 @@ TODO: {
             filename => $config_filename ) } 'remove section';
 
     $expect = <<'EOF'
+# Hallo
+	#Bello
 [branch "drei"]
 weird
 EOF

commit 642b9b380a1684e4e08dae6434294db85ef09634
Author: Christine Spang <spang at mit.edu>
Date:   Mon Jun 8 16:31:35 2009 +0300

    un-TODO tests for remove_section

diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index c90f44d..057df4a 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -9,6 +9,12 @@ use File::Temp;
 use lib 't/lib';
 use TestConfig;
 
+# Tests whose expected behaviour has been modified from that of the
+# original git-config test suite are marked with comments.
+#
+# Additional tests that were not pulled from the git-config test-suite
+# are also marked.
+
 sub slurp {
     my $file = shift;
     local( $/ ) ;
@@ -17,10 +23,12 @@ sub slurp {
 }
 
 sub burp {
-    my $file_name = shift;
-    open( my $fh, ">$file_name" ) ||
+    my ($file_name, $content, $append) = @_;
+    my $mode = $append ? '>>' : '>';
+
+    open( my $fh, $mode, $file_name ) ||
         die "can't open ${file_name}: $!";
-    print $fh @_;
+    print $fh $content;
 }
 
 # create an empty test directory in /tmp
@@ -464,6 +472,10 @@ EOF
 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
 	#Bello
@@ -471,7 +483,7 @@ burp($config_filename,
 	x = 1
 [branch.eins]
 	y = 1
-	[branch "1 234 blabl/a"]
+	[branch "1 234 blabl/a"] ; comment
 weird
 ');
 
@@ -485,7 +497,7 @@ $expect = <<'EOF'
 	x = 1
 [branch "zwei"]
 	y = 1
-	[branch "1 234 blabl/a"]
+	[branch "1 234 blabl/a"] ; comment
 weird
 EOF
 ;
@@ -503,6 +515,9 @@ 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"]
+# without the leading tab, and then clobber anything that followed)
 $expect = <<'EOF'
 # Hallo
 	#Bello
@@ -510,34 +525,33 @@ $expect = <<'EOF'
 	x = 1
 [branch "zwei"]
 	y = 1
-[branch "drei"]
+	[branch "drei"] ; comment
 weird
 EOF
 ;
 
 is(slurp($config_filename), $expect, 'rename succeeded');
 
-TODO: {
-    local $TODO = 'remove section is not yet implemented';
-
-    burp($config_filename,
+# [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';
+lives_ok { $config->remove_section( section => 'branch.zwei',
+        filename => $config_filename ) } 'remove section';
 
-    $expect = <<'EOF'
+$expect = <<'EOF'
 # Hallo
 	#Bello
-[branch "drei"]
+[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;
 

commit d345c6c461e54d9fdc90a5146faaa80eea077b85
Author: Christine Spang <spang at mit.edu>
Date:   Mon Jun 8 16:44:38 2009 +0300

    add rename_section and remove_section and related changes

diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 9a36e62..535c9cd 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -32,7 +32,7 @@ has 'multiple' => (
 
 =head1 NAME
 
-Config::GitLike - git-compatible config file parsing
+Config::GitLike - (mostly) git-compatible config file parsing
 
 =head1 SYNOPSIS
 
@@ -200,6 +200,7 @@ sub load_user {
     return $self->load_file( $self->user_file );
 }
 
+# returns undef if the file was unable to be opened
 sub _read_config {
     my $self = shift;
     my $filename = shift;
@@ -282,10 +283,22 @@ sub parse_content {
         if ($c =~ s/\A[#;].*?$//im) {
             next;
         # [sub]section headers of the format [section "subsection"] (with
-        # unlimited whitespace between). variable definitions may directly
-        # follow the section header, on the same line!
-        } elsif ($c =~ s/\A\[([0-9a-z.-]+)(?:[\t ]*"(.*?)")?\]//im) {
+        # unlimited whitespace between) or [section.subsection] variable
+        # definitions may directly follow the section header, on the same line!
+        # - rules for sections: not case sensitive, only alphanumeric
+        #   characters, -, and . allowed
+        # - rules for subsections enclosed in ""s: case sensitive, can
+        #   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) {
             $section = lc $1;
+            return $args{error}->(
+                content => $args{content},
+                offset =>  $offset,
+                # don't allow quoted subsections to contain unquoted
+                # double-quotes or backslashes
+            ) if $2 && $2 =~ /(?<!\\)(?:"|\\)/;
             $section .= ".$2" if defined $2;
             $args{callback}->(
                 section    => $section,
@@ -379,6 +392,17 @@ 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 = (
@@ -446,12 +470,15 @@ sub cast {
     }
 }
 
-=head2 get( key => 'foo', as => 'int', filter => qr/regex$/ )
+=head2 get( key => 'sect.subsect.key', as => 'int', filter => qr/regex$/ )
 
 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).
+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
@@ -475,6 +502,9 @@ sub get {
         @_,
     );
     $self->load unless $self->is_loaded;
+
+    $args{key} = $self->_remove_balanced_quotes($args{key});
+
     return undef unless exists $self->data->{$args{key}};
     my $v = $self->data->{$args{key}};
     if (ref $v) {
@@ -484,6 +514,20 @@ sub get {
     }
 }
 
+# I'm pretty sure that someone can come up with an edge case where stripping
+# all balanced quotes like this is not the right thing to do, but I don't
+# see it actually being a problem in practice.
+sub _remove_balanced_quotes {
+    my $self = shift;
+    my $key = shift;
+
+    no warnings 'uninitialized';
+    $key = join '', map { s/"(.*)"/$1/; $_ } split /("[^"]+"|[^.]+)/, $key;
+    $key = join '', map { s/'(.*)'/$1/; $_ } split /('[^']+'|[^.]+)/, $key;
+
+    return $key;
+}
+
 =head2 get_all( key => 'foo', filter => qr/regex$/, as => 'bool' )
 
 Like C<get>, but does not fail if the number of values for the key is not
@@ -503,6 +547,8 @@ sub get_all {
         @_,
     );
     $self->load unless $self->is_loaded;
+    $args{key} = $self->_remove_balanced_quotes($args{key});
+
     return undef unless exists $self->data->{$args{key}};
     my $v = $self->data->{$args{key}};
     my @v = ref $v ? @{$v} : ($v);
@@ -534,22 +580,33 @@ sub dump {
     return $data;
 }
 
-=head2 format_section 'section.subsection'
+=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.
+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;
-    my $section = shift;
-    if ($section =~ /^(.*?)\.(.*)$/) {
+
+    my %args = (
+        section => undef,
+        bare    => undef,
+        @_,
+    );
+
+    if ($args{section} =~ /^(.*?)\.(.*)$/) {
         my ($section, $subsection) = ($1, $2);
         $subsection =~ s/(["\\])/\\$1/g;
-        return qq|[$section "$subsection"]\n|;
+        my $ret = qq|[$section "$subsection"]|;
+        $ret .= "\n" unless $args{bare};
+        return $ret;
     } else {
-        return qq|[$section]\n|;
+        my $ret = qq|[$args{section}]|;
+        $ret .= "\n" unless $args{bare};
+        return $ret;
     }
 }
 
@@ -586,9 +643,12 @@ given filename. It's necessary to specify the filename since the C<confname> att
 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>.
 
-Returns nothing.
+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).
@@ -611,7 +671,9 @@ sub set {
         unless defined $args{multiple};
 
     $args{key} =~ /^(?:(.*)\.)?(.*)$/;
-    my($section, $key) = ($1, $2);
+    my($section, $key) = map { $self->_remove_balanced_quotes($_) }
+        grep { defined $_ } ($1, $2);
+
     die "No section given in key or invalid key $args{key}\n"
         unless defined $section;
 
@@ -622,7 +684,7 @@ sub set {
             unless defined $args{value};
         open(my $fh, ">", $args{filename})
             or die "Can't write to $args{filename}: $!\n";
-        print $fh $self->format_section($section);
+        print $fh $self->format_section(section => $section);
         print $fh $self->format_definition( key => $key, value => $args{value} );
         close $fh;
         return;
@@ -678,7 +740,7 @@ sub set {
                 );
             } else {
                 # Adding a new section
-                $c .= $self->format_section($section);
+                $c .= $self->format_section( section => $section );
                 $c .= $self->format_definition( key => $key, value => $args{value} );
             }
         } else {
@@ -696,13 +758,7 @@ sub set {
         }
     }
 
-    sysopen($fh, "$args{filename}.lock", O_CREAT|O_EXCL|O_WRONLY)
-        or die "Can't open $args{filename}.lock for writing: $!\n";
-    syswrite($fh, $c);
-    close($fh);
-
-    rename("$args{filename}.lock", $args{filename})
-        or die "Can't rename $args{filename}.lock to $args{filename}: $!\n";
+    return $self->_write_config($args{filename}, $c);
 }
 
 # according to git test suite, keys cannot start with a number
@@ -713,6 +769,146 @@ sub _invalid_key {
     return $key =~ /^[0-9]/;
 }
 
+# write config with locking
+sub _write_config {
+    my($self, $filename, $content) = @_;
+
+    # write new config file to disk
+    sysopen(my $fh, "${filename}.lock", O_CREAT|O_EXCL|O_WRONLY)
+        or die "Can't open ${filename}.lock for writing: $!\n";
+    syswrite($fh, $content);
+    close($fh);
+
+    rename("${filename}.lock", ${filename})
+        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;
+
+    my (%args) = (
+        from        => undef,
+        to          => undef,
+        filename    => undef,
+        @_
+    );
+
+    die "No section to rename from given\n" unless defined $args{from};
+
+    my $c = $self->_read_config($args{filename});
+    # file couldn't be opened = nothing to rename
+    return if !defined($c);
+
+    ($args{from}, $args{to}) = map { $self->_remove_balanced_quotes($_) }
+                                grep { defined $_ } ($args{from}, $args{to});
+
+    my @replace;
+    my $prev_matched = 0;
+    my $prev_offset = 0;
+    $self->parse_content(
+        content  => $c,
+        callback => sub {
+            my %got = @_;
+            $replace[-1]->{section_is_last} = 0 if (@replace && !defined($got{name}));
+            if (lc($got{section}) eq lc($args{from})) {
+                # 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
+                if (defined $got{name}) {
+                    if ($prev_matched && !defined $args{to} ) {
+                        $replace[-1]->{length} += $got{offset} + $got{length} -
+                            ($replace[-1]{offset} + $replace[-1]->{length});
+                    }
+                } else {
+                    $replace[-1]->{length} += $got{offset} -
+                        ($replace[-1]->{offset} + $replace[-1]->{length}) if
+                        @replace && $prev_matched && !defined($args{to});
+                    # modify section_is_last later if we find another section
+                    # after it (as well as modifying length)
+                    push @replace, {offset => $got{offset}, length => $got{length},
+                        section_is_last => 1};
+                    $prev_matched = 1;
+                }
+            } else {
+                $replace[-1]->{length} += $got{offset} - ($replace[-1]->{offset} + $replace[-1]->{length}) if @replace && $prev_matched && !defined($args{to});
+                $prev_matched = 0;
+            }
+        },
+        error    => sub {
+            die "Error parsing $args{filename}, near:\n at _\n";
+        },
+    );
+    die "No such section '$args{from}'\n"
+        unless @replace;
+
+    # 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;
+
+    # rename ALL section headers that matched to
+    # (there may be more than one)
+    my $replace_with = defined $args{to} ?
+        $self->format_section( section => $args{to}, bare => 1 ) : '';
+
+    for my $header (@replace) {
+        substr(
+            $c,
+            $header->{offset} + $difference,
+            !defined($args{to}) && $header->{section_is_last} ? length($c) -
+                ($header->{offset} + $difference) : $header->{length},
+            $replace_with,
+        );
+        $difference += (length($replace_with) - $header->{length});
+    }
+
+    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;
+
+    my (%args) = (
+        section     => undef,
+        filename    => undef,
+        @_
+    );
+
+    die "No section given to remove\n" unless $args{section};
+
+    # remove section is just a rename to nothing
+    return $self->rename_section( from => $args{section}, filename =>
+        $args{filename} );
+}
+
 1;
 
 __END__

-----------------------------------------------------------------------



More information about the Bps-public-commit mailing list