r42095 - in /branches/upstream/libconfig-gitlike-perl/current: Changes META.yml SIGNATURE lib/Config/GitLike.pm t/lib/TestConfig.pm t/t1300-repo-config.t
christine at users.alioth.debian.org
christine at users.alioth.debian.org
Wed Aug 19 13:03:22 UTC 2009
Author: christine
Date: Wed Aug 19 13:03:15 2009
New Revision: 42095
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=42095
Log:
[svn-upgrade] Integrating new upstream version, libconfig-gitlike-perl (1.02)
Modified:
branches/upstream/libconfig-gitlike-perl/current/Changes
branches/upstream/libconfig-gitlike-perl/current/META.yml
branches/upstream/libconfig-gitlike-perl/current/SIGNATURE
branches/upstream/libconfig-gitlike-perl/current/lib/Config/GitLike.pm
branches/upstream/libconfig-gitlike-perl/current/t/lib/TestConfig.pm
branches/upstream/libconfig-gitlike-perl/current/t/t1300-repo-config.t
Modified: branches/upstream/libconfig-gitlike-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-gitlike-perl/current/Changes?rev=42095&op=diff
==============================================================================
--- branches/upstream/libconfig-gitlike-perl/current/Changes (original)
+++ branches/upstream/libconfig-gitlike-perl/current/Changes Wed Aug 19 13:03:15 2009
@@ -1,3 +1,9 @@
+1.02 - 2009-08-19
+
+* Bugfixes and extra tests for escaped \ and " in subsections (sunnavy)
+* win32 fixes (sunnavy)
+* auto-escape \ and " in subsections on set (sunnavy)
+
1.01 - 2009-08-11
* Fix breakage under Mouse due to Moose references
Modified: branches/upstream/libconfig-gitlike-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-gitlike-perl/current/META.yml?rev=42095&op=diff
==============================================================================
--- branches/upstream/libconfig-gitlike-perl/current/META.yml (original)
+++ branches/upstream/libconfig-gitlike-perl/current/META.yml Wed Aug 19 13:03:15 2009
@@ -28,4 +28,4 @@
resources:
license: http://dev.perl.org/licenses/
repository: http://github.com/bestpractical/config-gitlike
-version: 1.01
+version: 1.02
Modified: branches/upstream/libconfig-gitlike-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-gitlike-perl/current/SIGNATURE?rev=42095&op=diff
==============================================================================
--- branches/upstream/libconfig-gitlike-perl/current/SIGNATURE (original)
+++ branches/upstream/libconfig-gitlike-perl/current/SIGNATURE Wed Aug 19 13:03:15 2009
@@ -14,9 +14,9 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA256
-SHA1 9883f0a620808fc39a327058b3d8414f6580f455 Changes
+SHA1 a05fa9b5dd6ec0191e92120a460122e6147a1d40 Changes
SHA1 e64d07b95f1af7d671d5d4a3d5cbe4f204dcc801 MANIFEST
-SHA1 91b40eaa5153c3300d99a151f143c716eb66f5a6 META.yml
+SHA1 cc5bf5564184ac5b00116299e5cb934e245b7148 META.yml
SHA1 652f43d3bb9a33ac5995713dee8716c4d384242f Makefile.PL
SHA1 fd5f3c4f0418efee3b9b16cf8c3902e8374909df inc/Module/Install.pm
SHA1 7cd7c349afdf3f012e475507b1017bdfa796bfbd inc/Module/Install/Base.pm
@@ -26,27 +26,27 @@
SHA1 12bf1867955480d47d5171a9e9c6a96fabe0b58f inc/Module/Install/Metadata.pm
SHA1 f7ee667e878bd2faf22ee9358a7b5a2cc8e91ba4 inc/Module/Install/Win32.pm
SHA1 8ed29d6cf217e0977469575d788599cbfb53a5ca inc/Module/Install/WriteAll.pm
-SHA1 891682f58c128f94b694a8dcdbd2957fa9ad148f lib/Config/GitLike.pm
+SHA1 cf876cd40e80990b8829719fe3281b5829b2e2bb lib/Config/GitLike.pm
SHA1 9426d508e6841b28449fd5bda97abd1b4f0cbe19 lib/Config/GitLike/Cascaded.pm
SHA1 5444576afe2536921e404e87023181f70f37cc75 lib/Config/GitLike/Git.pm
SHA1 8c30f69743e7a9d743d7206f2306ff9f12bb59a0 t/00_use.t
-SHA1 789d535e320bbc62b29914d7bcaa7dc0ec7abe82 t/lib/TestConfig.pm
-SHA1 a628535aa2bac3e5d87cb53f68bc4f42c1b344fe t/t1300-repo-config.t
+SHA1 cde69d95c8c39de4f9816b7bfb845b2d96554a7e t/lib/TestConfig.pm
+SHA1 f39867b3d007cc555bd4026aabd6b8345ed1cab4 t/t1300-repo-config.t
SHA1 53b21b0f0227909dd299d8adb033f5aff8f5fc42 t/util/translate.pl
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.9 (GNU/Linux)
-iQIcBAEBCAAGBQJKgZjcAAoJEGSVn+mDjfGcFXYQAI6RsRjgJL8MwgQ23earmZeV
-K5u82KkdRp+6HKsBc/xPh45E+DYaQ6EMeAMbck5bSA3h8/REh+K094XWjZO9J4Yp
-cykRXXaKz1xTQBHTLQlGAG3qi3O/1wI4V0xw6oGBvFGi3A8eg9ktToA7Z43hH17x
-S9fEF3+wa7VdL38BV1qVdyYANvqhno+1O81phv0+gS8cIHLqG4QkqnuWCzGvRKVh
-rgRvRGO6IFsjSLIpoSOKO/FCjb9U0mTUeHcC+YbIAq+si2rgvC4lzRzcfmVKr5sd
-P3V9iphwpog81u7F3mJA6MMMgnyi/kH5rQckaa3CFjqQb+dhzdxZKOwUlmEHGYo8
-q3wPSTAHuPOGvzXtrdK2yYT4gTaOtFgQ/uv2WDXVj0ki9bFq6X5AYSZtDYmghgrE
-6GjfYXVjWmL6tnzNAwcfGlCaKbeop8ly0Wrz9DPQ1+3viCwpMZ6N3ww++L7TojA/
-9xqfZF4Msp6ZDD2pacabrC9CVbtyrevhHD9Q1FZ4xG9lI7UZgQTwGCnfRxi/nDe1
-UyJOHO1bwKGJviw0THu4aDxsCxhrNxkzHdBsEhAS24+5khuQx+6/MDvJbbA1HVvo
-RIenayXfq/5Jn/aR00mHRB3ffOpRtXvZBQGFGJ6SShIB+EByf7Zk9Gd+iJgkdxoQ
-do+M+jaNQMF6zmhqCISR
-=Fxdh
+iQIcBAEBCAAGBQJKi/TsAAoJEGSVn+mDjfGcpskP+gNnn9TNKO4eppFCXzDHbIC/
+yIynIBf+UauZsrJ0Il8pA/305vj9ZsPgIO/OQ6ySeaoXnVRJgYXkIIOV0pXL0uHS
+VhsN9fJ3huLe3QPUnpyOahUsSRm+TUeO6/6gAe3UNB9aBPC8nh5LYeSUaQyoYHsf
+X2FLS0IKm2WcZ8E8CUw8Ho3DHPeB+gBO3qHgYY/32xIu6su7rdZ95gT+K3RHgvLF
+LWucIhwDJ//L1YNfYK+lGA5TEgKruqbE1e4VeAqNqy490S2DHip96nDG0gHLHlBP
+h2po9WQK+xIl1hxoEQXzx9D3+lnBbb6GXAw/1jX230Fkljo4xCw3kJkth/tUoigN
+hkSw33tiIWnTSEEnqpoCejs/g9K1S4RTPGteczmLQRBQQahj7IJd9RCUtRo5wk+m
+BoTgRAeYs82VhwWy7G98/m5zSd8yQr2/+Jbh3TRZ3gT/UcOziMREgi0GBolWKdoI
+vPoVU+lzBIZ5lQQdOz62NT7ym6aXXRfkHQD0nUpBYf6//CCuGWcqCn1yIxFlq2Fp
+w231GnMRpdE+iYT4DB+bWXB9TWWhkBSDqxaMVQFwT+dsBhAfz2nAXLX5+JBlZADO
+v1hzJb0mSwXuTyBBhRxP08S/cwcaAbEWFa/GoN/tJ2Z/JYt3YZBlQVON/B5/2fxH
+N6sjlNYh4jYvHNQgFLiC
+=08rp
-----END PGP SIGNATURE-----
Modified: branches/upstream/libconfig-gitlike-perl/current/lib/Config/GitLike.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-gitlike-perl/current/lib/Config/GitLike.pm?rev=42095&op=diff
==============================================================================
--- branches/upstream/libconfig-gitlike-perl/current/lib/Config/GitLike.pm (original)
+++ branches/upstream/libconfig-gitlike-perl/current/lib/Config/GitLike.pm Wed Aug 19 13:03:15 2009
@@ -7,7 +7,7 @@
use Fcntl qw(O_CREAT O_EXCL O_WRONLY);
use 5.008;
-our $VERSION = '1.01';
+our $VERSION = '1.02';
has 'confname' => (
@@ -227,13 +227,24 @@
# same rules as for sections
elsif ($c =~ s/$section_regex//) {
$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;
+ if ($2) {
+ my $subsection = $2;
+ my $check = $2;
+ $check =~ s{\\\\}{}g;
+ $check =~ s{\\"}{}g;
+ return $args{error}->(
+ content => $args{content},
+ offset => $offset,
+
+ # don't allow quoted subsections to contain unescaped
+ # double-quotes or backslashes
+ ) if $check =~ /\\|"/;
+
+ $subsection =~ s{\\\\}{\\}g;
+ $subsection =~ s{\\"}{"}g;
+ $section .= ".$subsection";
+ }
+
$args{callback}->(
section => $section,
offset => $offset,
@@ -274,6 +285,10 @@
# line continuation (\ character followed by new line)
elsif ($c =~ s/\A\\\r?\n//im) {
next;
+ }
+ # escaped backslash characters is translated to actual \
+ elsif ($c =~ s/\A\\\\//im) {
+ $value .= '\\';
}
# escaped quote characters are part of the value
elsif ($c =~ s/\A\\(['"])//im) {
@@ -394,9 +409,9 @@
);
use constant {
- BOOL_TRUE_REGEX => qr/^(?:true|yes|on|-?0*1)$/i,
+ BOOL_TRUE_REGEX => qr/^(?:true|yes|on|-?0*1)$/i,
BOOL_FALSE_REGEX => qr/^(?:false|no|off|0*)$/i,
- NUM_REGEX => qr/^-?[0-9]*\.?[0-9]*[kmg]?$/,
+ NUM_REGEX => qr/^-?[0-9]*\.?[0-9]*[kmg]?$/,
};
if (defined $args{as} && $args{as} eq 'bool-or-int') {
@@ -613,7 +628,6 @@
if ($args{section} =~ /^(.*?)\.(.*)$/) {
my ($section, $subsection) = ($1, $2);
- $subsection =~ s/(["\\])/\\$1/g;
my $ret = qq|[$section "$subsection"]|;
$ret .= "\n" unless $args{bare};
return $ret;
@@ -705,8 +719,14 @@
die "Invalid section name $section\n"
if $self->_invalid_section_name($section);
- die "Unescaped backslash or \" in subsection $subsection\n"
- if defined $subsection && $subsection =~ /(?<!\\)(?:"|\\)/;
+ # if the subsection to write contains unescaped \ or ", escape them
+ # automatically
+ my $unescaped_subsection;
+ if ( defined $subsection ) {
+ $unescaped_subsection = $subsection;
+ $subsection =~ s{\\}{\\\\}g;
+ $subsection =~ s{"}{\\"}g;
+ }
$args{value} = $self->cast(
value => $args{value},
@@ -718,9 +738,10 @@
my @replace;
# use this for comparison
- my $cmp_section
- = defined $subsection ? join('.', lc $section, $subsection)
- : lc $section;
+ my $cmp_section =
+ defined $unescaped_subsection
+ ? join( '.', lc $section, $unescaped_subsection )
+ : lc $section;
# ...but this for writing (don't lowercase)
my $combined_section
= defined $subsection ? join('.', $section, $subsection)
Modified: branches/upstream/libconfig-gitlike-perl/current/t/lib/TestConfig.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-gitlike-perl/current/t/lib/TestConfig.pm?rev=42095&op=diff
==============================================================================
--- branches/upstream/libconfig-gitlike-perl/current/t/lib/TestConfig.pm (original)
+++ branches/upstream/libconfig-gitlike-perl/current/t/lib/TestConfig.pm Wed Aug 19 13:03:15 2009
@@ -18,20 +18,24 @@
sub dir_file {
my $self = shift;
-
- return File::Spec->catfile($self->tmpdir, $self->confname);
+ my $dirs = (File::Spec->splitpath( $self->tmpdir, 1 ))[1];
+ return File::Spec->catfile($dirs, $self->confname);
}
sub user_file {
my $self = shift;
- return File::Spec->catfile($self->tmpdir, 'home', $self->confname);
+ return File::Spec->catfile(
+ ( File::Spec->splitpath( $self->tmpdir, 1 ) )[1],
+ 'home', $self->confname );
}
sub global_file {
my $self = shift;
- return File::Spec->catfile($self->tmpdir, 'etc', $self->confname);
+ return File::Spec->catfile(
+ ( File::Spec->splitpath( $self->tmpdir, 1 ) )[1],
+ 'etc', $self->confname );
}
__PACKAGE__->meta->make_immutable;
Modified: branches/upstream/libconfig-gitlike-perl/current/t/t1300-repo-config.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-gitlike-perl/current/t/t1300-repo-config.t?rev=42095&op=diff
==============================================================================
--- branches/upstream/libconfig-gitlike-perl/current/t/t1300-repo-config.t (original)
+++ branches/upstream/libconfig-gitlike-perl/current/t/t1300-repo-config.t Wed Aug 19 13:03:15 2009
@@ -2,7 +2,7 @@
use warnings;
use File::Copy;
-use Test::More tests => 133;
+use Test::More tests => 142;
use Test::Exception;
use File::Spec;
use File::Temp qw/tempdir/;
@@ -1065,33 +1065,38 @@
$config->load;
is( $config->dump, $expect, 'value continued on next line' );
+
# testing symlinked configuration
-symlink File::Spec->catfile( $config_dirname, 'notyet' ),
- File::Spec->catfile( $config_dirname, 'myconfig' );
-
-my $myconfig = TestConfig->new(
- confname => 'myconfig',
- tmpdir => $config_dirname
-);
-$myconfig->set(
- key => 'test.frotz',
- value => 'nitfol',
- filename => File::Spec->catfile( $config_dirname, 'myconfig' )
-);
-my $notyet = TestConfig->new(
- confname => 'notyet',
- tmpdir => $config_dirname
-);
-$notyet->set(
- key => 'test.xyzzy',
- value => 'rezrov',
- filename => File::Spec->catfile( $config_dirname, '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' );
+SKIP: {
+ skip 'windows does *not* support symlink', 2 if $^O =~ /MSWin/;
+
+ symlink File::Spec->catfile( $config_dirname, 'notyet' ),
+ File::Spec->catfile( $config_dirname, 'myconfig' );
+
+ my $myconfig = TestConfig->new(
+ confname => 'myconfig',
+ tmpdir => $config_dirname
+ );
+ $myconfig->set(
+ key => 'test.frotz',
+ value => 'nitfol',
+ filename => File::Spec->catfile( $config_dirname, 'myconfig' )
+ );
+ my $notyet = TestConfig->new(
+ confname => 'notyet',
+ tmpdir => $config_dirname
+ );
+ $notyet->set(
+ key => 'test.xyzzy',
+ value => 'rezrov',
+ filename => File::Spec->catfile( $config_dirname, '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' );
+}
### ADDITIONAL TESTS (not from the git test suite, just things that I didn't
### see tests for and think should be tested)
@@ -1214,7 +1219,6 @@
is( $config->get( key => 'section.a' ), 'off',
'user config is loaded');
-
burp(
$global_config,
'[section]
@@ -1448,22 +1452,6 @@
throws_ok {
$config->set(
- key => 'section.foo\bar.baz',
- value => 'none',
- filename => $config_filename,
- ) } qr/unescaped backslash or \" in subsection/im,
-'subsection names cannot contain unescaped backslash in compat mode';
-
-throws_ok {
- $config->set(
- key => 'section.foo"bar.baz',
- value => 'none',
- filename => $config_filename,
- ) } qr/unescaped backslash or \" in subsection/im,
-'subsection names cannot contain unescaped " in compat mode';
-
-throws_ok {
- $config->set(
key => "section.foo\nbar.baz",
value => 'none',
filename => $config_filename,
@@ -1472,13 +1460,6 @@
# these should be the case in no-compat mode too
$config->compatible(0);
-throws_ok {
- $config->set(
- key => 'section.foo\bar.baz',
- value => 'none',
- filename => $config_filename,
- ) } qr/unescaped backslash or \" in subsection/im,
-'subsection names cannot contain unescaped backslash in nocompat mode';
throws_ok {
$config->set(
@@ -1488,14 +1469,6 @@
) } qr/invalid key/im,
'subsection names cannot contain unescaped newlines in nocompat mode';
-throws_ok {
- $config->set(
- key => 'section.foo"bar.baz',
- value => 'none',
- filename => $config_filename,
- ) } qr/unescaped backslash or \" in subsection/im,
-'subsection names cannot contain unescaped " in nocompat mode';
-
# Make sure some bad configs throw errors.
burp(
$config_filename,
@@ -1526,3 +1499,66 @@
is( $config->get( key => 'test.a[]' ), 'b' );
} 'key can contain but not start with [ in nocompat mode';
+
+lives_and {
+ $config->set(
+ key => "section.foo\\\\bar.baz",
+ value => 'none',
+ filename => $config_filename,
+ );
+ $config->load;
+ is( $config->get( key => "section.foo\\\\bar.baz" ), 'none' );
+}
+"subsection with escaped backslashes";
+
+# special values in subsection
+
+my %special_in_value =
+ ( backslash => "\\", doublequote => q{"} );
+
+while ( my ( $k, $v ) = each %special_in_value ) {
+ for my $times ( 1 .. 3 ) {
+ my $value = 'chan' . $v x $times . "mon" . $v x $times;
+ lives_and {
+ $config->set(
+ key => "section.foo",
+ value => $value,
+ filename => $config_filename,
+ );
+ $config->load;
+ is( $config->get( key => "section.foo" ), $value );
+ }
+ "value with $k occurs $times time"
+ . (
+ $times == 1
+ ? ''
+ : 's'
+ );
+ }
+}
+
+# special chars in subsection, particularly auto-escaping \ and " on set
+my %special_in_subsection =
+ ( backslash => "\\", doublequote => q{"} );
+
+while ( my ( $k, $v ) = each %special_in_subsection ) {
+ for my $times ( 1 .. 3 ) {
+ my $key = 'section.foo' . $v x $times . 'bar' . $v x $times . 'baz';
+
+ lives_and {
+ $config->set(
+ key => $key,
+ value => 'none',
+ filename => $config_filename,
+ );
+ $config->load;
+ is( $config->get( key => $key ), 'none' );
+ }
+ "subsection with $k occurs with $times time"
+ . (
+ $times == 1
+ ? ''
+ : 's'
+ );
+ }
+}
More information about the Pkg-perl-cvs-commits
mailing list