view release on metacpan or  search on metacpan

ApacheFormat.pm  view on Meta::CPAN

Then, use the two-argument form of C<get()>:

  @values = $config->get(AddHandler => 'cgi-script');

This allows you to access each directive individually, which is needed
to correctly handle certain special-case Apache settings.

=item duplicate_directives

This option controls how duplicate directives are handled. By default,
if multiple directives of the same name are encountered, the last one
wins:

  Port 8080
  # ...
  Port 5053

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");

ApacheFormat.pm  view on Meta::CPAN

      @{$fstack->[-1]}{qw(fh filename)};
    my $line_num = \$fstack->[-1]{line_num};

  LINE: 
    while(1) {
        # done with current file?
        if (eof $fh) {
            last LINE if @$fstack == 1;
            pop @$fstack;
            ($fh, $filename) = 
              @{$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) {