fixed bugs and added -NoEscape + -Normalize(Option|Block|Value) parameters.

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

Changelog

@@ -1,3 +1,18 @@
+ 2.51   - fixed rt.cpan.org#77667 which resulted in invalid configs
+          written to file when using save_file() and a named block,
+          whose 2nd part starts with a /.
+
+        - fixed rt.cpan.org#64169 by applying patch by Dulaunoy Fabrice.
+          adds -NoEscape switch which turns off escaping of anything.
+
+        - implemented suggestion of rt.cpan.org#67564 by adding 3 new
+          parameters: -NormalizeOption, -NormalizeBlock and -NormalizeValue,
+          which take a subroutine reference and change the block,
+          option or value accordingly.
+        
+        - fixed rt.cpan.org#65860+76953 undefined value error.
+
+
  2.50
 	- fixed rt.cpan.org#63487 documentation error.
 

General.pm

@@ -5,7 +5,7 @@
 #          config values from a given file and
 #          return it as hash structure
 #
-# Copyright (c) 2000-2010 Thomas Linden <tlinden |AT| cpan.org>.
+# Copyright (c) 2000-2012 Thomas Linden <tlinden |AT| cpan.org>.
 # All Rights Reserved. Std. disclaimer applies.
 # Artistic License, same as perl itself. Have fun.
 #
@@ -88,7 +88,11 @@ sub new {
 	      UTF8                  => 0,
 	      SaveSorted            => 0,
               ForceArray            => 0,       # force single value array if value enclosed in []
-              AllowSingleQuoteInterpolation => 0
+              AllowSingleQuoteInterpolation => 0,
+              NoEscape              => 0,
+              NormalizeBlock        => 0,
+              NormalizeOption       => 0,
+              NormalizeValue        => 0,
 	     };
 
   # create the class instance
@@ -791,6 +795,10 @@ sub _parse {
       }
     }
 
+    if($this->{NormalizeOption}) {
+      $option = $this->{NormalizeOption}($option);
+    }
+
     if ($value && $value =~ /^"/ && $value =~ /"$/) {
       $value =~ s/^"//;                                    # remove leading and trailing "
       $value =~ s/"$//;
@@ -809,6 +817,16 @@ sub _parse {
 	    $blockname = $3 || $4;
 	  }
 	}
