[Bps-public-commit] Config-GitLike branch, master, updated. b95832ebbe3029821bcc319a36b5e8366dc03bb0
spang at bestpractical.com
spang at bestpractical.com
Wed Jun 3 08:36:10 EDT 2009
The branch, master has been updated
via b95832ebbe3029821bcc319a36b5e8366dc03bb0 (commit)
via 11c3fd782e996fdd7e491b540fc3b73abbdabb86 (commit)
via f4c71254bea3a9b0c30d3333139eb4ac29136f76 (commit)
via db51bf128349572252284b4025c60b0751bcf48f (commit)
via 93762f2ea4cf228d3c69fa9b1bf8c8a271f55e0e (commit)
via 5f6fbea29b11e92a285df17388f222fa49b74d0b (commit)
via 8682faf8c317990aa0df71c96acb9854cbc63006 (commit)
via 17a941a67f63c4e0486305edeeb9fe3883c4cc68 (commit)
via b117f8f0d599005da52d8fb043ad771045ff3d94 (commit)
via 4941a9aaa9de82436d3318dc7502446e748b89c1 (commit)
via 57a25c56a0a9587fc1d4ffc56af0d68cb953a7e7 (commit)
from 129f847c7e129baf988966ce9f74f71fb6bdf305 (commit)
Summary of changes:
Makefile.PL | 4 +
lib/Config/GitLike.pm | 123 +++++++-
t/lib/TestConfig.pm | 41 +++
t/t1300-repo-config.t | 804 +++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 957 insertions(+), 15 deletions(-)
create mode 100644 t/lib/TestConfig.pm
create mode 100644 t/t1300-repo-config.t
- Log -----------------------------------------------------------------
commit 57a25c56a0a9587fc1d4ffc56af0d68cb953a7e7
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 2 14:00:49 2009 +0300
more pod
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index b58cf93..c9d4725 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -379,6 +379,23 @@ sub define {
}
}
+=head2 cast( value => 'foo', as => 'int' )
+
+Return C<value> cast into the type specified by C<as>.
+
+Valid values for C<as> are C<bool> or C<int>. For C<bool>, C<true>, C<yes>,
+C<on>, C<1>, and undef are translated into a true value; anything else is
+false.
+
+For C<int>s, if C<value> ends in C<k>, C<m>, or C<g>, it will be multiplied by
+1024, 1048576, and 1073741824, respectively, before being returned.
+
+If C<as> is unspecified, C<value> is returned unchanged.
+
+XXX TODO
+
+=cut
+
sub cast {
my $self = shift;
my %args = (
@@ -401,15 +418,24 @@ sub cast {
}
}
-=head2 get( key => $str, as => $type )
+=head2 get( key => 'foo', 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 a string by default); the C<as>
-option is not (will return undef if unspecified).
+The C<key> option is required (will return undef if unspecified); the C<as>
+option is not (will return a string by default).
+
+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 C<get_all to retrieve multiple values.)
Loads the configuration file with name $confname if it hasn't yet been
-loaded.
+loaded. Note that if you've run any C<set> calls to the loaded
+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)
=cut
@@ -430,6 +456,17 @@ sub get {
}
}
+=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
+exactly one.
+
+Returns a list of values, cast as C<as> if C<as> is specified.
+
+TODO implement filter
+
+=cut
+
sub get_all {
my $self = shift;
my %args = (
@@ -444,6 +481,17 @@ sub get_all {
return map {$self->cast( value => $v, as => $args{as} )} @v;
}
+=head2 dump
+
+Print all configuration data, sorted in ASCII order, in the form:
+
+ section.key=value
+ section2.key=value
+
+This is similar to the output of C<git config --list>.
+
+=cut
+
sub dump {
my $self = shift;
for my $key (sort keys %{$self->data}) {
@@ -455,6 +503,13 @@ sub dump {
}
}
+=head2 format_section 'section.subsection'
+
+Return a formatted string representing how section headers should be printed in
+the config file.
+
+=cut
+
sub format_section {
my $self = shift;
my $section = shift;
@@ -485,6 +540,22 @@ sub format_definition {
return $ret;
}
+=head2 set( key => "section.foo", value => "bar", filename => File::Spec->catfile(qw/home user/, "." . $config->confname, filter => qr/regex/ )
+
+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 C<confname> attribute
+is not unambiguous enough to determine where to write to. (There may be multiple config
+files in different directories which inherit.)
+
+To unset a key, pass in C<key> but not C<value>.
+
+Returns nothing.
+
+TODO The filter arg is for multiple value support (see value_regex in git help config
+for details).
+
+=cut
+
sub set {
my $self = shift;
my (%args) = (
commit 4941a9aaa9de82436d3318dc7502446e748b89c1
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 2 14:08:08 2009 +0300
fix for discrepency caught by git test suite: section names are case-insensitive
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index c9d4725..f373eb5 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -595,7 +595,7 @@ sub set {
content => $c,
callback => sub {
my %got = @_;
- return unless $got{section} eq $section;
+ return unless lc($got{section}) eq lc($section);
$new = $got{offset} + $got{length};
return unless defined $got{name};
push @replace, {offset => $got{offset}, length => $got{length}}
commit b117f8f0d599005da52d8fb043ad771045ff3d94
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 2 15:09:03 2009 +0300
check to make sure key is given in set
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index f373eb5..bcc2a9f 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -566,6 +566,8 @@ sub set {
@_
);
+ die "No key given\n" unless defined $args{key};
+
$args{multiple} = $self->is_multiple($args{key})
unless defined $args{multiple};
commit 17a941a67f63c4e0486305edeeb9fe3883c4cc68
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 2 15:44:16 2009 +0300
fix missing , in format_definition which causes it to lose all its args
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index bcc2a9f..4479c13 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -527,7 +527,7 @@ sub format_definition {
my %args = (
key => undef,
value => undef,
- bare => undef
+ bare => undef,
@_,
);
my $quote = $args{value} =~ /(^\s|;|#|\s$)/ ? '"' : '';
commit 8682faf8c317990aa0df71c96acb9854cbc63006
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 2 17:15:59 2009 +0300
occurrance -> occurrence
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 4479c13..d7634cb 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -576,7 +576,7 @@ sub set {
die "No section given in key $args{key}\n" unless defined $section;
unless (-e $args{filename}) {
- die "No occurrance of $args{key} found to unset in $args{filename}\n"
+ die "No occurrence of $args{key} found to unset in $args{filename}\n"
unless defined $args{value};
open(my $fh, ">", $args{filename})
or die "Can't write to $args{filename}: $!\n";
@@ -611,7 +611,7 @@ sub set {
if ($args{multiple}) {
die "!!!"; # Unimplemented yet
} else {
- die "Multiple occurrances of non-multiple key?"
+ die "Multiple occurrences of non-multiple key?"
if @replace > 1;
if (defined $args{value}) {
if (@replace) {
@@ -644,7 +644,7 @@ sub set {
}
} else {
# Removing an existing value
- die "No occurrance of $args{key} found to unset in $args{filename}\n"
+ die "No occurrence of $args{key} found to unset in $args{filename}\n"
unless @replace;
my $start = rindex($c, "\n", $replace[0]{offset});
commit 5f6fbea29b11e92a285df17388f222fa49b74d0b
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 2 17:47:53 2009 +0300
attempt to load only plain files, not directories
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index d7634cb..7bd09f8 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -124,7 +124,7 @@ sub load_dirs {
my @dirs = File::Spec->splitdir( $dirs );
while (@dirs) {
my $path = File::Spec->catpath( $vol, File::Spec->catdir(@dirs), $self->dir_file );
- if (-e $path) {
+ if (-f $path) {
$self->load_file( $path );
last;
}
@@ -159,7 +159,7 @@ file has been loaded, or undef if no global config file is found.
sub load_global {
my $self = shift;
- return unless -e $self->global_file;
+ return unless -f $self->global_file;
return $self->load_file( $self->global_file );
}
@@ -191,7 +191,7 @@ has been loaded, or undef if no global config file is found.
sub load_user {
my $self = shift;
- return unless -e $self->user_file;
+ return unless -f $self->user_file;
return $self->load_file( $self->user_file );
}
@@ -575,7 +575,7 @@ sub set {
my($section, $key) = ($1, $2);
die "No section given in key $args{key}\n" unless defined $section;
- unless (-e $args{filename}) {
+ unless (-f $args{filename}) {
die "No occurrence of $args{key} found to unset in $args{filename}\n"
unless defined $args{value};
open(my $fh, ">", $args{filename})
commit 93762f2ea4cf228d3c69fa9b1bf8c8a271f55e0e
Author: Christine Spang <spang at mit.edu>
Date: Tue Jun 2 20:15:30 2009 +0300
fix for test suite compliance: reject keys that begin with a number
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 7bd09f8..b47f527 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -575,6 +575,8 @@ sub set {
my($section, $key) = ($1, $2);
die "No section given in key $args{key}\n" unless defined $section;
+ die "Invalid key $key\n" if $self->_invalid_key($key);
+
unless (-f $args{filename}) {
die "No occurrence of $args{key} found to unset in $args{filename}\n"
unless defined $args{value};
@@ -666,6 +668,14 @@ sub set {
or die "Can't rename $args{filename}.lock to $args{filename}: $!\n";
}
+# according to git test suite, keys cannot start with a number
+sub _invalid_key {
+ my $self = shift;
+ my $key = shift;
+
+ return $key =~ /^[0-9]/;
+}
+
1;
__END__
commit db51bf128349572252284b4025c60b0751bcf48f
Author: Christine Spang <spang at mit.edu>
Date: Wed Jun 3 14:38:22 2009 +0300
initial port of git config's test suite
diff --git a/t/lib/TestConfig.pm b/t/lib/TestConfig.pm
new file mode 100644
index 0000000..f0c876c
--- /dev/null
+++ b/t/lib/TestConfig.pm
@@ -0,0 +1,41 @@
+package TestConfig;
+use Any::Moose;
+use File::Spec;
+extends 'Config::GitLike';
+
+has 'tmpdir' => (
+ is => 'rw',
+ required => 1,
+ isa => 'Str',
+);
+
+# override these methods so:
+# (1) test cases don't need to chdir into the tmp directory in order to work correctly
+# (2) we don't try loading configs from the user's home directory or the system
+# /etc during tests, which could (a) cause tests to break and (b) change things on
+# the user's system during tests
+# (3) files in the test directory are not hidden (for easier debugging)
+
+sub dir_file {
+ my $self = shift;
+
+ return File::Spec->catfile($self->tmpdir, $self->confname);
+}
+
+sub user_file {
+ my $self = shift;
+
+ return File::Spec->catfile($self->tmpdir, 'home', $self->confname);
+}
+
+sub global_file {
+ my $self = shift;
+
+ return File::Spec->catfile($self->tmpdir, 'etc', $self->confname);
+}
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
+
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
new file mode 100644
index 0000000..6a857a8
--- /dev/null
+++ b/t/t1300-repo-config.t
@@ -0,0 +1,804 @@
+use strict;
+use warnings;
+
+use File::Copy;
+use Test::More tests => 65;
+use Test::Exception;
+use File::Spec;
+use File::Temp;
+use lib 't/lib';
+use TestConfig;
+
+sub slurp {
+ my $file = shift;
+ local( $/ ) ;
+ open( my $fh, $file ) or die "Unable to open file ${file}: $!";
+ return <$fh>;
+}
+
+sub burp {
+ my $file_name = shift;
+ open( my $fh, ">$file_name" ) ||
+ die "can't open ${file_name}: $!";
+ print $fh @_;
+}
+
+# create an empty test directory in /tmp
+my $config_dir = File::Temp->newdir(CLEANUP => !$ENV{CONFIG_GITLIKE_DEBUG});
+my $config_dirname = $config_dir->dirname;
+my $config_filename = File::Spec->catfile($config_dirname, 'config');
+
+diag "config file is: $config_filename";
+
+my $config = TestConfig->new(confname => 'config', tmpdir => $config_dirname);
+$config->load;
+
+diag('Test git config in different settings');
+
+$config->set(key => 'core.penguin', value => 'little blue', filename =>
+ $config_filename);
+
+my $expect = <<'EOF'
+[core]
+ penguin = little blue
+EOF
+;
+
+is(slurp($config_filename), $expect, 'initial');
+
+$config->set(key => 'Core.Movie', value => 'BadPhysics', filename =>
+ $config_filename);
+
+$expect = <<'EOF'
+[core]
+ penguin = little blue
+ Movie = BadPhysics
+EOF
+;
+
+is(slurp($config_filename), $expect, 'mixed case');
+
+$config->set(key => 'Cores.WhatEver', value => 'Second', filename =>
+ $config_filename);
+
+$expect = <<'EOF'
+[core]
+ penguin = little blue
+ Movie = BadPhysics
+[Cores]
+ WhatEver = Second
+EOF
+;
+
+is(slurp($config_filename), $expect, 'similar section');
+
+$config->set(key => 'CORE.UPPERCASE', value => 'true', filename =>
+ $config_filename);
+
+$expect = <<'EOF'
+[core]
+ penguin = little blue
+ Movie = BadPhysics
+ UPPERCASE = true
+[Cores]
+ WhatEver = Second
+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 => 'very blue', filter =>
+ qr/!kingpin/, filename => $config_filename) } 'replace with non-match';
+
+TODO: {
+ local $TODO = 'Multiple values are not yet implemented.';
+
+ $expect = <<'EOF'
+[core]
+ penguin = very blue
+ Movie = BadPhysics
+ UPPERCASE = true
+ penguin = kingpin
+[Cores]
+ WhatEver = Second
+EOF
+;
+
+ is(slurp($config_filename), $expect, 'non-match result');
+}
+
+burp($config_filename,
+'[alpha]
+bar = foo
+[beta]
+baz = multiple \
+lines
+');
+
+lives_ok { $config->set(key => 'beta.baz', filename => $config_filename) }
+ 'unset with cont. lines';
+
+$expect = <<'EOF'
+[alpha]
+bar = foo
+[beta]
+EOF
+;
+
+is(slurp($config_filename), $expect, 'unset with cont. lines is correct');
+
+burp($config_filename,
+'[beta] ; silly comment # another comment
+noIndent= sillyValue ; \'nother silly comment
+
+ ; 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');
+
+# 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');
+
+# 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
+ haha = gamma
+[nextSection] noNewline = ouch
+');
+
+$config->set(key => 'beta.haha', value => 'alpha', filename => $config_filename);
+
+$expect = <<'EOF'
+[beta] ; silly comment # another comment
+noIndent= sillyValue ; 'nother silly comment
+
+ ; comment
+ haha = alpha
+[nextSection] noNewline = ouch
+EOF
+;
+
+is(slurp($config_filename), $expect, 'really mean test');
+
+TODO: {
+ local $TODO = "cannot handle replacing value after section w/o newline yet";
+
+ $config->set(key => 'nextsection.nonewline', value => 'wow', filename => $config_filename);
+
+ $expect = <<'EOF'
+[beta] ; silly comment # another comment
+noIndent= sillyValue ; 'nother silly comment
+
+ ; comment
+ haha = alpha
+[nextSection]
+ nonewline = wow
+EOF
+ ;
+
+ is(slurp($config_filename), $expect, 'really really mean test');
+}
+
+# XXX remove this burp after un-TODOing the above block
+burp($config_filename,
+'[beta] ; silly comment # another comment
+noIndent= sillyValue ; \'nother silly comment
+
+ ; comment
+ haha = alpha
+[nextSection]
+ nonewline = wow
+');
+
+$config->load;
+is($config->get(key => 'beta.haha'), 'alpha', 'get value');
+
+# unset beta.haha (unset accomplished by value = undef)
+$config->set(key => 'beta.haha', filename => $config_filename);
+
+$expect = <<'EOF'
+[beta] ; silly comment # another comment
+noIndent= sillyValue ; 'nother silly comment
+
+ ; comment
+[nextSection]
+ nonewline = wow
+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);
+
+ $expect = <<'EOF'
+[beta] ; silly comment # another comment
+noIndent= sillyValue ; 'nother silly comment
+
+ ; comment
+[nextSection]
+ nonewline = wow
+ NoNewLine = wow2 for me
+EOF
+ ;
+
+ is(slurp($config_filename), $expect, 'multivar');
+
+ $config->load;
+ lives_ok { $config->get(key => 'nextsection.nonewline', filter => qr/!for/) }
+ 'non-match';
+
+ is($config->get(key => 'nextsection.nonewline', filter => qr/!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';
+
+ is($config->get_all(key => 'nextsection.nonewline'), ['wow', 'wow2 for me'],
+ 'get multivar');
+
+ $config->set(key => 'nextsection.nonewline', value => 'wow3', filter => qr/wow$/,
+ filename => $config_filename);
+
+ $expect = <<'EOF'
+noIndent= sillyValue ; 'nother silly comment
+
+ ; comment
+[nextSection]
+ nonewline = wow3
+ NoNewLine = wow2 for me
+EOF
+ ;
+
+ 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';
+
+ 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";
+
+ $expect = <<'EOF'
+noIndent= sillyValue ; 'nother silly comment
+
+ ; comment
+[nextSection]
+ NoNewLine = wow2 for me
+EOF
+ ;
+
+ 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';
+
+lives_ok { $config->set(key => '123456.a123', value => '987', filename =>
+ $config_filename) } 'correct key';
+
+lives_ok { $config->set(key => 'Version.1.2.3eX.Alpha', value => 'beta', filename =>
+ $config_filename) } 'correct key';
+
+$expect = <<'EOF'
+[beta] ; silly comment # another comment
+noIndent= sillyValue ; 'nother silly comment
+
+ ; comment
+[nextSection]
+ NoNewLine = wow2 for me
+[123456]
+ a123 = 987
+[Version "1.2.3eX"]
+ Alpha = beta
+EOF
+;
+
+is(slurp($config_filename), $expect, 'hierarchical section value');
+
+# TODO git outputs keys in the order they are in the config file;
+# this won't exactly match since ->dump outputs sorted
+TODO: {
+ local $TODO = 'git config doesn\'t sort when using --list';
+
+ $expect = <<'EOF'
+beta.noindent=sillyValue
+nextsection.nonewline=wow2 for me
+123456.a123=987
+version.1.2.3eX.alpha=beta
+EOF
+ ;
+
+ is($config->dump, $expect, 'working dump');
+}
+
+TODO: {
+ local $TODO = 'get_regexp is not implemented';
+
+ $expect = <<'EOF'
+beta.noindent sillyValue
+nextsection.nonewline wow2 for me
+EOF
+ ;
+
+ lives_and { is($config->get_regexp( 'in' ), $expect) } '--get-regexp';
+}
+
+TODO: {
+ local $TODO = 'cannot set multiple values yet';
+
+ $config->set(key => 'nextsection.nonewline', value => 'wow4 for you',
+ filename => $config_filename);
+
+ $expect = <<'EOF'
+wow2 for me
+wow4 for you
+EOF
+ ;
+
+ $config->load;
+ is($config->get_all(key => 'nextsection.nonewline'), $expect, '--add');
+}
+
+burp($config_filename,
+'[novalue]
+ variable
+[emptyvalue]
+ variable =
+');
+
+$config->load;
+lives_and { is($config->get( key => 'novalue.variable', filter => qr/^$/ ),
+ undef) } 'get variable with no value';
+
+lives_and { is($config->get( key => 'emptyvalue.variable', filter => qr/^$/ ),
+ '') } 'get variable with empty value';
+
+TODO: {
+ local $TODO = "get_regexp is not implemented";
+ # TODO perhaps regexps could just be supported by the get interface
+
+ lives_and { is($config->get_regexp( qr/novalue/ ), '') }
+ 'get_regexp variable with no value';
+
+ lives_and { is($config->get_regexp( qr/novalue/ ), '') }
+ 'get_regexp variable with empty value';
+}
+
+# should evaluate to a true value
+ok($config->get( key => 'novalue.variable', as => 'bool' ),
+ 'get bool variable with no value');
+
+# should evaluate to a false value
+ok(!$config->get( key => 'emptyvalue.variable', as => 'bool' ),
+ 'get bool variable with empty value');
+
+# testing alternate subsection notation
+burp($config_filename,
+'[a.b]
+ c = d
+');
+
+$config->set(key => 'a.x', value => 'y', filename => $config_filename);
+
+$expect = <<'EOF'
+[a.b]
+ c = d
+[a]
+ x = y
+EOF
+;
+
+is(slurp($config_filename), $expect, 'new section is partial match of another');
+
+$config->set(key => 'b.x', value => 'y', filename => $config_filename);
+$config->set(key => 'a.b', value => 'c', filename => $config_filename);
+$config->load;
+
+$expect = <<'EOF'
+[a.b]
+ c = d
+[a]
+ x = y
+ b = c
+[b]
+ x = y
+EOF
+;
+
+is(slurp($config_filename), $expect, 'new variable inserts into proper section');
+
+TODO: {
+ local $TODO = 'rename_section is not yet implemented';
+
+ lives_ok { $config->rename_section( from => 'branch.eins', to =>
+ 'branch.zwei', filename => $config_filename ) }
+ 'rename_section lives';
+
+ $expect = <<'EOF'
+[branch "zwei"]
+ x = 1
+[branch "zwei"]
+ y = 1
+ [branch "1 234 blabl/a"]
+weird
+EOF
+ ;
+ 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';
+
+ 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';
+
+ $expect = <<'EOF'
+[branch "zwei"]
+ x = 1
+[branch "zwei"]
+ y = 1
+[branch "drei"]
+weird
+EOF
+ ;
+
+ is(slurp($config_filename), $expect, 'rename succeeded');
+}
+
+TODO: {
+ local $TODO = 'remove section is not yet implemented';
+
+ burp($config_filename,
+'[branch "zwei"] a = 1 [branch "vier"]
+');
+
+ lives_ok { $config->remove_section( section => 'branch.zwei',
+ filename => $config_filename ) } 'remove section';
+
+ $expect = <<'EOF'
+[branch "drei"]
+weird
+EOF
+ ;
+
+ is(slurp($config_filename), $expect, 'section was removed properly');
+
+}
+
+unlink $config_filename;
+
+$expect = <<'EOF'
+[gitcvs]
+ enabled = true
+ dbname = %Ggitcvs2.%a.%m.sqlite
+[gitcvs "ext"]
+ dbname = %Ggitcvs1.%a.%m.sqlite
+EOF
+;
+
+$config->set( key => 'gitcvs.enabled', value => 'true',
+ filename => $config_filename );
+$config->set( key => 'gitcvs.ext.dbname', value => '%Ggitcvs1.%a.%m.sqlite',
+ filename => $config_filename);
+$config->set( key => 'gitcvs.dbname', value => '%Ggitcvs2.%a.%m.sqlite',
+ filename => $config_filename );
+is(slurp($config_filename), $expect, 'section ending');
+
+# testing int casting
+
+$config->set( key => 'kilo.gram', value => '1k', filename => $config_filename );
+$config->set( key => 'mega.ton', value => '1m', filename => $config_filename );
+$config->load;
+is($config->get( key => 'kilo.gram', as => 'int' ), 1024,
+ 'numbers: int k interp');
+is($config->get( key => 'mega.ton', as => 'int' ), 1048576,
+ 'numbers: int m interp');
+
+# units that aren't k/m/g should throw an error
+
+$config->set( key => 'aninvalid.unit', value => '1auto', filename => $config_filename );
+$config->load;
+throws_ok { $config->get( key => 'aninvalid.unit', as => 'int' ) }
+ qr/invalid unit/i, 'invalid unit';
+
+my %pairs = qw( true1 01 true2 -1 true3 YeS true4 true false1 000 false3 nO false4 FALSE);
+$pairs{false2} = '';
+
+for my $key (keys %pairs) {
+ $config->set( key => "bool.$key", value => $pairs{$key},
+ filename => $config_filename );
+}
+$config->load;
+
+my @results = ();
+
+for my $i (1..4) {
+ push(@results, $config->get( key => "bool.true$i", as => 'bool' ) eq 1,
+ $config->get( key => "bool.false$i", as => 'bool' ) eq 1);
+}
+
+my $b = 1;
+
+ at results = reverse @results;
+while (@results) {
+ if ($b) {
+ ok(pop @results, 'bool');
+ } else {
+ ok(!pop @results, 'bool');
+ }
+ $b = !$b;
+}
+
+$config->set( key => 'bool.nobool', value => 'foobar',
+ filename => $config_filename );
+$config->load;
+throws_ok { $config->get( key => 'bool.nobool', as => 'bool' ) }
+ qr/invalid bool/i, 'invalid bool (get)';
+
+# TODO currently the interface doesn't support casting for set. does that make sense?
+# test_expect_success 'invalid bool (set)' '
+#
+# test_must_fail git config --bool bool.nobool foobar'
+#
+# unlink $config_filename;
+#
+# $expect = <<'EOF'
+# [bool]
+# true1 = true
+# true2 = true
+# true3 = true
+# true4 = true
+# false1 = false
+# false2 = false
+# false3 = false
+# false4 = false
+# EOF
+#
+# test_expect_success 'set --bool' '
+#
+# git config --bool bool.true1 01 &&
+# git config --bool bool.true2 -1 &&
+# git config --bool bool.true3 YeS &&
+# git config --bool bool.true4 true &&
+# git config --bool bool.false1 000 &&
+# git config --bool bool.false2 "" &&
+# git config --bool bool.false3 nO &&
+# git config --bool bool.false4 FALSE &&
+# cmp expect .git/config'
+#
+# unlink $config_filename;
+#
+# $expect = <<'EOF'
+# [int]
+# val1 = 1
+# val2 = -1
+# val3 = 5242880
+# EOF
+#
+# test_expect_success 'set --int' '
+#
+# git config --int int.val1 01 &&
+# git config --int int.val2 -1 &&
+# git config --int int.val3 5m &&
+# cmp expect .git/config'
+#
+# unlink $config_filename;
+#
+# $expect = <<'EOF'
+# [bool]
+# true1 = true
+# true2 = true
+# false1 = false
+# false2 = false
+# [int]
+# int1 = 0
+# int2 = 1
+# int3 = -1
+# EOF
+#
+# TODO interface doesn't support bool-or-int (does it want to?)
+# test_expect_success 'get --bool-or-int' '
+# (
+# echo "[bool]"
+# echo true1
+# echo true2 = true
+# echo false = false
+# echo "[int]"
+# echo int1 = 0
+# echo int2 = 1
+# echo int3 = -1
+# ) >>.git/config &&
+# test $(git config --bool-or-int bool.true1) = true &&
+# test $(git config --bool-or-int bool.true2) = true &&
+# test $(git config --bool-or-int bool.false) = false &&
+# test $(git config --bool-or-int int.int1) = 0 &&
+# test $(git config --bool-or-int int.int2) = 1 &&
+# test $(git config --bool-or-int int.int3) = -1
+#
+# '
+#
+# unlink $config_filename;
+# $expect = <<'EOF'
+# [bool]
+# true1 = true
+# false1 = false
+# true2 = true
+# false2 = false
+# [int]
+# int1 = 0
+# int2 = 1
+# int3 = -1
+# EOF
+#
+# test_expect_success 'set --bool-or-int' '
+# git config --bool-or-int bool.true1 true &&
+# git config --bool-or-int bool.false1 false &&
+# git config --bool-or-int bool.true2 yes &&
+# git config --bool-or-int bool.false2 no &&
+# git config --bool-or-int int.int1 0 &&
+# git config --bool-or-int int.int2 1 &&
+# git config --bool-or-int int.int3 -1 &&
+# test_cmp expect .git/config
+# '
+
+unlink $config_filename;
+
+$config->set(key => 'quote.leading', value => ' test', filename =>
+ $config_filename);
+$config->set(key => 'quote.ending', value => 'test ', filename =>
+ $config_filename);
+$config->set(key => 'quote.semicolon', value => 'test;test', filename =>
+ $config_filename);
+$config->set(key => 'quote.hash', value => 'test#test', filename =>
+ $config_filename);
+
+$expect = <<'EOF'
+[quote]
+ leading = " test"
+ ending = "test "
+ semicolon = "test;test"
+ hash = "test#test"
+EOF
+;
+
+is(slurp($config_filename), $expect, 'quoting');
+
+throws_ok { $config->set( key => "key.with\nnewline", value => '123',
+ filename => $config_filename ) } qr/invalid key/, 'key with newline';
+
+lives_ok { $config->set( key => 'key.sub', value => "value.with\nnewline",
+ filename => $config_filename ) } 'value with newline';
+
+burp($config_filename,
+'[section]
+ ; comment \
+ continued = cont\
+inued
+ noncont = not continued ; \
+ quotecont = "cont;\
+inued"
+');
+
+$expect = <<'EOF'
+section.continued=continued
+section.noncont=not continued
+section.quotecont=cont;inued
+EOF
+;
+
+$config->load;
+is($config->dump, $expect, 'value continued on next line');
+
+# TODO NUL-byte termination is not supported by the current interface and I'm
+# not sure it would be useful to do so
+# burp($config_filename,
+# '[section "sub=section"]
+# val1 = foo=bar
+# val2 = foo\nbar
+# val3 = \n\n
+# val4 =
+# val5
+# ');
+
+# $expect = <<'EOF'
+# section.sub=section.val1
+# foo=barQsection.sub=section.val2
+# foo
+# barQsection.sub=section.val3
+#
+#
+# Qsection.sub=section.val4
+# Qsection.sub=section.val5Q
+# EOF
+#
+#
+# -- kill the tests or implement the null flag
+#git config --null --list | perl -pe 'y/\000/Q/' > result
+#echo >>result
+#
+#is(slurp($result), $expect, '--null --list');
+#
+#git config --null --get-regexp 'val[0-9]' | perl -pe 'y/\000/Q/' > result
+#echo >>result
+#
+#is(slurp($result), $expect, '--null --get-regexp');
+
+# testing symlinked configuration
+symlink File::Spec->catfile($config_dir, 'notyet'),
+ File::Spec->catfile($config_dir, 'myconfig');
+
+my $myconfig = TestConfig->new(confname => 'myconfig');
+$myconfig->set( key => 'test.frotz', value => 'nitfol',
+ filename => File::Spec->catfile($config_dir, 'myconfig'));
+my $notyet = TestConfig->new(confname => 'notyet');
+$notyet->set ( key => 'test.xyzzy', value => 'rezrov',
+ filename => File::Spec->catfile($config_dir, 'notyet'));
+$notyet->load;
+is($notyet->get(key => 'test.frotz'), 'nitfol',
+ 'can get 1st val from symlink');
+is($notyet->get(key => 'test.xyzzy'), 'rezrov',
+ 'can get 2nd val from symlink');
commit f4c71254bea3a9b0c30d3333139eb4ac29136f76
Author: Christine Spang <spang at mit.edu>
Date: Wed Jun 3 14:40:20 2009 +0300
add build deps to Makefile.PL
diff --git a/Makefile.PL b/Makefile.PL
index dd9f624..6a0fc0b 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -6,6 +6,10 @@ all_from('lib/Config/GitLike.pm');
requires 'Any::Moose';
requires 'Regexp::Common';
requires 'File::HomeDir';
+build_requires 'Test::More';
+build_requires 'Test::Exception';
+build_requires 'File::Spec';
+build_requires 'File::Temp';
sign();
WriteAll();
commit 11c3fd782e996fdd7e491b540fc3b73abbdabb86
Author: Christine Spang <spang at mit.edu>
Date: Wed Jun 3 14:41:58 2009 +0300
make cast's behaviour in-line with what the test suite specifies
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index b47f527..0d3b082 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -407,8 +407,17 @@ sub cast {
return $v unless defined $args{as};
if ($args{as} =~ /bool/i) {
return 1 unless defined $v;
- return $v =~ /true|yes|on|1/;
+ if ( $v =~ /^(?:true|yes|on|-?0*1)$/i ) {
+ return 1;
+ } elsif ($v =~ /^(?:false|no|off|0*)$/i) {
+ return 0;
+ } else {
+ die "Invalid bool $args{value}\n";
+ }
} elsif ($args{as} =~ /int|num/) {
+ die "Invalid unit while casting to $args{as}\n"
+ unless $v =~ /^[0-9]*\.?[0-9]*[kmg]?$/;
+
if ($v =~ s/([kmg])$//) {
$v *= 1024 if $1 eq "k";
$v *= 1024*1024 if $1 eq "m";
commit b95832ebbe3029821bcc319a36b5e8366dc03bb0
Author: Christine Spang <spang at mit.edu>
Date: Wed Jun 3 14:42:53 2009 +0300
this exception can also be thrown if there's a newline in the key
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 0d3b082..33b35b4 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -582,7 +582,8 @@ sub set {
$args{key} =~ /^(?:(.*)\.)?(.*)$/;
my($section, $key) = ($1, $2);
- die "No section given in key $args{key}\n" unless defined $section;
+ 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);
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list