﻿eaiovnaovbqoebvqoeavibavo
PK     ��iZ5<*�  �    Tiny.pmnu �[���        package Config::Tiny;

# If you thought Config::Simple was small...

use strict;
BEGIN {
	require 5.004;
	$Config::Tiny::VERSION = '2.14';
	$Config::Tiny::errstr  = '';
}

# Create an empty object
sub new { bless {}, shift }

# Create an object from a file
sub read {
	my $class = ref $_[0] ? ref shift : shift;

	# Check the file
	my $file = shift or return $class->_error( 'You did not specify a file name' );
	return $class->_error( "File '$file' does not exist" )              unless -e $file;
	return $class->_error( "'$file' is a directory, not a file" )       unless -f _;
	return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;

	# Slurp in the file
	local $/ = undef;
	open( CFG, $file ) or return $class->_error( "Failed to open file '$file': $!" );
	my $contents = <CFG>;
	close( CFG );

	$class->read_string( $contents );
}

# Create an object from a string
sub read_string {
	my $class = ref $_[0] ? ref shift : shift;
	my $self  = bless {}, $class;
	return undef unless defined $_[0];

	# Parse the file
	my $ns      = '_';
	my $counter = 0;
	foreach ( split /(?:\015{1,2}\012|\015|\012)/, shift ) {
		$counter++;

		# Skip comments and empty lines
		next if /^\s*(?:\#|\;|$)/;

		# Remove inline comments
		s/\s\;\s.+$//g;

		# Handle section headers
		if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
			# Create the sub-hash if it doesn't exist.
			# Without this sections without keys will not
			# appear at all in the completed struct.
			$self->{$ns = $1} ||= {};
			next;
		}

		# Handle properties
		if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
			$self->{$ns}->{$1} = $2;
			next;
		}

		return $self->_error( "Syntax error at line $counter: '$_'" );
	}

	$self;
}

# Save an object to a file
sub write {
	my $self = shift;
	my $file = shift or return $self->_error(
		'No file name provided'
		);

	# Write it to the file
	my $string = $self->write_string;
	return undef unless defined $string;
	open( CFG, '>' . $file ) or return $self->_error(
		"Failed to open file '$file' for writing: $!"
		);
	print CFG $string;
	close CFG;
}

# Save an object to a string
sub write_string {
	my $self = shift;

	my $contents = '';
	foreach my $section ( sort { (($b eq '_') <=> ($a eq '_')) || ($a cmp $b) } keys %$self ) {
		# Check for several known-bad situations with the section
		# 1. Leading whitespace
		# 2. Trailing whitespace
		# 3. Newlines in section name
		return $self->_error(
			"Illegal whitespace in section name '$section'"
		) if $section =~ /(?:^\s|\n|\s$)/s;
		my $block = $self->{$section};
		$contents .= "\n" if length $contents;
		$contents .= "[$section]\n" unless $section eq '_';
		foreach my $property ( sort keys %$block ) {
			return $self->_error(
				"Illegal newlines in property '$section.$property'"
			) if $block->{$property} =~ /(?:\012|\015)/s;
			$contents .= "$property=$block->{$property}\n";
		}
	}
	
	$contents;
}

# Error handling
sub errstr { $Config::Tiny::errstr }
sub _error { $Config::Tiny::errstr = $_[1]; undef }

1;

__END__

=pod

=head1 NAME

Config::Tiny - Read/Write .ini style files with as little code as possible

=head1 SYNOPSIS

    # In your configuration file
    rootproperty=blah

    [section]
    one=twp
    three= four
    Foo =Bar
    empty=

    # In your program
    use Config::Tiny;

    # Create a config
    my $Config = Config::Tiny->new;

    # Open the config
    $Config = Config::Tiny->read( 'file.conf' );

    # Reading properties
    my $rootproperty = $Config->{_}->{rootproperty};
    my $one = $Config->{section}->{one};
    my $Foo = $Config->{section}->{Foo};

    # Changing data
    $Config->{newsection} = { this => 'that' }; # Add a section
    $Config->{section}->{Foo} = 'Not Bar!';     # Change a value
    delete $Config->{_};                        # Delete a value or section

    # Save a config
    $Config->write( 'file.conf' );

=head1 DESCRIPTION

C<Config::Tiny> is a perl class to read and write .ini style configuration
files with as little code as possible, reducing load time and memory
overhead. Most of the time it is accepted that Perl applications use a lot
of memory and modules. The C<::Tiny> family of modules is specifically
intended to provide an ultralight alternative to the standard modules.

This module is primarily for reading human written files, and anything we
write shouldn't need to have documentation/comments. If you need something
with more power move up to L<Config::Simple>, L<Config::General> or one of
the many other C<Config::> modules. To rephrase, L<Config::Tiny> does B<not>
preserve your comments, whitespace, or the order of your config file.

=head1 CONFIGURATION FILE SYNTAX

Files are the same format as for windows .ini files. For example:

	[section]
	var1=value1
	var2=value2

If a property is outside of a section at the beginning of a file, it will
be assigned to the C<"root section">, available at C<$Config-E<gt>{_}>.

Lines starting with C<'#'> or C<';'> are considered comments and ignored,
as are blank lines.

When writing back to the config file, all comments, custom whitespace,
and the ordering of your config file elements is discarded. If you need
to keep the human elements of a config when writing back, upgrade to
something better, this module is not for you.

=head1 METHODS

=head2 new

The constructor C<new> creates and returns an empty C<Config::Tiny> object.

=head2 read $filename

The C<read> constructor reads a config file, and returns a new
C<Config::Tiny> object containing the properties in the file. 

Returns the object on success, or C<undef> on error.

When C<read> fails, C<Config::Tiny> sets an error message internally
you can recover via C<Config::Tiny-E<gt>errstr>. Although in B<some>
cases a failed C<read> will also set the operating system error
variable C<$!>, not all errors do and you should not rely on using
the C<$!> variable.

=head2 read_string $string;

The C<read_string> method takes as argument the contents of a config file
as a string and returns the C<Config::Tiny> object for it.

=head2 write $filename

The C<write> method generates the file content for the properties, and
writes it to disk to the filename specified.

Returns true on success or C<undef> on error.

=head2 write_string

Generates the file content for the object and returns it as a string.

=head2 errstr

When an error occurs, you can retrieve the error message either from the
C<$Config::Tiny::errstr> variable, or using the C<errstr()> method.

=head1 CAVEATS

=head2 Unsupported Section Headers

Some edge cases in section headers are not support, and additionally may not
be detected when writing the config file.

Specifically, section headers with leading whitespace, trailing whitespace,
or newlines anywhere in the section header, will not be written correctly
to the file and may cause file corruption.

=head1 SUPPORT

Bugs should be reported via the CPAN bug tracker at

L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Config-Tiny>

For other issues, or commercial enhancement or support, contact the author.

=head1 AUTHOR

Adam Kennedy E<lt>adamk@cpan.orgE<gt>

=head1 ACKNOWLEGEMENTS

Thanks to Sherzod Ruzmetov E<lt>sherzodr@cpan.orgE<gt> for
L<Config::Simple>, which inspired this module by being not quite
"simple" enough for me :)

=head1 SEE ALSO

L<Config::Simple>, L<Config::General>, L<ali.as>

=head1 COPYRIGHT

Copyright 2002 - 2011 Adam Kennedy.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut
PK     ��iZs�ط�< �< 
  General.pmnu �[���        #
# Config::General.pm - Generic Config Module
#
# Purpose: Provide a convenient way for loading
#          config values from a given file and
#          return it as hash structure
#
# Copyright (c) 2000-2016 Thomas Linden <tlinden |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies.
# Artistic License, same as perl itself. Have fun.
#
# namespace
package Config::General;

use strict;
use warnings;
use English '-no_match_vars';

use IO::File;
use FileHandle;
use File::Spec::Functions qw(splitpath file_name_is_absolute catfile catpath);
use File::Glob qw/:glob/;


# on debian with perl > 5.8.4 croak() doesn't work anymore without this.
# There is some require statement which dies 'cause it can't find Carp::Heavy,
# I really don't understand, what the hell they made, but the debian perl
# installation is definitely bullshit, damn!
use Carp::Heavy;


use Carp;
use Exporter;

$Config::General::VERSION = "2.61";

use vars  qw(@ISA @EXPORT_OK);
use base qw(Exporter);
@EXPORT_OK = qw(ParseConfig SaveConfig SaveConfigString);

use constant _UTF8_BOM => "\x{ef}\x{bb}\x{bf}";

sub new {
  #
  # create new Config::General object
  #
  my($this, @param ) = @_;
  my $class = ref($this) || $this;

  # define default options
  my $self = {
              # sha256 of current date
              # hopefully this lowers the probability that
              # this matches any configuration key or value out there
              # bugfix for rt.40925
              EOFseparator          => 'ad7d7b87f5b81d2a0d5cb75294afeb91aa4801b1f8e8532dc1b633c0e1d47037',
              SlashIsDirectory      => 0,
              AllowMultiOptions     => 1,
              MergeDuplicateOptions => 0,
              MergeDuplicateBlocks  => 0,
              LowerCaseNames        => 0,
              ApacheCompatible      => 0,
              UseApacheInclude      => 0,
              IncludeRelative       => 0,
              IncludeDirectories    => 0,
              IncludeGlob           => 0,
              IncludeAgain          => 0,
              AutoLaunder           => 0,
              AutoTrue              => 0,
              AutoTrueFlags         => {
                                        true  => '^(on|yes|true|1)$',
                                        false => '^(off|no|false|0)$',
                                       },
              DefaultConfig         => {},
              String                => '',
              level                 => 1,
              InterPolateVars       => 0,
              InterPolateEnv        => 0,
              ExtendedAccess        => 0,
              SplitPolicy           => 'guess', # also possible: whitespace, equalsign and custom
              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,       # 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
              parsed                => 0,       # internal state stuff for variable interpolation
              files                 => {},      # which files we have read, if any
              UTF8                  => 0,
              SaveSorted            => 0,
              ForceArray            => 0,       # force single value array if value enclosed in []
              AllowSingleQuoteInterpolation => 0,
              NoEscape              => 0,
              NormalizeBlock        => 0,
              NormalizeOption       => 0,
              NormalizeValue        => 0,
              Plug                  => {}
             };

  # create the class instance
  bless $self, $class;

  if ($#param >= 1) {
    # use of the new hash interface!
    $self->_prepare(@param);
  }
  elsif ($#param == 0) {
    # use of the old style
    $self->{ConfigFile} = $param[0];
    if (ref($self->{ConfigFile}) eq 'HASH') {
      $self->{ConfigHash} = delete $self->{ConfigFile};
    }
  }
  else {
    # this happens if $#param == -1,1 thus no param was given to new!
    $self->{config} = $self->_hashref();
    $self->{parsed} = 1;
  }

  # find split policy to use for option/value separation
  $self->_splitpolicy();

  # bless into variable interpolation module if necessary
  $self->_blessvars();

  # process as usual
  if (!$self->{parsed}) {
    $self->_process();
  }

  if ($self->{InterPolateVars}) {
    $self->{config} = $self->_clean_stack($self->{config});
  }

  # bless into OOP namespace if required
  $self->_blessoop();

  return $self;
}


sub _process {
  #
  # call _read() and _parse() on the given config
  my($self) = @_;

  if ($self->{DefaultConfig} && $self->{InterPolateVars}) {
    $self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig}); # FIXME: _hashref() ?
  }
  if (exists $self->{StringContent}) {
    # consider the supplied string as config file
    $self->_read($self->{StringContent}, 'SCALAR');
    $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
  }
  elsif (exists $self->{ConfigHash}) {
    if (ref($self->{ConfigHash}) eq 'HASH') {
      # initialize with given hash
      $self->{config} = $self->{ConfigHash};
      $self->{parsed} = 1;
    }
    else {
      croak "Config::General: Parameter -ConfigHash must be a hash reference!\n";
    }
  }
  elsif (ref($self->{ConfigFile}) eq 'GLOB' || ref($self->{ConfigFile}) eq 'FileHandle') {
    # use the file the glob points to
    $self->_read($self->{ConfigFile});
    $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
  }
  else {
    if ($self->{ConfigFile}) {
      # open the file and read the contents in
      $self->{configfile} = $self->{ConfigFile};
      if ( file_name_is_absolute($self->{ConfigFile}) ) {
	# look if this is an absolute path and save the basename if it is absolute
	my ($volume, $path, undef) = splitpath($self->{ConfigFile});
	$path =~ s#/$##; # remove eventually existing trailing slash
	if (! $self->{ConfigPath}) {
	  $self->{ConfigPath} = [];
	}
	unshift @{$self->{ConfigPath}}, catpath($volume, $path, q());
      }
      $self->_open($self->{configfile});
      # now, we parse immediately, getall simply returns the whole hash
      $self->{config} = $self->_hashref();
      $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
    }
    else {
      # hm, no valid config file given, so try it as an empty object
      $self->{config} = $self->_hashref();
      $self->{parsed} = 1;
    }
  }
}


sub _blessoop {
  #
  # bless into ::Extended if necessary
  my($self) = @_;
  if ($self->{ExtendedAccess}) {
    # we are blessing here again, to get into the ::Extended namespace
    # for inheriting the methods available over there, which we doesn't have.
    bless $self, 'Config::General::Extended';
    eval {
      require Config::General::Extended;
    };
    if ($EVAL_ERROR) {
      croak "Config::General: " . $EVAL_ERROR;
    }
  }
#  return $self;
}

sub _blessvars {
  #
  # bless into ::Interpolated if necessary
  my($self) = @_;
  if ($self->{InterPolateVars} || $self->{InterPolateEnv}) {
    # InterPolateEnv implies InterPolateVars
    $self->{InterPolateVars} = 1;

    # we are blessing here again, to get into the ::InterPolated namespace
    # for inheriting the methods available overthere, which we doesn't have here.
    bless $self, 'Config::General::Interpolated';
    eval {
      require Config::General::Interpolated;
    };
    if ($EVAL_ERROR) {
      croak "Config::General: " . $EVAL_ERROR;
    }
    # pre-compile the variable regexp
    $self->{regex} = $self->_set_regex();
  }
#  return $self;
}


sub _splitpolicy {
  #
  # find out what split policy to use
  my($self) = @_;
  if ($self->{SplitPolicy} ne 'guess') {
    if ($self->{SplitPolicy} eq 'whitespace') {
      $self->{SplitDelimiter} = '\s+';
      if (!$self->{StoreDelimiter}) {
	$self->{StoreDelimiter} = q(   );
      }
    }
    elsif ($self->{SplitPolicy} eq 'equalsign') {
      $self->{SplitDelimiter} = '\s*=\s*';
      if (!$self->{StoreDelimiter}) {
	$self->{StoreDelimiter} = ' = ';
      }
    }
    elsif ($self->{SplitPolicy} eq 'custom') {
      if (! $self->{SplitDelimiter} ) {
	croak "Config::General: SplitPolicy set to 'custom' but no SplitDelimiter set.\n";
      }
    }
    else {
      croak "Config::General: Unsupported SplitPolicy: $self->{SplitPolicy}.\n";
    }
  }
  else {
    if (!$self->{StoreDelimiter}) {
      $self->{StoreDelimiter} = q(   );
    }
  }
}

sub _prepare {
  #
  # prepare the class parameters, mangle them, if there
  # are options to reset or to override, do it here.
  my ($self, %conf) = @_;

  # save the parameter list for ::Extended's new() calls
  $self->{Params} = \%conf;

  # be backwards compatible
  if (exists $conf{-file}) {
    $self->{ConfigFile} = delete $conf{-file};
  }
  if (exists $conf{-hash}) {
    $self->{ConfigHash} = delete $conf{-hash};
  }

  # store input, file, handle, or array
  if (exists $conf{-ConfigFile}) {
    $self->{ConfigFile} = delete $conf{-ConfigFile};
  }
  if (exists $conf{-ConfigHash}) {
    $self->{ConfigHash} = delete $conf{-ConfigHash};
  }

  # store search path for relative configs, if any
  if (exists $conf{-ConfigPath}) {
    my $configpath = delete $conf{-ConfigPath};
    $self->{ConfigPath} = ref $configpath eq 'ARRAY' ? $configpath : [$configpath];
  }

  # handle options which contains values we need (strings, hashrefs or the like)
  if (exists $conf{-String} ) {
    #if (ref(\$conf{-String}) eq 'SCALAR') {
    if (not ref $conf{-String}) {
      if ( $conf{-String}) {
	$self->{StringContent} = $conf{-String};
      }
      delete $conf{-String};
    }
    # re-implement arrayref support, removed after 2.22 as _read were
    # re-organized
    # fixed bug#33385
    elsif(ref($conf{-String}) eq 'ARRAY') {
      $self->{StringContent} = join "\n", @{$conf{-String}};
    }
    else {
      croak "Config::General: Parameter -String must be a SCALAR or ARRAYREF!\n";
    }
    delete $conf{-String};
  }
  if (exists $conf{-Tie}) {
    if ($conf{-Tie}) {
      $self->{Tie} = delete $conf{-Tie};
      $self->{DefaultConfig} = $self->_hashref();
    }
  }

  if (exists $conf{-FlagBits}) {
    if ($conf{-FlagBits} && ref($conf{-FlagBits}) eq 'HASH') {
      $self->{FlagBits} = 1;
      $self->{FlagBitsFlags} = $conf{-FlagBits};
    }
    delete $conf{-FlagBits};
  }

  if (exists $conf{-DefaultConfig}) {
    if ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq 'HASH') {
      $self->{DefaultConfig} = $conf{-DefaultConfig};
    }
    elsif ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq q()) {
      $self->_read($conf{-DefaultConfig}, 'SCALAR');
      $self->{DefaultConfig} = $self->_parse($self->_hashref(), $self->{content});
      $self->{content} = ();
    }
    delete $conf{-DefaultConfig};
  }

  # handle options which may either be true or false
  # allowing "human" logic about what is true and what is not
  foreach my $entry (keys %conf) {
    my $key = $entry;
    $key =~ s/^\-//;
    if (! exists $self->{$key}) {
      croak "Config::General: Unknown parameter: $entry => \"$conf{$entry}\" (key: <$key>)\n";
    }
    if ($conf{$entry} =~ /$self->{AutoTrueFlags}->{true}/io) {
      $self->{$key} = 1;
    }
    elsif ($conf{$entry} =~ /$self->{AutoTrueFlags}->{false}/io) {
      $self->{$key} = 0;
    }
    else {
      # keep it untouched
      $self->{$key} = $conf{$entry};
    }
  }

  if ($self->{MergeDuplicateOptions}) {
    # override if not set by user
    if (! exists $conf{-AllowMultiOptions}) {
      $self->{AllowMultiOptions} = 0;
    }
  }

  if ($self->{ApacheCompatible}) {
    # turn on all apache compatibility options which has
    # been incorporated during the years...
    $self->{UseApacheInclude}   = 1;
    $self->{IncludeRelative}    = 1;
    $self->{IncludeDirectories} = 1;
    $self->{IncludeGlob}        = 1;
    $self->{SlashIsDirectory}   = 1;
    $self->{SplitPolicy}        = 'whitespace';
    $self->{CComments}          = 0;
  }
}

sub getall {
  #
  # just return the whole config hash
  #
  my($this) = @_;
  return (exists $this->{config} ? %{$this->{config}} : () );
}


sub files {
  #
  # return a list of files opened so far
  #
  my($this) = @_;
  return (exists $this->{files} ? keys %{$this->{files}} : () );
}


