1.28:

- added contributed sub module Config::General::Interpolated
	   by "Wei-Hon Chen" <plasmaball@pchome.com.tw> with
	   help from "Autrijus Tang" <autrijus@autrijus.org>
	   which makes it possible to use variables inside
	   config files.
	 - _read() accepts now c-comments inside c-comments if
	   they are on a single line.
	 - _read() is now more tolerant to here-identifiers
	   (the ends of here-docs), whitespaces right after
	   such an identifier are allowed (i.e. "EOF  ").
	 - _read() does now behave somewhat different with
	   C-comments, they will be the first thing being
	   processed in a config, so the parser really
	   ignores everything inside C-comments. Previously
	   it did not do that, for example here-docs has
	   not been ignored.


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

Changelog

@@ -1,3 +1,21 @@
+ 1.28:
+	 - added contributed sub module Config::General::Interpolated
+	   by "Wei-Hon Chen" <plasmaball@pchome.com.tw> with
+	   help from "Autrijus Tang" <autrijus@autrijus.org>
+	   which makes it possible to use variables inside
+	   config files.
+	 - _read() accepts now c-comments inside c-comments if
+	   they are on a single line.
+	 - _read() is now more tolerant to here-identifiers
+	   (the ends of here-docs), whitespaces right after
+	   such an identifier are allowed (i.e. "EOF  ").
+	 - _read() does now behave somewhat different with
+	   C-comments, they will be the first thing being
+	   processed in a config, so the parser really
+	   ignores everything inside C-comments. Previously
+	   it did not do that, for example here-docs has
+	   not been ignored.
+
  1.27:   - "make test" complained about uninitialized value
            in :146, which is now fixed.
 

General.pm

@@ -17,7 +17,7 @@ use FileHandle;
 use strict;
 use Carp;
 
