Splat with 2.45

git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@74 be1acefe-a474-0410-9a34-9b3221f2030f

Changelog

@@ -1,3 +1,19 @@
+2.45
+	- fixed rt.cpan.org#50647 escaping bug. Now escaped $ or
+	  backslash characters are handled correctly (across save too)
+
+	- fixed rt.cpan.org#52047, tied hash will remain tied
+	  when savong to a file.
+
+	- fixed rt.cpan.org#54580, preserve single quotes during
+	  variable interpolation corrected. No more using rand()
+	  to mark single quotes but an incrementor instead.
+
+	- fixed rt.cpan.org#42721+54583, empty config values will no
+	  more handed over to interpreting methods (as interpolate
+	  or autotrue and the like) but returned as undef untouched.
+
+
 2.44
 	- fixed rt.cpan.org#49023 by rolling back change in 2.43
 	   in line 158, regarding GLOB support.

General.pm

@@ -5,7 +5,7 @@
 #          config values from a given file and
 #          return it as hash structure
 #
-# Copyright (c) 2000-2009 Thomas Linden <tlinden |AT| cpan.org>.
+# Copyright (c) 2000-20010Thomas Linden <tlinden |AT| cpan.org>.
 # All Rights Reserved. Std. disclaimer applies.
 # Artificial License, same as perl itself. Have fun.
 #
@@ -32,7 +32,7 @@ use Carp::Heavy;
 use Carp;
 use Exporter;
 
-$Config::General::VERSION = 2.44;
+$Config::General::VERSION = 2.45;
 
 use vars  qw(@ISA @EXPORT_OK);
 use base qw(Exporter);
@@ -79,7 +79,7 @@ sub new {
 	      SplitDelimiter        => 0,       # must be set by the user if SplitPolicy is 'custom'
 	      StoreDelimiter        => 0,       # will be set by me unless user uses 'custom' policy
 	      CComments             => 1,       # by default turned on
-	      BackslashEscape       => 0,       # by default turned off, allows escaping anything using  the backslash
+	      BackslashEscape       => 0,       # deprecated
 	      StrictObjects         => 1,       # be strict on non-existent keys in OOP mode
 	      StrictVars            => 1,       # be strict on undefined variables in Interpolate mode
 	      Tie                   => q(),      # could be set to a perl module for tie'ing new hashes
@@ -377,7 +377,6 @@ sub _prepare {
     $self->{SlashIsDirectory}   = 1;
     $self->{SplitPolicy}        = 'whitespace';
     $self->{CComments}          = 0;
-    $self->{BackslashEscape}    = 1;
   }
 }
 