sub _open {
  #
  # open the config file, or expand a directory or glob or include
  #
  my($this, $basefile, $basepath) = @_;
  my $cont;

  ($cont, $basefile, $basepath) = $this->_hook('pre_open', $basefile, $basepath);
  return if(!$cont);

  my($fh, $configfile);

  if($basepath) {
    # if this doesn't work we can still try later the global config path to use
    $configfile = catfile($basepath, $basefile);
  }
  else {
    $configfile = $basefile;
  }

  if ($this->{IncludeGlob} and $configfile =~ /[*?\[\{\\]/) {
    # Something like: *.conf (or maybe dir/*.conf) was included; expand it and
    # pass each expansion through this method again.
    my @include = grep { -f $_ } bsd_glob($configfile, GLOB_BRACE | GLOB_QUOTE);

    # applied patch by AlexK fixing rt.cpan.org#41030
    if ( !@include && defined $this->{ConfigPath} ) {
      foreach my $dir (@{$this->{ConfigPath}}) {
        my ($volume, $path, undef) = splitpath($basefile);
        if ( -d catfile( $dir, $path )  ) {
          push @include, grep { -f $_ } bsd_glob(catfile($dir, $basefile), GLOB_BRACE | GLOB_QUOTE);
          last;
        }
      }
    }

    if (@include == 1) {
      $configfile = $include[0];
    }
    else {
      # Multiple results or no expansion results (which is fine,
      # include foo/* shouldn't fail if there isn't anything matching)
      # rt.cpan.org#79869: local $this->{IncludeGlob};
      for (@include) {
        $this->_open($_);
      }
      return;
    }
  }

  if (!-e $configfile) {
    my $found;
    if (defined $this->{ConfigPath}) {
      # try to find the file within ConfigPath
      foreach my $dir (@{$this->{ConfigPath}}) {
        if( -e catfile($dir, $basefile) ) {
          $configfile = catfile($dir, $basefile);
          $found = 1;
          last; # found it
        }
      }
    }
    if (!$found) {
      my $path_message = defined $this->{ConfigPath} ? q( within ConfigPath: ) . join(q(.), @{$this->{ConfigPath}}) : q();
      croak qq{Config::General The file "$basefile" does not exist$path_message!};
    }
  }

  local ($RS) = $RS;
  if (! $RS) {
    carp(q(\$RS (INPUT_RECORD_SEPARATOR) is undefined.  Guessing you want a line feed character));
    $RS = "\n";
  }

  if (-d $configfile and $this->{IncludeDirectories}) {
    # A directory was included; include all the files inside that directory in ASCII order
    local *INCLUDEDIR;
    opendir INCLUDEDIR, $configfile or croak "Config::General: Could not open directory $configfile!($!)\n";
    my @files = sort grep { -f catfile($configfile, $_) } catfile($configfile, $_), readdir INCLUDEDIR;
    closedir INCLUDEDIR;
    local $this->{CurrentConfigFilePath} = $configfile;
    for (@files) {
      my $file = catfile($configfile, $_);
      if (! exists $this->{files}->{$file} or $this->{IncludeAgain} ) {
        # support re-read if used urged us to do so, otherwise ignore the file
        $fh = $this->_openfile_for_read($file);
        $this->{files}->{"$file"} = 1;
        $this->_read($fh);
      }
      else {
        warn "File $file already loaded.  Use -IncludeAgain to load it again.\n";
      }
    }
  }
  elsif (-d $configfile) {
    croak "Config::General: config file argument is a directory, expecting a file!\n";
  }
  elsif (-e _) {
    if (exists $this->{files}->{$configfile} and not $this->{IncludeAgain}) {
      # do not read the same file twice, just return
      warn "File $configfile already loaded.  Use -IncludeAgain to load it again.\n";
      return;
    }
    else {
      $fh = $this->_openfile_for_read($configfile);
      $this->{files}->{$configfile}    = 1;

      my ($volume, $path, undef)           = splitpath($configfile);
      local $this->{CurrentConfigFilePath} = catpath($volume, $path, q());

      $this->_read($fh);
    }
  }
  return;
}


sub _openfile_for_read {
  #
  # actually open a file, turn on utf8 mode if requested by bom
  #
  my ($this, $file) = @_;

  my $fh = IO::File->new( $file, 'r')
    or croak "Config::General: Could not open $file!($!)\n";

  # attempt to read an initial utf8 byte-order mark (BOM)
  my $n_read  = sysread $fh, my $read_BOM, length(_UTF8_BOM);
  my $has_BOM = $n_read == length(_UTF8_BOM) && $read_BOM eq _UTF8_BOM;

  # set utf8 perlio layer if BOM was found or if option -UTF8 is turned on
  binmode $fh, ":utf8" if $this->{UTF8} || $has_BOM;

  # rewind to beginning of file if we read chars that were not the BOM
  sysseek $fh, 0, 0 if $n_read && !$has_BOM;

  return $fh;
}


sub _read {
  #
  # store the config contents in @content
  # and prepare it somewhat for easier parsing later
  # (comments, continuing lines, and stuff)
  #
  my($this, $fh, $flag) = @_;


  my(@stuff, @content, $c_comment, $longline, $hier, $hierend, @hierdoc);
  local $_ = q();

  if ($flag && $flag eq 'SCALAR') {
    if (ref($fh) eq 'ARRAY') {
      @stuff = @{$fh};
    }
    else {
      @stuff = split /\n/, $fh;
    }
  }
  else {
    @stuff = <$fh>;
  }

  my $cont;
  ($cont, $fh, @stuff) = $this->_hook('pre_read', $fh, @stuff);
  return if(!$cont);

  foreach (@stuff) {
    if ($this->{AutoLaunder}) {
      if (m/^(.*)$/) {
        $_ = $1;
      }
    }

    chomp;


    if ($hier) {
      # inside here-doc, only look for $hierend marker
      if (/^(\s*)\Q$hierend\E\s*$/) {
        my $indent = $1;                 # preserve indentation
        $hier .= ' ' . $this->{EOFseparator}; # bugfix of rt.40925
        # _parse will also preserver indentation
        if ($indent) {
          foreach (@hierdoc) {
            s/^$indent//;                # i.e. the end was: "    EOF" then we remove "    " from every here-doc line
            $hier .= $_ . "\n";          # and store it in $hier
          }
        }
        else {
          $hier .= join "\n", @hierdoc;  # there was no indentation of the end-string, so join it 1:1
        }
        push @{$this->{content}}, $hier; # push it onto the content stack
        @hierdoc = ();
        undef $hier;
        undef $hierend;
      }
      else {
        # everything else onto the stack
        push @hierdoc, $_;
      }
      next;
    }

    if ($this->{CComments}) {
      # look for C-Style comments, if activated
      if (/(\s*\/\*.*\*\/\s*)/) {
        # 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 it IS a C-Comment
    }

    # Remove comments and empty lines
    s/(?<!\\)#.*$//; # .+ => .* bugfix rt.cpan.org#44600
    next if /^\s*#/;
    #next if /^\s*$/;


    # look for multiline option, indicated by a trailing backslash
    if (/(?<!\\)\\$/) {
      chop; # remove trailing backslash
      s/^\s*//;
      $longline .= $_;
      next;
    }

    # transform explicit-empty blocks to conforming blocks
    # rt.cpan.org#80006 added \s* before $/
    if (!$this->{ApacheCompatible} && /\s*<([^\/]+?.*?)\/>\s*$/) {
      my $block = $1;
      if ($block !~ /\"/) {
        if ($block !~ /\s[^\s]/) {
          # fix of bug 7957, add quotation to pure slash at the
          # end of a block so that it will be considered as directory
          # unless the block is already quoted or contains whitespaces
          # and no quotes.
          if ($this->{SlashIsDirectory}) {
            push @{$this->{content}}, '<' . $block . '"/">';
            next;
          }
        }
      }
      my $orig  = $_;
      $orig     =~ s/\/>$/>/;
      $block    =~ s/\s\s*.*$//;
      push @{$this->{content}}, $orig, "</${block}>";
      next;
    }


    # look for here-doc identifier
    if ($this->{SplitPolicy} eq 'guess') {
      if (/^\s*([^=]+?)\s*=\s*<<\s*(.+?)\s*$/) {
        # try equal sign (fix bug rt#36607)
        $hier    = $1;  # the actual here-doc variable name
        $hierend = $2;  # the here-doc identifier, i.e. "EOF"
        next;
      }
      elsif (/^\s*(\S+?)\s+<<\s*(.+?)\s*$/) {
        # try whitespace
        $hier    = $1;  # the actual here-doc variable name
        $hierend = $2;  # the here-doc identifier, i.e. "EOF"
        next;
      }
    }
    else {
      # no guess, use one of the configured strict split policies
      if (/^\s*(.+?)($this->{SplitDelimiter})<<\s*(.+?)\s*$/) {
        $hier    = $1;  # the actual here-doc variable name
        $hierend = $3;  # the here-doc identifier, i.e. "EOF"
        next;
      }
    }


    ###
    ### any "normal" config lines from now on
    ###

    if ($longline) {
      # previous stuff was a longline and this is the last line of the longline
      s/^\s*//;
      $longline .= $_;
      push @{$this->{content}}, $longline;    # push it onto the content stack
      undef $longline;
      next;
    }
    else {
      # ignore empty lines
      next if /^\s*$/;

      # look for include statement(s)
      my $incl_file;
      my $path = '';
      if ( $this->{IncludeRelative} and defined $this->{CurrentConfigFilePath}) {
        $path = $this->{CurrentConfigFilePath};
      }
      elsif (defined $this->{ConfigPath}) {
        # fetch pathname of base config file, assuming the 1st one is the path of it
        $path = $this->{ConfigPath}->[0];
      }

      # bugfix rt.cpan.org#38635: support quoted filenames
      if ($this->{UseApacheInclude}) {
        my $opt = '';
        if (/^\s*(include|includeoptional)\s*(["'])(.*?)(?<!\\)\2$/i) {
          $incl_file = $3;
          $opt = $1;
        }
        elsif (/^\s*(include|includeoptional)\s+(.+?)\s*$/i) {
          $incl_file = $2;
          $opt = $1;
        }
        if ($incl_file) {
          if ($this->{IncludeGlob} && $opt =~ /opt/i && $incl_file !~ /[*?\[\{\\]/) {
            # fix rt#107108
            # glob enabled && optional include && file is not already a glob:
            # turn it into a singular matching glob, like:
            # "file" => "[f][i][l][e]"  and:
            # "dir/file" => "dir/[f][i][l][e]"
            # which IS a glob but only matches that particular file. if it
            # doesn't exist, it will be ignored by _open(), just what
            # we'd like to have when using IncludeOptional.
            my ($vol,$dirs,$file) = splitpath( $incl_file );
            $incl_file = catpath($vol, $dirs, join '', map { "[$_]" } split //, $file);
          }
        }
      }
      else {
        if (/^\s*<<include\s+(["'])(.+?)>>\\s*$/i) {
          $incl_file = $2;
        }
        elsif (/^\s*<<include\s+(.+?)>>\s*$/i) {
          $incl_file = $1;
        }
      }

      if ($incl_file) {
        if ( $this->{IncludeRelative} && $path && !file_name_is_absolute($incl_file) ) {
          # include the file from within location of $this->{configfile}
          $this->_open( $incl_file, $path );
        }
        else {
          # include the file from within pwd, or absolute
          $this->_open($incl_file);
        }
      }
      else {
        # standard entry, (option = value)
        push @{$this->{content}}, $_;
      }

    }

  }

  ($cont, $this->{content}) = $this->_hook('post_read', $this->{content});
  return 1;
}


sub _parse {
  #
  # parse the contents of the file
  #
  my($this, $config, $content) = @_;
  my(@newcontent, $block, $blockname, $chunk,$block_level);
  local $_;

  foreach (@{$content}) {                                  # loop over content stack
    chomp;
    $chunk++;
    $_ =~ s/^\s+//;                                        # strip spaces @ end and begin
    $_ =~ s/\s+$//;
    ###### bad $_ =~ s/^\x{ef}\x{bb}\x{bf}//; # strip utf BOM, if any, fix rt.cpan.org#113671

#
# build option value assignment, split current input
# using whitespace, equal sign or optionally here-doc
# separator EOFseparator
    my ($option,$value);
    if (/$this->{EOFseparator}/) {
      ($option,$value) = split /\s*$this->{EOFseparator}\s*/, $_, 2;   # separated by heredoc-finding in _open()
    }
    else {
      if ($this->{SplitPolicy} eq 'guess') {
        # again the old regex. use equalsign SplitPolicy to get the
        # 2.00 behavior. the new regexes were too odd.
        ($option,$value) = split /\s*=\s*|\s+/, $_, 2;
      }
      else {
        # no guess, use one of the configured strict split policies
        ($option,$value) = split /$this->{SplitDelimiter}/, $_, 2;
      }
    }

    if($this->{NormalizeOption}) {
      $option = $this->{NormalizeOption}($option);
    }

    if ($value && $value =~ /^"/ && $value =~ /"$/) {
      $value =~ s/^"//;                                    # remove leading and trailing "
      $value =~ s/"$//;
    }
    if (! defined $block) {                                # not inside a block @ the moment
      if (/^<([^\/]+?.*?)>$/) {                            # look if it is a block
        $block = $1;                                       # store block name
        if ($block =~ /^"([^"]+)"$/) {
# quoted block, unquote it and do not split
          $block =~ s/"//g;
        }
        else {
          # If it is a named block store the name separately; allow the block and name to each be quoted
          if ($block =~ /^(?:"([^"]+)"|(\S+))(?:\s+(?:"([^"]+)"|(.*)))?$/) {
            $block = $1 || $2;
            $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.
          $block     = $this->_interpolate($config, "<$block>", $block);
          if (defined $blockname) {
            $blockname = $this->_interpolate($config, "<$blockname>", "$blockname");
          }
        }
        if ($this->{LowerCaseNames}) {
          $block = lc $block;    # only for blocks lc(), if configured via new()
        }
        $this->{level} += 1;
        undef @newcontent;
        next;
      }
      elsif (/^<\/(.+?)>$/) { # it is an end block, but we don't have a matching block!
        croak "Config::General: EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
      }
      else {                                               # insert key/value pair into actual node
        if ($this->{LowerCaseNames}) {
          $option = lc $option;
        }

        if (exists $config->{$option}) {
          if ($this->{MergeDuplicateOptions}) {
            $config->{$option} = $this->_parse_value($config, $option, $value);

            # bugfix rt.cpan.org#33216
            if ($this->{InterPolateVars}) {
              # save pair on local stack
              $config->{__stack}->{$option} = $config->{$option};
            }
          }
          else {
            if (! $this->{AllowMultiOptions} ) {
              # no, duplicates not allowed
              croak "Config::General: Option \"$option\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
            }
            else {
              # yes, duplicates allowed
              if (ref($config->{$option}) ne 'ARRAY') {      # convert scalar to array
                my $savevalue = $config->{$option};
                delete $config->{$option};
                push @{$config->{$option}}, $savevalue;
              }
              eval {
                # check if arrays are supported by the underlying hash
                my $i = scalar @{$config->{$option}};
              };
              if ($EVAL_ERROR) {
                $config->{$option} = $this->_parse_value($config, $option, $value);
              }
              else {
                # it's already an array, just push
                push @{$config->{$option}}, $this->_parse_value($config, $option, $value);
              }
            }
          }
        }
        else {
          if($this->{ForceArray} && defined $value && $value =~ /^\[\s*(.+?)\s*\]$/) {
            # force single value array entry
            push @{$config->{$option}}, $this->_parse_value($config, $option, $1);
          }
          else {
            # standard config option, insert key/value pair into node
            $config->{$option} = $this->_parse_value($config, $option, $value);

            if ($this->{InterPolateVars}) {
              # save pair on local stack
              $config->{__stack}->{$option} = $config->{$option};
            }
          }
        }
      }
    }
    elsif (/^<([^\/]+?.*?)>$/) {    # found a start block inside a block, don't forget it
      $block_level++;               # $block_level indicates wether we are still inside a node
      push @newcontent, $_;         # push onto new content stack for later recursive call of _parse()
    }
    elsif (/^<\/(.+?)>$/) {
      if ($block_level) {           # this endblock is not the one we are searching for, decrement and push
        $block_level--;             # if it is 0, then the endblock was the one we searched for, see below
        push @newcontent, $_;       # push onto new content stack
      }
      else {                        # calling myself recursively, end of $block reached, $block_level is 0
        if (defined $blockname) {
          # a named block, make it a hashref inside a hash within the current node

          if (! exists $config->{$block}) {
            # Make sure that the hash is not created implicitly
            $config->{$block} = $this->_hashref();

            if ($this->{InterPolateVars}) {
              # inherit current __stack to new block
              $config->{$block}->{__stack} = $this->_copy($config->{__stack});
            }
          }

          if (ref($config->{$block}) eq '') {
            croak "Config::General: Block <$block> already exists as scalar entry!\n";
          }
          elsif (ref($config->{$block}) eq 'ARRAY') {
            croak "Config::General: Cannot append named block <$block $blockname> to array of scalars!\n"
              ."Block <$block> or scalar '$block' occurs more than once.\n"
              ."Turn on -MergeDuplicateBlocks or make sure <$block> occurs only once in the config.\n";
          }
          elsif (exists $config->{$block}->{$blockname}) {
            # the named block already exists, make it an array
            if ($this->{MergeDuplicateBlocks}) {
              # just merge the new block with the same name as an existing one into
              # this one.
              $config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent);
            }
            else {
              if (! $this->{AllowMultiOptions}) {
                croak "Config::General: Named block \"<$block $blockname>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
              }
              else {                                       # preserve existing data
                my $savevalue = $config->{$block}->{$blockname};
                delete $config->{$block}->{$blockname};
                my @ar;
                if (ref $savevalue eq 'ARRAY') {
                  push @ar, @{$savevalue};                   # preserve array if any
                }
                else {
                  push @ar, $savevalue;
                }
                push @ar, $this->_parse( $this->_hashref(), \@newcontent);  # append it
                $config->{$block}->{$blockname} = \@ar;
              }
            }
          }
          else {
            # the first occurrence of this particular named block
            my $tmphash = $this->_hashref();

            if ($this->{InterPolateVars}) {
              # inherit current __stack to new block
              $tmphash->{__stack} = $this->_copy($config->{__stack});
            }

            $config->{$block}->{$blockname} = $this->_parse($tmphash, \@newcontent);
          }
        }
        else {
          # standard block
          if (exists $config->{$block}) {
            if (ref($config->{$block}) eq '') {
              croak "Config::General: Cannot create hashref from <$block> because there is\n"
                ."already a scalar option '$block' with value '$config->{$block}'\n";
            }

            # the block already exists, make it an array
            if ($this->{MergeDuplicateBlocks}) {
              # just merge the new block with the same name as an existing one into
              # this one.
              $config->{$block} = $this->_parse($config->{$block}, \@newcontent);
            }
            else {
              if (! $this->{AllowMultiOptions}) {
                croak "Config::General: Block \"<$block>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
              }
              else {
                my $savevalue = $config->{$block};
                delete $config->{$block};
                my @ar;
                if (ref $savevalue eq "ARRAY") {
                  push @ar, @{$savevalue};
                }
                else {
                  push @ar, $savevalue;
                }

                # fixes rt#31529
                my $tmphash = $this->_hashref();
                if ($this->{InterPolateVars}) {
                  # inherit current __stack to new block
                  $tmphash->{__stack} = $this->_copy($config->{__stack});
                }

                push @ar, $this->_parse( $tmphash, \@newcontent);

                $config->{$block} = \@ar;
              }
            }
          }
          else {
            # the first occurrence of this particular block
            my $tmphash = $this->_hashref();

            if ($this->{InterPolateVars}) {
              # inherit current __stack to new block
              $tmphash->{__stack} = $this->_copy($config->{__stack});
            }

            $config->{$block} = $this->_parse($tmphash, \@newcontent);
          }
        }
        undef $blockname;
        undef $block;
        $this->{level} -= 1;
        next;
      }
    }
    else { # inside $block, just push onto new content stack
      push @newcontent, $_;
    }
  }
  if ($block) {
    # $block is still defined, which means, that it had
    # no matching endblock!
    croak "Config::General: Block \"<$block>\" has no EndBlock statement (level: $this->{level}, chunk $chunk)!\n";
  }
  return $config;
}


sub _copy {
  #
  # copy the contents of one hash into another
  # to circumvent invalid references
  # fixes rt.cpan.org bug #35122
  my($this, $source) = @_;
  my %hash = ();
  while (my ($key, $value) = each %{$source}) {
    $hash{$key} = $value;
  }
  return \%hash;
}


sub _parse_value {
  #
  # parse the value if value parsing is turned on
  # by either -AutoTrue and/or -FlagBits
  # otherwise just return the given value unchanged
  #
  my($this, $config, $option, $value) =@_;

  my $cont;
  ($cont, $option, $value) = $this->_hook('pre_parse_value', $option, $value);
  return $value if(!$cont);

  # avoid "Use of uninitialized value"
  if (! defined $value) {
    # patch fix rt#54583
    # Return an input undefined value without trying transformations
    return $value;
  }

  if($this->{NormalizeValue}) {
    $value = $this->{NormalizeValue}($value);
  }

  if ($this->{InterPolateVars}) {
    $value = $this->_interpolate($config, $option, $value);
  }

  # make true/false values to 1 or 0 (-AutoTrue)
  if ($this->{AutoTrue}) {
    if ($value =~ /$this->{AutoTrueFlags}->{true}/io) {
      $value = 1;
    }
    elsif ($value =~ /$this->{AutoTrueFlags}->{false}/io) {
      $value = 0;
    }
  }

  # assign predefined flags or undef for every flag | flag ... (-FlagBits)
  if ($this->{FlagBits}) {
    if (exists $this->{FlagBitsFlags}->{$option}) {
      my %__flags = map { $_ => 1 } split /\s*\|\s*/, $value;
      foreach my $flag (keys %{$this->{FlagBitsFlags}->{$option}}) {
	if (exists $__flags{$flag}) {
	  $__flags{$flag} = $this->{FlagBitsFlags}->{$option}->{$flag};
	}
	else {
	  $__flags{$flag} = undef;
	}
      }
      $value = \%__flags;
    }
  }

  if (!$this->{NoEscape}) {
    # are there any escaped characters left? put them out as is
    $value =~ s/\\([\$\\\"#])/$1/g;
  }

  ($cont, $option, $value) = $this->_hook('post_parse_value', $option, $value);
  
  return $value;
}


sub _hook {
  my ($this, $hook, @arguments) = @_;
  if(exists $this->{Plug}->{$hook}) {
    my $sub = $this->{Plug}->{$hook};
    my @hooked = &$sub(@arguments);
    return @hooked;
  }
  return (1, @arguments);
}


sub NoMultiOptions {
  #
  # turn AllowMultiOptions off, still exists for backward compatibility.
  # Since we do parsing from within new(), we must
  # call it again if one turns NoMultiOptions on!
  #
  croak q(Config::General: The NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!);
}


sub save {
  #
  # this is the old version of save() whose API interface
  # has been changed. I'm very sorry 'bout this.
  #
  # I'll try to figure out, if it has been called correctly
  # and if yes, feed the call to Save(), otherwise croak.
  #
  my($this, $one, @two) = @_;

  if ( (@two && $one) && ( (scalar @two) % 2 == 0) ) {
    # @two seems to be a hash
    my %h = @two;
    $this->save_file($one, \%h);
  }
  else {
    croak q(Config::General: The save() method is deprecated. Use the new save_file() method instead!);
  }
  return;
}


sub save_file {
  #
  # save the config back to disk
  #
  my($this, $file, $config) = @_;
  my $fh;
  my $config_string;

  if (!$file) {
    croak "Config::General: Filename is required!";
  }
  else {
    if ($this->{UTF8}) {
      $fh = IO::File->new;
      open($fh, ">:utf8", $file)
	or croak "Config::General: Could not open $file in UTF8 mode!($!)\n";
    }
    else {
      $fh = IO::File->new( "$file", 'w')
	or croak "Config::General: Could not open $file!($!)\n";
    }
    if (!$config) {
      if (exists $this->{config}) {
	$config_string = $this->_store(0, $this->{config});
      }
      else {
	croak "Config::General: No config hash supplied which could be saved to disk!\n";
      }
    }
    else {
      $config_string = $this->_store(0, $config);
    }

    if ($config_string) {
      print {$fh} $config_string;
    }
    else {
      # empty config for whatever reason, I don't care
      print {$fh} q();
    }

    close $fh;
  }
  return;
}


sub save_string {
  #
  # return the saved config as a string
  #
  my($this, $config) = @_;

  if (!$config || ref($config) ne 'HASH') {
    if (exists $this->{config}) {
      return $this->_store(0, $this->{config});
    }
    else {
      croak "Config::General: No config hash supplied which could be saved to disk!\n";
    }
  }
  else {
    return $this->_store(0, $config);
  }
  return;
}


sub _store {
  #
  # internal sub for saving a block
  #
  my($this, $level, $config) = @_;
  local $_;
  my $indent = q(    ) x $level;

  my $config_string = q();

  foreach my $entry ( $this->{SaveSorted} ? sort keys %$config : keys %$config ) {
    # fix rt#104548
    if ($entry =~ /[<>\n\r]/) {
      croak "Config::General: current key contains invalid characters: $entry!\n";
    }

    if (ref($config->{$entry}) eq 'ARRAY') {
      if( $this->{ForceArray} && scalar @{$config->{$entry}} == 1 && ! ref($config->{$entry}->[0]) ) {
        # a single value array forced to stay as array
        $config_string .= $this->_write_scalar($level, $entry, '[' . $config->{$entry}->[0] . ']');
      }
      else {
        foreach my $line ( $this->{SaveSorted} ? sort @{$config->{$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});
    }
  }

  return $config_string;
}


sub _write_scalar {
  #
  # internal sub, which writes a scalar
  # it returns it, in fact
  #
  my($this, $level, $entry, $line) = @_;

  my $indent = q(    ) x $level;

  my $config_string;

  # 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 .= '%';
      }
      else {
	$delimiter = $tmplimiter;
      }
    }
    my @lines = split /\n/, $line;
    $config_string .= $indent . $entry . $this->{StoreDelimiter} . "<<$delimiter\n";
    foreach (@lines) {
      $config_string .= $indent . $_ . "\n";
    }
    $config_string .= $indent . "$delimiter\n";
  }
  else {
    # a simple stupid scalar entry

    if (!$this->{NoEscape}) {
      # 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
      $line = "\"$line\"";
    }
    $config_string .= $indent . $entry . $this->{StoreDelimiter} . $line . "\n";
  }

  return $config_string;
}

sub _write_hash {
  #
  # internal sub, which writes a hash (block)
  # it returns it, in fact
  #
  my($this, $level, $entry, $line) = @_;

  my $indent = q(    ) x $level;
  my $config_string;

  if ($entry =~ /\s/) {
    # quote the entry if it contains whitespaces
    $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";

  return $config_string
}


sub _hashref {
  #
  # return a probably tied new empty hash ref
  #
  my($this) = @_;
  if ($this->{Tie}) {
    eval {
      eval qq{require $this->{Tie}};
    };
    if ($EVAL_ERROR) {
      croak q(Config::General: Could not create a tied hash of type: ) . $this->{Tie} . q(: ) . $EVAL_ERROR;
    }
    my %hash;
    tie %hash, $this->{Tie};
    return \%hash;
  }
  else {
    return {};
  }
}


#
# Procedural interface
#
sub ParseConfig {
  #
  # @_ may contain everything which is allowed for new()
  #
  return (new Config::General(@_))->getall();
}

sub SaveConfig {
  #
  # 2 parameters are required, filename and hash ref
  #
  my ($file, $hash) = @_;

  if (!$file || !$hash) {
    croak q{Config::General::SaveConfig(): filename and hash argument required.};
  }
  else {
    if (ref($hash) ne 'HASH') {
      croak q(Config::General::SaveConfig() The second parameter must be a reference to a hash!);
    }
    else {
      (new Config::General(-ConfigHash => $hash))->save_file($file);
    }
  }
  return;
}

sub SaveConfigString {
  #
  # same as SaveConfig, but return the config,
  # instead of saving it
  #
  my ($hash) = @_;

  if (!$hash) {
    croak q{Config::General::SaveConfigString(): Hash argument required.};
  }
  else {
    if (ref($hash) ne 'HASH') {
      croak q(Config::General::SaveConfigString() The parameter must be a reference to a hash!);
    }
    else {
      return (new Config::General(-ConfigHash => $hash))->save_string();
    }
  }
  return;
}


# keep this one
1;
__END__


=head1 NAME

Config::General - Generic Config Module

=head1 SYNOPSIS

 #
 # the OOP way
 use Config::General;
 $conf = Config::General->new("rcfile");
 my %config = $conf->getall;

 #
 # the procedural way
 use Config::General qw(ParseConfig SaveConfig SaveConfigString);
 my %config = ParseConfig("rcfile");

=head1 DESCRIPTION

This module opens a config file and parses its contents for you. The B<new> method
requires one parameter which needs to be a filename. The method B<getall> returns a hash
which contains all options and its associated values of your config file.

The format of config files supported by B<Config::General> is inspired by the well known Apache config
format, in fact, this module is 100% compatible to Apache configs, but you can also just use simple
 name/value pairs in your config files.

In addition to the capabilities of an Apache config file it supports some enhancements such as here-documents,
C-style comments or multiline options.


=head1 SUBROUTINES/METHODS

=over

=item new()

Possible ways to call B<new()>:

 $conf = Config::General->new("rcfile");

 $conf = Config::General->new(\%somehash);

 $conf = Config::General->new( %options ); # see below for description of possible options


This method returns a B<Config::General> object (a hash blessed into "Config::General" namespace.
All further methods must be used from that returned object. see below.

You can use the new style with hash parameters or the old style which is of course
still supported. Possible parameters to B<new()> are:

* a filename of a configfile, which will be opened and parsed by the parser

or

* a hash reference, which will be used as the config.

An alternative way to call B<new()> is supplying an option- hash with one or more of
the following keys set:

=over

=item B<-ConfigFile>

A filename or a filehandle, i.e.:

 -ConfigFile => "rcfile" or -ConfigFile => \$FileHandle


=item B<-ConfigHash>

A hash reference, which will be used as the config, i.e.:

 -ConfigHash => \%somehash


=item B<-String>

A string which contains a whole config, or an arrayref
containing the whole config line by line.
The parser will parse the contents of the string instead
of a file. i.e:

 -String => $complete_config

it is also possible to feed an array reference to -String:

 -String => \@config_lines


=item B<-AllowMultiOptions>

If the value is "no", then multiple identical options are disallowed.
The default is "yes".
i.e.:

 -AllowMultiOptions => "yes"

see B<IDENTICAL OPTIONS> for details.

=item B<-LowerCaseNames>

If set to a true value, then all options found in the config will be converted
to lowercase. This allows you to provide case-in-sensitive configs. The
values of the options will B<not> lowercased.


=item B<-UseApacheInclude>

If set to a true value, the parser will consider "include ..." as valid include
statement (just like the well known Apache include statement).

It also supports apache's "IncludeOptional" statement with the same behavior,
that is, if the include file doesn't exist no error will be thrown.

=item B<-IncludeRelative>

If set to a true value, included files with a relative path (i.e. "cfg/blah.conf")
will be opened from within the location of the configfile instead from within the
location of the script($0). This works only if the configfile has a absolute pathname
(i.e. "/etc/main.conf").

If the variable B<-ConfigPath> has been set and if the file to be included could
not be found in the location relative to the current config file, the module
will search within B<-ConfigPath> for the file. See the description of B<-ConfigPath>
for more details.


=item B<-IncludeDirectories>

If set to a true value, you may specify include a directory, in which case all
files inside the directory will be loaded in ASCII order.  Directory includes
will not recurse into subdirectories.  This is comparable to including a
directory in Apache-style config files.


=item B<-IncludeGlob>

If set to a true value, you may specify a glob pattern for an include to
include all matching files (e.g. <<include conf.d/*.conf>>).  Also note that as
with standard file patterns, * will not match dot-files, so <<include dir/*>>
is often more desirable than including a directory with B<-IncludeDirectories>.

An include option will not cause a parser error if the glob didn't return anything.

=item B<-IncludeAgain>

If set to a true value, you will be able to include a sub-configfile
multiple times.  With the default, false, you will get a warning about
duplicate includes and only the first include will succeed.

Reincluding a configfile can be useful if it contains data that you want to
be present in multiple places in the data tree.  See the example under
L</INCLUDES>.

Note, however, that there is currently no check for include recursion.


=item B<-ConfigPath>

As mentioned above, you can use this variable to specify a search path for relative
config files which have to be included. Config::General will search within this
path for the file if it cannot find the file at the location relative to the
current config file.

To provide multiple search paths you can specify an array reference for the
path.  For example:

 @path = qw(/usr/lib/perl /nfs/apps/lib /home/lib);
 ..
 -ConfigPath => \@path


=item B<-MergeDuplicateBlocks>

If set to a true value, then duplicate blocks, that means blocks and named blocks,
will be merged into a single one (see below for more details on this).
The default behavior of Config::General is to create an array if some junk in a
config appears more than once.


=item B<-MergeDuplicateOptions>

If set to a true value, then duplicate options will be merged. That means, if the
same option occurs more than once, the last one will be used in the resulting
config hash.

Setting this option implies B<-AllowMultiOptions == false> unless you set
B<-AllowMultiOptions> explicit to 'true'. In this case duplicate blocks are
allowed and put into an array but duplicate options will be merged.


=item B<-AutoLaunder>

If set to a true value, then all values in your config file will be laundered
to allow them to be used under a -T taint flag.  This could be regarded as circumventing
the purpose of the -T flag, however, if the bad guys can mess with your config file,
you have problems that -T will not be able to stop.  AutoLaunder will only handle
a config file being read from -ConfigFile.


=item B<-AutoTrue>

If set to a true value, then options in your config file, whose values are set to
true or false values, will be normalised to 1 or 0 respectively.

The following values will be considered as B<true>:

 yes, on, 1, true

The following values will be considered as B<false>:

 no, off, 0, false

This effect is case-insensitive, i.e. both "Yes" or "No" will result in 1.


=item B<-FlagBits>

This option takes one required parameter, which must be a hash reference.

The supplied hash reference needs to define variables for which you
want to preset values. Each variable you have defined in this hash-ref
and which occurs in your config file, will cause this variable being
set to the preset values to which the value in the config file refers to.

Multiple flags can be used, separated by the pipe character |.

Well, an example will clarify things:

 my $conf = Config::General->new(
         -ConfigFile => "rcfile",
         -FlagBits => {
              Mode => {
                 CLEAR    => 1,
                 STRONG   => 1,
                 UNSECURE => "32bit" }
         }
 );

In this example we are defining a variable named I<"Mode"> which
may contain one or more of "CLEAR", "STRONG" and "UNSECURE" as value.

The appropriate config entry may look like this:

 # rcfile
 Mode = CLEAR | UNSECURE

The parser will create a hash which will be the value of the key "Mode". This
hash will contain B<all> flags which you have pre-defined, but only those
which were set in the config will contain the pre-defined value, the other
ones will be undefined.

The resulting config structure would look like this after parsing:

 %config = (
             Mode => {
                       CLEAR    => 1,
                       UNSECURE => "32bit",
                       STRONG   => undef,
                     }
           );

This method allows the user (or, the "maintainer" of the configfile for your
application) to set multiple pre-defined values for one option.

Please beware, that all occurrences of those variables will be handled this
way, there is no way to distinguish between variables in different scopes.
That means, if "Mode" would also occur inside a named block, it would
also parsed this way.

Values which are not defined in the hash-ref supplied to the parameter B<-FlagBits>
and used in the corresponding variable in the config will be ignored.

Example:

 # rcfile
 Mode = BLAH | CLEAR

would result in this hash structure:

  %config = (
             Mode => {
                       CLEAR    => 1,
                       UNSECURE => undef,
                       STRONG   => undef,
                     }
           );

"BLAH" will be ignored silently.


=item B<-DefaultConfig>

This can be a hash reference or a simple scalar (string) of a config. This
causes the module to preset the resulting config hash with the given values,
which allows you to set default values for particular config options directly.

Note that you probably want to use this with B<-MergeDuplicateOptions>, otherwise
a default value already in the configuration file will produce an array of two
values.

=item B<-Tie>

B<-Tie> takes the name of a Tie class as argument that each new hash should be
based off of.

This hash will be used as the 'backing hash' instead of a standard Perl hash,
which allows you to affect the way, variable storing will be done. You could, for
example supply a tied hash, say Tie::DxHash, which preserves ordering of the
keys in the config (which a standard Perl hash won't do). Or, you could supply
a hash tied to a DBM file to save the parsed variables to disk.

There are many more things to do in tie-land, see L<tie> to get some interesting
ideas.

If you want to use the B<-Tie> feature together with B<-DefaultConfig> make sure
that the hash supplied to B<-DefaultConfig> must be tied to the same Tie class.

Make sure that the hash which receives the generated hash structure (e.g. which
you are using in the assignment: %hash = $config->getall()) must be tied to
the same Tie class.

Example:

 use Config::General qw(ParseConfig);
 use Tie::IxHash;
 tie my %hash, "Tie::IxHash";
 %hash = ParseConfig(
           -ConfigFile => shift(),
           -Tie => "Tie::IxHash"
	 );


=item B<-InterPolateVars>

If set to a true value, variable interpolation will be done on your config
input. See L<Config::General::Interpolated> for more information.

=item B<-InterPolateEnv>

If set to a true value, environment variables can be used in
configs.

This implies B<-InterPolateVars>.

=item B<-AllowSingleQuoteInterpolation>

By default variables inside single quotes will not be interpolated. If
you turn on this option, they will be interpolated as well.

=item B<-ExtendedAccess>

If set to a true value, you can use object oriented (extended) methods to
access the parsed config. See L<Config::General::Extended> for more information.

=item B<-StrictObjects>

By default this is turned on, which causes Config::General to croak with an
error if you try to access a non-existent key using the OOP-way (B<-ExtendedAcess>
enabled). If you turn B<-StrictObjects> off (by setting to 0 or "no") it will
just return an empty object/hash/scalar. This is valid for OOP-access 8via AUTOLOAD
and for the methods obj(), hash() and value().


=item B<-StrictVars>

By default this is turned on, which causes Config::General to croak with an
error if an undefined variable with B<InterPolateVars> turned on occurs
in a config. Set to I<false> (i.e. 0) to avoid such error messages.

=item B<-SplitPolicy>

You can influence the way how Config::General decides which part of a line
in a config file is the key and which one is the value. By default it tries
its best to guess. That means you can mix equalsign assignments and whitespace
assignments.

However, sometime you may wish to make it more strictly for some reason. In
this case you can set B<-SplitPolicy>. The possible values are: 'guess' which
is the default, 'whitespace' which causes the module to split by whitespace,
'equalsign' which causes it to split strictly by equal sign, or 'custom'. In the
latter case you must also set B<-SplitDelimiter> to some regular expression
of your choice. For example:

 -SplitDelimiter => '\s*:\s*'

will cause the module to split by colon while whitespace which surrounds
the delimiter will be removed.

Please note that the delimiter used when saving a config (save_file() or save_string())
will be chosen according to the current B<-SplitPolicy>. If -SplitPolicy is
set to 'guess' or 'whitespace', 3 spaces will be used to delimit saved
options. If 'custom' is set, then you need to set B<-StoreDelimiter>.

=item B<-SplitDelimiter>

Set this to any arbitrary regular expression which will be used for option/value
splitting. B<-SplitPolicy> must be set to 'custom' to make this work.

=item B<-StoreDelimiter>

You can use this parameter to specify a custom delimiter to use when saving
configs to a file or string. You only need to set it if you want to store
the config back to disk and if you have B<-SplitPolicy> set to 'custom'.

However, this parameter takes precedence over whatever is set for B<-SplitPolicy>.

Be very careful with this parameter.


=item B<-CComments>

Config::General is able to notice c-style comments (see section COMMENTS).
But for some reason you might no need this. In this case you can turn
this feature off by setting B<-CComments> to a false value('no', 0, 'off').

By default B<-CComments> is turned on.


=item B<-BackslashEscape>

B<Deprecated Option>.

=item B<-SlashIsDirectory>

If you turn on this parameter, a single slash as the last character
of a named block will be considered as a directory name.

By default this flag is turned off, which makes the module somewhat
incompatible to Apache configs, since such a setup will be normally
considered as an explicit empty block, just as XML defines it.

For example, if you have the following config:

 <Directory />
   Index index.awk
 </Directory>

you will get such an error message from the parser:

 EndBlock "</Directory>" has no StartBlock statement (level: 1, chunk 10)!

This is caused by the fact that the config chunk below will be
internally converted to:

 <Directory></Directory>
   Index index.awk
 </Directory>

Now there is one '</Directory>' too much. The proper solution is
to use quotation to circumvent this error:

 <Directory "/">
   Index index.awk
 </Directory>

However, a raw apache config comes without such quotes. In this
case you may consider to turn on B<-SlashIsDirectory>.

Please note that this is a new option (incorporated in version 2.30),
it may lead to various unexpected side effects or other failures.
You've been warned.

=item B<-ApacheCompatible>

Over the past years a lot of options has been incorporated
into Config::General to be able to parse real Apache configs.

The new B<-ApacheCompatible> option now makes it possible to
tweak all options in a way that Apache configs can be parsed.

This is called "apache compatibility mode" - if you will ever
have problems with parsing Apache configs without this option
being set, you'll get no help by me. Thanks :)

The following options will be set:

 UseApacheInclude   = 1
 IncludeRelative    = 1
 IncludeDirectories = 1
 IncludeGlob        = 1
 SlashIsDirectory   = 1
 SplitPolicy        = 'whitespace'
 CComments          = 0

Take a look into the particular documentation sections what
those options are doing.

Beside setting some options it also turns off support for
explicit empty blocks.

=item B<-UTF8>

If turned on, all files will be opened in utf8 mode. This may
not work properly with older versions of Perl.

=item B<-SaveSorted>

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 character, 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


=item getall()

Returns a hash structure which represents the whole config.

=item files()

Returns a list of all files read in.

=item save_file()

Writes the config hash back to the hard disk. This method takes one or two
parameters. The first parameter must be the filename where the config
should be written to. The second parameter is optional, it must be a
reference to a hash structure, if you set it. If you do not supply this second parameter
then the internal config hash, which has already been parsed, will be
used.

Please note that any occurrence of comments will be ignored by getall()
and thus be lost after you call this method.

You need also to know that named blocks will be converted to nested blocks
(which is the same from the perl point of view). An example:

 <user hans>
   id 13
 </user>

will become the following after saving:

 <user>
   <hans>
      id 13
   </hans>
 </user>

Example:

 $conf_obj->save_file("newrcfile", \%config);

or, if the config has already been parsed, or if it didn't change:

 $conf_obj->save_file("newrcfile");


=item save_string()

This method is equivalent to the previous save_file(), but it does not
store the generated config to a file. Instead it returns it as a string,
which you can save yourself afterwards.

It takes one optional parameter, which must be a reference to a hash structure.
If you omit this parameter, the internal config hash, which has already been parsed,
will be used.

Example:

 my $content = $conf_obj->save_string(\%config);

or:

 my $content = $conf_obj->save_string();


=back


=head1 CONFIG FILE FORMAT

Lines beginning with B<#> and empty lines will be ignored. (see section COMMENTS!)
Spaces at the beginning and the end of a line will also be ignored as well as tabulators.
If you need spaces at the end or the beginning of a value you can surround it with
double quotes.
An option line starts with its name followed by a value. An equal sign is optional.
Some possible examples:

 user    max
 user  = max
 user            max

If there are more than one statements with the same name, it will create an array
instead of a scalar. See the example below.

The method B<getall> returns a hash of all values.


=head1 BLOCKS

You can define a B<block> of options. A B<block> looks much like a block
in the wellknown Apache config format. It starts with E<lt>B<blockname>E<gt> and ends
with E<lt>/B<blockname>E<gt>.

A block start and end cannot be on the same line.

An example:

<database>
host   = muli
user   = moare
dbname = modb
dbpass = D4r_9Iu
</database>

Blocks can also be nested. Here is a more complicated example:

user   = hans
server = mc200
db     = maxis
passwd = D3rf$
<jonas>
user    = tom
db      = unknown
host    = mila
<tablestructure>
index   int(100000)
name    char(100)
prename char(100)
city    char(100)
status  int(10)
allowed moses
allowed ingram
allowed joice
</tablestructure>
</jonas>

The hash which the method B<getall> returns look like that:

print Data::Dumper(\%hash);
$VAR1 = {
'passwd' => 'D3rf$',
'jonas'  => {
'tablestructure' => {
'prename' => 'char(100)',
'index'   => 'int(100000)',
'city'    => 'char(100)',
'name'    => 'char(100)',
'status'  => 'int(10)',
'allowed' => [
'moses',
'ingram',
'joice',
]
},
'host'           => 'mila',
'db'             => 'unknown',
'user'           => 'tom'
},
'db'     => 'maxis',
'server' => 'mc200',
'user'   => 'hans'
};

If you have turned on B<-LowerCaseNames> (see new()) then blocks as in the
following example:

<Dir>
<AttriBUTES>
Owner  root
</attributes>
</dir>

would produce the following hash structure:

$VAR1 = {
'dir' => {
'attributes' => {
'owner  => "root",
}
}
};

As you can see, the keys inside the config hash are normalized.

Please note, that the above config block would result in a
valid hash structure, even if B<-LowerCaseNames> is not set!
This is because I<Config::General> does not
use the block names to check if a block ends, instead it uses an internal
state counter, which indicates a block end.

If the module cannot find an end-block statement, then this block will be ignored.


=head1 NAMED BLOCKS

If you need multiple blocks of the same name, then you have to name every block.
This works much like Apache config. If the module finds a named block, it will
create a hashref with the left part of the named block as the key containing
one or more hashrefs with the right part of the block as key containing everything
inside the block(which may again be nested!). As examples says more than words:

# given the following sample
<Directory /usr/frisco>
Limit Deny
Options ExecCgi Index
</Directory>
<Directory /usr/frik>
Limit DenyAll
Options None
</Directory>

# you will get:
$VAR1 = {
'Directory' => {
'/usr/frik' => {
'Options' => 'None',
'Limit' => 'DenyAll'
},
'/usr/frisco' => {
'Options' => 'ExecCgi Index',
'Limit' => 'Deny'
}
}
};

You cannot have more than one named block with the same name because it will
be stored in a hashref and therefore be overwritten if a block occurs once more.


=head1 WHITESPACE IN BLOCKS

The normal behavior of Config::General is to look for whitespace in
block names to decide if it's a named block or just a simple block.

Sometimes you may need blocknames which have whitespace in their names.

With named blocks this is no problem, as the module only looks for the
first whitespace:

<person hugo gera>
</person>

would be parsed to:

$VAR1 = {
'person' => {
'hugo gera' => {
},
}
};

The problem occurs, if you want to have a simple block containing whitespace:

<hugo gera>
</hugo gera>

This would be parsed as a named block, which is not what you wanted. In this
very case you may use quotation marks to indicate that it is not a named block:

<"hugo gera">
</"hugo gera">

The save() method of the module inserts automatically quotation marks in such
cases.


=head1 EXPLICIT EMPTY BLOCKS

Beside the notation of blocks mentioned above it is possible to use
explicit empty blocks.

Normally you would write this in your config to define an empty
block:

<driver Apache>
</driver>

To save writing you can also write:

<driver Apache/>

which is the very same as above. This works for normal blocks and
for named blocks.


=head1 IDENTICAL OPTIONS (ARRAYS)

You may have more than one line of the same option with different values.

Example:
log  log1
log  log2
log  log2

You will get a scalar if the option occurred only once or an array if it occurred
more than once. If you expect multiple identical options, then you may need to
check if an option occurred more than once:

$allowed = $hash{jonas}->{tablestructure}->{allowed};
if(ref($allowed) eq "ARRAY") {
@ALLOWED = @{$allowed};
else {
@ALLOWED = ($allowed);
}

The same applies to blocks and named blocks too (they are described in more detail
below). For example, if you have the following config:

<dir blah>
user max
</dir>
<dir blah>
user hannes
</dir>

then you would end up with a data structure like this:

$VAR1 = {
'dir' => {
'blah' => [
{
'user' => 'max'
},
{
'user' => 'hannes'
}
]
}
};

As you can see, the two identical blocks are stored in a hash which contains
an array(-reference) of hashes.

Under some rare conditions you might not want this behavior with blocks (and
named blocks too). If you want to get one single hash with the contents of
both identical blocks, then you need to turn the B<new()> parameter B<-MergeDuplicateBlocks>
on (see above). The parsed structure of the example above would then look like
this:

$VAR1 = {
'dir' => {
'blah' => {
'user' => [
'max',
'hannes'
]
}
}
};

As you can see, there is only one hash "dir->{blah}" containing multiple
"user" entries. As you can also see, turning on  B<-MergeDuplicateBlocks>
does not affect scalar options (i.e. "option = value"). In fact you can
tune merging of duplicate blocks and options independent from each other.

If you don't want to allow more than one identical options, you may turn it off
by setting the flag I<AllowMultiOptions> in the B<new()> method to "no".
If turned off, Config::General will complain about multiple occurring options
with identical names!

=head2 FORCE SINGLE VALUE ARRAYS

You may also force a single config line to get parsed into an array by
turning on the option B<-ForceArray> and by surrounding the value of the
config entry by []. Example:

hostlist = [ foo.bar ]

Will be a singlevalue array entry if the option is turned on. If you want
it to remain to be an array you have to turn on B<-ForceArray> during save too.

=head1 LONG LINES

If you have a config value, which is too long and would take more than one line,
you can break it into multiple lines by using the backslash character at the end
of the line. The Config::General module will concatenate those lines to one single-value.

Example:

command = cat /var/log/secure/tripwire | \
mail C<-s> "report from tripwire" \
honey@myotherhost.nl

command will become:
"cat /var/log/secure/tripwire | mail C<-s> 'report from twire' honey@myotherhost.nl"


=head1 HERE DOCUMENTS

You can also define a config value as a so called "here-document". You must tell
the module an identifier which indicates the end of a here document. An
identifier must follow a "<<".

Example:

message <<EOF
we want to
remove the
homedir of
root.
EOF

Everything between the two "EOF" strings will be in the option I<message>.

There is a special feature which allows you to use indentation with here documents.
You can have any amount of whitespace or tabulators in front of the end
identifier. If the module finds spaces or tabs then it will remove exactly those
amount of spaces from every line inside the here-document.

Example:

message <<EOF
we want to
remove the
homedir of
root.
EOF

After parsing, message will become:

we want to
remove the
homedir of
root.

because there were the string "     " in front of EOF, which were cut from every
line inside the here-document.


=head1 INCLUDES

You can include an external file at any position in your config file using the following statement
in your config file:

<<include externalconfig.rc>>

If you turned on B<-UseApacheInclude> (see B<new()>), then you can also use the following
statement to include an external file:

include externalconfig.rc

This file will be inserted at the position where it was found as if the contents of this file
were directly at this position.

You can also recursively include files, so an included file may include another one and so on.
Beware that you do not recursively load the same file, you will end with an error message like
"too many open files in system!".

By default included files with a relative pathname will be opened from within the current
working directory. Under some circumstances it maybe possible to
open included files from the directory, where the configfile resides. You need to turn on
the option B<-IncludeRelative> (see B<new()>) if you want that. An example:

my $conf = Config::General(
-ConfigFile => "/etc/crypt.d/server.cfg"
-IncludeRelative => 1
);

/etc/crypt.d/server.cfg:
<<include acl.cfg>>

In this example Config::General will try to include I<acl.cfg> from I</etc/crypt.d>:

/etc/crypt.d/acl.cfg

The default behavior (if B<-IncludeRelative> is B<not> set!) will be to open just I<acl.cfg>,
wherever it is, i.e. if you did a chdir("/usr/local/etc"), then Config::General will include:

/usr/local/etc/acl.cfg

Include statements can be case insensitive (added in version 1.25).

Include statements will be ignored within C-Comments and here-documents.

By default, a config file will only be included the first time it is
referenced.  If you wish to include a file in multiple places, set
B</-IncludeAgain> to true. But be warned: this may lead to infinite loops,
so make sure, you're not including the same file from within itself!

Example:

# main.cfg
<object billy>
class=Some::Class
<printers>
include printers.cfg
</printers>
# ...
</object>
<object bob>
class=Another::Class
<printers>
include printers.cfg
</printers>
# ...
</object>

Now C<printers.cfg> will be include in both the C<billy> and C<bob> objects.

You will have to be careful to not recursively include a file.  Behaviour
in this case is undefined.


=head1 COMMENTS

A comment starts with the number sign B<#>, there can be any number of spaces and/or
tab stops in front of the #.

A comment can also occur after a config statement. Example:

username = max  # this is the comment

If you want to comment out a large block you can use C-style comments. A B</*> signals
the begin of a comment block and the B<*/> signals the end of the comment block.
Example:

user  = max # valid option
db    = tothemax
/*
user  = andors
db    = toand
*/

In this example the second options of user and db will be ignored. Please beware of the fact,
if the Module finds a B</*> string which is the start of a comment block, but no matching
end block, it will ignore the whole rest of the config file!

B<NOTE:> If you require the B<#> character (number sign) to remain in the option value, then
you can use a backslash in front of it, to escape it. Example:

bgcolor = \#ffffcc

In this example the value of $config{bgcolor} will be "#ffffcc", Config::General will not treat
the number sign as the begin of a comment because of the leading backslash.

Inside here-documents escaping of number signs is NOT required!


=head1 PARSER PLUGINS

You can alter the behavior of the parser by supplying closures
which will be called on certain hooks during config file processing
and parsing.

The general aproach works like this:

sub ck {
my($file, $base) = @_;
print "_open() tries $file ... ";
if($file =~ /blah/) {
print "ignored\n";
return (0);
}
else {
print "allowed\n";
return (1, @_);
}
}
 
my %c = ParseConfig(
-IncludeGlob => 1,
-UseApacheInclude => 1,
-ConfigFile => shift,
-Plug => { pre_open => *ck }
);
 
Output:

 _open() tries cfg ... allowed
 _open() tries x/*.conf ... allowed
 _open() tries x/1.conf ... allowed
 _open() tries x/2.conf ... allowed
 _open() tries x/blah.conf ... ignored

As you can see, we wrote a little sub which takes a filename
and a base directory as parameters. We tell Config::General via
the B<Plug> parameter of B<new()> to call this sub everytime
before it attempts to open a file.

General processing continues as usual if the first value of
the returned array is true. The second value of that array
depends on the kind of hook being called.

The following hooks are available so far:

=over

=item B<pre_open>

Takes two parameters: filename and basedirectory.

Has to return an array consisting of 3 values:

 - 1 or 0 (continue processing or not)
 - filename
 - base directory

=item B<pre_read>

Takes two parameters: the filehandle of the file to be read
and an array containing the raw contents of said file.

This hook will be applied in _read(). File contents are already
available at this stage, comments will be removed, here-docs normalized
and the like. This hook gets the unaltered, original contents.

Has to return an array of 3 values:

 - 1 or 0 (continue processing or not)
 - the filehandle
 - an array of strings

You can use this hook to apply your own normalizations or whatever.

Be careful when returning the abort value (1st value of returned array 0),
since in this case nothing else would be done on the contents. If it still
contains comments or something, they will be parsed as legal config options.

=item B<post_read>

Takes one parameter: a reference to an array containing the prepared
config lines (after being processed by _read()).

This hook will be applied in _read() when everything else has been done.

Has to return an array of 2 values:

 - 1 or 0 (continue processing or not) [Ignored for post hooks]
 - a reference to an array containing the config lines

=item B<pre_parse_value>

Takes 2 parameters: an option name and its value.

This hook will be applied in _parse_value() before any processing.

Has to return an array of 3 values:

 - 1 or 0 (continue processing or not)
 - option name
 - value of the option

=item B<post_parse_value>

Almost identical to pre_parse_value, but will be applied after _parse_value()
is finished and all usual processing and normalization is done.

=back

Not implemented yet: hooks for variable interpolation and block
parsing.


=head1 OBJECT ORIENTED INTERFACE

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 config files 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 EXPORTED FUNCTIONS

Config::General exports some functions too, which makes it somewhat
easier to use it, if you like this.

How to import the functions:

 use Config::General qw(ParseConfig SaveConfig SaveConfigString);

=over

=item B<ParseConfig()>

This function takes exactly all those parameters, which are
allowed to the B<new()> method of the standard interface.

Example:

 use Config::General qw(ParseConfig);
 my %config = ParseConfig(-ConfigFile => "rcfile", -AutoTrue => 1);


=item B<SaveConfig()>

This function requires two arguments, a filename and a reference
to a hash structure.

Example:

 use Config::General qw(SaveConfig);
 ..
 SaveConfig("rcfile", \%some_hash);


=item B<SaveConfigString()>

This function requires a reference to a config hash as parameter.
It generates a configuration based on this hash as the object-interface
method B<save_string()> does.

Example:

 use Config::General qw(ParseConfig SaveConfigString);
 my %config = ParseConfig(-ConfigFile => "rcfile");
 .. # change %config something
 my $content = SaveConfigString(\%config);


=back

=head1 CONFIGURATION AND ENVIRONMENT

No environment variables will be used.

=head1 SEE ALSO

I recommend you to read the following documents, which are supplied with Perl:

 perlreftut                     Perl references short introduction
 perlref                        Perl references, the rest of the story
 perldsc                        Perl data structures intro
 perllol                        Perl data structures: arrays of arrays

 Config::General::Extended      Object oriented interface to parsed configs
 Config::General::Interpolated  Allows one to use variables inside config files

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2000-2016 Thomas Linden

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 BUGS AND LIMITATIONS

See rt.cpan.org for current bugs, if any.

=head1 INCOMPATIBILITIES

None known.

=head1 DIAGNOSTICS

To debug Config::General use the Perl debugger, see L<perldebug>.

=head1 DEPENDENCIES

Config::General depends on the modules L<FileHandle>,
L<File::Spec::Functions>, L<File::Glob>, which all are
shipped with Perl.

=head1 AUTHOR

Thomas Linden <tlinden |AT| cpan.org>

=head1 VERSION

2.61

=cut

PK     ��iZq���%0  %0    Any.pmnu �[���        package Config::Any;

use strict;
use warnings;

use Carp;
use Module::Pluggable::Object ();

our $VERSION = '0.24';

=head1 NAME

Config::Any - Load configuration from different file formats, transparently

=head1 SYNOPSIS

    use Config::Any;

    my $cfg = Config::Any->load_stems({stems => \@filepath_stems, ... });
    # or
    my $cfg = Config::Any->load_files({files => \@filepaths, ... });

    for (@$cfg) {
        my ($filename, $config) = %$_;
        $class->config($config);
        warn "loaded config from file: $filename";
    }

=head1 DESCRIPTION

L<Config::Any|Config::Any> provides a facility for Perl applications and libraries
to load configuration data from multiple different file formats. It supports XML, YAML,
JSON, Apache-style configuration, Windows INI files, and even Perl code.

The rationale for this module is as follows: Perl programs are deployed on many different
platforms and integrated with many different systems. Systems administrators and end 
users may prefer different configuration formats than the developers. The flexibility
inherent in a multiple format configuration loader allows different users to make 
different choices, without generating extra work for the developers. As a developer
you only need to learn a single interface to be able to use the power of different
configuration formats.

=head1 INTERFACE 

=cut

=head2 load_files( \%args )

    Config::Any->load_files( { files => \@files } );
    Config::Any->load_files( { files => \@files, filter  => \&filter } );
    Config::Any->load_files( { files => \@files, use_ext => 1 } );
    Config::Any->load_files( { files => \@files, flatten_to_hash => 1 } );

C<load_files()> attempts to load configuration from the list of files passed in
the C<files> parameter, if the file exists.

If the C<filter> parameter is set, it is used as a callback to modify the configuration 
data before it is returned. It will be passed a single hash-reference parameter which 
it should modify in-place.

If the C<use_ext> parameter is defined, the loader will attempt to parse the file
extension from each filename and will skip the file unless it matches a standard
extension for the loading plugins. Only plugins whose standard extensions match the
file extension will be used. For efficiency reasons, its use is encouraged, but
be aware that you will lose flexibility -- for example, a file called C<myapp.cfg> 
containing YAML data will not be offered to the YAML plugin, whereas C<myapp.yml>
or C<myapp.yaml> would be.

When the C<flatten_to_hash> parameter is defined, the loader will return a hash
keyed on the file names, as opposed to the usual list of single-key hashes.

C<load_files()> also supports a 'force_plugins' parameter, whose value should be an
arrayref of plugin names like C<Config::Any::INI>. Its intended use is to allow the use 
of a non-standard file extension while forcing it to be offered to a particular parser.
It is not compatible with 'use_ext'. 

You can supply a C<driver_args> hashref to pass special options to a particular
parser object. Example:

    Config::Any->load_files( { files => \@files, driver_args => {
        General => { -LowerCaseNames => 1 }
    } )

=cut

sub load_files {
    my ( $class, $args ) = @_;

    unless ( $args && exists $args->{ files } ) {
        warn "No files specified!";
        return;
    }

    return $class->_load( $args );
}

=head2 load_stems( \%args )

    Config::Any->load_stems( { stems => \@stems } );
    Config::Any->load_stems( { stems => \@stems, filter  => \&filter } );
    Config::Any->load_stems( { stems => \@stems, use_ext => 1 } );
    Config::Any->load_stems( { stems => \@stems, flatten_to_hash => 1 } );

C<load_stems()> attempts to load configuration from a list of files which it generates
by combining the filename stems list passed in the C<stems> parameter with the 
potential filename extensions from each loader, which you can check with the
C<extensions()> classmethod described below. Once this list of possible filenames is
built it is treated exactly as in C<load_files()> above, as which it takes the same
parameters. Please read the C<load_files()> documentation before using this method.

=cut

sub load_stems {
    my ( $class, $args ) = @_;

    unless ( $args && exists $args->{ stems } ) {
        warn "No stems specified!";
        return;
    }

    my $stems = delete $args->{ stems };
    my @files;
    for my $s ( @$stems ) {
        for my $ext ( $class->extensions ) {
            push @files, "$s.$ext";
        }
    }

    $args->{ files } = \@files;
    return $class->_load( $args );
}

sub _load {
    my ( $class, $args ) = @_;
    croak "_load requires a arrayref of file paths" unless $args->{ files };

    my $force = defined $args->{ force_plugins };
    if ( !$force and !defined $args->{ use_ext } ) {
        warn
            "use_ext argument was not explicitly set, as of 0.09, this is true by default";
        $args->{ use_ext } = 1;
    }

    # figure out what plugins we're using
    my @plugins = $force
        ? map { eval "require $_;"; $_; } @{ $args->{ force_plugins } }
        : $class->plugins;

    # map extensions if we have to
    my ( %extension_lut, $extension_re );
    my $use_ext_lut = !$force && $args->{ use_ext };
    if ( $use_ext_lut ) {
        for my $plugin ( @plugins ) {
            for ( $plugin->extensions ) {
                $extension_lut{ $_ } ||= [];
                push @{ $extension_lut{ $_ } }, $plugin;
            }
        }

        $extension_re = join( '|', keys %extension_lut );
    }

    # map args to plugins
    my $base_class = __PACKAGE__;
    my %loader_args;
    for my $plugin ( @plugins ) {
        $plugin =~ m{^$base_class\::(.+)};
        $loader_args{ $plugin } = $args->{ driver_args }->{ $1 } || {};
    }

    my @results;

    for my $filename ( @{ $args->{ files } } ) {

        # don't even bother if it's not there
        next unless -f $filename;

        my @try_plugins = @plugins;

        if ( $use_ext_lut ) {
            $filename =~ m{\.($extension_re)\z};

            if ( !$1 ) {
                $filename =~ m{\.([^.]+)\z};
                croak "There are no loaders available for .${1} files";
            }

            @try_plugins = @{ $extension_lut{ $1 } };
        }

        # not using use_ext means we try all plugins anyway, so we'll
        # ignore it for the "unsupported" error
        my $supported = $use_ext_lut ? 0 : 1;
        for my $loader ( @try_plugins ) {
            next unless $loader->is_supported;
            $supported = 1;
            my @configs
                = eval { $loader->load( $filename, $loader_args{ $loader } ); };

            # fatal error if we used extension matching
            croak "Error parsing $filename: $@" if $@ and $use_ext_lut;
            next if $@ or !@configs;

            # post-process config with a filter callback
            if ( $args->{ filter } ) {
                $args->{ filter }->( $_ ) for @configs;
            }

            push @results,
                { $filename => @configs == 1 ? $configs[ 0 ] : \@configs };
            last;
        }

        if ( !$supported ) {
            croak
                "Cannot load $filename: required support modules are not available.\nPlease install "
                . join( " OR ", map { _support_error( $_ ) } @try_plugins );
        }
    }

    if ( defined $args->{ flatten_to_hash } ) {
        my %flattened = map { %$_ } @results;
        return \%flattened;
    }

    return \@results;
}

sub _support_error {
    my $module = shift;
    if ( $module->can( 'requires_all_of' ) ) {
        return join( ' and ',
            map { ref $_ ? join( ' ', @$_ ) : $_ } $module->requires_all_of );
    }
    if ( $module->can( 'requires_any_of' ) ) {
        return 'one of '
            . join( ' or ',
            map { ref $_ ? join( ' ', @$_ ) : $_ } $module->requires_any_of );
    }
}

=head2 finder( )

The C<finder()> classmethod returns the 
L<Module::Pluggable::Object|Module::Pluggable::Object>
object which is used to load the plugins. See the documentation for that module for
more information.

=cut

sub finder {
    my $class  = shift;
    my $finder = Module::Pluggable::Object->new(
        search_path => [ __PACKAGE__ ],
        except      => [ __PACKAGE__ . '::Base' ],
        require     => 1
    );
    return $finder;
}

=head2 plugins( )

The C<plugins()> classmethod returns the names of configuration loading plugins as 
found by L<Module::Pluggable::Object|Module::Pluggable::Object>.

=cut

sub plugins {
    my $class = shift;

    # filter out things that don't look like our plugins
    return grep { $_->isa( 'Config::Any::Base' ) } $class->finder->plugins;
}

=head2 extensions( )

The C<extensions()> classmethod returns the possible file extensions which can be loaded
by C<load_stems()> and C<load_files()>. This may be useful if you set the C<use_ext>
parameter to those methods.

=cut

sub extensions {
    my $class = shift;
    my @ext
        = map { $_->extensions } $class->plugins;
    return wantarray ? @ext : \@ext;
}

=head1 DIAGNOSTICS

=over

=item C<No files specified!> or C<No stems specified!>

The C<load_files()> and C<load_stems()> methods will issue this warning if
called with an empty list of files/stems to load.

=item C<_load requires a arrayref of file paths>

This fatal error will be thrown by the internal C<_load> method. It should not occur
but is specified here for completeness. If your code dies with this error, please
email a failing test case to the authors below.

=back

=head1 CONFIGURATION AND ENVIRONMENT

Config::Any requires no configuration files or environment variables.

=head1 DEPENDENCIES

L<Module::Pluggable|Module::Pluggable>

And at least one of the following:
L<Config::General|Config::General>
L<Config::Tiny|Config::Tiny>
L<JSON|JSON>
L<YAML|YAML>
L<JSON::Syck|JSON::Syck>
L<YAML::Syck|YAML::Syck>
L<XML::Simple|XML::Simple>

=head1 INCOMPATIBILITIES

None reported.

=head1 BUGS AND LIMITATIONS

No bugs have been reported.

Please report any bugs or feature requests to
C<bug-config-any@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.

=head1 AUTHOR

Joel Bernstein E<lt>rataxis@cpan.orgE<gt>

=head1 CONTRIBUTORS

This module was based on the original 
L<Catalyst::Plugin::ConfigLoader|Catalyst::Plugin::ConfigLoader>
module by Brian Cassidy C<< <bricas@cpan.org> >>.

With ideas and support from Matt S Trout C<< <mst@shadowcatsystems.co.uk> >>.

Further enhancements suggested by Evan Kaufman C<< <evank@cpan.org> >>.

=head1 LICENCE AND COPYRIGHT

Copyright (c) 2006, Portugal Telecom C<< http://www.sapo.pt/ >>. All rights reserved.
Portions copyright 2007, Joel Bernstein C<< <rataxis@cpan.org> >>.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.

=head1 DISCLAIMER OF WARRANTY

BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
NECESSARY SERVICING, REPAIR, OR CORRECTION.

IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.

=head1 SEE ALSO

L<Catalyst::Plugin::ConfigLoader|Catalyst::Plugin::ConfigLoader> 
-- now a wrapper around this module.

=cut

"Drink more beer";
PK     ��iZ~��.  .    Merge/Perl.pmnu �[���        package Config::Merge::Perl;

use strict;
use warnings FATAL => 'all', NONFATAL => 'redefine';

=head1 NAME

Config::Merge::Perl - Load Perl config files

=head1 DESCRIPTION

Loads Perl files. Example:

    {
        name => 'TestApp',
        'Controller::Foo' => {
            foo => 'bar'
        },
        'Model::Baz' => {
            qux => 'xyzzy'
        }
    }

Any error/warning in the file will throw a fatal error.

=head1 METHODS

=head2 extensions( )

return an array of valid extensions (C<pl>, C<perl>).

=cut

sub extensions {qw( pl perl );}

=head2 load( $file )

Attempts to load C<$file> as a Perl file.

=cut


sub load {
    my $class = shift;
    my $file  = shift;
    delete $INC{$file};
    local ($^W) = 1;
    local $SIG{__WARN__} = sub { die $_[0]};
    require $file;
}

=head1 SEE ALSO

L<Config::Merge>

=head1 THANKS

Thanks to Joel Bernstein and Brian Cassidy for the original Config::Any::Perl
module

=head1 BUGS

None known

=head1 AUTHOR

Clinton Gormley, E<lt>clinton@traveljury.comE<gt>

=head1 COPYRIGHT

Copyright (C) 2007 by Clinton Gormley

=cut

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.7 or,
at your option, any later version of Perl 5 you may have available.


=cut

1;PK     ��iZ Wm  m    Any/Perl.pmnu �[���        package Config::Any::Perl;

use strict;
use warnings;

use base 'Config::Any::Base';

=head1 NAME

Config::Any::Perl - Load Perl config files

=head1 DESCRIPTION

Loads Perl files. Example:

    {
        name => 'TestApp',
        'Controller::Foo' => {
            foo => 'bar'
        },
        'Model::Baz' => {
            qux => 'xyzzy'
        }
    }

=head1 METHODS

=head2 extensions( )

return an array of valid extensions (C<pl>, C<perl>).

=cut

sub extensions {
    return qw( pl perl );
}

=head2 load( $file )

Attempts to load C<$file> as a Perl file.

=cut

sub load {
    my $class = shift;
    my $file  = shift;

    my( $exception, $content );
    {
        local $@;
        $content = do $file;
        $exception = $@;
    }
    die $exception if $exception;

    return $content;
}

=head1 AUTHOR

Brian Cassidy E<lt>bricas@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2013 by Brian Cassidy

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 SEE ALSO

=over 4 

=item * L<Catalyst>

=item * L<Config::Any>

=back

=cut

1;
PK     ��iZ�^��<  <    Any/General.pmnu �[���        package Config::Any::General;

use strict;
use warnings;

use base 'Config::Any::Base';

=head1 NAME

Config::Any::General - Load Config::General files

=head1 DESCRIPTION

Loads Config::General files. Example:

    name = TestApp
    <Component Controller::Foo>
        foo bar
        bar [ arrayref-value ]
    </Component>
    <Model Baz>
        qux xyzzy
    </Model>

=head1 METHODS

=head2 extensions( )

return an array of valid extensions (C<cnf>, C<conf>).

=cut

sub extensions {
    return qw( cnf conf );
}

=head2 load( $file )

Attempts to load C<$file> via Config::General.

=cut

sub load {
    my $class = shift;
    my $file  = shift;
    my $args  = shift || {};

    $args->{ -ConfigFile } = $file;

    require Config::General;
    Config::General->VERSION( '2.47' );

    $args->{ -ForceArray } = 1 unless exists $args->{ -ForceArray };

    my $configfile = Config::General->new( %$args );
    my $config     = { $configfile->getall };

    return $config;
}

=head2 requires_all_of( )

Specifies that this module requires L<Config::General> in order to work.

=cut

sub requires_all_of { [ 'Config::General' ] }

=head1 AUTHOR

Brian Cassidy E<lt>bricas@cpan.orgE<gt>

=head1 CONTRIBUTORS

Joel Bernstein E<lt>rataxis@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2013 by Brian Cassidy

Portions Copyright 2006 Portugal Telecom

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 SEE ALSO

=over 4 

=item * L<Catalyst>

=item * L<Config::Any>

=item * L<Config::General>

=back

=cut

1;
PK     ��iZx�P�^  ^    Any/JSON.pmnu �[���        package Config::Any::JSON;

use strict;
use warnings;

use base 'Config::Any::Base';

=head1 NAME

Config::Any::JSON - Load JSON config files

=head1 DESCRIPTION

Loads JSON files. Example:

    {
        "name": "TestApp",
        "Controller::Foo": {
            "foo": "bar"
        },
        "Model::Baz": {
            "qux": "xyzzy"
        }
    }

=head1 METHODS

=head2 extensions( )

return an array of valid extensions (C<json>, C<jsn>).

=cut

sub extensions {
    return qw( json jsn );
}

=head2 load( $file )

Attempts to load C<$file> as a JSON file.

=cut

sub load {
    my $class = shift;
    my $file  = shift;

    open( my $fh, $file ) or die $!;
    my $content = do { local $/; <$fh> };
    close $fh;

    eval { require JSON::DWIW; };
    unless( $@ ) {
        my $decoder = JSON::DWIW->new;
        my ( $data, $error ) = $decoder->from_json( $content );
        die $error if $error;
        return $data;
    }

    eval { require JSON::XS; };
    unless( $@ ) {
        my $decoder = JSON::XS->new->relaxed;
        return $decoder->decode( $content );
    }

    eval { require JSON::Syck; };
    unless( $@ ) {
        return JSON::Syck::Load( $content );
    }

    eval { require JSON::PP; JSON::PP->VERSION( 2 ); };
    unless( $@ ) {
        my $decoder = JSON::PP->new->relaxed;
        return $decoder->decode( $content );
    }

    require JSON;
    eval { JSON->VERSION( 2 ); };
    return $@ ? JSON::jsonToObj( $content ) : JSON::from_json( $content );
}

=head2 requires_any_of( )

Specifies that this modules requires one of,  L<JSON::DWIW>, L<JSON::XS>,
L<JSON::Syck> or L<JSON> in order to work.

=cut

sub requires_any_of { 'JSON::DWIW', 'JSON::XS', 'JSON::Syck', 'JSON::PP', 'JSON' }

=head1 AUTHOR

Brian Cassidy E<lt>bricas@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2013 by Brian Cassidy

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 SEE ALSO

=over 4 

=item * L<Catalyst>

=item * L<Config::Any>

=item * L<JSON::DWIW>

=item * L<JSON::XS>

=item * L<JSON::Syck>

=item * L<JSON>

=back

=cut

1;
PK     ��iZ��)�  �  
  Any/XML.pmnu �[���        package Config::Any::XML;

use strict;
use warnings;

use base 'Config::Any::Base';

=head1 NAME

Config::Any::XML - Load XML config files

=head1 DESCRIPTION

Loads XML files. Example:

    <config>
        <name>TestApp</name>
        <component name="Controller::Foo">
            <foo>bar</foo>
        </component>
        <model name="Baz">
            <qux>xyzzy</qux>
        </model>
    </config>

=head1 METHODS

=head2 extensions( )

return an array of valid extensions (C<xml>).

=cut

sub extensions {
    return qw( xml );
}

=head2 load( $file )

Attempts to load C<$file> as an XML file.

=cut

sub load {
    my $class = shift;
    my $file  = shift;
    my $args  = shift || {};

    require XML::Simple;
    my $config = XML::Simple::XMLin(
        $file,
        ForceArray => [ qw( component model view controller ) ],
        %$args
    );

    return $class->_coerce( $config );
}

sub _coerce {
    # coerce the XML-parsed config into the correct format
    my $class  = shift;
    my $config = shift;
    my $out;
    for my $k ( keys %$config ) {
        my $ref = $config->{ $k };
        my $name = ref $ref eq 'HASH' ? delete $ref->{ name } : undef;
        if ( defined $name ) {
            $out->{ $k }->{ $name } = $ref;
        }
        else {
            $out->{ $k } = $ref;
        }
    }
    $out;
}

=head2 requires_all_of( )

Specifies that this module requires L<XML::Simple> and L<XML::NamespaceSupport>
in order to work.

=cut

sub requires_all_of { 'XML::Simple', 'XML::NamespaceSupport' }

=head1 CAVEATS

=head2 Strict Mode

If, by some chance, L<XML::Simple> has already been loaded with the strict
flag turned on, then you will likely get errors as warnings will become
fatal exceptions and certain arguments to XMLin() will no longer be optional.

See L<XML::Simple's strict mode documentation|XML::Simple/STRICT_MODE> for
more information.

=head1 AUTHORS

Brian Cassidy E<lt>bricas@cpan.orgE<gt>

Joel Bernstein E<lt>rataxis@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2013 by Brian Cassidy

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 SEE ALSO

=over 4 

=item * L<Catalyst>

=item * L<Config::Any>

=item * L<XML::Simple>

=back

=cut

1;
PK     ��iZ��Z4  4    Any/Base.pmnu �[���        package Config::Any::Base;

use strict;
use warnings;

=head1 NAME

Config::Any::Base - Base class for loaders

=head1 DESCRIPTION

This is a base class for all loaders. It currently handles the specification
of dependencies in order to ensure the subclass can load the config file
format.

=head1 METHODS

=head2 is_supported( )

Allows us to determine if the file format can be loaded. The can be done via
one of two subclass methods:

=over 4

=item * C<requires_all_of()> - returns an array of items that must all be present in order to work

=item * C<requires_any_of()> - returns an array of items in which at least one must be present

=back

You can specify a module version by passing an array reference in the return.

    sub requires_all_of { [ 'My::Module', '1.1' ], 'My::OtherModule' }

Lack of specifying these subs will assume you require no extra modules to function.

=cut

sub is_supported {
    my ( $class ) = shift;
    if ( $class->can( 'requires_all_of' ) ) {
        eval join( '', map { _require_line( $_ ) } $class->requires_all_of );
        return $@ ? 0 : 1;
    }
    if ( $class->can( 'requires_any_of' ) ) {
        for ( $class->requires_any_of ) {
            eval _require_line( $_ );
            return 1 unless $@;
        }
        return 0;
    }

    # requires nothing!
    return 1;
}

sub _require_line {
    my ( $input ) = shift;
    my ( $module, $version ) = ( ref $input ? @$input : $input );
    return "require $module;"
        . ( $version ? "${module}->VERSION('${version}');" : '' );
}

=head1 AUTHOR

Brian Cassidy E<lt>bricas@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2008-2009 by Brian Cassidy

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 SEE ALSO

=over 4 

=item * L<Config::Any>

=back

=cut

1;
PK     ��iZi,�.  .    Any/YAML.pmnu �[���        package Config::Any::YAML;

use strict;
use warnings;

use base 'Config::Any::Base';

use Carp ();

=head1 NAME

Config::Any::YAML - Load YAML config files

=head1 DESCRIPTION

Loads YAML files. Example:

    ---
    name: TestApp
    Controller::Foo:
        foo: bar
    Model::Baz:
        qux: xyzzy
    

=head1 METHODS

=head2 extensions( )

return an array of valid extensions (C<yml>, C<yaml>).

=cut

sub extensions {
    return qw( yml yaml );
}

=head2 load( $file )

Attempts to load C<$file> as a YAML file.

=cut

sub load {
    my $class = shift;
    my $file  = shift;

    eval { require YAML::XS };
    unless ( $@ ) {
        return YAML::XS::LoadFile( $file );
    }

    eval { require YAML::Syck; YAML::Syck->VERSION( '0.70' ) };
    unless ( $@ ) {
        open( my $fh, $file ) or die $!;
        my $content = do { local $/; <$fh> };
        close $fh;
        return YAML::Syck::Load( $content );
    }

    require YAML;
    return YAML::LoadFile( $file );
}

=head2 requires_any_of( )

Specifies that this modules requires one of L<YAML::XS>, L<YAML::Syck> (0.70) or
L<YAML> in order to work.

=cut

sub requires_any_of { 'YAML::XS', [ 'YAML::Syck', '0.70' ], 'YAML' }

=head1 AUTHOR

Brian Cassidy E<lt>bricas@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2013 by Brian Cassidy

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 SEE ALSO

=over 4 

=item * L<Catalyst>

=item * L<Config::Any>

=item * L<YAML::XS>

=item * L<YAML>

=item * L<YAML::Syck>

=back

=cut

1;
PK     ��iZBTR4�  �  
  Any/INI.pmnu �[���        package Config::Any::INI;

use strict;
use warnings;

use base 'Config::Any::Base';

our $MAP_SECTION_SPACE_TO_NESTED_KEY = 1;

=head1 NAME

Config::Any::INI - Load INI config files

=head1 DESCRIPTION

Loads INI files. Example:

    name=TestApp
    
    [Controller::Foo]
    foo=bar
    
    [Model::Baz]
    qux=xyzzy

=head1 METHODS

=head2 extensions( )

return an array of valid extensions (C<ini>).

=cut

sub extensions {
    return qw( ini );
}

=head2 load( $file )

Attempts to load C<$file> as an INI file.

=cut

sub load {
    my $class = shift;
    my $file  = shift;

    require Config::Tiny;
    my $config = Config::Tiny->read( $file );

    die $Config::Tiny::errstr if not defined $config;

    my $out = delete $config->{ _ } || {};

    for my $k ( keys %$config ) {
        my @keys = split /\s+/, $k;
        my $ref = $config->{ $k };

        if ( $MAP_SECTION_SPACE_TO_NESTED_KEY && @keys > 1 ) {
            my ( $a, $b ) = @keys[ 0, 1 ];
            $out->{ $a }->{ $b } = $ref;
        }
        else {
            $out->{ $k } = { %{ $out->{ $k } || {} }, %$ref };
        }
    }

    return $out;
}

=head2 requires_all_of( )

Specifies that this module requires L<Config::Tiny> in order to work.

=cut

sub requires_all_of { 'Config::Tiny' }

=head1 PACKAGE VARIABLES

=over 4

=item $MAP_SECTION_SPACE_TO_NESTED_KEY (boolean)

This variable controls whether spaces in INI section headings will be expanded into nested hash keys.
e.g. it controls whether [Full Power] maps to $config->{'Full Power'} or $config->{'Full'}->{'Power'}

By default it is set to 1 (i.e. true). 

Set it to 0 to preserve literal spaces in section headings:

    use Config::Any;
    use Config::Any::INI;
    $Config::Any::INI::MAP_SECTION_SPACE_TO_NESTED_KEY = 0;

=back

=head1 AUTHORS

Brian Cassidy E<lt>bricas@cpan.orgE<gt>

Joel Bernstein E<lt>rataxis@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2013 by Brian Cassidy, portions copyright 2006, 2007 by Joel Bernstein

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 SEE ALSO

=over 4 

=item * L<Catalyst>

=item * L<Config::Any>

=item * L<Config::Tiny>

=back

=cut

1;
PK     ��iZ��)X��  ��    Merge.pmnu �[���        package Config::Merge;

use strict;
use warnings FATAL => 'all', NONFATAL => 'redefine';

use File::Spec();
use File::Glob 'bsd_glob';

use Storable();
use overload (
    '&{}' => sub {
        my $self = shift;
        return sub { $self->C(@_) }
    },
    'fallback' => 1
);

use vars qw($VERSION);
$VERSION = '1.04';

=head1 NAME

Config::Merge - load a configuration directory tree containing
YAML, JSON, XML, Perl, INI or Config::General files

=head1 SYNOPSIS

   OO style
   -------------------------------------------------------
   use Config::Merge();

   my $config    = Config::Merge->new('/path/to/config');

   @hosts        = $config->('db.hosts.session');
   $hosts_ref    = $config->('db.hosts.session');
   @cloned_hosts = $config->clone('db.hosts.session');
   -------------------------------------------------------

OR

   Functional style
   -------------------------------------------------------
   # On startup
   use Config::Merge('My::Config' => '/path/to/config');


   # Then, in any module where you want to use the config
   package My::Module;
   use My::Config;

   @hosts        = C('db.hosts.sesssion');
   $hosts_ref    = C('db.hosts.sesssion');
   @cloned_hosts = My::Config::clone('db.hosts.session');
   $config       = My::Config::object;
   -------------------------------------------------------

ADVANCED USAGE

   OO style
   -------------------------------------------------------
   my $config    = Config::Merge->new(
       path      => '/path/to/config',
       skip      => sub {} | regex | {} ,
       is_local  => sub {} | regex | {} ,
       load_as   => sub {} | regex ,
       sort      => sub {} ,
       debug     => 1 | 0
   );
   -------------------------------------------------------

   Functional style
   -------------------------------------------------------
   use Config::Merge(
       'My::Config' => '/path/to/config',
       {
           skip      => sub {} | regex | {} ,
           is_local  => sub {} | regex | {} ,
           load_as   => sub {} | regex ,
           sort      => sub {} ,
           debug     => 1 | 0
       }
   );

   # Also, you can subclass these:

     package My::Config;
     sub skip {
         ...
     }

   -------------------------------------------------------

=head1 DESCRIPTION

Config::Merge is a configuration module which has six goals:

=over

=item * Flexible storage

Store all configuration in your format(s) of choice (YAML, JSON, INI, XML, Perl,
Config::General / Apache-style config) broken down into individual files in
a configuration directory tree, for easy maintenance.
 See L</"CONFIG TREE LAYOUT">

=item * Flexible access

Provide a simple, easy to read, concise way of accessing the configuration
values (similar to L<Template>). See L</"ACCESSING CONFIG DATA">

=item * Minimal maintenance

Specify the location of the configuration files only once per
application, so that it requires minimal effort to relocate.
See L</"USING Config::Merge">

=item * Easy to alter development environment

Provide a way for overriding configuration values on a development
machine, so that differences between the dev environment and
the live environment do not get copied over accidentally.
See L</"OVERRIDING CONFIG LOCALLY">

=item * Minimise memory use

Load all config at startup so that (eg in the mod_perl environment) the
data is shared between all child processes. See L</"MINIMISING MEMORY USE">

=item * Flexible implementation

You may want to use a different schema for your configuration files,
so you can pass in (or subclass) methods for determining how your
files are merged.  See L</"ADVANCED USAGE">.

=back

=head1 USING C<Config::Merge>

There are two ways to use C<Config::Merge>:

=over

=item OO STYLE

   use Config::Merge();
   my $config    = Config::Merge->new('/path/to/config');

   @hosts        = $config->('db.hosts.session');
   $hosts_ref    = $config->('db.hosts.session');
   @cloned_hosts = $config->clone('db.hosts.session');

Also, see L</"ADVANCED USAGE">.

=item YOUR OWN CONFIG CLASS (functional style)

The following code:

   # On startup
   use Config::Merge('My::Config' => '/path/to/config');

=over

=item *

auto-generates the class C<My::Config>

=item *

loads the configuration data in C<'/path/to/config'>

=item *

creates the subs C<My::Config::C>, C<My::Config::clone>
and C<My::Config::object>.

=back

Then when you want your application to have access to your configuration data,
you add this (eg in your class C<My::Module>):

   package My::Module;
   use My::Config;       # Note, no ()

This exports the sub C<C> into your current package, which allows you to
access your configuation data as follows:

   @hosts        = C('db.hosts.sesssion');
   $hosts_ref    = C('db.hosts.sesssion');
   @cloned_hosts = My::Config::clone('db.hosts.session');
   $config       = My::Config::object;

=back

=head1 CONFIG TREE LAYOUT

Config::Merge reads the data from any number (and type) of config files
stored in a directory tree. File names and directory names are used as keys in
the configuration hash.

It uses file extensions to decide what type of data the file contains, so:

    YAML            : .yaml .yml
    JSON            : .json .jsn
    XML             : .xml
    INI             : .ini
    Perl            : .perl .pl
    Config::General : .conf .cnf

When loading your config data, Config::Merge starts at the directory
specified at startup (see L</"USING Config::Merge">) and looks
through all the sub-directories for files ending in one of the above
extensions.

The name of the file or subdirectory is used as the first key.  So:

    global/
        db.yaml:
            username : admin
            hosts:
                     - host1
                     - host2
            password:
              host1:   password1
              host2:   password2

would be loaded as :

    $Config = {
       global => {
           db => {
               username => 'admin',
               password => { host1 => 'password1', host2 => 'password2'},
               hosts    => ['host1','host2'],
           }
       }
    }

Subdirectories are processed before the current directory, so
you can have a directory and a config file with the same name,
and the values will be merged into a single hash, so for
instance, you can have:

    confdir:
       syndication/
       --data_types/
         --traffic.yaml
         --headlines.yaml
       --data_types.ini
       syndication.conf

The config items in syndication.conf will be added to (or overwrite)
the items loaded into the syndication namespace via the subdirectory
called syndication.

=head1 OVERRIDING CONFIG LOCALLY

The situation often arises where it is necessary to specify
different config values on different machines. For instance,
the database host on a dev machine may be different from the host
on the live application. Also, see L</"ADVANCED USAGE"> which
provides you with other means to merge local data.

Instead of changing this data during dev and then having to remember
to change it back before putting the new code live, we have a mechanism
for overriding config locally in a C<local.*> file and then, as long as
that file never gets uploaded to live, you are protected.

You can put a file called C<local.*> (where * is any of the recognised
extensions) in any sub-directory, and
the data in this file will be merged with the existing data.

Just make sure that the C<local.*> files are never checked into your live
code.

For instance, if we have:

    confdir:
        db.yaml
        local.yaml

and db.yaml has :

    connections:
        default_settings:
            host:       localhost
            table:      abc
            password:   123

And in local.yaml:

    db:
        connections:
            default_settings:
                password:   456

the resulting configuration will look like this:

    db:
        connections:
            default_settings:
                host:       localhost
                table:      abc
                password:   456

=head1 ACCESSING CONFIG DATA

All configuration data is loaded into a single hash, eg:

    $config = {
        db    => {
            hosts  => {
                session  => ['host1','host2','host3'],
                images   => ['host1','host2','host3'],
                etc...
            }
        }
    }


If you want to access it via standard Perl dereferences, you can just ask
for the hash:

    OO:
       $data_ref  = $config->();
       $hosts_ref = $data_ref->{db}{hosts}{session};
       $host_1    = $data_ref->{db}{hosts}{session}[0];

    Functional:
       $data_ref  = C();
       $hosts_ref = $data_ref->{db}{hosts}{session};
       $host_1    = $data_ref->{db}{hosts}{session}[0];

However, C<Config::Merge> also provides an easy to read dot-notation in the
style of Template Toolkit: C<('key1.key2.keyn')>.

A key can be the key of a hash or the index of an array. The return value is
context sensitive, so if called in list context, a hash ref or array ref will
be dereferenced.

    OO:
       @hosts     = $config->('db.hosts.session');
       $hosts_ref = $config->('db.hosts.session');
       $host_1    = $config->('db.hosts.session.0');

    Functional:
       @hosts     = C('db.hosts.session');
       $hosts_ref = C('db.hosts.session');
       $host_1    = C('db.hosts.session.0');

These lookups are memo'ised, so lookups are fast.

If the specified key is not found, then an error is thrown.

=head1 MINIMISING MEMORY USE

The more configuration data you load, the more memory you use. In order to
keep the memory use as low as possible for mod_perl (or other forking
applications), the configuration data should be loaded at startup in the
parent process.

As long as the data is never changed by the children, the configuration hash
will be stored in shared memory, rather than there being a separate copy in each
child process.

(See L<http://search.cpan.org/~pgollucci/mod_perl-2.0.3/docs/user/performance/mpm.pod>)

=head1 METHODS

=over

=item C<new()>

    $conf = Config::Merge->new($config_dir);

new() instantiates a config object, loads the config from
the directory specified, and returns the object.

=cut

#===================================
sub new {
#===================================
    my $proto = shift;
    my $class = ref $proto || $proto;

    my $self = {};
    bless( $self, $class );

    my $params
        = @_ > 1              ? {@_}
        : ref $_[0] eq 'HASH' ? shift()
        :                       { path => shift() };

    # Emit debug messages
    $self->{debug} = $params->{debug} ? 1 : 0;

    die "Parameter 'sort' must be a coderef"
        if exists $params->{sort} && ref $params->{sort} ne 'CODE';

    # Setup callbacks
    $self->_init_callback( $_, $params->{$_} )
        foreach qw(skip is_local load_as sort);

    my $path = $params->{path}
        or die( "Configuration directory not specified when creating a new "
            . "'$class' object" );

    if ( $path && -d $path && -r _ ) {

        $path =~ s|/?$|/|;
        $self->{config_dir} = $path;
        $self->load_config();

        return $self;
    }
    else {
        die( "Configuration directory '$path' not readable when creating a new "
                . "'$class' object" );
    }
    return $self;
}

=item C<C()>

  $val = $config->C('key1.key2.keyn');
  $val = $config->C('key1.key2.keyn',$hash_ref);

C<Config::Merge> objects are overloaded so that this also works:

  $val = $config->('key1.key2.keyn');
  $val = $config->('key1.key2.keyn',$hash_ref);

Or, if used in the functional style (see L</"USING Config::Merge">):

  $val = C('key1.key2.keyn');
  $val = C('key1.key2.keyn',$hash_ref);

C<key1> etc can be keys in a hash, or indexes of an array.

C<C('key1.key2.keyn')> returns everything from C<keyn> down,
so you can use the return value just as you would any normal Perl variable.

The return values are context-sensitive, so if called
in list context, an array ref or hash ref will be returned as lists.
Scalar values, code refs, regexes and blessed objects will always be returned
as themselves.

So for example:

  $password = C('database.main.password');
  $regex    = C('database.main.password_regex');

  @countries = C('lists.countries');
  $countries_array_ref = C('lists.countries');

  etc

If called with a hash ref as the second parameter, then that hash ref will be
examined, rather than the C<$config> data.

=cut

#===================================
sub C {
#===================================
    my $self = shift;
    my $path = shift;
    $path = '' unless defined $path;

    my ( $config, @keys );

    # If a private hash is passed in use that
    if (@_) {
        $config = $_[0];
        @keys   = split( /\./, $path );
        $config = $self->_walk_path( $config, 'PRIVATE', \@keys );
    }

    # Otherwise use the stored config data
    else {

        # Have we previously memoised this?
        if ( exists $self->{_memo}->{$path} ) {
            $config = ${ $self->{_memo}->{$path} };
        }

        # Not memoised, so get it manually
        else {
            $config = $self->{config};
            (@keys) = split( /\./, $path );
            $config = $self->_walk_path( $config, '', \@keys );
            $self->{_memo}->{$path} = \$config;
        }
    }

    return
          wantarray && ref($config) eq 'HASH'  ? %{$config}
        : wantarray && ref($config) eq 'ARRAY' ? @{$config}
        :                                        $config;
}

#===================================
sub _walk_path {
#===================================
    my $self = shift;
    my ( $config, $key_path, $keys ) = @_;

    foreach my $key (@$keys) {
        next unless defined $key && length($key);
        if (   ref $config eq 'ARRAY'
            && $key =~ /^[0-9]+/
            && exists $config->[$key] )
        {
            $config = $config->[$key];
            $key_path .= '.' . $key;
            next;
        }
        elsif ( ref $config eq 'HASH' && exists $config->{$key} ) {
            $config = $config->{$key};
            $key_path = $self->_join_key_path( $key_path, $key );
            next;
        }
        die("Invalid key '$key' specified for '$key_path'\n");
    }
    return $config;
}

=item C<clone()>

This works exactly the same way as L</"C()"> but it performs a
deep clone of the data before returning it.

This means that the returned data can be changed without
affecting the data stored in the $conf object;

The data is deep cloned, using Storable, so the bigger the data, the more
performance hit.  That said, Storable's dclone is very fast.

=cut

#===================================
sub clone {
#===================================
    my $self = shift;
    my $data = $self->Config::Merge::C(@_);
    return Storable::dclone($data);
}

my @Builtin_Merges = qw(
    Config::Any::YAML
    Config::Any::General
    Config::Any::XML
    Config::Any::INI
    Config::Any::JSON
    Config::Merge::Perl
);

my %Module_For_Ext = ();
__PACKAGE__->register_loader($_) foreach @Builtin_Merges;

=item C<register_loader()>

    Config::Merge->register_loader( 'Config::Merge::XYZ');

    Config::Merge->register_loader( 'Config::Merge::XYZ' => 'xyz','xxx');

By default, C<Config::Merge> uses the C<Config::Any>
plugins to support YAML, JSON, INI, XML, Perl and Config::General configuration
files, using the standard file extensions to recognise the file type. (See
L</"CONFIG TREE LAYOUT">).

If you would like to change the handler for an extension (eg, you want C<.conf>
and C<.cnf> files to be treated as YAML), do the following:

    Config::Merge->register_loader ('Config::Any::YAML' => 'conf', 'cnf');

If you would like to add a new config style, then your module should have two
methods: C<extensions()> (which returns a list of the extensions it handles),
and C<load()> which accepts the name of the file to load, and returns
a hash ref containing the data in the file. See L<Config::Any> for details.

Alternatively, you can specify the extensions when you load it:

    Config::Merge->register_loader ('My::Merge' => 'conf', 'cnf');

=cut

#===================================
sub register_loader {
#===================================
    my $class  = shift;
    my $loader = shift
        or die "No loader class passed to register_loader()";
    eval "require $loader"
        or die $@;
    my @extensions = @_ ? @_ : $loader->extensions;
    foreach my $ext (@extensions) {
        $Module_For_Ext{ lc($ext) } = $loader;
    }
    return;
}

=item C<load_config()>

    $config->load_config();

Will reload the config files located in the directory specified at object
creation (see L</"new()">).

BEWARE : If you are using this in a mod_perl environment, you will lose the
benefit of shared memory by calling this in a child process
 - each child will have its own copy of the data.
See L<MINIMISING MEMORY USE>.

Returns the config hash ref.

=cut

#===================================
sub load_config {
#===================================
    my $self = shift;
    $self->{_memo} = {};
    $self->debug("Loading config data");
    return $self->{config} = $self->_load_config() || {};
}

#===================================
sub _load_config {
#===================================
    my $self          = shift;
    my $dir           = shift || $self->{config_dir};
    my $key_path      = shift || '';
    my $loading_local = shift;

    my $config = {};

    my @local;

    my $config_files = $self->{sort}
        ->( $self, [ bsd_glob( File::Spec->catfile( $dir, '*' ) ) ] );

    my $is_local = $self->{is_local};
    $self->debug( '', "Entering dir: $dir", '-' x ( length($dir) + 14 ) );

CONFIG_FILE:
    foreach my $config_file (@$config_files) {
        my ( $data, $name, $curr_key_path, $loader );

        my $filename = ( File::Spec->splitpath($config_file) )[2];

        # If it is a file
        if ( -f $config_file ) {
            $self->debug("  Found file : $config_file");

            # Must have an extension
            ( $name, my $ext ) = ( $filename =~ /(.+)[.]([^.]+)/ )
                or $self->debug("  ... No extension") && next CONFIG_FILE;

            # Must have an associated module
            $loader = $Module_For_Ext{ lc $ext }
                or $self->debug("  ... No loader") && next CONFIG_FILE;
        }
        elsif ( -d $config_file ) {
            $self->debug("  Found dir : $config_file");
            $name = $filename;
            undef $loader;
        }

        # Anything else (eg symlink), skip
        else {
            next;
        }

        # If it is a local file/dir, process last
        if ( !$loading_local && $is_local->( $self, $name ) ) {
            $self->debug("  ... will merge later");
            push @local, [ $loader, $config_file, $filename ];
            next CONFIG_FILE;
        }

        # Find the key name from the filename
        $name = $self->_load_as( $key_path, $name, $loading_local );
        next CONFIG_FILE if not defined $name;

        # loader = module name to load file, or undef for directory
        $data
            = $loader
            ? $self->_load_config_file( $loader, $config_file )
            : $self->_load_config( $config_file,
            $self->_join_key_path( $key_path, $name ),
            $loading_local );

        next CONFIG_FILE unless defined $data;

        # Merge keys if already exists
        if (   exists $config->{$name}
            && ref $config->{$name} eq 'HASH'
            && ref $data eq 'HASH' )
        {
            $config->{$name}->{$_} = $data->{$_} foreach keys %$data;
        }
        else {
            $config->{$name} = $data;
        }
    }

    # Merge local config into main config
LOCAL_FILE:
    foreach my $local_file (@local) {
        my ( $loader, $config_file, $name ) = @$local_file;
        $self->debug("  Merging file $config_file");
        $name = $self->_load_as( $key_path, $name, 1 );
        next LOCAL_FILE
            unless defined $name;

        my $data
            = $loader
            ? $self->_load_config_file( $loader, $config_file )
            : $self->_load_config( $config_file, $key_path, 1 );

        next LOCAL_FILE unless defined $data;

        $config = $self->_merge_hash(
            $config, $name
            ? { $name => $data }
            : $data
        );
    }

    return keys %$config ? $config : undef;
}

#===================================
sub _load_as {
#===================================
    my ( $self, $key_path, $name, $loading_local ) = @_;

    # Find the key name from the filename
    $name = $self->{load_as}->( $self, $name, $loading_local );
    unless ( defined $name ) {
        $self->debug("  ... Skipped by load_as()");
        return;
    }

    die "load_as() cannot return '' when loading main config"
        if !$loading_local && $name eq '';

    my $curr_key_path = $self->_join_key_path( $key_path, $name );
    $self->debug( "  ... loading at : "
            . ( length($curr_key_path) ? $curr_key_path : '.' ) );

    if ( $self->{skip}->( $self, $curr_key_path ) ) {
        $self->debug("  ... skipped by skip()");
        return;
    }
    return $name;
}

#===================================
sub _join_key_path {
#===================================
    my ( $self, $key_path, $name ) = @_;
    return $key_path . '.' . $name if length($key_path);
    return $name;
}

#===================================
sub _load_config_file {
#===================================
    my $self = shift;
    my ( $loader, $config_file ) = @_;
    $self->debug("  ... with : $loader");
    my $data;
    eval {
        my @data = $loader->load($config_file);
        $data
            = @data > 1
            ? \@data
            : $data[0];
    };
    if ($@) {
        die( "Error loading config file $config_file:\n\n" . $@ );
    }

    return $data;
}

=item C<clear_cache()>

    $config->clear_cache();

Config data is generally not supposed to be changed at runtime. However, if
you do make changes, you may get inconsistent results, because lookups are
cached.

For instance:

    print $config->C('db.hosts.session');  # Caches this lookup
    > "host1 host2 host3"

    $data = $config->C('db.hosts');
    $data->{session} = 123;

    print $config->C('db.hosts.session'); # uses cached value
    > "host1 host2 host3"

    $config->clear_cache();
    print $config->C('db.hosts.session'); # uses actual value
    > "123"

=cut

#===================================
sub clear_cache {
#===================================
    my $self = shift;
    $self->{_memo} = {};
    return;
}

=item C<import()>

C<import()> will normally be called automatically when you
C<use Config::Merge>. However, you may want to do this:

    use Config::Merge();
    Config::Merge->register_loader('My::Plugin' => 'ext');
    Config::Merge->import('My::Config' => '/path/to/config/dir');

If called with two params: C<$config_class> and C<$config_dir>, it
generates the new class (which inherits from Config::Merge)
specified in C<$config_class>, creates a new
object of that class and creates 4 subs:

=over

=item C<C()>

    As a function:
        C('keys...')

    is the equivalent of:
        $config->C('keys...');

=item C<clone()>

    As a function:
        clone('keys...')

    is the equivalent of:
        $config->clone('keys...');

=item C<object()>

    $config = My::Config->object();

Returns the C<$config> object,

=item C<import()>

When you use your generated config class, it exports the C<C()> sub into your
package:

    use My::Config;
    $hosts = C('db.hosts.session');

=back

=back

=cut

#===================================
sub import {
#===================================
    my $caller_class = shift;
    my ( $class, $dir ) = @_;
    return
        unless defined $class;

    unless ( defined $dir ) {
        $dir   = $class;
        $class = $caller_class;
    }
    if ( $class eq __PACKAGE__ ) {
        die <<USAGE;

USAGE : use $class ('Your::Config' => '/path/to/config/dir' );

USAGE

    }

    my $inc_path = $class;
    $inc_path =~ s{::}{/}g;
    $inc_path .= '.pm';

    no strict 'refs';
    unless ( exists $INC{$inc_path} ) {
        @{ $class . '::ISA' } = ($caller_class);
        $INC{$inc_path} = 'Auto-inflated by ' . $caller_class;
    }

    my $params = @_ % 2 ? shift() : {@_};
    $params->{path} = $dir;
    my $config = $class->new(%$params);

    # Export C, clone to the subclass
    *{ $class . "::C" }
        = sub { my $c = ref $_[0] ? shift : $config; return C( $c, @_ ) };
    *{ $class . "::clone" } = sub {
        my $c = ref $_[0] ? shift : $config;
        return clone( $c, @_ );
    };
    *{ $class . "::object" } = sub { return $config };

    # Create a new import sub in the subclass
    *{ $class . "::import" } = eval '
        sub {
            my $callpkg = caller(0);
            no strict \'refs\';
            *{$callpkg."::C"} = \&' . $class . '::C;
        }';

    return;
}

#===================================
sub _merge_hash {
#===================================
    my $self   = shift;
    my $config = shift;
    my $local  = shift;
KEY:
    foreach my $key ( keys %$local ) {
        if ( ref $local->{$key} eq 'HASH'
            && exists $config->{$key} )
        {
            if ( ref $config->{$key} eq 'HASH' ) {
                $self->debug("  ... entering hash : $key");
                $config->{$key}
                    = $self->_merge_hash( $config->{$key}, $local->{$key} );
                next KEY;
            }
            if (   ref $config->{$key} eq 'ARRAY'
                && exists $local->{$key}{'!'}
                && ref $local->{$key}{'!'} eq 'HASH' )
            {
                $self->_merge_array( $key, $config, $local );
                next KEY;
            }
        }
        $self->debug("  ... setting key : $key");
        $config->{$key} = $local->{$key};
    }
    $self->debug("  ... leaving hash");
    return $config;
}

=head1 ADVANCED USAGE

The items in the section allow you to customise how Config::Merge
loads your data.  You may never need them.

You can:

=over

=item *

Override array values

=item *

Skip the loading of parts of your config tree

=item *

Specify which files / dirs are local

=item *

Specify how to translate a file / dir name into a key

=item *

Change order in which files are loaded

=item *

See debug output

=back

=over

=item Overriding array values

Overriding hash values is easy, however arrays are more complex.
it may be simpler to copy and paste and edit the array you want to
change locally.

However, if your array is too long, and you want to make small changes,
then you can use the following:

In the main config:

    {
      cron => [qw( job1 job2 job3 job4)]
    }

In the local file

    {
      cron => {
        '3'  => 'newjob4',      # changes 'job4' -> 'newjob4'

        '!'  => {               # signals an array override

             '-' => [1],        # deletes 'job2'

             '+' => ['job5'],   # appends 'job5'

          OR '+' => {           # inserts 'job3a' after 'job3'
                 2 => 'job3a'
             }
        }
    }

=over

=item *

The override has to be a hash, with at least this structure
 C<< { '!' => {} } >> to signal an array override

=item *

Any other keys with integers are treated as indexes and
are used to change the value at that index in the original array

=item *

The C<'-'> key should contain an array ref, with the indexes of the
elements to remove from the array.

=item *

If the C<'+'> key contains an array ref, then its contents are appended
to the original array.

=item *

If the C<'+'> key contains a hash ref, then each value is inserted
into the original array at the index given in the key

=item *

Indexes are zero based, just as in Perl.

=back

=cut

#===================================
sub _merge_array {
#===================================
    my ( $self, $key, $config, $local ) = @_;
    $self->debug("  ... merging array : $key");
    my $dest    = $config->{$key};
    my $merge   = $local->{$key};
    my $changes = delete $merge->{'!'};

    # Changed elements
    foreach my $index ( keys %$merge ) {
        $index = '' if !defined $index;
        die "Array override for key '$key' : '$index' is not an integer"
            unless $index =~ /^\d+$/;
        $dest->[$index] = $merge->{$index};
        $self->debug("      ... changing index  : $index");
    }

    my %actions;

    # Deleted elements
    my $remove = $changes->{'-'} || [];
    die "Index delete for key '$key' : '-' is not an array ref"
        unless ref $remove eq 'ARRAY';

    foreach my $delete_index (@$remove) {
        next unless $delete_index =~ /^\d+/;
        $actions{$delete_index} = ['-']
            if $delete_index < @$dest;
    }

    # Added elements
    my $add = $changes->{'+'} || [];

    # Append
    if ( ref $add eq 'ARRAY' ) {
        if (@$add) {
            push @$dest, @$add;
            $self->debug(
                '      ... appending ' . ( scalar @$add ) . ' element(s)' );
        }
    }

    # Insert
    elsif ( ref $add eq 'HASH' ) {
        foreach my $add_index ( keys %$add ) {
            next unless $add_index =~ /^\d+/;
            $actions{$add_index} = [
                ( exists $actions{$add_index} || $add_index >= @$dest )
                ? '~'
                : '+',
                $add->{$add_index}
            ];
        }

    }
    else {
        die "Array add for key '$key' : '+' is not an array or hash ref";
    }

    foreach my $index ( sort { $b <=> $a } keys %actions ) {
        my ( $action, $value ) = @{ $actions{$index} };
        if ( $action eq '-' ) {
            splice( @$dest, $index, 1 );
            $self->debug("      ... deleting index  : $index");
            next;
        }
        if ( $action eq '~' ) {
            $dest->[$index] = $value;
            $self->debug("      ... changing index  : $index");
            next;
        }
        splice( @$dest, $index, 0, $value );
        $self->debug("      ... inserting index : $index");
    }
    return;
}

=item C<skip()>

    $c = Config::Merge->new(
            path  => '/path/to/config',
            skip  => qr/regex/,
                     | [ qr/regex1/, qr/regex2/...]
                     | {  name1 => 1, name2 => 2}
                     | sub {}
    );

C<skip()> allows you to skip the loading of parts of your config
tree.  For instance, if you don't need a list of cron jobs when running
your web server, you can skip it.

The decision is made based on the path to that value, eg 'app.db.hosts'
rather than on filenames. Also, the check is only performed for each
new directory or filename - it doesn't check the data within each file.

To use C<skip()>, you can either subclass it, or pass in a parameter
to new:

=over

=item C<qr/regex/> or C<[qr/regex1/, qr/regex2]>

Each regex will be checked against the key path, and if it matches
then the loading of that tree will be skipped

=item C<< {key_path => 1} >>

If the key path exists in the hash, then loading will be skipped

=item C<sub {}> or subclassed C<skip>

   sub {
       my ($self,$key_path) = @_;
       ...make decision...
       return 1 | 0;
   }

=back

=cut

#===================================
sub skip {
#===================================
    return;
}

=item C<is_local()>

    $c = Config::Merge->new(
            path     => '/path/to/config',
            is_local => qr/regex/,
                        | [ qr/regex1/, qr/regex2/...]
                        | {  name1 => 1, name2 => 2}
                        | sub {}
    );

C<is_local()> indicates whether a file or dir should be considered
part of the main config (and thus loaded normally) or part of the
local config (and thus merged into the main config).

The decision is made based on the name of the file / dir, without
any extension.

To use C<is_local()>, you can either subclass it, or pass in a parameter
to new:

=over

=item C<qr/regex/> or C<[qr/regex1/, qr/regex2]>

Each regex will be checked against the file/dir name, and if it matches
then that tree will be merged

=item C<< {filename => 1, dirname => 1} >>

If the file/dir name exists in the hash, then that tree will be merged

=item C<sub {}> or subclassed C<is_local>

   sub {
       my ($self,$name) = @_;
       ...make decision...
       return 1 | 0;
   }

=back

See L</"EXAMPLE USING is_local() AND load_as()">.

=cut

#===================================
sub is_local {
#===================================
    my ( $self, $filename ) = @_;
    return $filename =~ /^local\b/;
}

=item C<load_as()>

    $c = Config::Merge->new(
            path     => '/path/to/config',
            load_as  => qr/(regex)/,
                        | sub {}
    );

C<load_as()> returns the name of the key to use when loading
the file / dir. By default, it returns the C<$name> for main
config files, or C<''> for local files.

The decision is made based on the name of the file / dir, without
any extension.

If C<load_as()> returns an empty string, then each key in the file/tree
is merged separately. This is how the C<local.*> files work by default.
See L</"OVERRIDING CONFIG LOCALLY">.

For instance:

   main.yaml:
     key1:  value
     key2:  value

   db.yaml:
     key3:  value
     key4:  value

   local.yaml:
     main:
        key1: new_value
     db:
        key4: new_value

To use C<load_as()>, you can either subclass it, or pass in a parameter
to new:

=over

=item C<qr/(regex)/>

The regex will be checked against the file/dir name, and if it matches
then it returns the string captured in the regex, otherwise it returns
the original name.

=item C<sub {}> or subclassed C<is_local>

   sub {
       my ($self,$name,$is_local) = @_;
       ...make decision...
       return 'string';   # string is used as the keyname
       return '';         # acts like local.* (see above)
       return undef;      # don't load this file/dir
   }

=back

Also, see L</"EXAMPLE USING is_local() AND load_as()">.

=cut

#===================================
sub load_as {
#===================================
    my ( $self, $filename, $local ) = @_;
    return $local ? '' : $filename;
}

my %callbacks = (
    CODE  => \&_init_code_callback,
    HASH  => \&_init_hash_callback,
    ARRAY => \&_init_array_callback,
);

=item EXAMPLE USING C<is_local()> AND C<load_as()>

For instance, instead of using C<local.*> files, you may want to
keep versioned copies of local configs for different machines, and so use:

   app.yaml
   app-(dev1.domain.com).yaml
   app-(dev2.domain.com).yaml

You would implement this as follows:

    my $config = Config::Merge->new(
        path        => '/path/to/config',

        # If matches 'xxx-(yyy)'
        is_local    => sub {
            my ( $self, $name ) = @_;
            return $name=~/- [(] .+ [)]/x ? 1 : 0;
        },

        # If local and matches 'xxx-(hostname)', return xxx
        load_as => sub {
            my ( $self, $name, $is_local ) = @_;
            if ($is_local) {
                if ( $name=~/(.*) - [(] ($hostname) [)] /x ) {
                    return  $1;
                }
                return undef;
            }
            return $name;
        }
    );

See C<examples/advanced.pl> for a working illustration.

=item C<sort()>

    $c = Config::Merge->new(
            path   => '/path/to/config',
            sort   => sub {}
    );

By default, directory entries are sorted alphabetically, with
directories before filenames.

This would be the order for these directory entries:

  api/
  api-(dev1)/
  api.yaml
  api-(dev1).yaml

To override this, you can subclass C<sort()> or pass it in as a
parameter to new:

   sub {
       my ($self,$names_array_ref) = @_
       ...sort...
       return $names_array_ref;
   }

=cut

#===================================
sub sort {
#===================================
    my ( $self, $names ) = @_;
    s/[.]([^.]+$)/ .$1/ foreach @$names;
    $names = [ sort { $a cmp $b } @$names ];
    s/ [.]([^.]+$)/.$1/ foreach @$names;
    return $names;
}

=item C<debug()>

    my $config = Config::Merge->new(
        path        => '/path/to/config',
        debug       => 1 | 0
    );

If C<debug> is true, then Config::Merge prints out an explanation
of what it is doing on STDERR.

=back

=cut

#===================================
sub debug {
#===================================
    my $self = shift;
    print STDERR ( join( "\n", @_, '' ) )
        if $self->{debug};
    return 1;
}

#===================================
sub _init_callback {
#===================================
    my ( $self, $callback, $check ) = @_;

    # If nothing set, use default or subclassed version
    unless ($check) {
        $self->{$callback} = $self->can($callback);
        $self->debug("Using default or subclassed $callback()");
        return;
    }

    $check = [$check]
        unless exists $callbacks{ ref $check };

    $self->debug( 'Using ' . ( ref $check ) . " handler for $callback()" );

    $self->{$callback} = $callbacks{ ref $check }->( $check, $callback );
    return;
}

#===================================
sub _init_code_callback {
#===================================
    return $_[0];
}

#===================================
sub _init_hash_callback {
#===================================
    my ( $check, $callback ) = @_;
    die "load_as() cannot be a hashref"
        if $callback eq 'load_as';
    return sub {
        my $self  = shift;
        my $param = shift;
        return exists $check->{$param};
    };
}

#===================================
sub _init_array_callback {
#===================================
    my ( $check, $callback ) = @_;
    if ( $callback eq 'load_as' ) {
        die "load_as() must contain a single regex"
            unless @$check == 1;
        my $regex = $check->[0];
        return sub {
            my $self     = shift;
            my $filename = shift;
            return $filename =~ m/$regex/
                ? $1
                : $filename;
        };
    }

    foreach my $value (@$check) {
        $value ||= '';
        die "'$value' is not a regular expression"
            unless ref $value eq 'Regexp';
    }
    return sub {
        my $self  = shift;
        my $value = shift;
        foreach my $regex (@$check) {
            return 1 if $value =~ m/$regex/;
        }
        return 0;
    };
}

=head1 SEE ALSO

L<Storable>, L<Config::Any>, L<Config::Any::YAML>,
L<Config::Any::JSON>, L<Config::Any::INI>, L<Config::Any::XML>,
L<Config::Any::General>

=head1 THANKS

Thanks to Hasanuddin Tamir [HASANT] for vacating the Config::Merge namespace,
which allowed me to rename Config::Loader to the more meaningful Config::Merge.

His version of Config::Merge can be found in
L<http://backpan.cpan.org/modules/by-authors/id/H/HA/HASANT/>.

Thanks to Joel Bernstein and Brian Cassidy for the interface to the various
configuration modules. Also to Ewan Edwards for his suggestions about how
to make Config::Merge more flexible.

=head1 BUGS

No bugs have been reported.

Please report any bugs or feature requests to
L<http://github.com/clintongormley/ConfigMerge/issues>.

=head1 AUTHOR

Clinton Gormley, E<lt>clinton@traveljury.comE<gt>

=head1 COPYRIGHT

Copyright (C) 2007-2010 by Clinton Gormley

=cut

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.7 or,
at your option, any later version of Perl 5 you may have available.


=cut

1

PK     ��iZ�HJ9�!  �!    General/Interpolated.pmnu �[���        #
# Config::General::Interpolated - special Class based on Config::General
#
# Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>.
# Copyright (c) 2000-2014 by Thomas Linden <tlinden |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies.
# Artistic License, same as perl itself. Have fun.
#

package Config::General::Interpolated;
$Config::General::Interpolated::VERSION = "2.15";

use strict;
use Carp;
use Config::General;
use Exporter ();


# Import stuff from Config::General
use vars qw(@ISA @EXPORT);
@ISA = qw(Config::General Exporter);


sub new {
  #
  # overwrite new() with our own version
  # and call the parent class new()
  #

  croak "Deprecated method Config::General::Interpolated::new() called.\n"
       ."Use Config::General::new() instead and set the -InterPolateVars flag.\n";
}


sub _set_regex {
  #
  # set the regex for finding vars
  #

  # the following regex is provided by Autrijus Tang
  # <autrijus@autrijus.org>, and I made some modifications.
  # thanx, autrijus. :)
  my $regex = qr{
		 (^|\G|[^\\])   # $1: can be the beginning of the line
		                #     or the beginning of next match
		                #     but can't begin with a '\'
		 \$		# dollar sign
		 (\{)?		# $2: optional opening curly
		 ([a-zA-Z0-9_\-\.:\+,]+) # $3: capturing variable name (fix of #33447)
		 (?(2)		# $4: if there's the opening curly...
		 \}		#     ... match closing curly
		)
	       }x;
  return $regex;
}


sub _interpolate  {
  #
  # interpolate a scalar value and keep the result
  # on the varstack.
  #
  # called directly by Config::General::_parse_value()
  #
  my ($this, $config, $key, $value) = @_;
  my $quote_counter = 100;

  # some dirty trick to circumvent single quoted vars to be interpolated
  # we remove all quotes and replace them with unique random literals,
  # which will be replaced after interpolation with the original quotes
  # fixes bug rt#35766
  my %quotes;

  if(! $this->{AllowSingleQuoteInterpolation} ) {
    $value =~ s/(\'[^\']+?\')/
      my $key = "QUOTE" . ($quote_counter++) . "QUOTE";
      $quotes{ $key } = $1;
      $key;
    /gex;
  }

  $value =~ s{$this->{regex}}{
    my $con = $1;
    my $var = $3;
    my $var_lc = $this->{LowerCaseNames} ? lc($var) : $var;

    if (exists $config->{__stack}->{$var_lc}) {
      $con . $config->{__stack}->{$var_lc};
    }
    elsif ($this->{InterPolateEnv}) {
      # may lead to vulnerabilities, by default flag turned off
      if (defined($ENV{$var})) {
	$con . $ENV{$var};
      }
      else {
	$con;
      }
    }
    elsif ($this->{StrictVars}) {
      croak "Use of uninitialized variable (\$$var) while loading config entry: $key = $value\n";
    }
    else {
      # be cool
      $con;
    }
  }egx;

  # re-insert unaltered quotes
  # fixes bug rt#35766
  foreach my $quote (keys %quotes) {
    $value =~ s/$quote/$quotes{$quote}/;
  }

  return $value;
};


sub _interpolate_hash {
  #
  # interpolate a complete hash and keep the results
  # on the varstack.
  #
  # called directly by Config::General::new()
  #
  my ($this, $config) = @_;

  # bugfix rt.cpan.org#46184, moved code from _interpolate() to here.
  if ($this->{InterPolateEnv}) {
    # may lead to vulnerabilities, by default flag turned off
    for my $key (keys %ENV){
      $config->{__stack}->{$key}=$ENV{$key};
    }
  }

  $config = $this->_var_hash_stacker($config);

  return $config;
}

sub _var_hash_stacker {
  #
  # build a varstack of a given hash ref
  #
  my ($this, $config) = @_;

  foreach my $key (keys %{$config}) {
    next if($key eq "__stack");
    if (ref($config->{$key}) eq "ARRAY" ) {
      $config->{$key} = $this->_var_array_stacker($config->{$key}, $key);
    }
    elsif (ref($config->{$key}) eq "HASH") {
      my $tmphash = $config->{$key};
      $tmphash->{__stack} = $config->{__stack};
      $config->{$key} = $this->_var_hash_stacker($tmphash);
    }
    else {
      # SCALAR
      $config->{__stack}->{$key} = $config->{$key};
    }
  }

  return $config;
}


sub _var_array_stacker {
  #
  # same as _var_hash_stacker but for arrayrefs
  #
  my ($this, $config, $key) = @_;

  my @new;

  foreach my $entry (@{$config}) {
    if (ref($entry) eq "HASH") {
      $entry = $this->_var_hash_stacker($entry);
    }
    elsif (ref($entry) eq "ARRAY") {
      # ignore this. Arrays of Arrays cannot be created/supported
      # with Config::General, because they are not accessible by
      # any key (anonymous array-ref)
      next;
    }
    else {
      #### $config->{__stack}->{$key} = $config->{$key};
      # removed. a array of scalars (eg: option = [1,2,3]) cannot
      # be used for interpolation (which one shall we use?!), so
      # we ignore those types of lists.
      # found by fbicknel, fixes rt.cpan.org#41570
    }
    push @new, $entry;
  }

  return  \@new;
}

sub _clean_stack {
  #
  # recursively empty the variable stack
  #
  my ($this, $config) = @_;
  #return $config; # DEBUG
  foreach my $key (keys %{$config}) {
    if ($key eq "__stack") {
      delete $config->{__stack};
      next;
    }
    if (ref($config->{$key}) eq "ARRAY" ) {
      $config->{$key} = $this->_clean_array_stack($config->{$key});
    }
    elsif (ref($config->{$key}) eq "HASH") {
      $config->{$key} = $this->_clean_stack($config->{$key});
    }
  }
  return $config;
}


sub _clean_array_stack {
  #
  # same as _var_hash_stacker but for arrayrefs
  #
  my ($this, $config) = @_;

  my @new;

  foreach my $entry (@{$config}) {
    if (ref($entry) eq "HASH") {
      $entry = $this->_clean_stack($entry);
    }
    elsif (ref($entry) eq "ARRAY") {
      # ignore this. Arrays of Arrays cannot be created/supported
      # with Config::General, because they are not accessible by
      # any key (anonymous array-ref)
      next;
    }
    push @new, $entry;
  }

  return  \@new;
}

1;

__END__


=head1 NAME

Config::General::Interpolated - Parse variables within Config files


=head1 SYNOPSIS

 use Config::General;
 $conf = Config::General->new(
    -ConfigFile      => 'configfile',
    -InterPolateVars => 1
 );

=head1 DESCRIPTION

This is an internal module which makes it possible to interpolate
Perl style variables in your config file (i.e. C<$variable>
or C<${variable}>).

Normally you don't call it directly.


=head1 VARIABLES

Variables can be defined everywhere in the config and can be used
afterwards as the value of an option. Variables cannot be used as
keys or as part of keys.

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 <tlinden |AT| cpan.org>
 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>.
Copyright 2002-2014 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.

See L<http://www.perl.com/perl/misc/Artistic.html>

=head1 VERSION

2.15

=cut

PK     ��iZ���<�9  �9    General/Extended.pmnu �[���        #
# Config::General::Extended - special Class based on Config::General
#
# Copyright (c) 2000-2014 Thomas Linden <tlinden |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies.
# Artistic License, same as perl itself. Have fun.
#

# namespace
package Config::General::Extended;

# yes we need the hash support of new() in 1.18 or higher!
use Config::General 1.18;

use FileHandle;
use Carp;
use Exporter ();
use vars qw(@ISA @EXPORT);

# inherit new() and so on from Config::General
@ISA = qw(Config::General Exporter);

use strict;


$Config::General::Extended::VERSION = "2.07";


sub new {
  croak "Deprecated method Config::General::Extended::new() called.\n"
       ."Use Config::General::new() instead and set the -ExtendedAccess flag.\n";
}


sub getbypath {
  my ($this, $path) = @_;
  my $xconfig = $this->{config};
  $path =~ s#^/##;
  $path =~ s#/$##;
  my @pathlist = split /\//, $path;
  my $index;
  foreach my $element (@pathlist) {
    if($element =~ /^([^\[]*)\[(\d+)\]$/) {
      $element = $1;
      $index   = $2;
    }
    else {
      $index = undef;
    }

    if(ref($xconfig) eq "ARRAY") {
      return {};
    }
    elsif (! exists $xconfig->{$element}) {
      return {};
    }

    if(ref($xconfig->{$element}) eq "ARRAY") {
      if(! defined($index) ) {
        #croak "$element is an array but you didn't specify an index to access it!\n";
        $xconfig = $xconfig->{$element};
      }
      else {
        if(exists $xconfig->{$element}->[$index]) {
          $xconfig = $xconfig->{$element}->[$index];
        }
        else {
          croak "$element doesn't have an element with index $index!\n";
        }
      }
    }
    else {
      $xconfig = $xconfig->{$element};
    }
  }

  return $xconfig;
}

sub obj {
  #
  # returns a config object from a given key
  # or from the current config hash if the $key does not exist
  # or an empty object if the content of $key is empty.
  #
  my($this, $key) = @_;

  # just create the empty object, just in case
  my $empty = $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => {}, %{$this->{Params}} );

  if (exists $this->{config}->{$key}) {
    if (!$this->{config}->{$key}) {
      # be cool, create an empty object!
      return $empty
    }
    elsif (ref($this->{config}->{$key}) eq "ARRAY") {
      my @objlist;
      foreach my $element (@{$this->{config}->{$key}}) {
	if (ref($element) eq "HASH") {
	  push @objlist,
	    $this->SUPER::new( -ExtendedAccess => 1,
			       -ConfigHash     => $element,
			       %{$this->{Params}} );
	}
	else {
	  if ($this->{StrictObjects}) {
	    croak "element in list \"$key\" does not point to a hash reference!\n";
	  }
	  # else: skip this element
	}
      }
      return \@objlist;
    }
    elsif (ref($this->{config}->{$key}) eq "HASH") {
      return $this->SUPER::new( -ExtendedAccess => 1,
				-ConfigHash => $this->{config}->{$key}, %{$this->{Params}} );
    }
    else {
      # nothing supported
      if ($this->{StrictObjects}) {
	croak "key \"$key\" does not point to a hash reference!\n";
      }
      else {
	# be cool, create an empty object!
	return $empty;
      }
    }
  }
  else {
    # even return an empty object if $key does not exist
    return $empty;
  }
}


sub value {
  #
  # returns a value of the config hash from a given key
  # this can be a hashref or a scalar
  #
  my($this, $key, $value) = @_;
  if (defined $value) {
    $this->{config}->{$key} = $value;
  }
  else {
    if (exists $this->{config}->{$key}) {
      return $this->{config}->{$key};
    }
    else {
      if ($this->{StrictObjects}) {
	croak "Key \"$key\" does not exist within current object\n";
      }
      else {
	return "";
      }
    }
  }
}


sub hash {
  #
  # returns a value of the config hash from a given key
  # as hash
  #
  my($this, $key) = @_;
  if (exists $this->{config}->{$key}) {
    return %{$this->{config}->{$key}};
  }
  else {
    if ($this->{StrictObjects}) {
      croak "Key \"$key\" does not exist within current object\n";
    }
    else {
      return ();
    }
  }
}


sub array {
  #
  # returns a value of the config hash from a given key
  # as array
  #
  my($this, $key) = @_;
  if (exists $this->{config}->{$key}) {
    return @{$this->{config}->{$key}};
  }
  if ($this->{StrictObjects}) {
      croak "Key \"$key\" does not exist within current object\n";
    }
  else {
    return ();
  }
}


sub is_hash {
  #
  # return true if the given key contains a hashref
  #
  my($this, $key) = @_;
  if (exists $this->{config}->{$key}) {
    if (ref($this->{config}->{$key}) eq "HASH") {
      return 1;
    }
    else {
      return;
    }
  }
  else {
    return;
  }
}


sub is_array {
  #
  # return true if the given key contains an arrayref
  #
  my($this, $key) = @_;
  if (exists $this->{config}->{$key}) {
    if (ref($this->{config}->{$key}) eq "ARRAY") {
      return 1;
    }
    else {
      return;
    }
  }
  else {
    return;
  }
}


sub is_scalar {
  #
  # returns true if the given key contains a scalar(or number)
  #
  my($this, $key) = @_;
  if (exists $this->{config}->{$key} && !ref($this->{config}->{$key})) {
    return 1;
  }
  return;
}


sub exists {
  #
  # returns true if the key exists
  #
  my($this, $key) = @_;
  if (exists $this->{config}->{$key}) {
    return 1;
  }
  else {
    return;
  }
}


sub keys {
  #
  # returns all keys under in the hash of the specified key, if
  # it contains keys (so it must be a hash!)
  #
  my($this, $key) = @_;
  if (!$key) {
    if (ref($this->{config}) eq "HASH") {
      return map { $_ } keys %{$this->{config}};
    }
    else {
      return ();
    }
  }
  elsif (exists $this->{config}->{$key} && ref($this->{config}->{$key}) eq "HASH") {
    return map { $_ } keys %{$this->{config}->{$key}};
  }
  else {
    return ();
  }
}


sub delete {
  #
  # delete the given key from the config, if any
  # and return what is deleted (just as 'delete $hash{key}' does)
  #
  my($this, $key) = @_;
  if (exists $this->{config}->{$key}) {
    return delete $this->{config}->{$key};
  }
  else {
    return undef;
  }
}


sub configfile {
  #
  # sets or returns the config filename
  #
  my($this,$file) = @_;
  if ($file) {
    $this->{configfile} = $file;
  }
  return $this->{configfile};
}

sub find {
  my $this = shift;
  my $key = shift;
  return undef unless $this->exists($key);
  if (@_) {
    return $this->obj($key)->find(@_);
  }
  else {
    return $this->obj($key);
  }
}

sub AUTOLOAD {
  #
  # returns the representing value, if it is a scalar.
  #
  my($this, $value) = @_;
  my $key = $Config::General::Extended::AUTOLOAD;  # get to know how we were called
  $key =~ s/.*:://; # remove package name!

  if (defined $value) {
    # just set $key to $value!
    $this->{config}->{$key} = $value;
  }
  elsif (exists $this->{config}->{$key}) {
    if ($this->is_hash($key)) {
      croak "Key \"$key\" points to a hash and cannot be automatically accessed\n";
    }
    elsif ($this->is_array($key)) {
      croak "Key \"$key\" points to an array and cannot be automatically accessed\n";
    }
    else {
      return $this->{config}->{$key};
    }
  }
  else {
    if ($this->{StrictObjects}) {
      croak "Key \"$key\" does not exist within current object\n";
    }
    else {
      # be cool
      return undef; # bugfix rt.cpan.org#42331
    }
  }
}

sub DESTROY {
  my $this = shift;
  $this = ();
}

# keep this one
1;


=head1 NAME

Config::General::Extended - Extended access to Config files


=head1 SYNOPSIS

 use Config::General;

 $conf = Config::General->new(
    -ConfigFile     => 'configfile',
    -ExtendedAccess => 1
 );

=head1 DESCRIPTION

This is an internal module which makes it possible to use object
oriented methods to access parts of your config file.

Normally you don't call it directly.

=head1 METHODS

=over

=item configfile('filename')

Set the filename to be used by B<save> to "filename". It returns the current
configured filename if called without arguments.


=item obj('key')

Returns a new object (of Config::General::Extended Class) from the given key.
Short example:
Assume you have the following config:

 <individual>
      <martin>
         age   23
      </martin>
      <joseph>
         age   56
      </joseph>
 </individual>
 <other>
      blah     blubber
      blah     gobble
      leer
 </other>

and already read it in using B<Config::General::Extended::new()>, then you can get a
new object from the "individual" block this way:

 $individual = $conf->obj("individual");

Now if you call B<getall> on I<$individual> (just for reference) you would get:

 $VAR1 = (
    martin => { age => 13 }
         );

Or, here is another use:

 my $individual = $conf->obj("individual");
 foreach my $person ($conf->keys("individual")) {
    $man = $individual->obj($person);
    print "$person is " . $man->value("age") . " years old\n";
 }

See the discussion on B<hash()> and B<value()> below.

If the key from which you want to create a new object is empty, an empty
object will be returned. If you run the following on the above config:

 $obj = $conf->obj("other")->obj("leer");

Then $obj will be empty, just like if you have had run this:

 $obj = Config::General::Extended->new( () );

Read operations on this empty object will return nothing or even fail.
But you can use an empty object for I<creating> a new config using write
operations, i.e.:

 $obj->someoption("value");

See the discussion on B<AUTOLOAD METHODS> below.

If the key points to a list of hashes, a list of objects will be
returned. Given the following example config:

 <option>
   name = max
 </option>
 <option>
   name = bea
 </option>

you could write code like this to access the list the OOP way:

 my $objlist = $conf->obj("option");
 foreach my $option (@{$objlist}) {
  print $option->name;
 }

Please note that the list will be returned as a reference to an array.

Empty elements or non-hash elements of the list, if any, will be skipped.

=item hash('key')

This method returns a hash(if it B<is> one!) from the config which is referenced by
"key". Given the sample config above you would get:

 my %sub_hash = $conf->hash("individual");
 print Dumper(\%sub_hash);
 $VAR1 = {
    martin => { age => 13 }
         };

=item array('key')

This the equivalent of B<hash()> mentioned above, except that it returns an array.
Again, we use the sample config mentioned above:

 $other = $conf->obj("other");
 my @blahs = $other->array("blah");
 print Dumper(\@blahs);
 $VAR1 = [ "blubber", "gobble" ];


=item value('key')

This method returns the scalar value of a given key. Given the following sample
config:

 name  = arthur
 age   = 23

you could do something like that:

 print $conf->value("name") . " is " . $conf->value("age") . " years old\n";


You can use this method also to set the value of "key" to something if you give over
a hash reference, array reference or a scalar in addition to the key. An example:

 $conf->value("key", \%somehash);
 # or
 $conf->value("key", \@somearray);
 # or
 $conf->value("key", $somescalar);

Please note, that this method does not complain about existing values within "key"!

=item is_hash('key') is_array('key') is_scalar('key')

As seen above, you can access parts of your current config using hash, array or scalar
methods. But you are right if you guess, that this might become problematic, if
for example you call B<hash()> on a key which is in real not a hash but a scalar. Under
normal circumstances perl would refuse this and die.

To avoid such behavior you can use one of the methods is_hash() is_array() is_scalar() to
check if the value of "key" is really what you expect it to be.

An example(based on the config example from above):

 if($conf->is_hash("individual") {
    $individual = $conf->obj("individual");
 }
 else {
    die "You need to configure a "individual" block!\n";
 }


=item exists('key')

This method returns just true if the given key exists in the config.


=item keys('key')

Returns an array of the keys under the specified "key". If you use the example
config above you could do that:

 print Dumper($conf->keys("individual");
 $VAR1 = [ "martin", "joseph" ];

If no key name was supplied, then the keys of the object itself will be returned.

You can use this method in B<foreach> loops as seen in an example above(obj() ).


=item delete('key')

This method removes the given key and all associated data from the internal
hash structure. If 'key' contained data, then this data will be returned,
otherwise undef will be returned.

=item find(@list)

Given a list of nodes, ->find will search for a tree that branches in
just this way, returning the Config::General::Extended object it finds
at the bottom if it exists.  You can also search partway down the tree
and ->find should return where you left off.

For example, given the values B<find (qw (A B C))> and the following
tree (</end> tags omitted for brevity):

 <A>
        <FOO>
                ...
        <B>
                <BAZ>
                        ...
                <C>
                        BAR = shoo

B<find()> will find the object at I<C> with the value BAR = shoo and
return it.


=back


=head1 AUTOLOAD METHODS

Another useful feature is implemented in this class using the B<AUTOLOAD> feature
of perl. If you know the keynames of a block within your config, you can access to
the values of each individual key using the method notation. See the following example
and you will get it:

We assume the following config:

 <person>
    name    = Moser
    prename = Peter
    birth   = 12.10.1972
 </person>

Now we read it in and process it:

 my $conf = Config::General::Extended->new("configfile");
 my $person = $conf->obj("person");
 print $person->prename . " " . $person->name . " is " . $person->age . " years old\n";

This notation supports only scalar values! You need to make sure, that the block
<person> does not contain any subblock or multiple identical options(which will become
an array after parsing)!

If you access a non-existent key this way, Config::General will croak an error.
You can turn this behavior off by setting B<-StrictObjects> to 0 or "no". In
this case undef will be returned.

Of course you can use this kind of methods for writing data too:

 $person->name("Neustein");

This changes the value of the "name" key to "Neustein". This feature behaves exactly like
B<value()>, which means you can assign hash or array references as well and that existing
values under the given key will be overwritten.


=head1 COPYRIGHT

Copyright (c) 2000-2014 Thomas Linden

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.


=head1 BUGS

none known yet.


=head1 AUTHOR

Thomas Linden <tlinden |AT| cpan.org>

=head1 VERSION

2.07

=cut

PK     �#jZh-��Y  Y    PropertyConfigurator.pmnu �[���        package Log::Log4perl::Config::PropertyConfigurator;
use Log::Log4perl::Config::BaseConfigurator;

use warnings;
use strict;

our @ISA = qw(Log::Log4perl::Config::BaseConfigurator);

our %NOT_A_MULT_VALUE = map { $_ => 1 }
    qw(conversionpattern);

#poor man's export
*eval_if_perl = \&Log::Log4perl::Config::eval_if_perl;
*compile_if_perl = \&Log::Log4perl::Config::compile_if_perl;
*unlog4j      = \&Log::Log4perl::Config::unlog4j;

use constant _INTERNAL_DEBUG => 0;

our $COMMENT_REGEX = qr/[#;!]/;

################################################
sub parse {
################################################
    my($self, $newtext) = @_;

    $self->text($newtext) if defined $newtext;

    my $text = $self->{text};

    die "Config parser has nothing to parse" unless defined $text;

    my $data = {};
    my %var_subst = ();

    while (@$text) {
        local $_ = shift @$text;
        s/^\s*$COMMENT_REGEX.*//;
        next unless /\S/;
    
        my @parts = ();

        while (/(.+?)\\\s*$/) {
            my $prev = $1;
            my $next = shift(@$text);
            $next =~ s/^ +//g;  #leading spaces
            $next =~ s/^$COMMENT_REGEX.*//;
            $_ = $prev. $next;
            chomp;
        }

        if(my($key, $val) = /(\S+?)\s*=\s*(.*)/) {

            my $key_org = $key;

            $val =~ s/\s+$//;

                # Everything could potentially be a variable assignment
            $var_subst{$key} = $val;

                # Substitute any variables
            $val =~ s/\$\{(.*?)\}/
                      Log::Log4perl::Config::var_subst($1, \%var_subst)/gex;

            $key = unlog4j($key);

            my $how_deep = 0;
            my $ptr = $data;
            for my $part (split /\.|::/, $key) {
                push @parts, $part;
                $ptr->{$part} = {} unless exists $ptr->{$part};
                $ptr = $ptr->{$part};
                ++$how_deep;
            }

            #here's where we deal with turning multiple values like this:
            # log4j.appender.jabbender.to = him@a.jabber.server
            # log4j.appender.jabbender.to = her@a.jabber.server
            #into an arrayref like this:
            #to => { value => 
            #       ["him\@a.jabber.server", "her\@a.jabber.server"] },
            # 
            # This only is allowed for properties of appenders
            # not listed in %NOT_A_MULT_VALUE (see top of file).
            if (exists $ptr->{value} && 
                $how_deep > 2 &&
                defined $parts[0] && lc($parts[0]) eq "appender" && 
                defined $parts[2] && ! exists $NOT_A_MULT_VALUE{lc($parts[2])}
               ) {
                if (ref ($ptr->{value}) ne 'ARRAY') {
                    my $temp = $ptr->{value};
                    $ptr->{value} = [];
                    push (@{$ptr->{value}}, $temp);
                }
                push (@{$ptr->{value}}, $val);
            }else{
                if(defined $ptr->{value}) {
                    if(! $Log::Log4perl::Logger::NO_STRICT) {
                        die "$key_org redefined";
                    }
                }
                $ptr->{value} = $val;
            }
        }
    }
    $self->{data} = $data;
    return $data;
}

################################################
sub value {
################################################
  my($self, $path) = @_;

  $path = unlog4j($path);

  my @p = split /::/, $path;

  my $found = 0;
  my $r = $self->{data};

  while (my $n = shift @p) {
      if (exists $r->{$n}) {
          $r = $r->{$n};
          $found = 1;
      } else {
          $found = 0;
      }
  }

  if($found and exists $r->{value}) {
      return $r->{value};
  } else {
      return undef;
  }
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Config::PropertyConfigurator - reads properties file

=head1 SYNOPSIS

    # This class is used internally by Log::Log4perl

    use Log::Log4perl::Config::PropertyConfigurator;

    my $conf = Log::Log4perl::Config::PropertyConfigurator->new();
    $conf->file("l4p.conf");
    $conf->parse(); # will die() on error

    my $value = $conf->value("log4perl.appender.LOGFILE.filename");
   
    if(defined $value) {
        printf("The appender's file name is $value\n");
    } else {
        printf("The appender's file name is not defined.\n");
    }

=head1 DESCRIPTION

Initializes log4perl from a properties file, stuff like

    log4j.category.a.b.c.d = WARN, A1
    log4j.category.a.b = INFO, A1

It also understands variable substitution, the following
configuration is equivalent to the previous one:

    settings = WARN, A1
    log4j.category.a.b.c.d = ${settings}
    log4j.category.a.b = INFO, A1

=head1 SEE ALSO

Log::Log4perl::Config

Log::Log4perl::Config::BaseConfigurator

Log::Log4perl::Config::DOMConfigurator

Log::Log4perl::Config::LDAPConfigurator (tbd!)

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �#jZ��W��!  �!    BaseConfigurator.pmnu �[���        package Log::Log4perl::Config::BaseConfigurator;

use warnings;
use strict;
use constant _INTERNAL_DEBUG => 0;

*eval_if_perl      = \&Log::Log4perl::Config::eval_if_perl;
*compile_if_perl   = \&Log::Log4perl::Config::compile_if_perl;
*leaf_path_to_hash = \&Log::Log4perl::Config::leaf_path_to_hash;

################################################
sub new {
################################################
    my($class, %options) = @_;

    my $self = { 
        utf8 => 0,
        %options,
    };

    bless $self, $class;

    $self->file($self->{file}) if exists $self->{file};
    $self->text($self->{text}) if exists $self->{text};

    return $self;
}

################################################
sub text {
################################################
    my($self, $text) = @_;

        # $text is an array of scalars (lines)
    if(defined $text) {
        if(ref $text eq "ARRAY") {
            $self->{text} = $text;
        } else {
            $self->{text} = [split "\n", $text];
        }
    }

    return $self->{text};
}

################################################
sub file {
################################################
    my($self, $filename) = @_;

    open my $fh, "$filename" or die "Cannot open $filename ($!)";

    if( $self->{ utf8 } ) {
        binmode $fh, ":utf8";
    }

    $self->file_h_read( $fh );
    close $fh;
}

################################################
sub file_h_read {
################################################
    my($self, $fh) = @_;

        # Dennis Gregorovic <dgregor@redhat.com> added this
        # to protect apps which are tinkering with $/ globally.
    local $/ = "\n";

    $self->{text} = [<$fh>];
}

################################################
sub parse {
################################################
    die __PACKAGE__ . "::parse() is a virtual method. " .
        "It must be implemented " .
        "in a derived class (currently: ", ref(shift), ")";
}

################################################
sub parse_post_process {
################################################
    my($self, $data, $leaf_paths) = @_;
    
    #   [
    #     'category',
    #     'value',
    #     'WARN, Logfile'
    #   ],
    #   [
    #     'appender',
    #     'Logfile',
    #     'value',
    #     'Log::Log4perl::Appender::File'
    #   ],
    #   [
    #     'appender',
    #     'Logfile',
    #     'filename',
    #     'value',
    #     'test.log'
    #   ],
    #   [
    #     'appender',
    #     'Logfile',
    #     'layout',
    #     'value',
    #     'Log::Log4perl::Layout::PatternLayout'
    #   ],
    #   [
    #     'appender',
    #     'Logfile',
    #     'layout',
    #     'ConversionPattern',
    #     'value',
    #     '%d %F{1} %L> %m %n'
    #   ]

    for my $path ( @{ Log::Log4perl::Config::leaf_paths( $data )} ) {

        print "path=@$path\n" if _INTERNAL_DEBUG;

        if(0) {
        } elsif( 
            $path->[0] eq "appender" and
            $path->[2] eq "trigger"
          ) {
            my $ref = leaf_path_to_hash( $path, $data );
            my $code = compile_if_perl( $$ref );

            if(_INTERNAL_DEBUG) {
                if($code) {
                    print "Code compiled: $$ref\n";
                } else {
                    print "Not compiled: $$ref\n";
                }
            }

            $$ref = $code if defined $code;
        } elsif (
            $path->[0] eq "filter"
          ) {
            # do nothing
        } elsif (
            $path->[0] eq "appender" and
            $path->[2] eq "warp_message"
          ) {
            # do nothing
        } elsif (
            $path->[0] eq "appender" and
            $path->[3] eq "cspec" or
            $path->[1] eq "cspec"
          ) {
              # could be either
              #    appender appndr layout cspec
              # or 
              #    PatternLayout cspec U value ...
              #
            # do nothing
        } else {
            my $ref = leaf_path_to_hash( $path, $data );

            if(_INTERNAL_DEBUG) {
                print "Calling eval_if_perl on $$ref\n";
            }

            $$ref = eval_if_perl( $$ref );
        }
    }

    return $data;
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Config::BaseConfigurator - Configurator Base Class

=head1 SYNOPSIS

This is a virtual base class, all configurators should be derived from it.

=head1 DESCRIPTION

=head2 METHODS

=over 4

=item C<< new >>

Constructor, typically called like

    my $config_parser = SomeConfigParser->new(
        file => $file,
    );

    my $data = $config_parser->parse();

Instead of C<file>, the derived class C<SomeConfigParser> may define any 
type of configuration input medium (e.g. C<url =E<gt> 'http://foobar'>).
It just has to make sure its C<parse()> method will later pull the input
data from the medium specified.

The base class accepts a filename or a reference to an array
of text lines:

=over 4

=item C<< file >>

Specifies a file which the C<parse()> method later parses.

=item C<< text >>

Specifies a reference to an array of scalars, representing configuration
records (typically lines of a file). Also accepts a simple scalar, which it 
splits at its newlines and transforms it into an array:

    my $config_parser = MyYAMLParser->new(
        text => ['foo: bar',
                 'baz: bam',
                ],
    );

    my $data = $config_parser->parse();

=back

If either C<file> or C<text> parameters have been specified in the 
constructor call, a later call to the configurator's C<text()> method
will return a reference to an array of configuration text lines.
This will typically be used by the C<parse()> method to process the 
input.

=item C<< parse >>

Virtual method, needs to be defined by the derived class.

=back

=head2 Parser requirements

=over 4

=item *

If the parser provides variable substitution functionality, it has
to implement it.

=item *

The parser's C<parse()> method returns a reference to a hash of hashes (HoH). 
The top-most hash contains the
top-level keywords (C<category>, C<appender>) as keys, associated
with values which are references to more deeply nested hashes.

=item *

The C<log4perl.> prefix (e.g. as used in the PropertyConfigurator class)
is stripped, it's not part in the HoH structure.

=item *

Each Log4perl config value is indicated by the C<value> key, as in

    $data->{category}->{Bar}->{Twix}->{value} = "WARN, Logfile"

=back

=head2 EXAMPLES

The following Log::Log4perl configuration:

    log4perl.category.Bar.Twix        = WARN, Screen
    log4perl.appender.Screen          = Log::Log4perl::Appender::File
    log4perl.appender.Screen.filename = test.log
    log4perl.appender.Screen.layout   = Log::Log4perl::Layout::SimpleLayout

needs to be transformed by the parser's C<parse()> method 
into this data structure:

    { appender => {
        Screen  => {
          layout => { 
            value  => "Log::Log4perl::Layout::SimpleLayout" },
            value  => "Log::Log4perl::Appender::Screen",
        },
      },
      category => { 
        Bar => { 
          Twix => { 
            value => "WARN, Screen" } 
        } }
    }

For a full-fledged example, check out the sample YAML parser implementation 
in C<eg/yamlparser>. It uses a simple YAML syntax to specify the Log4perl 
configuration to illustrate the concept.

=head1 SEE ALSO

Log::Log4perl::Config::PropertyConfigurator

Log::Log4perl::Config::DOMConfigurator

Log::Log4perl::Config::LDAPConfigurator (tbd!)

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �#jZ����j  �j    DOMConfigurator.pmnu �[���        package Log::Log4perl::Config::DOMConfigurator;
use Log::Log4perl::Config::BaseConfigurator;

our @ISA = qw(Log::Log4perl::Config::BaseConfigurator);

#todo
# DONE(param-text) some params not attrs but values, like <sql>...</sql>
# DONE see DEBUG!!!  below
# NO, (really is only used for AsyncAppender) appender-ref in <appender>
# DONE check multiple appenders in a category
# DONE in Config.pm re URL loading, steal from XML::DOM
# DONE, OK see PropConfigurator re importing unlog4j, eval_if_perl
# NO (is specified in DTD) - need to handle 0/1, true/false?
# DONEsee Config, need to check version of XML::DOM
# OK user defined levels? see parse_level
# OK make sure 2nd test is using log4perl constructs, not log4j
# OK handle new filter stuff
# make sure sample code actually works
# try removing namespace prefixes in the xml

use XML::DOM;
use Log::Log4perl::Level;
use strict;

use constant _INTERNAL_DEBUG => 0;

our $VERSION = 0.03;

our $APPENDER_TAG = qr/^((log4j|log4perl):)?appender$/;

our $FILTER_TAG = qr/^(log4perl:)?filter$/;
our $FILTER_REF_TAG = qr/^(log4perl:)?filter-ref$/;

#can't use ValParser here because we're using namespaces? 
#doesn't seem to work - kg 3/2003 
our $PARSER_CLASS = 'XML::DOM::Parser';

our $LOG4J_PREFIX = 'log4j';
our $LOG4PERL_PREFIX = 'log4perl';
    

#poor man's export
*eval_if_perl = \&Log::Log4perl::Config::eval_if_perl;
*unlog4j      = \&Log::Log4perl::Config::unlog4j;


###################################################
sub parse {
###################################################
    my($self, $newtext) = @_;

    $self->text($newtext) if defined $newtext;
    my $text = $self->{text};

    my $parser = $PARSER_CLASS->new;
    my $doc = $parser->parse (join('',@$text));


    my $l4p_tree = {};
    
    my $config = $doc->getElementsByTagName("$LOG4J_PREFIX:configuration")->item(0)||
                 $doc->getElementsByTagName("$LOG4PERL_PREFIX:configuration")->item(0);

    my $threshold = uc(subst($config->getAttribute('threshold')));
    if ($threshold) {
        $l4p_tree->{threshold}{value} = $threshold;
    }

    if (subst($config->getAttribute('oneMessagePerAppender')) eq 'true') {
        $l4p_tree->{oneMessagePerAppender}{value} = 1;
    }

    for my $kid ($config->getChildNodes){

        next unless $kid->getNodeType == ELEMENT_NODE;

        my $tag_name = $kid->getTagName;

        if ($tag_name =~ $APPENDER_TAG) {
            &parse_appender($l4p_tree, $kid);

        }elsif ($tag_name eq 'category' || $tag_name eq 'logger'){
            &parse_category($l4p_tree, $kid);
            #Treating them the same is not entirely accurate, 
            #the dtd says 'logger' doesn't accept
            #a 'class' attribute while 'category' does.
            #But that's ok, log4perl doesn't do anything with that attribute

        }elsif ($tag_name eq 'root'){
            &parse_root($l4p_tree, $kid);

        }elsif ($tag_name =~ $FILTER_TAG){
            #parse log4perl's chainable boolean filters
            &parse_l4p_filter($l4p_tree, $kid);

        }elsif ($tag_name eq 'renderer'){
            warn "Log4perl: ignoring renderer tag in config, unimplemented";
            #"log4j will render the content of the log message according to 
            # user specified criteria. For example, if you frequently need 
            # to log Oranges, an object type used in your current project, 
            # then you can register an OrangeRenderer that will be invoked 
            # whenever an orange needs to be logged. "
         
        }elsif ($tag_name eq 'PatternLayout'){#log4perl only
            &parse_patternlayout($l4p_tree, $kid);
        }
    }
    $doc->dispose;

    return $l4p_tree;
}

#this is just for toplevel log4perl.PatternLayout tags
#holding the custome cspecs
sub parse_patternlayout {
    my ($l4p_tree, $node) = @_;

    my $l4p_branch = {};

    for my $child ($node->getChildNodes) {
        next unless $child->getNodeType == ELEMENT_NODE;

        my $name = subst($child->getAttribute('name'));
        my $value;

        foreach my $grandkid ($child->getChildNodes){
            if ($grandkid->getNodeType == TEXT_NODE) {
                $value .= $grandkid->getData;
            }
        }
        $value =~ s/^ +//;  #just to make the unit tests pass
        $value =~ s/ +$//;
        $l4p_branch->{$name}{value} = subst($value);
    }
    $l4p_tree->{PatternLayout}{cspec} = $l4p_branch;
}


#for parsing the root logger, if any
sub parse_root {
    my ($l4p_tree, $node) = @_;

    my $l4p_branch = {};

    &parse_children_of_logger_element($l4p_branch, $node);

    $l4p_tree->{category}{value} = $l4p_branch->{value};

}


#this parses a custom log4perl-specific filter set up under
#the root element, as opposed to children of the appenders
sub parse_l4p_filter {
    my ($l4p_tree, $node) = @_;

    my $l4p_branch = {};

    my $name = subst($node->getAttribute('name'));

    my $class = subst($node->getAttribute('class'));
    my $value = subst($node->getAttribute('value'));

    if ($class && $value) {
        die "Log4perl: only one of class or value allowed, not both, "
            ."in XMLConfig filter '$name'";
    }elsif ($class || $value){
        $l4p_branch->{value} = ($value || $class);

    }

    for my $child ($node->getChildNodes) {

        if ($child->getNodeType == ELEMENT_NODE){

            my $tag_name = $child->getTagName();

            if ($tag_name =~ /^(param|param-nested|param-text)$/) {
                &parse_any_param($l4p_branch, $child);
            }
        }elsif ($child->getNodeType == TEXT_NODE){
            my $text = $child->getData;
            next unless $text =~ /\S/;
            if ($class && $value) {
                die "Log4perl: only one of class, value or PCDATA allowed, "
                    ."in XMLConfig filter '$name'";
            }
            $l4p_branch->{value} .= subst($text); 
        }
    }

    $l4p_tree->{filter}{$name} = $l4p_branch;
}

   
#for parsing a category/logger element
sub parse_category {
    my ($l4p_tree, $node) = @_;

    my $name = subst($node->getAttribute('name'));

    $l4p_tree->{category} ||= {};
 
    my $ptr = $l4p_tree->{category};

    for my $part (split /\.|::/, $name) {
        $ptr->{$part} = {} unless exists $ptr->{$part};
        $ptr = $ptr->{$part};
    }

    my $l4p_branch = $ptr;

    my $class = subst($node->getAttribute('class'));
    $class                       && 
       $class ne 'Log::Log4perl' &&
       $class ne 'org.apache.log4j.Logger' &&
       warn "setting category $name to class $class ignored, only Log::Log4perl implemented";

    #this is kind of funky, additivity has its own spot in the tree
    my $additivity = subst(subst($node->getAttribute('additivity')));
    if (length $additivity > 0) {
        $l4p_tree->{additivity} ||= {};
        my $add_ptr = $l4p_tree->{additivity};

        for my $part (split /\.|::/, $name) {
            $add_ptr->{$part} = {} unless exists $add_ptr->{$part};
            $add_ptr = $add_ptr->{$part};
        }
        $add_ptr->{value} = &parse_boolean($additivity);
    }

    &parse_children_of_logger_element($l4p_branch, $node);
}

# parses the children of a category element
sub parse_children_of_logger_element {
    my ($l4p_branch, $node) = @_;

    my (@appenders, $priority);

    for my $child ($node->getChildNodes) {
        next unless $child->getNodeType == ELEMENT_NODE;
            
        my $tag_name = $child->getTagName();

        if ($tag_name eq 'param') {
            my $name = subst($child->getAttribute('name'));
            my $value = subst($child->getAttribute('value'));
            if ($value =~ /^(all|debug|info|warn|error|fatal|off|null)^/) {
                $value = uc $value;
            }
            $l4p_branch->{$name} = {value => $value};
        
        }elsif ($tag_name eq 'appender-ref'){
            push @appenders, subst($child->getAttribute('ref'));
            
        }elsif ($tag_name eq 'level' || $tag_name eq 'priority'){
            $priority = &parse_level($child);
        }
    }
    $l4p_branch->{value} = $priority.', '.join(',', @appenders);
    
    return;
}


sub parse_level {
    my $node = shift;

    my $level = uc (subst($node->getAttribute('value')));

    die "Log4perl: invalid level in config: $level"
        unless Log::Log4perl::Level::is_valid($level);

    return $level;
}


sub parse_appender {
    my ($l4p_tree, $node) = @_;

    my $name = subst($node->getAttribute("name"));

    my $l4p_branch = {};

    my $class = subst($node->getAttribute("class"));

    $l4p_branch->{value} = $class;

    print "looking at $name----------------------\n"  if _INTERNAL_DEBUG;

    for my $child ($node->getChildNodes) {
        next unless $child->getNodeType == ELEMENT_NODE;

        my $tag_name = $child->getTagName();

        my $name = unlog4j(subst($child->getAttribute('name')));

        if ($tag_name =~ /^(param|param-nested|param-text)$/) {

            &parse_any_param($l4p_branch, $child);

            my $value;

        }elsif ($tag_name =~ /($LOG4PERL_PREFIX:)?layout/){
            $l4p_branch->{layout} = parse_layout($child);

        }elsif ($tag_name =~  $FILTER_TAG){
            $l4p_branch->{Filter} = parse_filter($child);

        }elsif ($tag_name =~ $FILTER_REF_TAG){
            $l4p_branch->{Filter} = parse_filter_ref($child);

        }elsif ($tag_name eq 'errorHandler'){
            die "errorHandlers not supported yet";

        }elsif ($tag_name eq 'appender-ref'){
            #dtd: Appenders may also reference (or include) other appenders. 
            #This feature in log4j is only for appenders who implement the 
            #AppenderAttachable interface, and the only one that does that
            #is the AsyncAppender, which writes logs in a separate thread.
            #I don't see the need to support this on the perl side any 
            #time soon.  --kg 3/2003
            die "Log4perl: in config file, <appender-ref> tag is unsupported in <appender>";
        }else{
            die "Log4perl: in config file, <$tag_name> is unsupported\n";
        }
    }
    $l4p_tree->{appender}{$name} = $l4p_branch;
}

sub parse_any_param {
    my ($l4p_branch, $child) = @_;

    my $tag_name = $child->getTagName();
    my $name = subst($child->getAttribute('name'));
    my $value;

    print "parse_any_param: <$tag_name name=$name\n" if _INTERNAL_DEBUG;

    #<param-nested>
    #note we don't set it to { value => $value }
    #and we don't test for multiple values
    if ($tag_name eq 'param-nested'){
        
        if ($l4p_branch->{$name}){
            die "Log4perl: in config file, multiple param-nested tags for $name not supported";
        }
        $l4p_branch->{$name} = &parse_param_nested($child); 

        return;

    #<param>
    }elsif ($tag_name eq 'param') {

         $value = subst($child->getAttribute('value'));

         print "parse_param_nested: got param $name = $value\n"  
             if _INTERNAL_DEBUG;
        
         if ($value =~ /^(all|debug|info|warn|error|fatal|off|null)$/) {
             $value = uc $value;
         }

         if ($name !~ /warp_message|filter/ &&
            $child->getParentNode->getAttribute('name') ne 'cspec') {
            $value = eval_if_perl($value);
         }
    #<param-text>
    }elsif ($tag_name eq 'param-text'){

        foreach my $grandkid ($child->getChildNodes){
            if ($grandkid->getNodeType == TEXT_NODE) {
                $value .= $grandkid->getData;
            }
        }
        if ($name !~ /warp_message|filter/ &&
            $child->getParentNode->getAttribute('name') ne 'cspec') {
            $value = eval_if_perl($value);
        }
    }

    $value = subst($value);

     #multiple values for the same param name
     if (defined $l4p_branch->{$name}{value} ) {
         if (ref $l4p_branch->{$name}{value} ne 'ARRAY'){
             my $temp = $l4p_branch->{$name}{value};
             $l4p_branch->{$name}{value} = [$temp];
         }
         push @{$l4p_branch->{$name}{value}}, $value;
     }else{
         $l4p_branch->{$name} = {value => $value};
     }
}

#handles an appender's <param-nested> elements
sub parse_param_nested {
    my ($node) = shift;

    my $l4p_branch = {};

    for my $child ($node->getChildNodes) {
        next unless $child->getNodeType == ELEMENT_NODE;

        my $tag_name = $child->getTagName();

        if ($tag_name =~ /^param|param-nested|param-text$/) {
            &parse_any_param($l4p_branch, $child);
        }
    }

    return $l4p_branch;
}

#this handles filters that are children of appenders, as opposed
#to the custom filters that go under the root element
sub parse_filter {
    my $node = shift;

    my $filter_tree = {};

    my $class_name = subst($node->getAttribute('class'));

    $filter_tree->{value} = $class_name;

    print "\tparsing filter on class $class_name\n"  if _INTERNAL_DEBUG;  

    for my $child ($node->getChildNodes) {
        next unless $child->getNodeType == ELEMENT_NODE;

        my $tag_name = $child->getTagName();

        if ($tag_name =~ 'param|param-nested|param-text') {
            &parse_any_param($filter_tree, $child);
        
        }else{
            die "Log4perl: don't know what to do with a ".$child->getTagName()
                ."inside a filter element";
        }
    }
    return $filter_tree;
}

sub parse_filter_ref {
    my $node = shift;

    my $filter_tree = {};

    my $filter_id = subst($node->getAttribute('id'));

    $filter_tree->{value} = $filter_id;

    return $filter_tree;
}


sub parse_layout {
    my $node = shift;

    my $layout_tree = {};

    my $class_name = subst($node->getAttribute('class'));
    
    $layout_tree->{value} = $class_name;
    #
    print "\tparsing layout $class_name\n"  if _INTERNAL_DEBUG;  
    for my $child ($node->getChildNodes) {
        next unless $child->getNodeType == ELEMENT_NODE;
        if ($child->getTagName() eq 'param') {
            my $name = subst($child->getAttribute('name'));
            my $value = subst($child->getAttribute('value'));
            if ($value =~ /^(all|debug|info|warn|error|fatal|off|null)$/) {
                $value = uc $value;
            }
            print "\tparse_layout: got param $name = $value\n"
                if _INTERNAL_DEBUG;
            $layout_tree->{$name}{value} = $value;  

        }elsif ($child->getTagName() eq 'cspec') {
            my $name = subst($child->getAttribute('name'));
            my $value;
            foreach my $grandkid ($child->getChildNodes){
                if ($grandkid->getNodeType == TEXT_NODE) {
                    $value .= $grandkid->getData;
                }
            }
            $value =~ s/^ +//;
            $value =~ s/ +$//;
            $layout_tree->{cspec}{$name}{value} = subst($value);  
        }
    }
    return $layout_tree;
}

sub parse_boolean {
    my $a = shift;

    if ($a eq '0' || lc $a eq 'false') {
        return '0';
    }elsif ($a eq '1' || lc $a eq 'true'){
        return '1';
    }else{
        return $a; #probably an error, punt
    }
}


#this handles variable substitution
sub subst {
    my $val = shift;

    $val =~ s/\$\{(.*?)}/
                      Log::Log4perl::Config::var_subst($1, {})/gex;
    return $val;
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Config::DOMConfigurator - reads xml config files

=head1 SYNOPSIS

    --------------------------
    --using the log4j DTD--
    --------------------------

    <?xml version="1.0" encoding="UTF-8"?>
    <!DOCTYPE log4j:configuration SYSTEM "log4j.dtd">

    <log4j:configuration xmlns:log4j="http://jakarta.apache.org/log4j/">

    <appender name="FileAppndr1" class="org.apache.log4j.FileAppender">
        <layout class="Log::Log4perl::Layout::PatternLayout">
                <param name="ConversionPattern"
                       value="%d %4r [%t] %-5p %c %t - %m%n"/>
        </layout>
        <param name="File" value="t/tmp/DOMtest"/>
        <param name="Append" value="false"/>
    </appender>

    <category name="a.b.c.d" additivity="false">
        <level value="warn"/>  <!-- note lowercase! -->
        <appender-ref ref="FileAppndr1"/>
    </category>

   <root>
        <priority value="warn"/>
        <appender-ref ref="FileAppndr1"/>
   </root>

   </log4j:configuration>
   
   
   --------------------------
   --using the log4perl DTD--
   --------------------------
   
   <?xml version="1.0" encoding="UTF-8"?>
    <!DOCTYPE log4perl:configuration SYSTEM "log4perl.dtd">

    <log4perl:configuration xmlns:log4perl="http://log4perl.sourceforge.net/"
        threshold="debug" oneMessagePerAppender="true">

    <log4perl:appender name="jabbender" class="Log::Dispatch::Jabber">

            <param-nested name="login">
                   <param name="hostname" value="a.jabber.server"/>
                   <param name="password" value="12345"/>
                   <param name="port"     value="5222"/>
                   <param name="resource" value="logger"/>
                   <param name="username" value="bobjones"/>
            </param-nested>

            <param name="to" value="bob@a.jabber.server"/>

            <param-text name="to">
                  mary@another.jabber.server
            </param-text>

            <log4perl:layout class="org.apache.log4j.PatternLayout">
                <param name="ConversionPattern" value = "%K xx %G %U"/>
                <cspec name="K">
                    sub { return sprintf "%1x", $$}
                </cspec>
                <cspec name="G">
                    sub {return 'thisistheGcspec'}
                </cspec>
            </log4perl:layout>
    </log4perl:appender>

    <log4perl:appender name="DBAppndr2" class="Log::Log4perl::Appender::DBI">
              <param name="warp_message" value="0"/>
              <param name="datasource" value="DBI:CSV:f_dir=t/tmp"/>
              <param name="bufferSize" value="2"/>
              <param name="password" value="sub { $ENV{PWD} }"/>
              <param name="username" value="bobjones"/>

              <param-text name="sql">
                  INSERT INTO log4perltest
                            (loglevel, message, shortcaller, thingid,
                            category, pkg, runtime1, runtime2)
                  VALUES
                             (?,?,?,?,?,?,?,?)
              </param-text>

               <param-nested name="params">
                    <param name="1" value="%p"/>
                    <param name="3" value="%5.5l"/>
                    <param name="5" value="%c"/>
                    <param name="6" value="%C"/>
               </param-nested>

               <layout class="Log::Log4perl::Layout::NoopLayout"/>
    </log4perl:appender>

    <category name="animal.dog">
               <priority value="info"/>
               <appender-ref ref="jabbender"/>
               <appender-ref ref="DBAppndr2"/>
    </category>

    <category name="plant">
            <priority value="debug"/>
            <appender-ref ref="DBAppndr2"/>
    </category>

    <PatternLayout>
        <cspec name="U"><![CDATA[
            sub {
                return "UID $< GID $(";
            }
        ]]></cspec>
    </PatternLayout>

    </log4perl:configuration>
    

=head1 DESCRIPTION

This module implements an XML config, complementing the properties-style
config described elsewhere.

=head1 WHY

"Why would I want my config in XML?" you ask.  Well, there are a couple
reasons you might want to.  Maybe you have a personal preference
for XML.  Maybe you manage your config with other tools that have an
affinity for XML, like XML-aware editors or automated config
generators.  Or maybe (and this is the big one) you don't like
having to run your application just to check the syntax of your
config file.

By using an XML config and referencing a DTD, you can use a namespace-aware
validating parser to see if your XML config at least follows the rules set 
in the DTD. 

=head1 HOW

To reference a DTD, drop this in after the <?xml...> declaration
in your config file:

    <!DOCTYPE log4perl:configuration SYSTEM "log4perl.dtd">

That tells the parser to validate your config against the DTD in
"log4perl.dtd", which is available in the xml/ directory of
the log4perl distribution.  Note that you'll also need to grab
the log4j-1.2.dtd from there as well, since the it's included
by log4perl.dtd.

Namespace-aware validating parsers are not the norm in Perl.  
But the Xerces project 
(http://xml.apache.org/xerces-c/index.html --lots of binaries available, 
even rpm's)  does provide just such a parser
that you can use like this:

    StdInParse -ns -v < my-log4perl-config.xml

This module itself does not use a validating parser, the obvious
one XML::DOM::ValParser doesn't seem to handle namespaces.

=head1 WHY TWO DTDs

The log4j DTD is from the log4j project, they designed it to 
handle their needs.  log4perl has added some extensions to the 
original log4j functionality which needed some extensions to the
log4j DTD.  If you aren't using these features then you can validate
your config against the log4j dtd and know that you're using
unadulterated log4j config tags.   

The features added by the log4perl dtd are:

=over 4

=item 1 oneMessagePerAppender global setting

    log4perl.oneMessagePerAppender=1

=item 2 globally defined user conversion specifiers

    log4perl.PatternLayout.cspec.G=sub { return "UID $< GID $("; }

=item 3 appender-local custom conversion specifiers

     log4j.appender.appndr1.layout.cspec.K = sub {return sprintf "%1x", $$ }

=item 4 nested options

     log4j.appender.jabbender          = Log::Dispatch::Jabber
     #(note how these are nested under 'login')
     log4j.appender.jabbender.login.hostname = a.jabber.server
     log4j.appender.jabbender.login.port     = 5222
     log4j.appender.jabbender.login.username = bobjones

=item 5 the log4perl-specific filters, see L<Log::Log4perl::Filter>,
lots of examples in t/044XML-Filter.t, here's a short one:


  <?xml version="1.0" encoding="UTF-8"?> 
  <!DOCTYPE log4perl:configuration SYSTEM "log4perl.dtd">

  <log4perl:configuration xmlns:log4perl="http://log4perl.sourceforge.net/">
   
  <appender name="A1" class="Log::Log4perl::Appender::TestBuffer">
        <layout class="Log::Log4perl::Layout::SimpleLayout"/>
        <filter class="Log::Log4perl::Filter::Boolean">
            <param name="logic" value="!Match3 &amp;&amp; (Match1 || Match2)"/> 
        </filter>
  </appender>   
  
  <appender name="A2" class="Log::Log4perl::Appender::TestBuffer">
        <layout class="Log::Log4perl::Layout::SimpleLayout"/>
        <filter-ref id="Match1"/>
  </appender>   
  
  <log4perl:filter name="Match1" value="sub { /let this through/ }" />
  
  <log4perl:filter name="Match2">
        sub { 
            /and that, too/ 
        }
   </log4perl:filter>
  
  <log4perl:filter name="Match3" class="Log::Log4perl::Filter::StringMatch">
    <param name="StringToMatch" value="suppress"/>
    <param name="AcceptOnMatch" value="true"/>
  </log4perl:filter>
  
  <log4perl:filter name="MyBoolean" class="Log::Log4perl::Filter::Boolean">
    <param name="logic" value="!Match3 &amp;&amp; (Match1 || Match2)"/>
  </log4perl:filter>
  
   
   <root>
           <priority value="info"/>
           <appender-ref ref="A1"/>
   </root>
   
   </log4perl:configuration>


=back


So we needed to extend the log4j dtd to cover these additions.
Now I could have just taken a 'steal this code' approach and mixed
parts of the log4j dtd into a log4perl dtd, but that would be
cut-n-paste programming.  So I've used namespaces and

=over 4

=item * 

replaced three elements:

=over 4

=item <log4perl:configuration>

handles #1) and accepts <PatternLayout>

=item <log4perl:appender> 

accepts <param-nested> and <param-text>

=item <log4perl:layout> 

accepts custom cspecs for #3)

=back

=item * 

added a <param-nested> element (complementing the <param> element)
    to handle #4)

=item * 

added a root <PatternLayout> element to handle #2)

=item * 

added <param-text> which lets you put things like perl code
    into escaped CDATA between the tags, so you don't have to worry
    about escaping characters and quotes

=item * 

added <cspec>

=back

See the examples up in the L<"SYNOPSIS"> for how all that gets used.

=head1 WHY NAMESPACES

I liked the idea of using the log4j DTD I<in situ>, so I used namespaces
to extend it.  If you really don't like having to type <log4perl:appender>
instead of just <appender>, you can make your own DTD combining
the two DTDs and getting rid of the namespace prefixes.  Then you can
validate against that, and log4perl should accept it just fine.

=head1 VARIABLE SUBSTITUTION

This supports variable substitution like C<${foobar}> in text and in 
attribute values except for appender-ref.  If an environment variable is defined
for that name, its value is substituted. So you can do stuff like

        <param name="${hostname}" value="${hostnameval}.foo.com"/>
        <param-text name="to">${currentsysadmin}@foo.com</param-text>


=head1 REQUIRES

To use this module you need XML::DOM installed.  

To use the log4perl.dtd, you'll have to reference it in your XML config,
and you'll also need to note that log4perl.dtd references the 
log4j dtd as "log4j-1.2.dtd", so your validator needs to be able
to find that file as well.  If you don't like having to schlep two
files around, feel free
to dump the contents of "log4j-1.2.dtd" into your "log4perl.dtd" file.

=head1 CAVEATS

You can't mix a multiple param-nesteds with the same name, I'm going to
leave that for now, there's presently no need for a list of structs
in the config.

=head1 CHANGES

0.03 2/26/2003 Added support for log4perl extensions to the log4j dtd

=head1 SEE ALSO

t/038XML-DOM1.t, t/039XML-DOM2.t for examples

xml/log4perl.dtd, xml/log4j-1.2.dtd

Log::Log4perl::Config

Log::Log4perl::Config::PropertyConfigurator

Log::Log4perl::Config::LDAPConfigurator (coming soon!)

The code is brazenly modeled on log4j's DOMConfigurator class, (by 
Christopher Taylor, Ceki Gülcü, and Anders Kristensen) and any
perceived similarity is not coincidental.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK     �#jZP��Q@(  @(    Watch.pmnu �[���        package Log::Log4perl::Config::Watch;

use constant _INTERNAL_DEBUG => 0;

our $NEXT_CHECK_TIME;
our $SIGNAL_CAUGHT;

our $L4P_TEST_CHANGE_DETECTED;
our $L4P_TEST_CHANGE_CHECKED;

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $self = { file            => "",
                 check_interval  => 30,
                 l4p_internal    => 0,
                 signal          => undef,
                 %options,
                 _last_checked_at => 0,
                 _last_timestamp  => 0,
               };

    bless $self, $class;

    if($self->{signal}) {
            # We're in signal mode, set up the handler
        print "Setting up signal handler for '$self->{signal}'\n" if
            _INTERNAL_DEBUG;

        # save old signal handlers; they belong to other appenders or
        # possibly something else in the consuming application
        my $old_sig_handler = $SIG{$self->{signal}};
        $SIG{$self->{signal}} = sub { 
            print "Caught $self->{signal} signal\n" if _INTERNAL_DEBUG;
            $self->force_next_check();
            $old_sig_handler->(@_) if $old_sig_handler and ref $old_sig_handler eq 'CODE';
        };
            # Reset the marker. The handler is going to modify it.
        $self->{signal_caught} = 0;
        $SIGNAL_CAUGHT = 0 if $self->{l4p_internal};
    } else {
            # Just called to initialize
        $self->change_detected(undef, 1);
        $self->file_has_moved(undef, 1);
    }

    return $self;
}

###########################################
sub force_next_check {
###########################################
    my($self) = @_;

    $self->{signal_caught}   = 1;
    $self->{next_check_time} = 0;

    if( $self->{l4p_internal} ) {
        $SIGNAL_CAUGHT = 1;
        $NEXT_CHECK_TIME = 0;
    }
}

###########################################
sub force_next_check_reset {
###########################################
    my($self) = @_;

    $self->{signal_caught} = 0;
    $SIGNAL_CAUGHT = 0 if $self->{l4p_internal};
}

###########################################
sub file {
###########################################
    my($self) = @_;

    return $self->{file};
}

###########################################
sub signal {
###########################################
    my($self) = @_;

    return $self->{signal};
}

###########################################
sub check_interval {
###########################################
    my($self) = @_;

    return $self->{check_interval};
}

###########################################
sub file_has_moved {
###########################################
    my($self, $time, $force) = @_;

    my $task = sub {
        my @stat = stat($self->{file});

        my $has_moved = 0;

        if(! $stat[0]) {
            # The file's gone, obviously it got moved or deleted.
            print "File is gone\n" if _INTERNAL_DEBUG;
            return 1;
        }

        my $current_inode = "$stat[0]:$stat[1]";
        print "Current inode: $current_inode\n" if _INTERNAL_DEBUG;

        if(exists $self->{_file_inode} and 
            $self->{_file_inode} ne $current_inode) {
            print "Inode changed from $self->{_file_inode} to ",
                  "$current_inode\n" if _INTERNAL_DEBUG;
            $has_moved = 1;
        }

        $self->{_file_inode} = $current_inode;
        return $has_moved;
    };

    return $self->check($time, $task, $force);
}

###########################################
sub change_detected {
###########################################
    my($self, $time, $force) = @_;

    my $task = sub {
        my @stat = stat($self->{file});
        my $new_timestamp = $stat[9];

        $L4P_TEST_CHANGE_CHECKED = 1;

        if(! defined $new_timestamp) {
            if($self->{l4p_internal}) {
                # The file is gone? Let it slide, we don't want L4p to re-read
                # the config now, it's gonna die.
                return undef;
            }
            $L4P_TEST_CHANGE_DETECTED = 1;
            return 1;
        }

        if($new_timestamp > $self->{_last_timestamp}) {
            $self->{_last_timestamp} = $new_timestamp;
            print "Change detected (file=$self->{file} store=$new_timestamp)\n"
                  if _INTERNAL_DEBUG;
            $L4P_TEST_CHANGE_DETECTED = 1;
            return 1; # Has changed
        }
           
        print "$self->{file} unchanged (file=$new_timestamp ",
              "stored=$self->{_last_timestamp})!\n" if _INTERNAL_DEBUG;
        return "";  # Hasn't changed
    };

    return $self->check($time, $task, $force);
}

###########################################
sub check {
###########################################
    my($self, $time, $task, $force) = @_;

    $time = time() unless defined $time;

    if( $self->{signal_caught} or $SIGNAL_CAUGHT ) {
       $force = 1;
       $self->force_next_check_reset();
       print "Caught signal, forcing check\n" if _INTERNAL_DEBUG;

    }

    print "Soft check (file=$self->{file} time=$time)\n" if _INTERNAL_DEBUG;

        # Do we need to check?
    if(!$force and
       $self->{_last_checked_at} + 
       $self->{check_interval} > $time) {
        print "No need to check\n" if _INTERNAL_DEBUG;
        return ""; # don't need to check, return false
    }
       
    $self->{_last_checked_at} = $time;

    # Set global var for optimizations in case we just have one watcher
    # (like in Log::Log4perl)
    $self->{next_check_time} = $time + $self->{check_interval};
    $NEXT_CHECK_TIME = $self->{next_check_time} if $self->{l4p_internal};

    print "Hard check (file=$self->{file} time=$time)\n" if _INTERNAL_DEBUG;
    return $task->($time);
}

1;

__END__

=encoding utf8

=head1 NAME

Log::Log4perl::Config::Watch - Detect file changes

=head1 SYNOPSIS

    use Log::Log4perl::Config::Watch;

    my $watcher = Log::Log4perl::Config::Watch->new(
                          file            => "/data/my.conf",
                          check_interval  => 30,
                  );

    while(1) {
        if($watcher->change_detected()) {
            print "Change detected!\n";
        }
        sleep(1);
    }

=head1 DESCRIPTION

This module helps detecting changes in files. Although it comes with the
C<Log::Log4perl> distribution, it can be used independently.

The constructor defines the file to be watched and the check interval 
in seconds. Subsequent calls to C<change_detected()> will 

=over 4

=item *

return a false value immediately without doing physical file checks
if C<check_interval> hasn't elapsed.

=item *

perform a physical test on the specified file if the number
of seconds specified in C<check_interval> 
have elapsed since the last physical check. If the file's modification
date has changed since the last physical check, it will return a true 
value, otherwise a false value is returned.

=back

Bottom line: C<check_interval> allows you to call the function
C<change_detected()> as often as you like, without paying the performing
a significant performance penalty because file system operations 
are being performed (however, you pay the price of not knowing about
file changes until C<check_interval> seconds have elapsed).

The module clearly distinguishes system time from file system time. 
If your (e.g. NFS mounted) file system is off by a constant amount
of time compared to the executing computer's clock, it'll just
work fine.

To disable the resource-saving delay feature, just set C<check_interval> 
to 0 and C<change_detected()> will run a physical file test on
every call.

If you already have the current time available, you can pass it
on to C<change_detected()> as an optional parameter, like in

    change_detected($time)

which then won't trigger a call to C<time()>, but use the value
provided.

=head2 SIGNAL MODE

Instead of polling time and file changes, C<new()> can be instructed 
to set up a signal handler. If you call the constructor like

    my $watcher = Log::Log4perl::Config::Watch->new(
                          file    => "/data/my.conf",
                          signal  => 'HUP'
                  );

then a signal handler will be installed, setting the object's variable 
C<$self-E<gt>{signal_caught}> to a true value when the signal arrives.
Comes with all the problems that signal handlers go along with.

=head2 TRIGGER CHECKS

To trigger a physical file check on the next call to C<change_detected()>
regardless if C<check_interval> has expired or not, call

    $watcher->force_next_check();

on the watcher object.

=head2 DETECT MOVED FILES

The watcher can also be used to detect files that have moved. It will 
not only detect if a watched file has disappeared, but also if it has
been replaced by a new file in the meantime.

    my $watcher = Log::Log4perl::Config::Watch->new(
        file           => "/data/my.conf",
        check_interval => 30,
    );

    while(1) {
        if($watcher->file_has_moved()) {
            print "File has moved!\n";
        }
        sleep(1);
    }

The parameters C<check_interval> and C<signal> limit the number of physical 
file system checks, simililarily as with C<change_detected()>.

=head1 LICENSE

Copyright 2002-2013 by Mike Schilli E<lt>m@perlmeister.comE<gt> 
and Kevin Goess E<lt>cpan@goess.orgE<gt>.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 AUTHOR

Please contribute patches to the project on Github:

    http://github.com/mschilli/log4perl

Send bug reports or requests for enhancements to the authors via our

MAILING LIST (questions, bug reports, suggestions/patches): 
log4perl-devel@lists.sourceforge.net

Authors (please contact them via the list above, not directly):
Mike Schilli <m@perlmeister.com>,
Kevin Goess <cpan@goess.org>

Contributors (in alphabetical order):
Ateeq Altaf, Cory Bennett, Jens Berthold, Jeremy Bopp, Hutton
Davidson, Chris R. Donnelly, Matisse Enzer, Hugh Esco, Anthony
Foiani, James FitzGibbon, Carl Franks, Dennis Gregorovic, Andy
Grundman, Paul Harrington, Alexander Hartmaier  David Hull, 
Robert Jacobson, Jason Kohles, Jeff Macdonald, Markus Peter, 
Brett Rann, Peter Rabbitson, Erik Selberg, Aaron Straup Cope, 
Lars Thegler, David Viner, Mac Yang.

PK       ��iZ5<*�  �                  Tiny.pmnu �[���        PK       ��iZs�ط�< �< 
            �  General.pmnu �[���        PK       ��iZq���%0  %0              �Z Any.pmnu �[���        PK       ��iZ~��.  .              :� Merge/Perl.pmnu �[���        PK       ��iZ Wm  m              �� Any/Perl.pmnu �[���        PK       ��iZ�^��<  <              M� Any/General.pmnu �[���        PK       ��iZx�P�^  ^              Ǜ Any/JSON.pmnu �[���        PK       ��iZ��)�  �  
            `� Any/XML.pmnu �[���        PK       ��iZ��Z4  4              �� Any/Base.pmnu �[���        PK       ��iZi,�.  .              �� Any/YAML.pmnu �[���        PK       ��iZBTR4�  �  
            _� Any/INI.pmnu �[���        PK       ��iZ��)X��  ��              L� Merge.pmnu �[���        PK       ��iZ�HJ9�!  �!              -_ General/Interpolated.pmnu �[���        PK       ��iZ���<�9  �9              ?� General/Extended.pmnu �[���        PK       �#jZh-��Y  Y              W� PropertyConfigurator.pmnu �[���        PK       �#jZ��W��!  �!              �� BaseConfigurator.pmnu �[���        PK       �#jZ����j  �j              � DOMConfigurator.pmnu �[���        PK       �#jZP��Q@(  @(              �_ Watch.pmnu �[���        PK      h  s�   