+        if($this->{NormalizeBlock}) {
+          $block = $this->{NormalizeBlock}($block);
+	  if (defined $blockname) {
+            $blockname = $this->{NormalizeBlock}($blockname);
+            if($blockname eq "") {
+              # if, after normalization no blockname is left, remove it
+              $blockname = undef;
+            }
+	  }
+        }
 	if ($this->{InterPolateVars}) {
 	  # interpolate block(name), add "<" and ">" to the key, because
 	  # it is sure that such keys does not exist otherwise.
@@ -869,7 +887,7 @@ sub _parse {
 	  }
 	}
 	else {
-          if($this->{ForceArray} && $value =~ /^\[\s*(.+?)\s*\]$/) {
+          if($this->{ForceArray} && defined $value && $value =~ /^\[\s*(.+?)\s*\]$/) {
             # force single value array entry
             push @{$config->{$option}}, $this->_parse_value($config, $option, $1);
           }
@@ -949,7 +967,6 @@ sub _parse {
 	    if ($this->{InterPolateVars}) {
 	      # inherit current __stack to new block
 	      $tmphash->{__stack} = $this->_copy($config->{__stack});
-	      #$tmphash->{__stack} = $config->{$block}->{__stack};
 	    }
 
 	    $config->{$block}->{$blockname} = $this->_parse($tmphash, \@newcontent);
@@ -1057,6 +1074,10 @@ sub _parse_value {
     return $value;
   }
 
+  if($this->{NormalizeValue}) {
+    $value = $this->{NormalizeValue}($value);
+  }
+
   if ($this->{InterPolateVars}) {
     $value = $this->_interpolate($config, $option, $value);
   }
@@ -1087,8 +1108,10 @@ sub _parse_value {
     }
   }
 
-  # are there any escaped characters left? put them out as is
-  $value =~ s/\\([\$\\\"#])/$1/g;
+  if (!$this->{NoEscape}) {
+    # are there any escaped characters left? put them out as is
+    $value =~ s/\\([\$\\\"#])/$1/g;
+  }
 
   return $value;
 }
@@ -1277,8 +1300,10 @@ sub _write_scalar {
   else {
     # a simple stupid scalar entry
 
-    # re-escape contained $ or # or \ chars
-    $line =~ s/([#\$\\\"])/\\$1/g;
+    if (!$this->{NoEscape}) {
+      # re-escape contained $ or # or \ chars
+      $line =~ s/([#\$\\\"])/\\$1/g;
+    }
 
     # bugfix rt.cpan.org#42287
     if ($line =~ /^\s/ or $line =~ /\s$/) {
@@ -1306,6 +1331,20 @@ sub _write_hash {
     $entry = q(") . $entry . q(");
   }
 
+  # check if the next level key points to a hash and is the only one
+  # in this case put out a named block
+  # fixes rt.77667
+  my $num = scalar keys %{$line};
+  if($num == 1) {
+    my $key = (keys %{$line})[0];
+    if(ref($line->{$key}) eq 'HASH') {
+      $config_string .= $indent . qq(<$entry $key>\n);
+      $config_string .= $this->_store($level + 1, $line->{$key});
+      $config_string .= $indent . qq(</) . $entry . ">\n";
+      return $config_string;
+    }
+  }
+ 
   $config_string .= $indent . q(<) . $entry . ">\n";
   $config_string .= $this->_store($level + 1, $line);
   $config_string .= $indent . q(</) . $entry . ">\n";
@@ -1900,6 +1939,32 @@ not work properly with older versions of Perl.
 If you want to save configs in a sorted manner, turn this
 parameter on. It is not enabled by default.
 
+=item B<-NoEscape>
+
+If you want to use the data ( scalar or final leaf ) without escaping special charatecter, turn this
+parameter on. It is not enabled by default.
+
+=item B<-NormalizeBlock>
+
+Takes a subroutine reference as parameter and gets the current
+block or blockname passed as parameter and is expected to return
+it in some altered way as a scalar string. The sub will be called
+before anything else will be done by the module itself (e.g. interpolation).
+
+Example:
+
+ -NormalizeBlock => sub { my $x = shift; $x =~ s/\s*$//; $x; }
+
+This removes trailing whitespaces of block names.
+
+=item B<-NormalizeOption>
+
+Same as B<-NormalizeBlock> but applied on options only.
+
+=item B<-NormalizeValue>
+
+Same as B<-NormalizeBlock> but applied on values only.
+
 =back
 
 
@@ -2512,7 +2577,7 @@ I recommend you to read the following documents, which are supplied with Perl:
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright (c) 2000-2010 Thomas Linden
+Copyright (c) 2000-2012 Thomas Linden
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.

General/Extended.pm

@@ -1,7 +1,7 @@
 #
 # Config::General::Extended - special Class based on Config::General
 #
-# Copyright (c) 2000-2010 Thomas Linden <tlinden |AT| cpan.org>.
+# Copyright (c) 2000-2012 Thomas Linden <tlinden |AT| cpan.org>.
 # All Rights Reserved. Std. disclaimer applies.
 # Artistic License, same as perl itself. Have fun.
 #
@@ -621,7 +621,7 @@ values under the given key will be overwritten.
 
 =head1 COPYRIGHT
 
-Copyright (c) 2000-2010 Thomas Linden
+Copyright (c) 2000-2012 Thomas Linden
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.

General/Interpolated.pm

@@ -2,7 +2,7 @@
 # Config::General::Interpolated - special Class based on Config::General
 #
 # Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>.
-# Copyright (c) 2000-2010 by Thomas Linden <tlinden |AT| cpan.org>.
+# Copyright (c) 2000-2012 by Thomas Linden <tlinden |AT| cpan.org>.
 # All Rights Reserved. Std. disclaimer applies.
 # Artistic License, same as perl itself. Have fun.
 #
@@ -341,7 +341,7 @@ L<Config::General>
 =head1 COPYRIGHT
 
 Copyright 2001 by Wei-Hon Chen E<lt>plasmaball@pchome.com.twE<gt>.
-Copyright 2002-2010 by Thomas Linden <tlinden |AT| cpan.org>.
+Copyright 2002-2012 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.

Makefile.PL

@@ -1,7 +1,7 @@
 #
 # Makefile.PL - build file for Config::General
 #
-# Copyright (c) 2000-2010 Thomas Linden <tom@daemon.de>.
+# Copyright (c) 2000-2012 Thomas Linden <tom@daemon.de>.
 # All Rights Reserved. Std. disclaimer applies.
 # Artistic License, same as perl itself. Have fun.
 #

t/run.t

@@ -8,7 +8,7 @@
 
 
 use Data::Dumper;
-use Test::More tests => 68;
+use Test::More tests => 69;
 #use Test::More qw(no_plan);
 
 # ahem, we deliver the test code with a local copy of
@@ -731,4 +731,7 @@ is($hash53{have}, "'1'", "check -AllowSingleQuoteInterpolation");
 # Make sure no warnings were seen during the test.
 ok( !@WARNINGS_FOUND, "No unexpected warnings seen" );
 
-
+# check if disabling escape chars does work
+my $cfg54 = new Config::General(-NoEscape => 1, -String => qq(val = \\\$notavar:\\blah\n));
+my %hash54 = $cfg54->getall();
+is($hash54{val}, qq(\\\$notavar:\\blah), "check -NoEscape");