[Bps-public-commit] Config-GitLike branch, master, updated. 8c892b9bbedf513330585af340e6581d8e38e7ab
spang at bestpractical.com
spang at bestpractical.com
Tue Jun 16 06:48:58 EDT 2009
The branch, master has been updated
via 8c892b9bbedf513330585af340e6581d8e38e7ab (commit)
via 809a5011c8c61302fb949f6c83161aee73f4a5b3 (commit)
via 9d179b8c6c73b283eeedb0470eb7d99284602bf8 (commit)
via 91f533a456a0a784e653ac805ed5899a8c18eba8 (commit)
via 7ade4902c63ede6d9c3e05d5a0016efc71dcaaa8 (commit)
via 3414e5f7efb1baba48c196ece9a0324b37866a1c (commit)
via e9ce2f0a515a54eb3996c96f44767f0d194ddd51 (commit)
via f5d355d3d715323b2da5d3057d2858af27d8da3f (commit)
via 498c1b2cca459babded135649416d4b9bcb02470 (commit)
from 373fe6f4588998a6b66f42bc497ef72720bd9506 (commit)
Summary of changes:
lib/Config/GitLike.pm | 169 ++++++++++++++++++++++++++++++++++++++++---------
t/t1300-repo-config.t | 113 ++++++++++++++++++++++++++++++++-
2 files changed, 250 insertions(+), 32 deletions(-)
- Log -----------------------------------------------------------------
commit 498c1b2cca459babded135649416d4b9bcb02470
Author: Christine Spang <spang at mit.edu>
Date: Sun Jun 14 10:54:53 2009 +0300
keep track of what files have been loaded
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index af24e79..dba2d8c 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -31,6 +31,12 @@ has 'multiple' => (
default => sub { +{} },
);
+has 'config_files' => (
+ is => 'rw',
+ isa => 'ArrayRef',
+ default => sub { [] },
+);
+
sub set_multiple {
my $self = shift;
my ($name, $mult) = @_, 1;
@@ -47,6 +53,7 @@ sub load {
my $self = shift;
my $path = shift || Cwd::cwd;
$self->data({});
+ $self->config_files([]);
$self->load_global;
$self->load_user;
$self->load_dirs( $path );
@@ -126,6 +133,10 @@ sub load_file {
die "Error parsing $filename, near:\n at _\n";
},
);
+
+ # note this filename as having been loaded
+ push @{$self->config_files}, $filename;
+
return $self->data;
}
@@ -1044,6 +1055,11 @@ 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 config_filenames
+
+An array reference containing the absolute filenames of all config files
+that are currently loaded.
+
=head2 get
Parameters:
commit f5d355d3d715323b2da5d3057d2858af27d8da3f
Author: Christine Spang <spang at mit.edu>
Date: Sun Jun 14 10:55:40 2009 +0300
fixes to load / load_dirs doc
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index dba2d8c..2ecf25a 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -71,8 +71,9 @@ sub load_dirs {
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;
@@ -1051,6 +1052,9 @@ C<confname>(if they exist). Configuration variables loaded later
override those loaded earlier, so variables from the directory
configuration file have the highest precedence.
+Pass in an optional path, and it will be passed on to L<"load_dirs"> (which
+loads the directory configuration file(s)).
+
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.
@@ -1204,10 +1208,16 @@ in the current user's home directory with filename C<confname>.
=head2 load_dirs
+Parameters:
+
+ '/path/to/look/in/'
+
Load the configuration file with the filename L<"dir_file"> in the current
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.)
+one is found. (No error is thrown if none is found.) If an optional path
+is passed in, that directory will be used as the base directory instead
+of the working directory.
Returns nothing of note.
commit e9ce2f0a515a54eb3996c96f44767f0d194ddd51
Author: Christine Spang <spang at mit.edu>
Date: Sun Jun 14 12:21:43 2009 +0300
keys can only contain alphanumeric and - characters (no underscores)
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 2ecf25a..207d725 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -722,12 +722,13 @@ sub _unset_variables {
return ($c, $difference);
}
-# according to the git test suite, keys cannot start with a number
+# keys can only contain alphanumeric characters and -
+# also, they cannot start with a number
sub _invalid_key {
my $self = shift;
my $key = shift;
- return $key =~ /^[0-9]/;
+ return $key =~ /^[0-9]/ || $key !~ /^[0-9a-zA-Z-]+$/;
}
# write config with locking
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 0175912..55a894a 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 => 95;
+use Test::More tests => 96;
use Test::Exception;
use File::Spec;
use File::Temp;
@@ -403,7 +403,17 @@ throws_ok {
filename => $config_filename
);
}
-qr/invalid key/i, 'invalid key';
+qr/invalid key/i, 'invalid key starting with a number';
+
+# ADDITIONAL TEST: keys cannot contain underscore
+throws_ok {
+ $config->set(
+ key => 'inval.underscore_key',
+ value => 'blabla',
+ filename => $config_filename
+ );
+}
+qr/invalid key/i, 'invalid key containing underscore';
lives_ok {
$config->set(
commit 3414e5f7efb1baba48c196ece9a0324b37866a1c
Author: Christine Spang <spang at mit.edu>
Date: Mon Jun 15 19:03:02 2009 +0300
Dramatically relax rules for key names.
SD/Prophet need to be able to have spaces in key names for storing
aliases, and ., :, and / characters for automatic addition of sources
for friendly names. There's little reason not to allow any characters
that won't screw up the parsing except for "because git does it that
way". Dot characters in variable names do allow a chance for identifier
collision in some very weird cases, but it's doubtful that this will
cause problems in practice.
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 207d725..70d8e6f 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -46,7 +46,8 @@ sub set_multiple {
sub is_multiple {
my $self = shift;
my $name = shift;
- return $self->multiple->{$name};
+ return if !defined $name;
+ return exists $self->multiple->{$name};
}
sub load {
@@ -150,6 +151,7 @@ sub parse_content {
@_,
);
my $c = $args{content};
+ return if !$c; # nothing to do if content is empty
my $length = length $c;
my($section, $prev) = (undef, '');
@@ -161,6 +163,7 @@ sub parse_content {
# drop to end of line on comments
if ($c =~ s/\A[#;].*?$//im) {
next;
+ }
# [sub]section headers of the format [section "subsection"] (with
# unlimited whitespace between) or [section.subsection] variable
# definitions may directly follow the section header, on the same line!
@@ -170,7 +173,6 @@ 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) {
$section = lc $1;
return $args{error}->(
@@ -185,20 +187,24 @@ sub parse_content {
offset => $offset,
length => ($length - length($c)) - $offset,
);
+ }
# keys followed by a unlimited whitespace and (optionally) a comment
# (no value)
- }
- elsif ($c =~ s/\A([0-9a-z-]+)[\t ]*([#;].*)?$//im) {
+ #
+ # for keys, we allow any characters that won't screw up the parsing
+ # (= and newline), and match non-greedily to allow any trailing
+ # whitespace to be dropped
+ elsif ($c =~ s/\A([^=\n]+?)[\t ]*([#;].*)?$//im) {
$args{callback}->(
section => $section,
name => $1,
offset => $offset,
length => ($length - length($c)) - $offset,
);
+ }
# 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([^=\n]+?)[\t ]*=[\t ]*//im) {
my $name = $1;
my $value = "";
# parse the value
@@ -565,21 +571,32 @@ sub set {
die "No key given\n" unless defined $args{key};
- $args{multiple} = $self->is_multiple($args{key})
- unless defined $args{multiple};
+ my ($section, $key);
+ # allow quoting of the key to, for example, preserve
+ # . characters in the key
+ if ( $args{key} =~ s/\.["'](.*)["']$// ) {
+ $key = $1;
+ $section = $args{key};
+ }
+ else {
+ $args{key} =~ /^(?:(.*)\.)?(.*)$/;
+ ($section, $key) = map { $self->_remove_balanced_quotes($_) }
+ grep { defined $_ } ($1, $2);
+ }
- $args{key} =~ /^(?:(.*)\.)?(.*)$/;
- my($section, $key) = map { $self->_remove_balanced_quotes($_) }
- grep { defined $_ } ($1, $2);
+ $args{multiple} = $self->is_multiple($key)
+ unless defined $args{multiple};
die "No section given in key or invalid key $args{key}\n"
unless defined $section;
die "Invalid key $key\n" if $self->_invalid_key($key);
- $args{value} = $self->cast(value => $args{value}, as => $args{as},
- human => 1)
- if defined $args{value} && defined $args{as};
+ $args{value} = $self->cast(
+ value => $args{value},
+ as => $args{as},
+ human => 1,
+ ) if defined $args{value} && defined $args{as};
unless (-f $args{filename}) {
die "No occurrence of $args{key} found to unset in $args{filename}\n"
@@ -722,13 +739,26 @@ sub _unset_variables {
return ($c, $difference);
}
-# keys can only contain alphanumeric characters and -
-# also, they cannot start with a number
+# keys can contain any characters that aren't newlines or
+# = characters, but cannot start or end with whitespace
+#
+# Allowing . characters in key names actually makes it so you
+# can get collisions between identifiers for things that are not
+# actually the same.
+#
+# For example, you could have a collision like this:
+# [section "foo"] bar.com = 1
+# [section] foo.bar.com = 1
+#
+# Both of these would be turned into 'section.foo.bar.com'. But it's
+# unlikely to ever actually come up, since you'd have to have
+# a *need* to have two things like this that are very similar
+# and yet different.
sub _invalid_key {
my $self = shift;
my $key = shift;
- return $key =~ /^[0-9]/ || $key !~ /^[0-9a-zA-Z-]+$/;
+ return $key !~ /^[^=\n]*$/ || $key =~ /(?:^[ \t]+|[ \t+]$)/;
}
# write config with locking
@@ -982,7 +1012,9 @@ 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.
+written by git. The converse is usually true, but only if you don't take
+advantage of this module's increased permissiveness when it comes to key
+names. (See L<DIFFERENCES FROM GIT-CONFIG> for details.)
This is an object-oriented module using L<Any::Moose|Any::Moose>. All
subroutines are object method calls.
@@ -1148,6 +1180,10 @@ To unset a key, pass in C<key> but not C<value>.
Returns true on success.
+If you need to have a . character in your variable name, you can surround the
+name with quotes (single or double): C<key => 'section."foo.bar.com"'>
+Don't do this unless you really have to.
+
=head3 multiple values
By default, set will replace the old value rather than giving a key multiple
@@ -1352,6 +1388,11 @@ followed by a newline.
This module does the following things differently from git-config:
+We are much more permissive about valid key names: instead of limiting
+key names to alphanumeric characters and -, we allow any characters
+except for = and newlines, including spaces as long as they are
+not leading or trailing, and . as long as the key name is quoted.
+
When replacing variable values and renaming sections, we merely use
a substring replacement rather than writing out new lines formatted in the
default manner for new lines. Git's replacement/renaming (as of
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 55a894a..9e016db 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 => 96;
+use Test::More tests => 101;
use Test::Exception;
use File::Spec;
use File::Temp;
@@ -396,24 +396,65 @@ EOF
is( slurp($config_filename), $expect, 'multivar unset' );
+# ADDITIONAL TESTS (7): our rules for valid keys are
+# much more permissive than git's
throws_ok {
$config->set(
- key => 'inval.2key',
+ key => "inval.key=foo",
value => 'blabla',
filename => $config_filename
);
}
-qr/invalid key/i, 'invalid key starting with a number';
+qr/invalid key/i, 'invalid key containing = char';
-# ADDITIONAL TEST: keys cannot contain underscore
throws_ok {
$config->set(
- key => 'inval.underscore_key',
+ key => 'inval. key',
value => 'blabla',
filename => $config_filename
);
}
-qr/invalid key/i, 'invalid key containing underscore';
+qr/invalid key/i, 'invalid key starting with whitespace';
+
+throws_ok {
+ $config->set(
+ key => 'inval.key ',
+ value => 'blabla',
+ filename => $config_filename
+ );
+}
+qr/invalid key/i, 'invalid key ending with whitespace';
+
+throws_ok {
+ $config->set(
+ key => "inval.key\n2",
+ value => 'blabla',
+ filename => $config_filename
+ );
+}
+qr/invalid key/i, 'invalid key containing newline';
+
+lives_ok {
+ $config->set(
+ key => 'valid."http://example.com/"',
+ value => 'true',
+ filename => $config_filename,
+ );
+}
+'can have . char in key if quoted';
+
+lives_and {
+ $config->load;
+ is( $config->get( key => 'valid."http://example.com/"' ), 'true' );
+}
+'URL key value is correct';
+
+# kill this section just to not have to modify all the following tests
+lives_ok {
+ $config->remove_section( section => 'valid', filename => $config_filename );
+ $config->load;
+}
+'remove URL key section';
lives_ok {
$config->set(
commit 7ade4902c63ede6d9c3e05d5a0016efc71dcaaa8
Author: Christine Spang <spang at mit.edu>
Date: Mon Jun 15 20:50:47 2009 +0300
Make dump print multiple values correctly.
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 70d8e6f..fbb1ca6 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -500,7 +500,15 @@ sub dump {
for my $key (sort keys %{$self->data}) {
my $str;
if (defined $self->data->{$key}) {
- $str = "$key=".$self->data->{$key}."\n";
+ $str = "$key=";
+ if ( $self->is_multiple($key) ) {
+ $str .= '[';
+ $str .= join(', ', @{$self->data->{$key}});
+ $str .= "]\n";
+ }
+ else {
+ $str .= $self->data->{$key}."\n";
+ }
}
else {
$str = "$key\n";
commit 91f533a456a0a784e653ac805ed5899a8c18eba8
Author: Christine Spang <spang at mit.edu>
Date: Mon Jun 15 20:51:44 2009 +0300
Make this legible.
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index fbb1ca6..6ea4ee4 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -486,8 +486,11 @@ sub get_regexp {
}
}
- @results{keys %results} = map { $self->cast( value => $results{$_}, as =>
- $args{as} ) } keys %results;
+ @results{keys %results} =
+ map { $self->cast(
+ value => $results{$_},
+ as => $args{as}
+ ); } keys %results;
return wantarray ? %results : \%results;
}
@@ -1264,6 +1267,9 @@ one is found. (No error is thrown if none is found.) If an optional path
is passed in, that directory will be used as the base directory instead
of the working directory.
+You'll want to use L<"load_file"> to load config files from your overridden
+version of this subroutine.
+
Returns nothing of note.
=head1 OTHER METHODS
@@ -1292,6 +1298,10 @@ 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).
+Note that you ought to only call this subroutine with an argument that you
+know exists, otherwise config files that don't exist will be recorded as
+havind been loaded.
+
=head2 parse_content
Parameters:
commit 9d179b8c6c73b283eeedb0470eb7d99284602bf8
Author: Christine Spang <spang at mit.edu>
Date: Mon Jun 15 23:32:14 2009 +0300
Ow: clear multiple on reload as well.
Otherwise, we can have keys being marked as multiple
leaking into later uses where they're really not.
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 6ea4ee4..ab21f08 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -54,6 +54,7 @@ sub load {
my $self = shift;
my $path = shift || Cwd::cwd;
$self->data({});
+ $self->multiple({});
$self->config_files([]);
$self->load_global;
$self->load_user;
commit 809a5011c8c61302fb949f6c83161aee73f4a5b3
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 16 12:06:32 2009 +0300
Keep track of which file each key was loaded from.
Ow. We need this because otherwise, when loading, say,
a user config file that contains a value that's also
contained in a global config file that has already
been loaded, instead of overriding the old key with
the one from the new file, it would treat the key
has having multiple values. Which isn't the desired
behaviour.
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index ab21f08..f99d041 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -25,12 +25,20 @@ has 'data' => (
isa => 'HashRef',
);
+# key => bool
has 'multiple' => (
is => 'rw',
isa => 'HashRef',
default => sub { +{} },
);
+# filename where the definition of each key was loaded from
+has 'origins' => (
+ is => 'rw',
+ isa => 'HashRef',
+ default => sub { +{} },
+);
+
has 'config_files' => (
is => 'rw',
isa => 'ArrayRef',
@@ -47,7 +55,7 @@ sub is_multiple {
my $self = shift;
my $name = shift;
return if !defined $name;
- return exists $self->multiple->{$name};
+ return $self->multiple->{$name};
}
sub load {
@@ -130,7 +138,7 @@ sub load_file {
$self->parse_content(
content => $c,
callback => sub {
- $self->define(@_);
+ $self->define(@_, origin => $filename);
},
error => sub {
die "Error parsing $filename, near:\n at _\n";
@@ -298,21 +306,37 @@ sub define {
section => undef,
name => undef,
value => undef,
+ origin => undef,
@_,
);
return unless defined $args{name};
$args{name} = lc $args{name};
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}];
+
+ # we're either adding a whole new key or adding a multiple key from
+ # the same file
+ if ( !defined $self->origins->{$key}
+ || $self->origins->{$key} eq $args{origin} ) {
+ 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};
+ }
}
+ # we're overriding a key set previously from a different file
else {
+ # un-mark as multiple if it was previously marked as such
+ $self->set_multiple( $key, 0 ) if $self->is_multiple( $key );
+
+ # set the new value
$self->data->{$key} = $args{value};
}
+ $self->origins->{$key} = $args{origin};
}
sub cast {
commit 8c892b9bbedf513330585af340e6581d8e38e7ab
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 16 12:09:27 2009 +0300
Add tests for overriding keys from files of higher precedence.
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 9e016db..299ac62 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 => 101;
+use Test::More tests => 104;
use Test::Exception;
use File::Spec;
use File::Temp;
@@ -1177,3 +1177,59 @@ 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');
+
+# Test config file inheritance/overriding.
+
+# Config files are loaded in the order: global, user, dir. Variables contained
+# in files loaded later replace variables of the same name that were
+# loaded earlier.
+
+unlink $config_filename;
+
+my $global_config = File::Spec->catfile( $config_dirname, 'etc', 'config' );
+my $user_config = File::Spec->catfile( $config_dirname, 'home', 'config' );
+my $repo_config = $config_filename;
+
+mkdir File::Spec->catdir( $config_dirname, 'etc' );
+mkdir File::Spec->catdir( $config_dirname, 'home' );
+
+burp(
+ $repo_config,
+ '[section]
+ b = off
+'
+);
+
+burp(
+ $user_config,
+ '[section]
+ b = on
+ a = off
+'
+);
+
+$config->load;
+
+is( $config->get( key => 'section.b' ), 'off',
+ 'repo config overrides user config');
+
+is( $config->get( key => 'section.a' ), 'off',
+ 'user config is loaded');
+
+burp(
+ $global_config,
+ '[section]
+ b = true
+ a = true
+ c = true
+'
+);
+
+$config->load;
+
+%results = $config->dump;
+is_deeply(
+ \%results,
+ { 'section.a' => 'off', 'section.b' => 'off', 'section.c' => 'true' },
+ 'global config is loaded and user/repo configs override it'
+);
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list