File Coverage

blib/lib/Config/Context/XMLSimple.pm

Criterion	Covered	Total	%
statement	19	74	25.6
branch	0	20	0.0
condition	0	11	0.0
subroutine	7	11	63.6
pod	4	4	100.0
total	30	120	25.0

package Config::Context::XMLSimple;

use warnings;
use strict;
use Carp;
use Cwd;

use Hash::Merge ();

=head1 NAME

Config::Context::XMLSimple - Use XML-based config files with Config::Context

=head1 SYNOPSIS

    use Config::Context;

    my $config_text = '



            User Area



            1



    ';

    my $conf = Config::Context->new(
        string        => $config_text,
        driver        => 'XMLSimple',
        match_sections => [
            {
                name          => 'Location',
                match_type    => 'path',
            },
            {
                name          => 'LocationMatch',
                match_type    => 'regex',
            },
        ],
    );

    my %config = $conf->context('/users/~mary/index.html');

    use Data::Dumper;
    print Dumper(\%config);
    --------
    $VAR1 = {
        'title'         => 'User Area',
        'image_file'    => undef,
    };

    my %config = $conf->context('/users/~biff/images/flaming_logo.gif');
    print Dumper(\%config);
    --------
    $VAR1 = {
        'title'         => 'User Area',
        'image_file'    => 1,
    };


=head1 DESCRIPTION

This module uses C to parse XML config files for
C.  See the C docs for more
information.

=head1 DRIVER OPTIONS

By default, it is assumed that the C of your configuration
files is C<<  >>.  For instance:



      Users Area



If you change this to some other element, then you must specify the
C parameter in C:

    # Change the name of the root block to ..
    my $conf = Config::Context->new(
        driver => 'XMLSimple',
        driver_options => {
           XMLSimple = > {
               RootName  => 'Config',
           },
        },
    );


=head1 DEFAULT OPTIONS

By default the options passed to C are:

    KeyAttr    => [],
    ForceArray => \@section_names,

...where @section_names is a list of the sections as defined in C.
This makes for consistently formatted configurations that are similar to
those generated by the other drivers.

You can change this behaviour by passing a different value to
C to C:

    my $conf = Config::Context->new(
        driver => 'XMLSimple',
        driver_options => {
           XMLSimple = > {
               ForceArray  => 1,
           },
        },
    );

=head1 INCLUDE FILES

You include XML files within other XML files by using the C
syntax.  To include a file called C you would use:





Files included this way are included in the same scope.  For instance:

    # config.xml


      Users Area




    # other_config.xml


      Members Area



In this example, the raw config will look like

    {
        'location' => {
            'users' => {
                'title'         => 'Members Area',
            }
        }
    }

And the config matching users will look like:

    {
        'title'         => 'Members Area',
    }


Note that the placement of the C<<  >> tag within a block
(e.g. top or bottom) doesn't matter.  Contents are merged into the block
so that the included file has precedence.


=cut

# This is a customized subclass of XInclude, which can remember
# the names of all the files it has read in.

my %Included_Files;
{
    package XML::Filter::XInclude::RememberFiles;
    use vars '@ISA';
    @ISA = qw(XML::Filter::XInclude);

    sub _include_xml_document {
        my $self   = shift;
        my ($url)  = @_;
        my $base   = $self->{bases}[-1];
        my $source = URI->new_abs($url, $base);
        $Included_Files{$source->as_string} = 1;

        $self->SUPER::_include_xml_document(@_);
    }
}


=head1 CONSTRUCTOR

=head2 new(...)

    my $driver = Config::Context::XMLSimple->new(
        file             => $config_file,
        options          => {
            # ...
        }
    );

or:

    my $driver = Config::Context::XMLSimple->new(
        string           => $config_string,
        options          => {
            # ...
        }
    );

Returns a new driver object, using the provided options.

=cut

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my %args  = @_;

    Config::Context->_require_prerequisite_modules($class);

    my %driver_opts = %{ $args{'options'}{'XMLSimple'} || {} };

    # ForceArray for all section names
    # we use a regex for this, for case insensitivity
    #    ForceArray => qr/^(?:(?:Location)|(?:LocationMatch))$/i

    my $match_sections = $args{'match_sections'} || [];
    my @force_array    = map { $_->{'name'} } @$match_sections;

    my $self = {};

    if ($args{'lower_case_names'}) {
        carp "Lower Case Names not supported with XML::Simple driver";
    }
    $self->{'root_key'}         = $driver_opts{'RootName'} || 'opt';

    my $simple = XML::Simple->new(ForceArray => \@force_array, %driver_opts);
    my $filter = XML::Filter::XInclude::RememberFiles->new(Handler => $simple);
    my $parser = XML::SAX::ParserFactory->parser(Handler => $filter);

    $self->{'parser'} = $parser;

    if ($args{'string'}) {
        $self->{'string'} = $args{'string'};
    }
    elsif($args{'file'}) {
        $self->{'file'} = $args{'file'};
    }
    else {
        croak __PACKAGE__ . "->new(): one of 'file' or 'string' is required";
    }

    bless $self, $class;
    return $self;

}

=head1 METHODS

=head2 parse()

Returns the data structure for the parsed config.

=cut

sub parse {
    my $self = shift;

    %Included_Files = ();
    my $config;
    my $parser = $self->{'parser'};
    if ($self->{'string'}) {
        $config = $parser->parse_string($self->{'string'});
    }
    elsif($self->{'file'}) {
        $config = $parser->parse_uri($self->{'file'});
    }

    # handle inclusion by recursively merging all keys named 'opt' into
    # the root name space

    my $rootkey = $self->{'root_name'} || 'opt';

    while (grep { $_ eq $rootkey } keys %$config) {
        foreach my $key (keys %$config) {
            if ($key eq $rootkey) {
                 my $sub_config = delete $config->{$key};
                 $config = Hash::Merge::merge($sub_config, $config);
                 last;
            }
        }
    }

    $self->{'included_files'} = \%Included_Files;

    # Include the containing config file itself
    if ($self->{'file'}) {
        $self->{'included_files'}{Cwd::abs_path($self->{'file'})} = 1;
    }

    return %$config if wantarray;
    return $config;
}

=head2 files()

Returns a list of all the config files read, including any config files
included in the main file.

=cut

sub files {
    my $self = shift;
    $self->{'included_files'} ||= {};
    my @included_files = keys %{$self->{'included_files'}};
    return @included_files if wantarray;
    return \@included_files;
}


=head2 config_modules

Returns the modules required to parse the config.  In this case:
C, C and C.

=cut

sub config_modules {
    return qw(
        XML::Simple
        XML::SAX
        XML::Filter::XInclude
    );
}

=head1 CAVEATS

=head2 Lower Case names not supported with this driver

The C option is not supported used with this driver.
If you specify it, it will produce a warning.

=head1 SEE ALSO

    Config::Context
    CGI::Application::Plugin::Config::Context
    XML::Simple

=head1 COPYRIGHT & LICENSE

Copyright 2004-2005 Michael Graham, All Rights Reserved.

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

=cut




1;