view release on metacpan or  search on metacpan

lib/Config/ApacheExtended.pm  view on Meta::CPAN

package Config::ApacheExtended;

use Parse::RecDescent;
use Config::ApacheExtended::Grammar;
use IO::File;
use Scalar::Util qw(weaken);
use Text::Balanced qw(extract_variable);
use File::Spec::Functions qw(splitpath catpath abs2rel rel2abs file_name_is_absolute);
use Carp qw(croak cluck);
use strict;
BEGIN {
	use vars qw ($VERSION $DEBUG);
	$VERSION	= sprintf("%d.%02d", q$Revision: 1.15 $ =~ /(\d+)/g);
	$DEBUG		= 0;
}

=pod

=head1 NAME

Config::ApacheExtended - use extended apache format config files

=head1 SYNOPSIS

=for example begin

  use Config::ApacheExtended
  my $conf = Config::ApacheExtended->new(source => "t/parse.conf");
  $conf->parse() or die "Unsuccessful Parsing of config file";

  # Print out all the Directives
  foreach ($conf->get())
  {
      print "$_ => " . $conf->get($_) . "\n";
  }

  # Show all the blocks at the root
  foreach ($conf->block())
  {
      foreach ($conf->block($_))
      {
          print $_->[0] . " => " . $_->[1] . "\n";
          foreach ($conf->block(@$_))
          {
              my $block = $_;
              foreach ($block->get())
              {
                  print "$_ => " . $block->get($_) . "\n";
              }
          }
      }
  }

=for example end

=head1 DESCRIPTION

This module is used to parse a configuration file similar to that of the
Apache webserver (see http://httpd.apache.org for more details).  This module
provides several extensions to that syntax, namely variable substitution and
Hereto documents.  Other features include, value inheritance, directive and
block validation, and include support.  This module also handles quoted strings
and split lines properly.

=head1 METHODS

lib/Config/ApacheExtended.pm  view on Meta::CPAN

		  my $block = $conf->block(@$blockspec);
		  map { print "\t\t$_\n" } ($block->get());
	  }
  }

=back

=cut

sub block
{
	my $self = shift;
	my ($type,$key) = @_;
	my $data = $self->{_data};

	unless (defined($type))
	{
		return grep { ref($data->{$_}) eq 'HASH' } keys(%$data);
	}

	$type = lc $type;
	return undef unless ref($data->{$type}) eq 'HASH';

	unless ( defined($key) )
	{
		return map { [$type, $_]  } keys(%{$data->{$type}});
	}

	$key = lc $key;
	return undef if !exists($data->{$type}->{$key});
	return $self->_createBlock( $data->{$type}->{$key} );
}

=pod

=head2 as_hash

 Usage     : as_hash()
 Purpose   : Returns the current block's data as a hash
 Returns   : a copy of the current block's data as a hash ref.
 Comments  : Don't use this.  It is Dangerous.

=cut

sub as_hash
{
	my $self = shift;
	return { %{$self->{_data}} };
}

sub _createBlock
{
	my $self = shift;
	my $data = shift;
	my $block = bless { %{$self} }, ref($self);
	$block->{_data} = {%$data};

	if ( $self->{_inherit_vals} )
	{
		my $parent = $self;
		weaken($parent);
		$block->{_parent} = $parent;
	}

	$block->_substituteValues() if $self->{_expand_vars};
	return $block;
}

1;

=head1 VARIABLE SUBSTITUTION

It just occured to me that this section has been omitted for some time. Sorry.
Variable substitution is supported in one of three ways.  Given the configuration:

  ValList1 myval1 myval2
  ValList2 myval3 myval4

  MyVal @ValList1 @ValList2
  OddVal thatval1 @ValList1 thatval2
  Stringification "The (@ValList1) is a list of two values"
  AnotherVal $ValList1
  YetAnotherVal $ValList2[1]

Retrieving C<MyVal> will yield a list with 4 values namely: I<myval1, myval2, myval3, myval4>.
Retrieving C<OddVal> will also yield a list with 4 values: I<thatval1, myval1, myval2, thatval2>.
Retrieving C<AnotherVal> will yeild I<myval1>.  Retrieving C<YetAnotherVal> will yield: I<myval4>.
Retrieving C<Stringification> will yield the string: I<The (myval1 myval2) is a list of two values>.

So this leads to the conclusion that:

=over 4

=item *

The "$" prefix substitutes the first/only value of another directive.

=item *

The "$" prefix used with the index I<N> after the directive name will substitute the Nth value of the other directive.
Indexes are zero indexed just as Perl array indexes are.

=item *

The "@" prefix substitutes the entire value list of the other directive in place.

=item *

The "@" prefix will substitute the entire value list joined on the C<$LIST_SEPARATOR> if it occurs within a quoted string.
B<NOTE:> That C<"@SomeVal"> will not cause stringification of the list.  I'm working on this.

=back

This behaviour has only slightly changed from 1.15 to 1.16.  The difference is that the "@" prefix now causes the entire list
to be substituted rather than having the values joined with the C<$LIST_SEPARATOR> character.
Also note that substitution B<WILL> occur inside single quotes.  This is a limitation of the current implementation,
as I do not have enough hints at substitution time to know whether the values where inside single or double quotes.
I welcome patches/suggestions to fix this.

=head1 BUGS