Template::Plugin::XML - XML plugin for the Template Toolkit

    [% USE XML;
       dom    = XML.dom('foo.xml');
       xpath  = XML.xpath('bar.xml');
       simple = XML.simple('baz.xml');
       rss    = XML.simple('news.rdf');
    %]

    [% USE XML(file='foo.xml');
       dom    = XML.dom
       xpath  = XML.xpath
       # ...etc...
    %]

    [% USE XML(dir='/path/to/xml');
       file  = XML.file('foo.xml' );
       dom   = file.dom
       xpath = file.xpath
       # ...etc...
    %]

    [% dom = XML.dom(filename) %]

    [% file = XML.file(filename);
       dom  = file.dom
    %]

    [% dir = XML.dir(dirname);
       dom = dir.dom(filename)
    %]

    [% xpath = XML.xpath(filename) %]

    [% file  = XML.file(filename);
       xpath = file.xpath
    %]

    [% dir   = XML.dir(dirname);
       xpath = dir.xpath(filename)
    %]

    [% USE XD = XML.Dom %]
    [% dom = XD.parse_file('example.xml') %]
    [% pages = dom.getElementsByTagName('page') %]

    [% USE news = XML.RSS('news.rdf') -%]
    [% FOREACH item IN news.items -%]
       * [% item.title %]
    [% END %]

    [%  USE xml = XML.Simple('example.xml') %]

    [% USE xpath = XML.XPath('example.xml');
       bar = xpath.find('/foo/bar');
    %]

package Template::Plugin::XML;

use strict;
use warnings;
use base 'Template::Plugin';

our $VERSION    = 2.17;
our $DEBUG      = 0 unless defined $DEBUG;
our $EXCEPTION  = 'Template::Exception' unless defined $EXCEPTION;
our $LIBXML     = eval { require XML::LibXML } unless defined $LIBXML;
our $OPENHANDLE = eval "use Scalar::Util qw(openhandle)";
our @TYPES      = qw( file fh text 
                      xml xml_file xml_fh xml_text 
                      html html_file html_fh html_text );


sub new {
    my $class   = shift;
    my $context = shift;
    my $params  = @_ && ref $_[-1] eq 'HASH' ? pop(@_) : { };
    my ($source, $type);

    if (@_) {
        # first positional argument is file name or XML string
        $source = shift;
        $type   = $class->detect_type($source);
    }
    else {
        # look in named params for a known type
        foreach (@TYPES) {
            $type = $_, last 
                if defined ($source = delete $params->{ $_ });
        }
    }

    my $self = bless { 
        context => $context,
        debug   => delete $params->{ debug  },
        libxml  => delete $params->{ libxml },
    }, $class;

    # apply defaults for debug and libxml from package variable
    $self->{ debug  } = $DEBUG  unless defined $self->{ debug  };
    $self->{ libxml } = $LIBXML unless defined $self->{ libxml };

    # if libxml is enabled then we create an XML::LibXML parser
    $self->{ libxml } &&= do {
        # make sure they didn't try and force libxml=>1 when $LIBXML
        # says we haven't got XML::LibXML installed
        return $self->throw('XML::LibXML is not available')
            unless $LIBXML;

        my $parser = XML::LibXML->new();

        # iterate through remaining params trying to call the 
        # appropriate method on the XML::LibXML object, e.g.
        # expand_entities => 1 becomes $parse->expand_entities(1)

        my ($param, $value, $method);
        while (($param, $value) = each %$params) {
            # throw an error if the parser doesn't have the method
            $self->throw("invalid configuration parameter: $param")
                unless ($method = UNIVERSAL::can($parser, $param));

            # catch any errors thrown and re-throw as our exceptions
            eval { &$method($parser, $value) };
            $self->throw("configuration parameter '$param' failed: $@")
                if $@;
        }
        $parser;
    };

    return $self;
}


sub source {
    return $_[0]->{ source };
}


sub type {
    return $_[0]->{ type };
}


sub debug {
    my $self = shift;
    return $self->{ debug };
}


sub libxml {
    my $self = shift;
    return $self->{ libxml };
}


sub file {
    my $self   = shift;
    my $params = @_ && ref $_[-1] eq 'HASH' ? pop(@_) : { };
    my @args   = @_;
    push(@args, $params);

    $params->{ libxml } = $self->{ libxml } 
        unless defined $params->{ libxml };
    return $self->{ context }->plugin('XML.File', \@args);
}


sub dir {
    die "dir() not yet implemented";

    # pretty much as per file
}

sub dom {
    my $self = shift;

    # TODO: see if we've got a filename defined, create a DOM parser
    # (and cache it), and then call its parse() method

    # ...but for now, we'll just create a plugin
    $self->{ context }->plugin('XML.DOM', \@_);
}

sub xpath {
    my $self = shift;
    # as above
    $self->{ context }->plugin('XML.XPath', \@_);
}

sub rss {
    my $self = shift;
    # as above
    $self->{ context }->plugin('XML.RSS', \@_);
}

sub simple {
    my $self = shift;
    # as above
    $self->{ context }->plugin('XML.Simple', \@_ );
}


sub throw {
    my $self = shift;
    die $EXCEPTION->new( XML => join('', @_) );
}



sub detect_filehandle {
    my $self = shift;

    # look for a filehandle using Scalar::Utils openhandle if it's 
    # available or our poor-man's version if not.
    return $OPENHANDLE ? openhandle($_[0]) : defined(fileno $_[0]);
}


sub detect_type {
    my $self = shift;

    # look for a filehandle using Scalar::Utils openhandle if it's 
    # available or our poor-man's version if not.
    return 'fh' if $self->detect_filehandle($_[0]);

    # okay, look for the xml declaration at the start
    return 'xml_text' if $_[0] =~ m/^\<\?xml/;

    # okay, look for the html declaration anywhere in the doc
    return 'html_text' if $_[0] =~ m/<html>/i;

    # okay, does this contain a "<" symbol, and declare it to be
    # xml if it's got one, though they should use "<?xml"
    return 'text' if $_[0] =~ m{\<};

    # okay, we've tried everything else, return a filename
    return 'file';
}



1;

__END__

# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: