Config-ApacheFormat
view release on metacpan or search on metacpan
ApacheFormat.pm view on Meta::CPAN
You can write:
$config->foo;
Defaults to 0.
=item case_sensitive
Set this to 1 to preserve the case of directive names. Otherwise, all
names will be C<lc()>ed and matched case-insensitively. Defaults to 0.
=item fix_booleans
If set to 1, then during parsing, the strings "Yes", "On", and "True"
will be converted to 1, and the strings "No", "Off", and "False" will
be converted to 0. This allows you to more easily use C<get()> in
conditional statements.
For example:
# httpd.conf
UseCanonicalName On
Then in Perl:
$config = Config::ApacheFormat->new(fix_booleans => 1);
$config->read("httpd.conf");
if ($config->get("UseCanonicalName")) {
# this will get executed if set to Yes/On/True
}
This option defaults to 0.
=item expand_vars
If set, then you can use variable expansion in your config file by
prefixing directives with a C<$>. Hopefully this seems logical to you:
Website http://my.own.dom
JScript $Website/js
Images $Website/images
Undefined variables in your config file will result in an error. To
use a literal C<$>, simply prefix it with a C<\> (backslash). Like
in Perl, you can use brackets to delimit the variables more precisely:
Nickname Rob
Fullname ${Nickname}ert
Since only scalars are supported, if you use a multi-value, you will
only get back the first one:
Options Plus Minus "About the Same"
Values $Options
In this examples, "Values" will become "Plus". This is seldom a limitation
since in most cases, variable subsitution is used like the first example
shows. This option defaults to 0.
=item setenv_vars
If this is set to 1, then the special C<SetEnv> directive will be set
values in the environment via C<%ENV>. Also, the special C<UnSetEnv>
directive will delete environment variables.
For example:
# $ENV{PATH} = "/usr/sbin:/usr/bin"
SetEnv PATH "/usr/sbin:/usr/bin"
# $ENV{MY_SPECIAL_VAR} = 10
SetEnv MY_SPECIAL_VAR 10
# delete $ENV{THIS}
UnsetEnv THIS
This option defaults to 0.
=item valid_directives
If you provide an array of directive names then syntax errors will be
generated during parsing for invalid directives. Otherwise, any
directive name will be accepted. For exmaple, to only allow
directives called "Bar" and "Bif":
$config = Config::ApacheFormat->new(
valid_directives => [qw(Bar Bif)],
);
=item valid_blocks
If you provide an array of block names then syntax errors will be
generated during parsing for invalid blocks. Otherwise, any block
name will be accepted. For exmaple, to only allow "Directory" and
"Location" blocks in your config file:
$config = Config::ApacheFormat->new(
valid_blocks => [qw(Directory Location)],
);
=item include_directives
This directive controls the name of the include directive. By default
it is C<< ['Include'] >>, but you can set it to any list of directive
names.
=item root_directive
This controls what the root directive is, if any. If you set this to
the name of a directive it will be used as a base directory for
C<Include> processing. This mimics the behavior of C<ServerRoot> in
real Apache config files, and as such you'll want to set it to
'ServerRoot' when parsing an Apache config. The default is C<undef>.
=item hash_directives
This determines which directives (if any) should be parsed so that the
first value is actually a key into the remaining values. For example,
C<AddHandler> is such a directive.
ApacheFormat.pm view on Meta::CPAN
In this case, the directive C<Port> would be set to the last value, C<5053>.
This is useful because it allows you to include other config files, which
you can then override:
# default setup
Include /my/app/defaults.conf
# override port
Port 5053
In addition to this default behavior, C<Config::ApacheFormat> also supports
the following modes:
last - the value from the last one is kept (default)
error - duplicate directives result in an error
combine - combine values of duplicate directives together
These should be self-explanatory. If set to C<error>, any duplicates
will result in an error. If set to C<last> (the default), the last
value wins. If set to C<combine>, then duplicate directives are
combined together, just like they had been specified on the same line.
=back
All of the above attributes are also available as accessor methods. Thus,
this:
$config = Config::ApacheFormat->new(inheritance_support => 0,
include_support => 1);
Is equivalent to:
$config = Config::ApacheFormat->new();
$config->inheritance_support(0);
$config->include_support(1);
=over 4
=cut
use File::Spec;
use Carp qw(croak);
use Text::Balanced qw(extract_delimited extract_variable);
use Scalar::Util qw(weaken);
# this "placeholder" is used to handle escaped variables (\$)
# if it conflicts with a define in your config file somehow, simply
# override it with "$Config::ApacheFormat::PLACEHOLDER = 'whatever';"
our $PLACEHOLDER = "~PLaCE_h0LDeR_$$~";
# declare generated methods
use Class::MethodMaker
new_with_init => "new",
new_hash_init => "hash_init",
get_set => [ -noclear => qw/
inheritance_support
include_support
autoload_support
case_sensitive
expand_vars
setenv_vars
valid_directives
valid_blocks
duplicate_directives
hash_directives
fix_booleans
root_directive
include_directives
_parent
_data
_block_vals
/];
# setup defaults
sub init {
my $self = shift;
my %args = (
inheritance_support => 1,
include_support => 1,
autoload_support => 0,
case_sensitive => 0,
expand_vars => 0,
setenv_vars => 0,
valid_directives => undef,
valid_blocks => undef,
duplicate_directives=> 'last',
include_directives => ['Include'],
hash_directives => undef,
fix_booleans => 0,
root_directive => undef,
_data => {},
@_);
# could probably use a few more of these...
croak("Invalid duplicate_directives option '$self->{duplicate_directives}' - must be 'last', 'error', or 'combine'")
unless $args{duplicate_directives} eq 'last' or
$args{duplicate_directives} eq 'error' or
$args{duplicate_directives} eq 'combine';
return $self->hash_init(%args);
}
=item $config->read("my.conf");
=item $config->read(\*FILE);
Reads a configuration file into the config object. You must pass
either the path of the file to be read or a reference to an open
filehandle. If an error is encountered while reading the file, this
method will die().
Calling read() more than once will add the new configuration values
from another source, overwriting any conflicting values. Call clear()
first if you want to read a new set from scratch.
=cut
# read the configuration file, optionally ending at block_name
sub read {
my ($self, $file) = @_;
my @fstack;
# open the file if needed and setup file stack
my $fh;
if (ref $file) {
@fstack = { fh => $file,
filename => "",
line_num => 0 };
} else {
open($fh, "<", $file) or croak("Unable to open file '$file': $!");
@fstack = { fh => $fh,
filename => $file,
line_num => 0 };
}
return $self->_read(\@fstack);
}
# underlying _read, called recursively an block name for
# nested block objects
sub _read {
my ($self, $fstack, $block_name) = @_;
ApacheFormat.pm view on Meta::CPAN
@{$fstack->[-1]}{qw(fh filename)};
$line_num = \$fstack->[-1]{line_num};
}
# accumulate a full line, dealing with line-continuation
$line = "";
do {
no warnings 'uninitialized'; # blank warnings
$_ = <$fh>;
${$line_num}++;
s/^\s+//; # strip leading space
next LINE if /^#/; # skip comments
s/\s+$//; # strip trailing space
$line .= $_;
} while ($line =~ s/\\$// and not eof($fh));
# skip blank lines
next LINE unless length $line;
# parse line
if ($line =~ /^<\/(\w+)>$/) {
# end block
$orig = $name = $1;
$name = lc $name unless $case_sensitive; # lc($1) breaks on 5.6.1!
croak("Error in config file $filename, line $$line_num: " .
"Unexpected end to block '$orig' found" .
(defined $block_name ?
"\nI was waiting for </$block_name>\n" : ""))
unless defined $block_name and $block_name eq $name;
# this is our cue to return
last LINE;
} elsif ($line =~ /^<(\w+)\s*(.*)>$/) {
# open block
$orig = $name = $1;
$values = $2;
$name = lc $name unless $case_sensitive;
croak("Error in config file $filename, line $$line_num: " .
"block '<$orig>' is not a valid block name")
unless not $validate_blocks or
exists $valid_blocks{$name};
my $val = [];
$val = _parse_value_list($values) if $values;
# create new object for block, inheriting options from
# this object, with this object set as parent (using
# weaken() to avoid creating a circular reference that
# would leak memory)
my $parent = $self;
weaken($parent);
my $block = ref($self)->new(
inheritance_support => $self->{inheritance_support},
include_support => $self->{include_support},
autoload_support => $self->{autoload_support},
case_sensitive => $case_sensitive,
expand_vars => $self->{expand_vars},
setenv_vars => $self->{setenv_vars},
valid_directives => $self->{valid_directives},
valid_blocks => $self->{valid_blocks},
duplicate_directives=> $self->{duplicate_directives},
hash_directives => $self->{hash_directives},
fix_booleans => $self->{fix_booleans},
root_directive => $self->{root_directive},
include_directives => $self->{include_directives},
_parent => $parent,
_block_vals => ref $val ? $val : [ $val ],
);
# tell the block to read from $fh up to the closing tag
# for this block
$block->_read($fstack, $name);
# store block for get() and block()
push @{$data->{$name}}, $block;
} elsif ($line =~ /^(\w+)(?:\s+(.+))?$/) {
# directive
$orig = $name = $1;
$values = $2;
$values = 1 unless defined $values;
$name = lc $name unless $case_sensitive;
croak("Error in config file $filename, line $$line_num: " .
"directive '$name' is not a valid directive name")
unless not $validate_directives or
exists $valid_directives{$name};
# parse out values, handling any strings or arrays
my @val;
eval {
@val = _parse_value_list($values);
};
croak("Error in config file $filename, line $$line_num: $@")
if $@;
# expand_vars if set
eval {
@val = $self->_expand_vars(@val) if $self->{expand_vars};
};
croak("Error in config file $filename, line $$line_num: $@")
if $@;
# and then setenv too (allowing PATH "$BASEDIR/bin")
if ($self->{setenv_vars}) {
if ($name =~ /^setenv$/i) {
croak("Error in config file $filename, line $$line_num: ".
" can't use setenv_vars " .
"with malformed SetEnv directive") if @val != 2;
$ENV{"$val[0]"} = $val[1];
} elsif ($name =~ /^unsetenv$/i) {
croak("Error in config file $filename, line $$line_num: ".
"can't use setenv_vars " .
"with malformed UnsetEnv directive") unless @val;
delete $ENV{$_} for @val;
}
}
# Include processing
# because of the way our inheritance works, we navigate multiple files in reverse
if ($name =~ /$include_re/) {
for my $f (reverse @val) {
# if they specified a root_directive (ServerRoot) and
# it is defined, prefix that to relative paths
my $root = $self->{case_sensitive} ? $self->{root_directive}
: lc $self->{root_directive};
if (! File::Spec->file_name_is_absolute($f) && exists $data->{$root}) {
# looks odd; but only reliable method is construct UNIX-style
# then deconstruct
my @parts = File::Spec->splitpath("$data->{$root}[0]/$f");
$f = File::Spec->catpath(@parts);
}
# this handles directory includes (i.e. will include all files in a directory)
my @files;
if (-d $f) {
opendir(INCD, $f)
|| croak("Cannot open include directory '$f' at $filename ",
"line $$line_num: $!");
@files = map { "$f/$_" } sort grep { -f "$f/$_" } readdir INCD;
closedir(INCD);
} else {
@files = $f;
}
for my $values (reverse @files) {
# just try to open it as-is
my $include_fh;
unless (open($include_fh, "<", $values)) {
if ($fstack->[0]{filename}) {
# try opening it relative to the enclosing file
# using File::Spec
my @parts = File::Spec->splitpath($filename);
$parts[-1] = $values;
open($include_fh, "<", File::Spec->catpath(@parts)) or
croak("Unable to open include file '$values' ",
"at $filename line $$line_num: $!");
} else {
croak("Unable to open include file '$values' ",
"at $filename line $$line_num: $!");
}
}
# push a new record onto the @fstack for this file
push(@$fstack, { fh => $fh = $include_fh,
filename => $filename = $values,
line_number => 0 });
# hook up line counter
$line_num = \$fstack->[-1]{line_num};
}
}
next LINE;
ApacheFormat.pm view on Meta::CPAN
delete $self->{_data};
$self->{_data} = {};
}
=item $config->dump()
This returns a dumped copy of the current configuration. It can be
used on a block object as well. Since it returns a string, you should
say:
print $config->dump;
Or:
for ($config->block(VirtualHost => '10.1.65.1')) {
print $_->dump;
}
If you want to see any output.
=cut
sub dump {
my $self = shift;
require Data::Dumper;
$Data::Dumper::Indent = 1;
return Data::Dumper::Dumper($self);
}
# handle autoload_support feature
sub DESTROY { 1 }
sub AUTOLOAD {
our $AUTOLOAD;
my $self = shift;
my ($name) = $AUTOLOAD =~ /([^:]+)$/;
croak(qq(Can't locate object method "$name" via package ") .
ref($self) . '"')
unless $self->{autoload_support};
return $self->get($name);
}
1;
__END__
=back
=head1 Parsing a Real Apache Config File
To parse a real Apache config file (ex. C<httpd.conf>) you'll need to
use some non-default options. Here's a reasonable starting point:
$config = Config::ApacheFormat->new(
root_directive => 'ServerRoot',
hash_directives => [ 'AddHandler' ],
include_directives => [ 'Include',
'AccessConfig',
'ResourceConfig' ],
setenv_vars => 1,
fix_booleans => 1);
=head1 TODO
Some possible ideas for future development:
=over 4
=item *
Add a set() method. (useless?)
=item *
Add a write() method to create a new configuration file. (useless?)
=back
=head1 BUGS
I know of no bugs in this software. If you find one, please create a
bug report at:
http://rt.cpan.org/
Include the version of the module you're using and a small piece of
code that I can run which demonstrates the problem.
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2002-2003 Sam Tregar
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl 5 itself.
=head1 AUTHORS
=item Sam Tregar <sam@tregar.com>
Original author and maintainer
=item Nathan Wiger <nate@wiger.org>
Porting of features from L<Apache::ConfigFile|Apache::ConfigFile>
=head1 SEE ALSO
L<Apache::ConfigFile|Apache::ConfigFile>
L<Apache::ConfigParser|Apache::ConfigParser>
=cut
( run in 0.694 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )