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