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 = '
        <opt>

          <Location name="/users">
            <title>User Area</title>
          </Location>

          <LocationMatch name="\.*(jpg|gif|png)$">
            <image_file>1</image_file>
          </LocationMatch>

        </opt>
    ';

    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<XML::Simple> to parse XML config files for
C<Config::Context>.  See the C<Config::Context> docs for more
information.

=head1 DRIVER OPTIONS

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

    <opt>
     <Location /users>
      <title>Users Area</title>
     </Location>
    <opt>

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

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


=head1 DEFAULT OPTIONS

By default the options passed to C<XML::Simple> are:

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

...where @section_names is a list of the sections as defined in C<match_sections>.
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<driver_params> to C<new>:

    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<XInclude>
syntax.  To include a file called C<other_config.xml> you would use:

   <opt>
     <xi:include href="other_config.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
   </opt>

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

    # config.xml
    <opt>
     <Location /users>
      <title>Users Area</title>
     </Location>
     <xi:include href="other_config.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
    <opt>

    # other_config.xml
    <opt>
     <Location /users>
      <title>Members Area</title>
     </Location>
    </opt>

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<< <xi:include> >> 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<XML::Simple>, C<XML::SAX> and C<XML::Filter::XInclude>.

=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<lower_case_names> 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;