-$Config::General::VERSION = "1.27";
+$Config::General::VERSION = "1.28";
 
 sub new {
   #
@@ -157,8 +157,29 @@ sub _read {
 
   foreach (@stuff) {
     chomp;
-    # patch by "Manuel Valente" <manuel@ripe.net>:
+    if (/(\s*\/\*.*\*\/\s*)/) {
-    if (!$hierend) {
+      # single c-comment on one line
+      s/\s*\/\*.*\*\/\s*//;
+    }
+    elsif (/^\s*\/\*/) {                           # the beginning of a C-comment ("/*"), from now on ignore everything.
+      if (/\*\/\s*$/) {                         # C-comment end is already there, so just ignore this line!
+	$c_comment = 0;
+      }
+      else {
+	$c_comment = 1;
+      }
+    }
+    elsif (/\*\//) {
+      if (!$c_comment) {
+	warn "invalid syntax: found end of C-comment without previous start!\n";
+      }
+      $c_comment = 0;                           # the current C-comment ends here, go on
+      s/^.*\*\///;                              # if there is still stuff, it will be read
+    }
+
+    next if($c_comment);                        # ignore EVERYTHING from now on
+
+    if (!$hierend) {                            # patch by "Manuel Valente" <manuel@ripe.net>:
       s/(?<!\\)#.+$//;                          # Remove comments
       next if /^#/;                             # Remove lines beginning with "#"
       next if /^\s*$/;                          # Skip empty lines
@@ -168,7 +189,7 @@ sub _read {
       $hier    = $1;                            # $hier is the actual here-doc
       $hierend = $3;                            # the here-doc end string, i.e. "EOF"
     }
-    elsif (defined $hierend && /^(\s*)\Q$hierend\E$/) {             # the current here-doc ends here
+    elsif (defined $hierend && /^(\s*)\Q$hierend\E\s*$/) {             # the current here-doc ends here (allow spaces)
       my $indent = $1;                          # preserve indentation
       $hier .= " " . chr(182);                  # append a "<22>" to the here-doc-name, so _parse will also preserver indentation
       if ($indent) {
@@ -185,29 +206,16 @@ sub _read {
       undef $hier;
       undef $hierend;
     }
-    elsif (/^\s*\/\*/) {                        # the beginning of a C-comment ("/*"), from now on ignore everything.
+
-      if (/\*\/\s*$/) {                         # C-comment end is already there, so just ignore this line!
-	$c_comment = 0;
-      }
-      else {
-	$c_comment = 1;
-      }
-    }
-    elsif (/\*\//) {
-      if (!$c_comment) {
-	warn "invalid syntax: found end of C-comment without previous start!\n";
-      }
-      $c_comment = 0;                           # the current C-comment ends here, go on
-    }
     elsif (/\\$/) {                             # a multiline option, indicated by a trailing backslash
       chop;
       s/^\s*//;
-      $longline .= $_ if(!$c_comment);          # store in $longline
+      $longline .= $_;                          # store in $longline
     }
     else {                                      # any "normal" config lines
       if ($longline) {                          # previous stuff was a longline and this is the last line of the longline
 	s/^\s*//;
-	$longline .= $_ if(!$c_comment);
+	$longline .= $_;
 	push @{$this->{content}}, $longline;    # push it onto the content stack
 	undef $longline;
       }
@@ -216,7 +224,6 @@ sub _read {
       }
       else {
 	# look for include statement(s)
-	if (!$c_comment) {
 	my $incl_file;
 	if (/^\s*<<include (.+?)>>\s*$/i || (/^\s*include (.+?)\s*$/i && $this->{UseApacheInclude})) {
 	  $incl_file = $1;
@@ -235,7 +242,6 @@ sub _read {
       }
     }
   }
-  }
   return 1;
 }
 
@@ -979,6 +985,11 @@ There is a way to access a parsed config the OO-way.
 Use the module B<Config::General::Extended>, which is
 supplied with the Config::General distribution.
 
+=head1 VARIABLE INTERPOLATION
+
+You can use variables inside your configfiles if you like. To do
+that you have to use the module B<Config::General::Interpolated>,
+which is supplied with the Config::General distribution.
 
 =head1 SEE ALSO
 
@@ -1011,7 +1022,7 @@ Thomas Linden <tom@daemon.de>
 
 =head1 VERSION
 
-1.27
+1.28
 
 =cut
 

General/Interpolated.pm

@@ -0,0 +1,207 @@
+package Config::General::Interpolated;
+$Config::General::Interpolated::VERSION = "1.0";
+
+use strict;
+use Carp;
+use Config::General;
+
+# Import stuff from Config::General
+use vars qw(@ISA);
+@ISA = qw(Config::General);
+
+sub new {
+  #
+  # overwrite new() with our own version
+  # and call the parent class new()
+  #
+  my $class = shift;
+  my $self  = $class->SUPER::new(@_);
+
+  # the following regex is provided by Autrijus Tang
+  # <autrijus@autrijus.org>, and I made some modifications.
+  # thanx, autrijus. :)
+  $self->{regex} = qr{
+	               (^|[^\\])	# can be the beginning of the line
+	                                # but can't begin with a '\'
+	               \$		# dollar sign
+	               (\{)?		# $1: optional opening curly
+	               ([a-zA-Z_]\w*)	# $2: capturing variable name
+	               (
+	               ?(2)		# $3: if there's the opening curly...
+	               \}		#     ... match closing curly
+	              )
+	             }x;
+
+  $self->{config} = $self->vars($self->{config}, {});
+
+  return $self;
+}
+
+
+
+
+
+sub vars {
+    my ($this, $config, $stack) = @_;
+    my %varstack;
+
+    $stack = {} unless defined $stack;	# make sure $stack is assigned.
+
+    # collect values that don't need to be substituted first
+    while (my ($key, $value) = each %{$config}) {
+	$varstack{$key} = $value
+	    unless ref($value) or $value =~ $this->{regex};
+    }
+
+    my $sub_interpolate = sub {
+      my ($value) = @_;
+
+      # this is a scalar
+      if ($value =~ m/^'/ and $value =~ m/'$/) {
+	# single-quote, remove it and don't do variable interpolation
+	$value =~ s/^'//;   $value =~ s/'$//;
+      }
+      else {
+	$value =~ s{$this->{regex}}{
+	  my $v = $varstack{$3} || $stack->{$3};
+	  $v = '' if ref($v);
+	  $1 . $v;
+	}egx;
+      }
+
+      return $value;
+    };
+
+    # interpolate variables
+    while (my ($key, $value) = each %{$config}) {
+      if (my $reftype = ref($value)) {
+	next unless $reftype eq 'ARRAY';
+
+	# we encounter multiple options
+	@{$value} = map { $sub_interpolate->($_) } @{$value};
+      }
+      else {
+	$value = $sub_interpolate->($value);
+	$config->{$key} = $value;
+	$varstack{$key} = $value;
+      }
+    }
+
+    # traverse the hierarchy part
+    while (my ($key, $value) = each %{$config}) {
+      # this is not a scalar recursive call to myself
+      $this->vars($value, {%{$stack}, %varstack})
+	if ref($value) eq 'HASH';
+    }
+
+    return $config;
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Config::General::Interpolated - Parse variables within Config files
+
+
+=head1 SYNOPSIS
+
+ use Config::General::Interpolated;
+ $conf = new Config::General::Interpolated("rcfile");
+ # or
+ $conf = new Config::General::Interpolated(\%somehash);
+
+=head1 DESCRIPTION
+
+This module is a subclass of B<Config::General>. You can use it if
+your config file contains perl-style variables (i.e. C<$variable>
+or C<${variable}>). The following methods are directly inherited
+from Config::General: B<new() getall()>.
+
+
+Please refer to the L<Config::General> for the module's usage and the
+format of config files.
+
+=head1 VARIABLES
+
+Variables can be defined everywhere in the config and can be used
+afterwards. If you define a variable inside a block or a named block
+then it is only visible within this block or within blocks which
+are defined inside this block. Well - let's take a look to an example:
+
+ # sample config which uses variables
+ basedir   = /opt/ora
+ user      = t_space
+ sys       = unix
+ <table intern>
+     instance  = INTERN
+     owner     = $user                 # "t_space"
+     logdir    = $basedir/log          # "/opt/ora/log"
+     sys       = macos
+     <procs>
+         misc1   = ${sys}_${instance}  # macos_INTERN
+         misc2   = $user               # "t_space"
+     </procs>
+ </table>
+
+This will result in the following structure:
+
+ {
+     'basedir' => '/opt/ora',
+     'user'    => 't_space'
+     'sys'     => 'unix',
+     'table'   => {
+	  'intern' => {
+	        'sys'      => 'macos',
+	        'logdir'   => '/opt/ora/log',
+	        'instance' => 'INTERN',
+	        'owner' => 't_space',
+	        'procs' => {
+		     'misc1' => 'macos_INTERN',
+		     'misc2' => 't_space'
+            }
+	 }
+     }
+
+As you can see, the variable B<sys> has been defined twice. Inside
+the <procs> block a variable ${sys} has been used, which then were
+interpolated into the value of B<sys> defined inside the <table>
+block, not the sys variable one level above. If sys were not defined
+inside the <table> block then the "global" variable B<sys> would have
+been used instead with the value of "unix".
+
+Variables inside double quotes will be interpolated, but variables
+inside single quotes will B<not> interpolated. This is the same
+behavior as you know of perl itself.
+
+In addition you can surround variable names with curly braces to
+avoid misinterpretation by the parser.
+
+=head1 SEE ALSO
+
+L<Config::General>
+
+=head1 AUTHORS
+
+ Thomas Linden <tom@daemon.de>
+ Autrijus Tang <autrijus@autrijus.org>
+ Wei-Hon Chen <plasmaball@pchome.com.tw>
+
+=head1 COPYRIGHT
+
+Copyright 2001 by Wei-Hon Chen E<lt>plasmaball@pchome.com.twE<gt>.
+
+This program is free software; you can redistribute it and/or 
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=head1 VERSION
+
+This document describes version 1.0 of B<Config::General::Interpolated>.
+
+=cut
+

MANIFEST

@@ -1,5 +1,6 @@
 Changelog
 General/Extended.pm
+General/Interpolated.pm
 General.pm
 MANIFEST
 Makefile.PL