File Coverage

lib/Template/Plugin/XML/LibXML.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

#============================================================= -*-Perl-*-
#
# Template::Plugin::XML::LibXML
#
# DESCRIPTION
#
#   Template Toolkit plugin interfacing to the XML::LibXML.pm module.
#
# AUTHOR
#   Mark Fowler
#
# COPYRIGHT
#   Copyright (C) 2002-3 Mark Fowler.  All Rights Reserved.
#
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
#----------------------------------------------------------------------------
#
# CVS tag goes here.
#
#============================================================================

package Template::Plugin::XML::LibXML;

require 5.004;

use strict;
use Template::Exception;
use Template::Plugin;
use XML::LibXML;

# load the recommended (but not manditory) openhandle routine
# for filehandle detection.
BEGIN { eval "use Scalar::Util qw(openhandle)" }

use base qw( Template::Plugin );
use vars qw( $VERSION $parser );

$VERSION = 1.07; #sprintf("%d.%02d", q$Revision: 2.50 $ =~ /(\d+)\.(\d+)/);

# these are a list of combatibilty mappings from names that were used
# (or logical extensions of those names for html) in the XML::XPath
# plugin.  Though we're using existing names, I want you to be able
# to still use the old names.  Very DWIM
use constant TYPE  => { 'xml'           => 'string',
                        'text'          => 'string',
		        'filename'      => 'file',
		        'html'          => 'html_string',
		        'html_text'     => 'html_string',
		        'html_file'     => 'html_file',
                        'html_filename' => 'html_file',
		      };

#------------------------------------------------------------------------
# new($context, \%config)
#
# Constructor method for XML::LibXML plugin.  Creates an XML::LibXML
# object and initialises plugin configuration.
#------------------------------------------------------------------------

sub new {

    local $_;

    my $class   = shift;
    my $context = shift;

    # get the named arguments if there were any
    my $args    = ref $_[-1] eq 'HASH' ? pop(@_) : { };

    my $type;    # how we're going to get out data
    my $content; # a ref to the data

    # work out what data we should process
     if (@_)
    {
      # ah, we got positional data.
      $content = \$_[0];            # remember where it is
      $type = _guess_type($_[0]);   # guess what type we're doing
    }
    else
    {
      # okay, the data must be in the named parameters

      # first up we'll just try the method names.  You really should
      # supply the arguments like this you know.
      foreach (qw(string file fh html_string html_file html_fh))
      {
	if ($args->{ $_ })
	{
	  $content = \$args->{ $_ }; # remember where it is
	  delete $args->{ $_ };      # don't pass on parameter though
	  $type = $_;                # remember what type we're doing
	  last;                      # skip to the end
	}
      }

      unless ($type)
      {
	# last ditch effort.  In this case we'll try some of the names
	# that the XML::XPath plugin uses.  We might strike lucky
	foreach (keys %{ &TYPE })
	{
	  if ($args->{ $_ })
	  {
	    $content = \$args->{ $_ }; # remember where it is
	    delete $args->{ $_ };      # don't pass on parameter though
	    $type = &TYPE->{ $_ };     # remember what type we're doing
	    last;                      # skip to the end
	  }
	}
      }
    }

    # return an error if we didn't get a response back
    return $class->_throw('no filename, handle or text specified')
	unless $type;

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

    # set the options
    foreach my $method (keys %$args)
    {
      # try setting the method
      eval { $parser->$method($args->{$method}) };

      # if there's a problem throw a Tempalte::Exception
      if ($@)
      {
	die Template::Exception->new("XML.LibXML",
				     "option '$method' not supported");
      }
    }

    # parse
    my $method = "parse_$type";
    return $parser->$method($$content);
}

#------------------------------------------------------------------------
# _guess_type($string)
#
# Guesses what type of data this is
#------------------------------------------------------------------------

sub _guess_type
{
    # look for a filehandle
    return "fh" if _openhandle($_[0]);

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

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

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

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

#------------------------------------------------------------------------
# _throw($errmsg)
#
# Raise a Template::Exception of type XML.XPath via die().
#------------------------------------------------------------------------

sub _throw {
    my ($self, $error) = @_;
#    print STDERR "about to throw $error\n";
    die Template::Exception->new('XML.LibXML', $error);
}

#------------------------------------------------------------------------
# _openhandle($scalar)
#
# Determines if this is probably an open filehandle or not.
#
# uses openhandle from Scalar::Util if we have it.
#------------------------------------------------------------------------

sub _openhandle ($)
{
   return openhandle($_[0]) if defined(&openhandle);

   # poor man's openhandle
   return defined(fileno $_[0]);
}

#========================================================================
package XML::LibXML::Node;
#========================================================================

#-----------------------------------------------------------------------
# present($view)
#
# Method to present an node via a view, using the block that has the
# same localname.
#-----------------------------------------------------------------------

# note, should this worry about namespaces?  Probably.  Hmm.

sub present {
  my ($self, $view) = @_;
  my $localname = $self->localname();

  # convert anything that isn't A-Za-z1-9 to _.  All those years
  # of working on i18n and this throws it all away.  I suck.
  $localname =~ s/[^A-Za-z0-9]/_/g;

  # render out with the block matching the hacked version of localname
  $view->view($localname, $self);
}

 #-----------------------------------------------------------------------
# content($view)
#
# Method present the node's children via a view
#-----------------------------------------------------------------------

sub content {
    my ($self, $view) = @_;
    my $output = '';
    foreach my $node ($self->childNodes ) {
	$output .= $node->present($view);
    }
    return $output;
}

#----------------------------------------------------------------------
# starttag(), endtag()
#
# Methods to output the start & end tag, e.g.
# and
#----------------------------------------------------------------------

sub starttag {
    my ($self) = @_;
    my $output =  "<". $self->nodeName();
    foreach my $attr ($self->attributes)
    {
	$output .= $attr->toString();
    }
    $output .= ">";
    return $output;
}

sub endtag {
    my ($self) = @_;
    return "nodeName() . ">";
}

#========================================================================
package XML::LibXML::Document;
#========================================================================

#------------------------------------------------------------------------
# present($view)
#
# Method to present a document node via a view.
#------------------------------------------------------------------------

sub present {
    my ($self, $view) = @_;
    # okay, just start rendering from the first element, ignore the pi
    # and all that
    $self->documentElement->present($view);
}

#========================================================================
package XML::LibXML::Text;
#========================================================================

#------------------------------------------------------------------------
# present($view)
#
# Method to present a text node via a view.
#------------------------------------------------------------------------

sub present {
    my ($self, $view) = @_;
    $view->view('text', $self->data);  # same as $self->nodeData
}

#========================================================================
package XML::LibXML::NodeList;
#========================================================================

#------------------------------------------------------------------------
# present($view)
#
# Method to present a node list via a view.  This is only normally useful
# when you call outside of TT as findnodes will be called in list context
# normally
#------------------------------------------------------------------------

sub present {
    my ($self, $view) = @_;
    my $output = '';
    foreach my $node ($self->get_nodelist ) {
	$output .= $node->present($view);
    }
    return $output;
}

#package debug;

#sub debug
#{
#  local $^W;
#  my $nodename;
#  eval { $nodename = $_[0]->nodeName(); };
#  my $methodname = (caller(1))[3];
#  $methodname =~ s/.*:://;
#
#  print STDERR "${nodename}'s $methodname: ".
#               (join ",", (map { ref } @_)) .
#	       "\n";
#}

1;

__END__