@@ -620,8 +619,9 @@ sub _read {
 
 
     # look for multiline option, indicated by a trailing backslash
-    my $extra = $this->{BackslashEscape} ? '(?<!\\\\)' : q();
+    #my $extra = $this->{BackslashEscape} ? '(?<!\\\\)' : q();
-    if (/$extra\\$/) {
+    #if (/$extra\\$/) {
+    if (/(?<!\\)\\$/) {
       chop;
       s/^\s*//;
       $longline .= $_;
@@ -630,13 +630,13 @@ sub _read {
 
     # remove the \ from all characters if BackslashEscape is turned on
     # FIXME (rt.cpan.org#33218
-    if ($this->{BackslashEscape}) {
+    #if ($this->{BackslashEscape}) {
-      s/\\(.)/$1/g;
+    #  s/\\(.)/$1/g;
-    }
+    #}
-    else {
+    #else {
-      # remove the \ char in front of masked "#", if any
+    #  # remove the \ char in front of masked "#", if any
-      s/\\#/#/g;
+    #  s/\\#/#/g;
-    }
+    #}
 
 
     # transform explicit-empty blocks to conforming blocks
@@ -1041,7 +1041,9 @@ sub _parse_value {
 
   # avoid "Use of uninitialized value"
   if (! defined $value) {
-    $value = undef; # bigfix rt.cpan.org#42721  q();
+    # patch fix rt#54583
+    # Return an input undefined value without trying transformations
+    return $value;
   }
 
   if ($this->{InterPolateVars}) {
@@ -1073,6 +1075,10 @@ sub _parse_value {
       $value = \%__flags;
     }
   }
+
+  # are there any escaped characters left? put them out as is
+  $value =~ s/\\([\$\\\"])/$1/g;
+
   return $value;
 }
 
@@ -1087,7 +1093,7 @@ sub NoMultiOptions {
   # Since we do parsing from within new(), we must
   # call it again if one turns NoMultiOptions on!
   #
-  croak q(Config::Genera: lThe NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!);
+  croak q(Config::General: The NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!);
 }
 
 
@@ -1193,48 +1199,22 @@ sub _store {
 
   my $config_string = q();
 
-  if($this->{SaveSorted}) {
+  foreach my $entry ( $this->{SaveSorted} ? sort keys %$config : keys %$config ) {
-    # ahm, well this might look strange because the two loops
+    if (ref($config->{$entry}) eq 'ARRAY') {
-    # are obviously the same, but I don't know how to call
+      foreach my $line (sort @{$config->{$entry}}) {
-    # a foreach() with sort and without sort() on the same
+        if (ref($line) eq 'HASH') {
-    # line (I think it's impossible)
+          $config_string .= $this->_write_hash($level, $entry, $line);
-    foreach my $entry (sort keys %{$config}) {
+        }
-      if (ref($config->{$entry}) eq 'ARRAY') {
+        else {
-        foreach my $line (sort @{$config->{$entry}}) {
+          $config_string .= $this->_write_scalar($level, $entry, $line);
-          if (ref($line) eq 'HASH') {
-            $config_string .= $this->_write_hash($level, $entry, $line);
-          }
-          else {
-            $config_string .= $this->_write_scalar($level, $entry, $line);
-          }
         }
-      }
-      elsif (ref($config->{$entry}) eq 'HASH') {
-        $config_string .= $this->_write_hash($level, $entry, $config->{$entry});
-      }
-      else {
-        $config_string .= $this->_write_scalar($level, $entry, $config->{$entry});
       }
     }
-  }
+    elsif (ref($config->{$entry}) eq 'HASH') {
-  else {
+      $config_string .= $this->_write_hash($level, $entry, $config->{$entry});
-    foreach my $entry (keys %{$config}) {
+    }
-      if (ref($config->{$entry}) eq 'ARRAY') {
+    else {
-        foreach my $line (@{$config->{$entry}}) {
+      $config_string .= $this->_write_scalar($level, $entry, $config->{$entry});
-          if (ref($line) eq 'HASH') {
-            $config_string .= $this->_write_hash($level, $entry, $line);
-          }
-          else {
-            $config_string .= $this->_write_scalar($level, $entry, $line);
-          }
-        }
-      }
-      elsif (ref($config->{$entry}) eq 'HASH') {
-        $config_string .= $this->_write_hash($level, $entry, $config->{$entry});
-      }
-      else {
-        $config_string .= $this->_write_scalar($level, $entry, $config->{$entry});
-      }
     }
   }
 
@@ -1253,14 +1233,18 @@ sub _write_scalar {
 
   my $config_string;
 
-  if ($line =~ /\n/ || $line =~ /\\$/) {
+  # patch fix rt#54583
+  if ( ! defined $line ) {
+    $config_string .= $indent . $entry . "\n";
+  }
+  elsif ($line =~ /\n/ || $line =~ /\\$/) {
     # it is a here doc
     my $delimiter;
     my $tmplimiter = 'EOF';
     while (!$delimiter) {
       # create a unique here-doc identifier
       if ($line =~ /$tmplimiter/s) {
-	$tmplimiter .= q(%);
+	$tmplimiter .= '%';
       }
       else {
 	$delimiter = $tmplimiter;
@@ -1275,7 +1259,10 @@ sub _write_scalar {
   }
   else {
     # a simple stupid scalar entry
-    $line =~ s/#/\\#/g;
+
+    # re-escape contained $ or # or \ chars
+    $line =~ s/([#\$\\\"])/\\$1/g;
+
     # bugfix rt.cpan.org#42287
     if ($line =~ /^\s/ or $line =~ /\s$/) {
       # need to quote it
@@ -1811,14 +1798,7 @@ By default B<-CComments> is turned on.
 
 =item B<-BackslashEscape>
 
-If you turn on this parameter, a backslash can be used to escape any special
+B<Deprecated Option>.
-character within configurations.
-
-By default it is turned off.
-
-Be careful with this option, as it removes all backslashes after parsing.
-
-B<This option might be removed in future versions>.
 
 =item B<-SlashIsDirectory>
 
@@ -1881,7 +1861,6 @@ The following options will be set:
  SlashIsDirectory   = 1
  SplitPolicy        = 'equalsign'
  CComments          = 0
- BackslashEscape    = 1
 
 Take a look into the particular documentation sections what
 those options are doing.
@@ -2502,7 +2481,7 @@ I recommend you to read the following documents, which are supplied with Perl:
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright (c) 2000-2009 Thomas Linden
+Copyright (c) 2000-2010 Thomas Linden
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
@@ -2531,7 +2510,7 @@ Thomas Linden <tlinden |AT| cpan.org>
 
 =head1 VERSION
 
-2.44
+2.45
 
 =cut
 

General/Interpolated.pm

@@ -2,13 +2,13 @@
 # Config::General::Interpolated - special Class based on Config::General
 #
 # Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>.
-# Copyright (c) 2000-2009 by Thomas Linden <tlinden |AT| cpan.org>.
+# Copyright (c) 2000-2010 by Thomas Linden <tlinden |AT| cpan.org>.
 # All Rights Reserved. Std. disclaimer applies.
 # Artificial License, same as perl itself. Have fun.
 #
 
 package Config::General::Interpolated;
-$Config::General::Interpolated::VERSION = "2.11";
+$Config::General::Interpolated::VERSION = "2.12";
 
 use strict;
 use Carp;
@@ -65,12 +65,7 @@ sub _interpolate  {
   # called directly by Config::General::_parse_value()
   #
   my ($this, $config, $key, $value) = @_;
-
+  my $quote_counter = 100;
-  if (! defined($value)) {
-    # bugfix rt.cpan.org#50329
-    # nothing to do here
-    return $value;
-  }
 
   # some dirty trick to circumvent single quoted vars to be interpolated
   # we remove all quotes and replace them with unique random literals,
@@ -78,7 +73,7 @@ sub _interpolate  {
   # fixes bug rt#35766
   my %quotes;
   $value =~ s/(\'[^\']+?\')/
-    my $key = "QUOTE" . int(rand(1000)) . "QUOTE";
+    my $key = "QUOTE" . ($quote_counter++) . "QUOTE";
     $quotes{ $key } = $1;
     $key;
   /gex;
@@ -100,14 +95,12 @@ sub _interpolate  {
 	$con;
       }
     }
+    elsif ($this->{StrictVars}) {
+      croak "Use of uninitialized variable (\$$var) while loading config entry: $key = $value\n";
+    }
     else {
-      if ($this->{StrictVars}) {
+      # be cool
-	croak "Use of uninitialized variable (\$$var) while loading config entry: $key = $value\n";
+      $con;
-      }
-      else {
-	# be cool
-	$con;
-      }
     }
   }egx;
 
@@ -345,7 +338,7 @@ L<Config::General>
 =head1 COPYRIGHT
 
 Copyright 2001 by Wei-Hon Chen E<lt>plasmaball@pchome.com.twE<gt>.
-Copyright 2002-2009 by Thomas Linden <tlinden |AT| cpan.org>.
+Copyright 2002-2010 by Thomas Linden <tlinden |AT| cpan.org>.
 
 This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
@@ -354,7 +347,7 @@ See L<http://www.perl.com/perl/misc/Artistic.html>
 
 =head1 VERSION
 
-2.11
+2.12
 
 =cut
 

MANIFEST

@@ -1,19 +1,15 @@
+Changelog
+example.cfg
 General/Extended.pm
 General/Interpolated.pm
-t/Tie/IxHash.pm
+General.pm
-t/Tie/README
+Makefile.PL
-t/complex/n1.cfg
+MANIFEST
-t/complex/n2.cfg
+META.yml
-t/sub1/sub2/sub3/cfg.sub3
+README
-t/sub1/sub2/cfg.sub2
-t/sub1/sub2/cfg.sub2b
-t/sub1/cfg.sub1
-t/sub1/cfg.sub1b
-t/sub1/cfg.sub1c
-t/sub1/cfg.sub1d
-t/sub1/cfg.sub1e
 t/apache-include.conf
 t/cfg.16
+t/cfg.16a
 t/cfg.17
 t/cfg.19
 t/cfg.2
@@ -34,15 +30,21 @@ t/cfg.5
 t/cfg.6
 t/cfg.7
 t/cfg.8
+t/complex/n1.cfg
+t/complex/n2.cfg
 t/complex.cfg
 t/dual-include.conf
-t/run.t
 t/included.conf
+t/run.t
+t/sub1/cfg.sub1
+t/sub1/cfg.sub1b
+t/sub1/cfg.sub1c
+t/sub1/cfg.sub1d
+t/sub1/cfg.sub1e
+t/sub1/sub2/cfg.sub2
+t/sub1/sub2/cfg.sub2b
+t/sub1/sub2/sub3/cfg.sub3
 t/test.rc
-Changelog
+t/Tie/IxHash.pm
-General.pm
+t/Tie/README
-MANIFEST
+t/cfg.51
-Makefile.PL
-README
-example.cfg
-META.yml                                 Module meta-data (added by MakeMaker)

META.yml

@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Config-General
-version:      2.42
+version:      2.45
 version_from: General.pm
 installdirs:  site
 requires:

README

@@ -104,4 +104,4 @@ AUTHOR
 
 
 VERSION
-	2.39
+	2.45

t/cfg.51

@@ -0,0 +1,4 @@
+dollar = \$foo
+backslash = contains \\ backslash
+prize = 18 $
+hostparam = "\"'wsh.dir'\""

t/cfg.8

@@ -9,8 +9,7 @@
   </officer>
 </cops>
 domain	b0fh.org
-domain  l0pht.com
+domain  b0fh.org
-domain  infonexus.com
 message <<EOF
   yes. we are not here. you
   can reach us somewhere in
@@ -37,3 +36,5 @@ host = blah.blubber
 quoted = "this one contains whitespace at the end    "
 
 quotedwithquotes = " holy crap, it contains \"masked quotes\" and 'single quotes'  "
+
+

t/run.t

@@ -8,8 +8,8 @@
 
 
 use Data::Dumper;
-use Test::More tests => 53;
+#use Test::More tests => 57;
-#use Test::More qw(no_plan);
+use Test::More qw(no_plan);
 
 # ahem, we deliver the test code with a local copy of
 # the Tie::IxHash module so we can do tests on sorted
@@ -508,6 +508,9 @@ my $expect46 = {
 is_deeply($expect46, \%conf46, "Variables inside single quotes");
 
 
+
+
+
 # complexity test
 # check the combination of various features
 my $conf47 = new Config::General(
@@ -549,7 +552,7 @@ my $expect47 = {
                  },
           'onflag' => 1,
           'var2' => 'zeppelin',
-          'ignore' => '\\$set',
+          'ignore' => '$set', # escaped $ should get to plain $, not \\$!
           'quote' => 'this should be \'kept: $set\' and not be \'$set!\'',
           'x5' => {
                     'klack' => '11111'
@@ -614,7 +617,7 @@ my $expect47 = {
   work
   too!'
 };
-
+#scip
 is_deeply($expect47, \%conf47, "complexity test");
 
 # check if sorted save works
@@ -652,13 +655,50 @@ my $str48 = $cfg48->save_string(\%hash48);
 is( $str48, $ostr48, "tied hash test");
 
 
-# Check whether we can create a C::G object when -ConfigFile is passed as a stringify-able object.
+
-use PathObject;
+# check for undef and -w
-my $cfgFileObject = new PathObject;
+{
-my $cfg49 = new Config::General(
+my $ostr49 = "foo\n";
-				-ConfigFile => $cfgFileObject,
+local $^W = 1;
-				-ExtendedAccess    => 1
+my $cfg49 =  new Config::General( -String => $ostr49 );
-    );
+my %hash49 = $cfg49->getall();
-ok($cfg49, "Creating a new object using the stringify-able file object way");
+ok( exists $hash49{foo}, "value for undefined key found");
-my $domain49 = $cfg49->keys("domain");
+is( $hash49{foo}, undef, "value returned as expected - undef");
-ok($domain49, "Config object created using the stringify-able file object way contains the domain section.");
+
+# repeat with interpolation turned on
+$cfg49 =  new Config::General( -String => $ostr49, -InterPolateVars => 1 );
+%hash49 = $cfg49->getall();
+ok( exists $hash49{foo}, "value for undefined key found");
+is( $hash49{foo}, undef, "value returned as expected - undef");
+$^W = 0;
+}
+
+
+# verifies bug fix rt#54580
+# Test handling of values containing *many* single-quoted strings
+# when -InterPolateVars option is set
+my $dupcount50 = 2000;
+my $ostr50;
+foreach my $counter ( reverse 1 .. $dupcount50 ) {
+  $ostr50 .= " 'luck${counter}'";
+}
+$ostr50 =~ s{\A }{};
+my $cfgsrc50 = 'test_single_many ' . $ostr50;
+$cfg50 =  new Config::General( -String => $cfgsrc50, -InterPolateVars => 1 );
+%hash50 = $cfg50->getall();
+is($hash50{test_single_many}, $ostr50, "value with single-quote strings is as expected" );
+
+
+# check for escaped chars
+my $cfg51  =  new Config::General( -ConfigFile => "t/cfg.51" );
+my %hash51 = $cfg51->getall();
+is($hash51{dollar},    '$foo',                 "keep escaped dollar character");
+is($hash51{backslash}, 'contains \ backslash', "keep escaped backslash character");
+is($hash51{prize},     '18 $',                 "keep un-escaped dollar character");
+is($hash51{hostparam}, q("'wsh.dir'"),         "keep escaped quote character");
+
+# now save it to a file and re-read it in and see if everything remains escaped
+$cfg51->save_file("t/cfg.51.out");
+$cfg51  =  new Config::General( -ConfigFile => "t/cfg.51.out", -InterPolateVars => 1 );
+my %hash51new = $cfg51->getall();
+is_deeply(\%hash51, \%hash51new, "compare saved config containing escaped chars");