File Coverage

blib/lib/XML/XSLT.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

##############################################################################
#
# Perl module: XML::XSLT
#
# By Geert Josten, [e-mail]
# and Egon Willighagen, [e-mail]
# and Jonathan Stowe
#
###############################################################################

=head1 NAME

XML::XSLT - A perl module for processing XSLT

=cut

######################################################################
package XML::XSLT;
######################################################################

use strict;
use warnings;

use XML::DOM 1.25;
use XML::DOM::XPath;
use LWP::Simple qw(get);
use URI;
use Cwd;
use File::Basename qw(dirname);
use Carp;

# Namespace constants

use constant NS_XSLT  => 'http://www.w3.org/1999/XSL/Transform';
use constant NS_XHTML => 'http://www.w3.org/TR/xhtml1/strict';

use vars qw ( $VERSION @ISA @EXPORT_OK $AUTOLOAD );

$VERSION = '0.50_5';

@ISA       = qw( Exporter );
@EXPORT_OK = qw( &transform &serve );

my %deprecation_used;

######################################################################
# PUBLIC DEFINITIONS

=head1 SYNOPSIS

 use XML::XSLT;

 my $xslt = XML::XSLT->new ($xsl, warnings => 1);

 $xslt->transform ($xmlfile);
 print $xslt->toString;

 $xslt->dispose();

=head1 DESCRIPTION

This module implements the W3C's XSLT specification. The goal is full
implementation of this spec, but we have not yet achieved
that. However, it already works well.  See L for
the current status of each command.

XML::XSLT makes use of XML::DOM and LWP::Simple, while XML::DOM
uses XML::Parser.  Therefore XML::Parser, XML::DOM and LWP::Simple
have to be installed properly for XML::XSLT to run.

=head1 Specifying Sources

The stylesheets and the documents may be passed as filenames, file
handles regular strings, string references or DOM-trees.  Functions
that require sources (e.g. new), will accept either a named parameter
or simply the argument.

Either of the following are allowed:

 my $xslt = XML::XSLT->new($xsl);
 my $xslt = XML::XSLT->new(Source => $xsl);

In documentation, the named parameter `Source' is always shown, but it
is never required.

=head2 METHODS

=over 4

=cut

=item new(Source => $xml [, %args])

Returns a new XSLT parser object.  Valid flags are:

=over 2

=item DOMparser_args

Hashref of arguments to pass to the XML::DOM::Parser object's parse
method.

=item variables

Hashref of variables and their values for the stylesheet.

=item base

Base of URL for file inclusion.

=item debug

Turn on debugging messages.

=item warnings

Turn on warning messages.

=item indent

Starting amount of indention for debug messages.  Defaults to 0.

=item indent_incr

Amount to indent each level of debug message.  Defaults to 1.

=back

=cut

sub new
{
    my $class = shift;
    my $self  = bless {}, $class;
    my %args  = $self->__parse_args(@_);

    $self->{DEBUG}       = defined $args{debug} ? $args{debug} : "";
	 no strict 'subs';

	 if ( $self->{DEBUG} )
    {
	    *__PACKAGE__::debug = \&debug;
	 }
	 else
	 {
		*__PACKAGE__::debug = sub {};
	 }

	 use strict 'subs';

    $self->{INDENT}      = defined $args{indent}      ? $args{indent}      : 0;
    $self->{PARSER}      = XML::DOM::Parser->new();
    $self->{PARSER_ARGS} =
      defined $args{DOMparser_args} ? $args{DOMparser_args} : {};
    $self->{VARIABLES}   = defined $args{variables}   ? $args{variables}   : {};
	 $self->debug(join ' ', keys %{$self->{VARIABLES}});
    $self->{WARNINGS}    = defined $args{warnings}    ? $args{warnings}    : 0;
    $self->{INDENT_INCR} = defined $args{indent_incr} ? $args{indent_incr} : 1;
    $self->{XSL_BASE}    =
      defined $args{base} ? $args{base} : 'file://' . cwd . '/';
    $self->{XML_BASE} =
      defined $args{base} ? $args{base} : 'file://' . cwd . '/';

    $self->use_deprecated( $args{use_deprecated} )
      if exists $args{use_deprecated};

    $self->debug("creating parser object:");

    $self->_indent();
    $self->open_xsl(%args);
    $self->_outdent();

    return $self;
}

sub use_deprecated
{
    my ( $self, $use_deprecated ) = @_;

    if ( defined $use_deprecated )
    {
        $self->{USE_DEPRECATED} = $use_deprecated;
    }

    return $self->{USE_DEPRECATED} || 0;
}

sub DESTROY { }    # Cuts out random dies on includes

=item default_xml_version

Gets and/or sets the default XML version used in the output documents,
this will almost certainly want to be 1.0

=cut

sub default_xml_version
{
    my ( $self, $xml_version ) = @_;

    if ( defined $xml_version )
    {
        $self->{DEFAULT_XML_VERSION} = $xml_version;
    }

    return $self->{DEFAULT_XML_VERSION} ||= '1.0';
}

=item serve(Source => $xml [, %args])

Processes the given XML through the stylesheet.  Returns a string
containg the result.  Example:

  use XML::XSLT qw(serve);

  $xslt = XML::XSLT->new($xsl);
  print $xslt->serve $xml;

=over 4

=item http_headers

If true, then prepends the appropriate HTTP headers (e.g. Content-Type,
Content-Length);

Defaults to true.

=item xml_declaration

If true, then the result contains the appropriate  header.

Defaults to true.

=item xml_version

The version of the XML.

Defaults to 1.0.

=item doctype

The type of DOCTYPE this document is.  Defaults to SYSTEM.

=back

=cut

sub serve
{
    my $self  = shift;
    my $class = ref $self || croak "Not a method call";
    my %args  = $self->__parse_args(@_);
    my $ret;

    $args{http_headers}    = 1 unless defined $args{http_headers};
    $args{xml_declaration} = 1 unless defined $args{xml_declaration};
    $args{xml_version} = $self->default_xml_version()
      unless defined $args{xml_version};
    $args{doctype} = 'SYSTEM' unless defined $args{doctype};
    $args{clean}   = 0        unless defined $args{clean};

    $ret = $self->transform( $args{Source} )->toString;

    if ( $args{clean} )
    {
        eval { require HTML::Clean };

        if ($@)
        {
            CORE::warn("Not passing through HTML::Clean -- install the module");
        }
        else
        {
            my $hold = HTML::Clean->new( \$ret );
            $hold->strip;
            $ret = ${ $hold->data };
        }
    }

    if ( my $doctype = $self->doctype() )
    {
        $ret = $doctype . "\n" . $ret;
    }

    if ( $args{xml_declaration} )
    {
        $ret = $self->xml_declaration() . "\n" . $ret;
    }

    if ( $args{http_headers} )
    {
        $ret =
            "Content-Type: "
          . $self->media_type() . "\n"
          . "Content-Length: "
          . length($ret) . "\n\n"
          . $ret;
    }

    return $ret;
}

=item xml_declaration

Will return an XML declaration element based on the output encoding and
XML version.

=cut

sub xml_declaration
{
    my ( $self, $xml_version, $output_encoding ) = @_;

    $xml_version     ||= $self->default_xml_version();
    $output_encoding ||= $self->output_encoding();

    return qq{};
}

=item output_encoding

Gets and/or sets the output encoding that is used in the xml declaration
and elsewhere (default: UTF-8)

=cut

# defaulting blindly to UTF-8 is a bug, this should also be used to
# appropriately set the encoding of the output.
#
sub output_encoding
{
    my ( $self, $encoding ) = @_;

    if ( defined $encoding )
    {
        $self->{OUTPUT_ENCODING} = $encoding;
    }

    return exists $self->{OUTPUT_ENCODING} ? $self->{OUTPUT_ENCODING} : 'UTF-8';
}

sub doctype_system
{
    my ( $self, $doctype ) = @_;

    if ( defined $doctype )
    {
        $self->{DOCTYPE_SYSTEM} = $doctype;
    }

    return $self->{DOCTYPE_SYSTEM};
}

sub doctype_public
{
    my ( $self, $doctype ) = @_;

    if ( defined $doctype )
    {
        $self->{DOCTYPE_PUBLIC} = $doctype;
    }

    return $self->{DOCTYPE_PUBLIC};
}

=item result_document

An accessor for the XML::DOM object that the transformed document is
assembled into.

=cut

sub result_document()
{
    my ( $self, $document ) = @_;

    if ( defined $document )
    {
        $self->{RESULT_DOCUMENT} = $document;
    }

    return $self->{RESULT_DOCUMENT};
}

sub debug
{
    my $self = shift;
    my $arg  = shift || "";

	 if ($self->{DEBUG} and $self->{DEBUG} > 1 )
	 {
        $arg  = (caller(1))[3] . ": $arg";
	 }

    print STDERR " " x $self->{INDENT}, "$arg\n"
      if $self->{DEBUG};
}

sub warn
{
    my $self = shift;
    my $arg  = shift || "";

    print STDERR " " x $self->{INDENT}, "$arg\n"
      if $self->{DEBUG};
    print STDERR "$arg\n"
      if $self->{WARNINGS} && !$self->{DEBUG};
}

=item open_xml(Source => $xml [, %args])

Gives the XSLT object new XML to process.  Returns an XML::DOM object
corresponding to the XML.

=over 4

=item base

The base URL to use for opening documents.

=item parser_args

Arguments to pase to the parser.

=back

=cut

sub open_xml
{
    my $self  = shift;
    my $class = ref $self || croak "Not a method call";
    my %args  = $self->__parse_args(@_);

    if ( defined $self->xml_document() && not $self->{XML_PASSED_AS_DOM} )
    {
        $self->debug("flushing old XML::DOM::Document object...");
        $self->xml_document()->dispose;
    }

    if (ref $args{Source} && UNIVERSAL::isa($args{Source}, 'XML::DOM::Document' ) )
    {
       $self->{XML_PASSED_AS_DOM} = 1;
    }

    if ( defined $self->result_document() )
    {
        $self->debug("flushing result...");
        $self->result_document()->dispose();
    }

    $self->debug("opening xml...");

    $args{parser_args} ||= {};

    my $xml_document = $self->__open_document(
        Source      => $args{Source},
        base        => $self->{XML_BASE},
        parser_args => { %{ $self->{PARSER_ARGS} }, %{ $args{parser_args} } },
    );

    $self->xml_document($xml_document);

    $self->{XML_BASE} =
      dirname( URI->new_abs( $args{Source}, $self->{XML_BASE} )->as_string )
      . '/';
    $self->result_document( $self->xml_document()->createDocumentFragment());
}

=item xml_document

Gets and/or sets the XML::DOM object corresponding to the XML document
being processed. The document might be altered during processing.

=cut

sub xml_document
{
    my ( $self, $xml_document ) = @_;

    if ( defined $xml_document )
    {
        $self->{XML_DOCUMENT} = $xml_document;
    }

    return $self->{XML_DOCUMENT};
}

=item open_xsl(Source => $xml, [, %args])

Gives the XSLT object a new stylesheet to use in processing XML.
Returns an XML::DOM object corresponding to the stylesheet.  Any
arguments present are passed to the XML::DOM::Parser.

=over 4

=item base

The base URL to use for opening documents.

=item parser_args

Arguments to pase to the parser.

=back

=cut

sub open_xsl
{
    my $self  = shift;
    my $class = ref $self || croak "Not a method call";
    my %args  = $self->__parse_args(@_);



    $self->xsl_document()->dispose
      if not $self->{XSL_PASSED_AS_DOM}
      and defined $self->xsl_document();



    if ( ref $args{Source} && UNIVERSAL::isa($args{Source}, 'XML::DOM::Document' ))
    {
       $self->{XSL_PASSED_AS_DOM} = 1
    }


    # open new document  # open new document
    $self->debug("opening xsl...");

    $args{parser_args} ||= {};

    my $xsl_document = $self->__open_document(
        Source      => $args{Source},
        base        => $self->{XSL_BASE},
        parser_args => { %{ $self->{PARSER_ARGS} }, %{ $args{parser_args} } },
    );


    $self->{ORIG_XSL_DOC} = $xsl_document;

    $self->xsl_document($xsl_document);

    $self->{XSL_BASE} =
      dirname( URI->new_abs( $args{Source}, $self->{XSL_BASE} )->as_string )
      . '/';

    $self->__preprocess_stylesheet;
}

=item xsl_document

Gets and/or sets the XML::DOM object corresponding to the XSLT document
that is being used for processing, this will be altered during processing
so should not be an object that needs to be reused elsewhere.

=cut

sub xsl_document
{
    my ( $self, $xsl_document ) = @_;

    if ( defined $xsl_document )
    {
        $self->{XSL_DOCUMENT} = $xsl_document;
    }

    return $self->{XSL_DOCUMENT};
}

# Argument parsing with backwards compatibility.
sub __parse_args
{
    my $self = shift;
    my %args;

    if ( @_ % 2 )
    {
        $args{Source} = shift;
        %args = ( %args, @_ );
    }
    else
    {
        %args = @_;
        if ( not exists $args{Source} )
        {
            my $name = [ caller(1) ]->[3];
            carp
"Argument syntax of call to $name deprecated.  See the documentation for $name"
              unless $self->use_deprecated($args{use_deprecated})
              or exists $deprecation_used{$name};
            $deprecation_used{$name} = 1;
            %args                    = ();
            $args{Source}            = shift;
            shift;
            %args = ( %args, @_ );
        }
    }

    return %args;
}

# private auxiliary function #
sub __my_tag_compression
{
    my ( $tag, $elem ) = @_;

=begin internal_docs

__my_tag_compression__( $tag, $elem )

A function for DOM::XML::setTagCompression to determine the style for printing
of empty tags and empty container tags.

XML::XSLT implements an XHTML-friendly style.

Allow tag to be preceded by a namespace: ([\w\.]+\:){0,1}

   ->

  or

   ->

Empty tag list obtained from:

  http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd

According to "Appendix C. HTML Compatibility Guidelines",
  C.3 Element Minimization and Empty Element Content

  Given an empty instance of an element whose content model is not EMPTY
  (for example, an empty title or paragraph) do not use the minimized form
  (e.g. use   and not ).

However, the  tag is processed like an empty tag here!

Tags allowed:

  base meta link hr br param img area input col

Special Case: p (even though it violates C.3)

The tags are matched in order of expected common occurence.

=end internal_docs

=cut

    $tag = [ split ':', $tag ]->[1] if index( $tag, ':' ) >= 0;
    return 2 if $tag =~ m/^(p|br|img|hr|input|meta|base|link|param|area|col)$/i;

    # Print other empty tags like this:
    return 1;
}

# private auxiliary function #
sub __preprocess_stylesheet
{
    my $self = $_[0];

    $self->debug("preprocessing stylesheet...");

    $self->__get_first_element;
    $self->__extract_namespaces;
    $self->__get_stylesheet;

   # Why is this here when __get_first_element does, apparently, the same thing?
   # Because, in __get_stylesheet we warp the document.
    $self->__expand_xsl_includes;
    $self->_top_xsl_node( $self->xsl_document()->getFirstChild );
    $self->__extract_top_level_variables;

    $self->__add_default_templates;
    $self->__cache_templates;    # speed optim

    $self->__set_xsl_output;
}

sub _top_xsl_node
{
    my ( $self, $top_xsl_node ) = @_;

    if ( defined $top_xsl_node )
    {
        $self->{TOP_XSL_NODE} = $top_xsl_node;
    }

    return $self->{TOP_XSL_NODE};
}

# private auxiliary function #

sub __get_stylesheet
{
    my $self = shift;
    my $stylesheet;
    my $xsl_ns = $self->xsl_ns();
    my $xsl    = $self->xsl_document();

    foreach my $child ( $xsl->getElementsByTagName( '*', 0 ) )
    {
        my ( $ns, $tag ) = split( ':', $child->getTagName() );
        if ( not defined $tag )
        {
            $tag = $ns;
            $ns  = $self->default_ns();
        }
        if ( $tag eq 'stylesheet' || $tag eq 'transform' )
        {
            if ( my $attributes = $child->getAttributes() )
            {
                my $version = $attributes->getNamedItem('version');

                $self->xslt_version( $version->getNodeValue() ) if $version;
            }

            $stylesheet = $child;
            last;
        }
    }

    if ( !$stylesheet )
    {

        # stylesheet is actually one complete template!
        # put it in a template-element

        $stylesheet = $xsl->createElement("${xsl_ns}stylesheet");
        my $template = $xsl->createElement("${xsl_ns}template");
        $template->setAttribute( 'match', "/" );

        my $template_content = $xsl->getElementsByTagName( '*', 0 )->item(0);
        $xsl->replaceChild( $stylesheet, $template_content );
        $stylesheet->appendChild($template);
        $template->appendChild($template_content);
    }

    $self->xsl_document($stylesheet);
}

sub xslt_version
{
    my ( $self, $xslt_version ) = @_;

    if ( defined $xslt_version )
    {
        $self->{XSLT_VERSION} = $xslt_version;
    }

    return $self->{XSLT_VERSION} ||= '1.0';
}

# private auxiliary function #
sub __get_first_element
{
    my ($self) = @_;
    my $node = $self->xsl_document()->getFirstChild();

    $node = $node->getNextSibling until $node->isa( 'XML::DOM::Element' );

    $self->_top_xsl_node($node);
}

# private auxiliary function #
sub __extract_namespaces
{
    my ($self) = @_;

    my $attr = $self->_top_xsl_node()->getAttributes;
    if ( defined $attr )
    {
        foreach
          my $attribute ( $self->_top_xsl_node()->getAttributes->getValues )
        {
            my ( $pre, $post ) = split( ":", $attribute->getName, 2 );
            my $value = $attribute->getValue;

            # Take care of namespaces
            if ( $pre eq 'xmlns' and not defined $post )
            {
                $self->default_ns('');

                $self->{NAMESPACE}->{ $self->default_ns() }->{namespace} =
                  $value;
                $self->xsl_ns('')
                  if $value eq NS_XSLT;
                $self->debug(
                    "Namespace `" . $self->default_ns() . "' = `$value'" );
            }
            elsif ( $pre eq 'xmlns' )
            {
                $self->{NAMESPACE}->{$post}->{namespace} = $value;
                $self->xsl_ns("$post:")
                  if $value eq NS_XSLT;
                $self->debug("Namespace `$post:' = `$value'");
            }
            else
            {
                $self->default_ns('');
            }

            # Take care of versions
            if ( $pre eq "version" and not defined $post )
            {
                $self->{NAMESPACE}->{ $self->default_ns() }->{version} = $value;
                $self->debug( "Version for namespace `"
                      . $self->default_ns()
                      . "' = `$value'" );
            }
            elsif ( $pre eq "version" )
            {
                $self->{NAMESPACE}->{$post}->{version} = $value;
                $self->debug("Version for namespace `$post:' = `$value'");
            }
        }
    }
    if ( not defined $self->default_ns() )
    {
        my ($dns) = split( ':', $self->_top_xsl_node()->getTagName );
        $self->default_ns($dns);
    }
    $self->debug( "Default Namespace: `" . $self->default_ns() . "'" );
    $self->xsl_ns( $self->default_ns() ) unless $self->xsl_ns();

    $self->debug( "XSL Namespace: `" . $self->xsl_ns() . "'" );

    # ** FIXME: is this right?
    $self->{NAMESPACE}->{ $self->default_ns() }->{namespace} ||= NS_XHTML;
}

=item default_ns

Gets and/or sets the default namespace to be used in the XSL

=cut

sub default_ns
{
    my ( $self, $default_ns ) = @_;

    if ( defined $default_ns )
    {
        $self->{DEFAULT_NS} = $default_ns;
    }
    return exists $self->{DEFAULT_NS} ? $self->{DEFAULT_NS} : undef;
}

sub xsl_ns
{
    my ( $self, $prefix ) = @_;

    if ( defined $prefix )
    {
        $prefix .= ':' unless $prefix =~ /:$/;
        $self->{XSL_NS} = $prefix;
    }
    return $self->{XSL_NS};
}

# private auxiliary function #
sub __expand_xsl_includes
{
    my $self = shift;

    $self->debug("IN INCLUDE");
    $self->debug($self->xsl_ns());
    foreach my $include_node ( $self->xsl_document()   # _top_xsl_node()
        ->getElementsByTagName( $self->xsl_ns() . "include" ) )
    {
        my $include_file = $include_node->getAttribute('href');

        $self->debug("including - $include_file");
        die "include tag carries no selection!"
          unless defined $include_file;

        my $include_doc;
        my $tmp_doc;
        eval {
            $tmp_doc =
              $self->__open_by_filename( $include_file, $self->{XSL_BASE} );
            $include_doc = $tmp_doc->getFirstChild();
            #$tmp_doc->removeChild($include_doc);
        };
        die "parsing of $include_file failed: $@"
          if $@;

        $self->debug("inserting `$include_file'");
        #$self->xsl_document()->setOwnerDocument($include_doc);
        $include_doc->setOwnerDocument( $self->{ORIG_XSL_DOC} );
        $self->xsl_document()->replaceChild( $include_doc, $include_node );
        #$include_doc->dispose;
    }
}

# private auxiliary function #
sub __extract_top_level_variables
{
   my $self = $_[0];

   $self->debug("Extracting variables");
   foreach my $child ( $self->xsl_document()->getChildNodes() )
   {
      next unless $child->getNodeType() == ELEMENT_NODE;
      my $name = $child->getNodeName();
      my ( $ns, $tag ) = split( ':', $name );

      $self->debug("$ns $tag");
        #					 ( $tag eq '' && $self->xsl_ns() eq '' )
        #            || $self->xsl_ns() eq $ns )
      if (1)
      {
         $tag = $ns if $tag eq '';

         $self->debug($tag);
         if ( $tag eq 'variable' || $tag eq 'param' )
         {

            my $name = $child->getAttribute("name");
            if ( exists $self->{VARIABLES}->{$name} )
            {
               $self->debug(
                  "$tag $name already set to '$self->{VARIABLES}->{$name}'");
            }
            elsif ($name)
            {
               $self->debug("got $tag called $name");
               my $value = $child->getAttributeNode("select");
               if ( !defined $value )
               {
                   $self->debug("evaluating variable from child nodes");
                  if ( $child->getChildNodes()->getLength() )
                  {
                     my $result = XML::DOM::DocumentFragment->new();

                     #$self->xml_document()->createDocumentFragment;
                     $self->_evaluate_template( $child, $self->xml_document(),
                        '', $result );
                     $value = $self->__string__($result);
                     $result->dispose();
                  }
               }
               else
               {
                   $self->debug("Trying to get a literal");
                  $value = $value->getValue();
                  if ( $value =~ /^'([^']*)'$/m )
                  {
                     $value = $1;
                  }
               }
               if ( defined $value )
               {
                  $self->debug("Setting $tag `$name' = `$value'");
                  $self->{VARIABLES}->{$name} = $value;
               }
            }
            else
            {

               # Required, so we die (http://www.w3.org/TR/xslt#variables)
               die "$tag tag carries no name!";
            }
         }
      }
   }
}

# private auxiliary function #
sub __add_default_templates
{
    my $self = $_[0];
    my $doc  = $self->_top_xsl_node()->getOwnerDocument;

    # create template for '*' and '/'
    my $elem_template = $doc->createElement( $self->xsl_ns() . "template" );
    $elem_template->setAttribute( 'match', '*|/' );

    #
    $elem_template->appendChild(
        $doc->createElement( $self->xsl_ns() . "apply-templates" ) );

    # create template for 'text()' and '@*'
    my $attr_template = $doc->createElement( $self->xsl_ns() . "template" );
    $attr_template->setAttribute( 'match', 'text()|@*' );

    #
    $attr_template->appendChild(
        $doc->createElement( $self->xsl_ns() . "value-of" ) );
    $attr_template->getFirstChild->setAttribute( 'select', '.' );

    # create template for 'processing-instruction()' and 'comment()'
    my $pi_template = $doc->createElement( $self->xsl_ns() . "template" );
    $pi_template->setAttribute( 'match', 'processing-instruction()|comment()' );

    $self->debug("adding default templates to stylesheet");

    # add them to the stylesheet
    $self->xsl_document()->insertBefore( $pi_template, $self->_top_xsl_node );
    $self->xsl_document()
      ->insertBefore( $attr_template, $self->_top_xsl_node() );
    $self->xsl_document()
      ->insertBefore( $elem_template, $self->_top_xsl_node() );
}

=item

Returns the templates from the XSL document.

=cut

sub templates
{
    my ( $self, $templates ) = @_;

    if ( defined $templates )
    {
        $self->{TEMPLATE} = $templates;
    }

    $self->debug("templates() called from : " . (caller(1))[3]);
    unless ( exists $self->{TEMPLATE} )
    {
        $self->{TEMPLATE} = [];
        my $xsld = $self->xsl_document();
        my $tag  = $self->xsl_ns() . 'template';

        $self->debug("getting $tag");
        @{ $self->{TEMPLATE} } = $xsld->getElementsByTagName($tag);
    }

    return wantarray ? @{ $self->{TEMPLATE} } : $self->{TEMPLATE};
}

# private auxiliary function #
sub __cache_templates
{
    my $self = $_[0];

    # pre-cache template names and matches #
    # reversing the template order is much more efficient #

    foreach my $template ( reverse $self->templates() )
    {
       next unless $template->getParentNode();
        if ( $template->getParentNode->getTagName =~
            /^([\w\.\-]+\:){0,1}(stylesheet|transform|include)/ )
        {
            my $match = $template->getAttribute('match') || '';
            my $name  = $template->getAttribute('name')  || '';
            push( @{ $self->{TEMPLATE_MATCH} }, $match );
            push( @{ $self->{TEMPLATE_NAME} },  $name );
        }
    }
}


=item xsl_output_method

Get or set the
'text' and 'xml'

=cut

sub xsl_output_method
{
    my ( $self, $method) = @_;

	 if (defined $method and $method =~ /(?:html|text|xml)/ )
	 {
	    $self->{METHOD} = $method;
	 }

	 return exists $self->{METHOD} ? $self->{METHOD} : 'xml';
}

# private auxiliary function #
sub __set_xsl_output
{
    my $self = $_[0];

    # default settings
    $self->media_type('text/xml');

    # extraction of top-level xsl:output tag
    my ($output) =
      $self->xsl_document()
      ->getElementsByTagName( $self->xsl_ns() . "output", 0 );

    if ( defined $output )
    {

        # extraction and processing of the attributes
        my $attribs = $output->getAttributes;
        my $media   = $attribs->getNamedItem('media-type');
        my $method  = $attribs->getNamedItem('method');
        $self->media_type( $media->getNodeValue ) if defined $media;
        $self->xsl_output_method($method->getNodeValue) if defined $method;

        if ( my $omit = $attribs->getNamedItem('omit-xml-declaration') )
        {
            if ( $omit->getNodeValue() =~ /^(yes|no)$/ )
            {
                $self->omit_xml_declaration($1);
            }
            else
            {

                # I would say that this should be fatal
                # Perhaps there should be a 'strict' option to the constructor

                my $m =
                    qq{Wrong value for attribute "omit-xml-declaration" in\n\t}
                  . $self->xsl_ns()
                  . qq{output, should be "yes" or "no"};
                $self->warn($m);
            }
        }

        unless ( $self->omit_xml_declaration() )
        {
            my $output_ver = $attribs->getNamedItem('version');
            my $output_enc = $attribs->getNamedItem('encoding');
            $self->output_version( $output_ver->getNodeValue )
              if defined $output_ver;
            $self->output_encoding( $output_enc->getNodeValue )
              if defined $output_enc;

            if ( not $self->output_version() || not $self->output_encoding() )
            {
                $self->warn(
                        qq{Expected attributes "version" and "encoding" in\n\t}
                      . $self->xsl_ns()
                      . "output" );
            }
        }
        my $doctype_public = $attribs->getNamedItem('doctype-public');
        my $doctype_system = $attribs->getNamedItem('doctype-system');

        my $dp = defined $doctype_public ? $doctype_public->getNodeValue : '';

        $self->doctype_public($dp);

        my $ds = defined $doctype_system ? $doctype_system->getNodeValue : '';
        $self->doctype_system($ds);

        # cdata-section-elements should only be used if the output type
        # is XML but as we are not checking that right now ...

        my $cdata_section = $attribs->getNamedItem('cdata-section-elements');

        if ( defined $cdata_section )
        {
            my $cdata_sections = [];
            @{$cdata_sections} = split /\s+/, $cdata_section->getNodeValue();
            $self->cdata_sections($cdata_sections);
        }
    }
    else
    {
        $self->debug("Default Output options being used");
    }
}

sub omit_xml_declaration
{
    my ( $self, $omit_xml_declaration ) = @_;

    if ( defined $omit_xml_declaration )
    {
        if ( $omit_xml_declaration =~ /^(yes|no)$/ )
        {
            $self->{OMIT_XML_DECL} = ( $1 eq 'yes' );
        }
        else
        {
            $self->{OMIT_XML_DECL} = $omit_xml_declaration ? 1 : 0;
        }
    }

    return exists $self->{OMIT_XML_DECL} ? $self->{OMIT_XML_DECL} : 0;
}

=item cdata_sections

Get or set the element names supplied via the cdata-section-elements
attribute (i.e. a space separated list of element names.)

=cut

sub cdata_sections
{
    my ( $self, $cdata_sections ) = @_;

    if ( defined $cdata_sections )
    {
        $self->{CDATA_SECTIONS} = $cdata_sections;
    }

    $self->{CDATA_SECTIONS} = [] unless exists $self->{CDATA_SECTIONS};

    return wantarray() ? @{ $self->{CDATA_SECTIONS} } : $self->{CDATA_SECTIONS};
}

sub is_cdata_section
{
    my ( $self, $element ) = @_;

    my %cdata_sections;

    my @cdata_temp = $self->cdata_sections();
    @cdata_sections{@cdata_temp} = (1) x @cdata_temp;

    my $tagname;

    if ( defined $element and ref($element) and ref($element) eq 'XML::DOM' )
    {
        $tagname = $element->getTagName();
    }
    else
    {
        $tagname = $element;
    }

    # Will need to do namespace checking on this really

    return exists $cdata_sections{$tagname} ? 1 : 0;
}

=item output_version

Gets and/or sets the XML version that will be used for the output
(defaults to default_xml_version())

=cut

sub output_version
{
    my ( $self, $output_version ) = @_;

    if ( defined $output_version )
    {
        $self->{OUTPUT_VERSION} = $output_version;
    }

    return exists $self->{OUTPUT_VERSION}
      ? $self->{OUTPUT_VERSION}
      : $self->default_xml_version();
}

sub __get_attribute_sets
{
    my ($self) = @_;

    my $doc     = $self->xsl_document();
    my $nsp     = $self->xsl_ns();
    my $tagname = $nsp . 'attribute-set';
	 my %inc;
	 my @included;
    foreach my $attribute_set ( $doc->getElementsByTagName( $tagname, 0 ) )
    {
        my $attribs = $attribute_set->getAttributes();
        next unless defined $attribs;
        my $name_attr = $attribs->getNamedItem('name');
        next unless defined $name_attr;
        my $name = $name_attr->getValue();
        $self->debug("processing attribute-set $name");

		  if ( my $uas = $attribs->getNamedItem('use-attribute-sets') )
		  {
			   $self->_indent();
            $inc{$name} = $uas->getValue();
				$self->debug("Attribute set $name includes $inc{$name}");
				push @included, $name;
			   $self->_outdent();
		  }

        my $attr_set = {};

        my $tagname = $nsp . 'attribute';

        foreach
          my $attribute ( $attribute_set->getElementsByTagName( $tagname, 0 ) )
        {
            my $attribs = $attribute->getAttributes();
            next unless defined $attribs;
            my $name_attr = $attribs->getNamedItem('name');
            next unless defined $name_attr;
            my $attr_name = $name_attr->getValue();
            $self->debug("Processing attribute $attr_name");
            if ($attr_name)
            {
                my $result = $self->xml_document()->createDocumentFragment();
                $self->_evaluate_template( $attribute, $self->xml_document(),
                    '/', $result );    # might need variables
                my $value =
                  $self->fix_attribute_value( $self->__string__($result) );
                $attr_set->{$attr_name} = $value;
                $result->dispose();
                $self->debug("Adding attribute $attr_name with value $value");
            }
        }

        $self->__attribute_set_( $name, $attr_set );

    }
	 foreach my $as (@included )
	 {
		 $self->_indent();
		 $self->debug("adding attributes from $inc{$as} to $as");
		 my %fix = (%{$self->__attribute_set_($as)},%{$self->__attribute_set_($inc{$as})});
       $self->__attribute_set_($as,\%fix);
		 $self->_outdent();
	 }
}

# Accessor for attribute sets

sub __attribute_set_
{
    my ( $self, $name, $attr_hash ) = @_;

    if ( defined $attr_hash && defined $name )
    {
		  if ( exists $self->{ATTRIBUTE_SETS}->{$name}  )
		  {
		     %{$self->{ATTRIBUTE_SETS}->{$name}} =
			               ( %{$self->{ATTRIBUTE_SETS}->{$name}}, %{$attr_hash});
		  }
		  else
		  {
           $self->{ATTRIBUTE_SETS}->{$name} = $attr_hash;
		  }
    }

    return defined $name
      && exists $self->{ATTRIBUTE_SETS}->{$name}
      ? $self->{ATTRIBUTE_SETS}->{$name}
      : undef;
}

sub open_project
{
    my $self = shift;
    my $xml  = shift;
    my $xsl  = shift;
    my ( $xmlflag, $xslflag, %args ) = @_;

    carp "open_project is deprecated."
      unless $self->use_deprecated()
      or exists $deprecation_used{open_project};
    $deprecation_used{open_project} = 1;

    $self->debug("opening project:");
    $self->_indent();

    $self->open_xml( $xml, %args );
    $self->open_xsl( $xsl, %args );

    $self->debug("done...");
    $self->_outdent();
}

=item transform(Source => $xml [, %args])

Processes the given XML through the stylesheet.  Returns an XML::DOM
object corresponding to the transformed XML.  Any arguments present
are passed to the XML::DOM::Parser.

=cut

sub transform
{
    my $self         = shift;

	 if ( keys %{$self->{VARIABLES}} )
	 {
		$self->debug("Adding variables");
		push @_,'variables', $self->{VARIABLES};
	 }

    my %topvariables = $self->__parse_args(@_);

    $self->debug("transforming document:");
    $self->_indent();

    $self->open_xml(%topvariables);

    $self->debug("done...");
    $self->_outdent();

    # The _get_attribute_set needs an open XML document

    $self->_indent();
    $self->__get_attribute_sets();
    $self->_outdent();

    $self->debug("processing project:");
    $self->_indent();

    $self->process(%topvariables);

    $self->debug("done!");
    $self->_outdent();
    $self->result_document()->normalize();
    return $self->result_document();
}

=item process(%variables)

Processes the previously loaded XML through the stylesheet using the
variables set in the argument.

=cut

sub process
{
    my ( $self, %topvariables ) = @_;

    $self->debug("processing project:");
    $self->_indent();

    my $root_template = $self->_match_template( "match", '/', 1, '' );

	 $self->debug(join ' ', keys %topvariables);
    %topvariables = (
        defined $topvariables{variables} ? %{$topvariables{variables}} : (),
        defined $self->{VARIABLES}
          && ref $self->{VARIABLES}
          && ref $self->{VARIABLES} eq 'ARRAY' ? @{ $self->{VARIABLES} } : ()
    );

	 $self->debug(join ' ', keys %topvariables);


    $self->_evaluate_template(
        $root_template,    # starting template: the root template
        $self->xml_document(),
        '',                          # current XML selection path: the root
        $self->result_document(),    # current result tree node: the root
        { () },                      # current known variables: none
        \%topvariables    # previously known variables: top level variables
    );

    $self->debug("done!");
    $self->_outdent();
}

# Handles deprecations.
sub AUTOLOAD
{
    my $self = shift;
    my $type = ref($self) || croak "Not a method call";
    my $name = $AUTOLOAD;
    $name =~ s/.*://;

    my %deprecation = (
        'output_string'      => 'toString',
        'result_string'      => 'toString',
        'output'             => 'toString',
        'result'             => 'toString',
        'result_mime_type'   => 'media_type',
        'output_mime_type'   => 'media_type',
        'result_tree'        => 'to_dom',
        'output_tree'        => 'to_dom',
        'transform_document' => 'transform',
        'process_project'    => 'process'
    );

    if ( exists $deprecation{$name} )
    {
        carp "$name is deprecated.  Use $deprecation{$name}"
          unless $self->use_deprecated()
          or exists $deprecation_used{$name};
        $deprecation_used{$name} = 1;
        eval qq{return \$self->$deprecation{$name}(\@_)};
    }
    else
    {
        croak "$name: No such method name";
    }
}

sub _my_print_text
{
    my ( $self, $FILE ) = @_;

    if ( UNIVERSAL::isa( $self, "XML::DOM::CDATASection" ) )
    {
        $FILE->print( $self->getData() );
    }
    else
    {
        $FILE->print( XML::DOM::encodeText( $self->getData(), "<&" ) );
    }
}

=item toString

Returns the result of transforming the XML with the stylesheet as a
string.

=cut

sub toString
{
    my $self = $_[0];

    local $^W;
    no warnings 'redefine';
    local *XML::DOM::Text::print = \&_my_print_text;

    my $string = '';

    if (defined $self->result_document() )
    {
      $string = $self->result_document()->toString();
    }
    return $string;
}

=item to_dom

Returns the result of transforming the XML with the stylesheet as an
XML::DOM object.

=cut

sub to_dom
{
    my ($self) = @_;

    my $document = XML::DOM::Document->new();

    my $dom = $self->result_document()->cloneNode(1);
    $dom->setOwnerDocument($document);
    $document->appendChild($dom);
    return $document;
}

=item media_type

Returns the media type (aka mime type) of the object.

=cut

sub media_type
{
    my ( $self, $media_type ) = @_;

    if ( defined $media_type )
    {
        $self->{MEDIA_TYPE} = $media_type;
    }

    return $self->{MEDIA_TYPE};
}

sub print_output
{
    my ( $self, $file, $mime ) = @_;
    $file ||= '';    # print to STDOUT by default
    $mime = 1 unless defined $mime;

    # print mime-type header etc by default

    #  $self->{RESULT_DOCUMENT}->printToFileHandle (\*STDOUT);
    #  or $self->{RESULT_DOCUMENT}->print (\*STDOUT); ???
    #  exit;

    carp "print_output is deprecated.  Use serve."
      unless $self->use_deprecated()
      or exists $deprecation_used{print_output};
    $deprecation_used{print_output} = 1;

    if ($mime)
    {
        print "Content-type: " . $self->media_type() . "\n\n";

        if ( $self->xsl_output_method =~ /(?:xml|html)/ )
        {
            unless ( $self->omit_xml_declaration() )
            {
                print $self->xml_declaration(), "\n";
            }
        }

        if ( my $doctype = $self->doctype() )
        {
            print "$doctype\n";
        }
    }

    if ($file)
    {
        if ( ref( \$file ) eq 'SCALAR' )
        {
            print $file $self->output_string, "\n";
        }
        else
        {
            if ( open( FILE, ">$file" ) )
            {
                print FILE $self->output_string, "\n";
                if ( !close(FILE) )
                {
                    die("Error writing $file: $!. Nothing written...\n");
                }
            }
            else
            {
                die("Error opening $file: $!. Nothing done...\n");
            }
        }
    }
    else
    {
        print $self->output_string, "\n";
    }
}

=item print_result

An alias for print_output

=cut

*print_result = *print_output;

sub doctype
{
    my ($self) = @_;

    my $doctype = "";

    if ( $self->doctype_public() || $self->doctype_system() )
    {
        my $root_name =
          $self->result_document()->getElementsByTagName( '*', 0 )->item(0)
          ->getTagName;

        if ( $self->doctype_public() )
        {
            $doctype =
                qq{
              . $self->doctype_public() . qq{" "}
              . $self->doctype_system() . qq{">};
        }
        else
        {
            $doctype =
              qq{
              . $self->doctype_system() . qq{">};
        }
    }

    $self->debug("returning doctype of $doctype");
    return $doctype;
}

=item dispose

Executes the C method on each XML::DOM object.

=cut

sub dispose
{

    $_[0]->result_document()->dispose if ( defined $_[0]->result_document() );

    if ( (not defined $_[0]->{XML_PASSED_AS_DOM} )
          and defined $_[0]->xml_document() )
    {
        $_[0]->xml_document()->dispose;
    }

    if ( (not defined $_[0]->{XSL_PASSED_AS_DOM} )
          and defined $_[0]->xsl_document() )
    {
	    $_[0]->xsl_document()->dispose;
    }

    $_[0]->_top_xsl_node()->dispose() if defined $_[0]->_top_xsl_node();



    foreach my $topkey ( %{$_[0]} )
    {
        $_[0]->{$topkey} = undef if defined $topkey;
    }

    $_[0] = undef;
}

######################################################################
# PRIVATE DEFINITIONS

sub __open_document
{
   my $self = shift;
   my %args = @_;
   %args = ( %{ $self->{PARSER_ARGS} }, %args );
   my $doc;

   $self->debug("opening document");

   eval {
      my $ref = ref( $args{Source} );
      if ( !$ref )
      {
         if (
               length $args{Source} < 255
            && $args{Source} !~ /\n/
            && ( -f $args{Source}
               || $args{Source} =~ /^(https?|ftp|file):/i )
           )
         {

            # Filename
            $self->debug("Opening URL");
            $doc = $self->__open_by_filename( $args{Source}, $args{base} );
         }
         else
         {

            # String
            $self->debug("Opening String");
            $doc = $self->{PARSER}->parse( $args{Source} );
         }
      }
      elsif ( $ref eq "SCALAR" )
      {

         # Stringref
         $self->debug("Opening Stringref");
         $doc = $self->{PARSER}->parse( ${ $args{Source} } );
      }
      elsif ( $args{Source}->isa('XML::DOM::Document') )
      {

         # DOM object
         $self->debug("Opening XML::DOM");
         $doc = $args{Source};
      }
      elsif ( $ref eq "GLOB" )
      {    # This is a file glob
         $self->debug("Opening GLOB");
         my $ioref = *{ $args{Source} }{IO};
         $doc = $self->{PARSER}->parse($ioref);
      }
      elsif ( UNIVERSAL::isa( $args{Source}, 'IO::Handle' ) )
      {    # IO::Handle
         $self->debug("Opening IO::Handle");
         $doc = $self->{PARSER}->parse( $args{Source} );
      }
      else
      {
         $doc = undef;
      }
   };
   die "Error while parsing: $@\n" . $args{Source} if $@;
   return $doc;
}

# private auxiliary function #
sub __open_by_filename
{
    my ( $self, $filename, $base ) = @_;
    my $doc;

    # ** FIXME: currently reads the whole document into memory
    #           might not be avoidable

    # LWP should be able to deal with files as well as links
    $ENV{DOMAIN} ||= "example.com";    # hide complaints from Net::Domain

    my $file = get( URI->new_abs( $filename, $base ) );

    return $self->{PARSER}->parse( $file, defined $self->{PARSER_ARGS} ? %{ $self->{PARSER_ARGS} } : undef );
}

sub _match_template
{
    my ( $self, $attribute_name, $select_value, $xml_count, $xml_selection_path,
        $mode )
      = @_;
    $mode ||= "";

    my $template         = "";
    my @template_matches = ();

    $self->debug(
            qq{matching template for "$select_value" with count $xml_count\n\t}
          . qq{and path "$xml_selection_path":} );

    if ( $attribute_name eq "match" && ref $self->{TEMPLATE_MATCH} )
    {
        push @template_matches, @{ $self->{TEMPLATE_MATCH} };
    }
    elsif ( $attribute_name eq "name" && ref $self->{TEMPLATE_NAME} )
    {
        push @template_matches, @{ $self->{TEMPLATE_NAME} };
    }

  # note that the order of @template_matches is the reverse of $self->{TEMPLATE}
    my $count = @template_matches;

    $self->debug("matches: @template_matches");

    foreach my $original_match (@template_matches)
    {

        # templates with no match or name or with both simultaniuously
        # have no $template_match value
        if ($original_match)
        {
            my $full_match = $original_match;

            # multipe match? (for example: match="*|/")
            while ( $full_match =~ s/^(.+?)\|// )
            {
                my $match = $1;
                if (
                    &__template_matches__(
                        $match,     $select_value,
                        $xml_count, $xml_selection_path
                    )
                  )
                {
                    $self->debug(
                        qq{  found #$count with "$match" in "$original_match"});

                    $template = ( $self->templates() )[ $count - 1 ];
                    return $template;

                    #	  last;
                }
            }

            # last match?
            if ( !$template )
            {
                if (
                    &__template_matches__(
                        $full_match, $select_value,
                        $xml_count,  $xml_selection_path
                    )
                  )
                {
                    $self->debug(
qq{  found #$count with "$full_match" in "$original_match"}
                    );
                    $template = ( $self->templates() )[ $count - 1 ];
                    return $template;

                    #          last;
                }
                else
                {
                    $self->debug(qq{  #$count "$original_match" did not match});
                }
            }
        }
        $count--;
    }

    if ( !$template )
    {
        $self->warn(qq{No template matching `$xml_selection_path' found !!});
    }

    return $template;
}

# auxiliary function #
sub __template_matches__
{
    my ( $template, $select, $count, $path ) = @_;

    my $nocount_path = $path;
    $nocount_path =~ s/\[.*?\]//g;

    if (   ( $template eq $select )
        || ( $template eq $path )
        || ( $template eq "$select\[$count\]" )
        || ( $template eq "$path\[$count\]" ) )
    {

        # perfect match or path ends with templates match
        #print "perfect match","\n";
        return "True";
    }
    elsif (
           ( $template eq substr( $path, -length($template) ) )
        || ( $template eq substr( $nocount_path, -length($template) ) )
        || ( "$template\[$count\]" eq substr( $path, -length($template) ) )
        || (
            "$template\[$count\]" eq substr( $nocount_path, -length($template) )
        )
      )
    {

        # template matches tail of path matches perfectly
        #print "perfect tail match","\n";
        return "True";
    }
    elsif ( $select =~ /\[\s*(\@.*?)\s*=\s*(.*?)\s*\]$/ )
    {

        # match attribute test
        my $attribute = $1;
        my $value     = $2;
        return "";    # False, no test evaluation yet #
    }
    elsif ( $select =~ /\[\s*(.*?)\s*=\s*(.*?)\s*\]$/ )
    {

        # match test
        my $element = $1;
        my $value   = $2;
        return "";    # False, no test evaluation yet #
    }
    elsif ( $select =~ /(\@\*|\@[\w\.\-\:]+)$/ )
    {

        # match attribute
        my $attribute = $1;

        #print "attribute match?\n";
        return ( ( $template eq '@*' )
              || ( $template eq $attribute )
              || ( $template eq "\@*\[$count\]" )
              || ( $template eq "$attribute\[$count\]" ) );
    }
    elsif ( $select =~ /(\*|[\w\.\-\:]+)$/ )
    {

        # match element
        my $element = $1;

        #print "element match?\n";
        return ( ( $template eq "*" )
              || ( $template eq $element )
              || ( $template eq "*\[$count\]" )
              || ( $template eq "$element\[$count\]" ) );
    }
    else
    {
        return "";    # False #
    }
}

sub _evaluate_test
{
    my ( $self, $test, $current_xml_node, $current_xml_selection_path,
        $variables ) = @_;

    $self->_indent();
    my $rc = 0;

    my $cond;

    $self->debug("evaluating $test");
    foreach my $test_part ( split /\s+\b(or|and)\b\s+/, $test )
    {
        $self->debug("evaluating part $test_part");

        if ( $test_part =~ /^(or|and)$/i )
        {
            $cond = $1;
            $self->debug("got '$cond'");
        }
        else
        {
            my $one_rc = $self->_evaluate_test_one($test_part,$current_xml_node, $current_xml_selection_path, $variables );

            if (!$cond)
            {
                $self->debug("using response");
                $rc = $one_rc;
            }
            elsif( $cond eq 'or' )
            {
                $self->debug("or'ing response");
                $rc |= $one_rc;
            }
            elsif( $cond eq 'and' )
            {
                $self->debug("and'ing response");
                $rc &= $one_rc;
            }
        }
    }

    $self->_outdent();
    return $rc;
}

sub _evaluate_test_one
{
    my ( $self, $test, $current_xml_node, $current_xml_selection_path, $variables )
      = @_;

    $self->_indent();
    $self->debug("processing test $test");

    my $rc = 0;

    if ( $test =~ /^(.+)\/\[(.+)\]$/ )
    {
        my $path = $1;
        my $test = $2;

        $self->debug("evaluating test $test at path $path:");

        my $node =
          $self->_get_node_set( $path, $self->xml_document(),
            $current_xml_selection_path, $current_xml_node, $variables );
        if (@$node)
        {
            $rc = $self->_evaluate_test_one($test,$node->[0], $current_xml_selection_path, $variables);
        }
    }
    else
    {
        $self->debug("evaluating path or test $test:");
        my $node =
          $self->_get_node_set( $test, $self->xml_document(),
            $current_xml_selection_path, $current_xml_node, $variables,
            "silent" );
        if (@$node)
        {
            $self->debug("path exists!");
            $rc = 1;
        }
        else
        {
            $self->debug("not a valid path, evaluating as test");
            $rc = $self->__evaluate_test__( $test, $current_xml_selection_path,
        $current_xml_node, $variables );
        }
    }


    $self->debug("test evaluates @{[ $rc ? 'true': 'false']}");

    $self->_outdent();
    return $rc;
}

sub _evaluate_template
{
    my ( $self, $template, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    $self->debug( qq{evaluating template content with current path }
          . qq{"$current_xml_selection_path": } );
    $self->_indent();

    die "No Template"
      unless defined $template && ref $template;
    $template->normalize;

    foreach my $child ( $template->getChildNodes )
    {
        my $ref = ref $child;

        $self->debug("$ref");
        $self->_indent();
        my $node_type = $child->getNodeType;
        if ( $node_type == ELEMENT_NODE )
        {
            $self->_evaluate_element( $child, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );
        }
        elsif ( $node_type == TEXT_NODE )
        {
            my $value = $child->getNodeValue;
            if ( length($value) and $value !~ /^[\x20\x09\x0D\x0A]+$/s )
            {
                $self->_add_node( $child, $current_result_node );
            }
        }
        elsif ( $node_type == CDATA_SECTION_NODE )
        {
            my $text = $self->_create_text_node( $child->getData );
            $self->_add_node( $text, $current_result_node );
        }
        elsif ( $node_type == ENTITY_REFERENCE_NODE )
        {
            $self->_add_node( $child, $current_result_node );
        }
        elsif ( $node_type == DOCUMENT_TYPE_NODE )
        {

            # skip #
            $self->debug("Skipping Document Type node...");
        }
        elsif ( $node_type == COMMENT_NODE )
        {

            # skip #
            $self->debug("Skipping Comment node...");
        }
        else
        {
            $self->warn(
"evaluate-template: Dunno what to do with node of type $ref !!!\n\t"
                  . "($current_xml_selection_path)" );
        }

        $self->_outdent();
    }

    $self->debug("done!");
    $self->_outdent();
}

sub _add_node
{
    my ( $self, $node, $parent, $deep, $owner ) = @_;
    $owner ||= $self->xml_document();

    my $what = defined $deep ? 'deep' : 'non-deep';

    $self->debug("adding node ($what)..");

    $node = $node->cloneNode($deep);
    $node->setOwnerDocument($owner);
    if ( $node->getNodeType == ATTRIBUTE_NODE )
    {
        $parent->setAttributeNode($node);
    }
    else
    {
        $parent->appendChild($node);
    }
}

sub _apply_templates
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;
    my $children;
    my $params       = {};
    my $newvariables = defined $variables ? {%$variables} : {};

    my $select = $xsl_node->getAttribute('select');

    if ( $select =~ /\$/ and defined $variables )
    {

        # replacing occurences of variables:
        foreach my $varname ( keys(%$variables) )
        {
				$self->debug("Applying variable $varname");
            $select =~ s/[^\\]\$$varname/$$variables{$varname}/g;
        }
    }

    if ($select)
    {
        $self->debug(
qq{applying templates on children select of "$current_xml_selection_path":}
        );
        $children =
          $self->_get_node_set( $select, $self->xml_document(),
            $current_xml_selection_path, $current_xml_node, $variables );
    }
    else
    {
        $self->debug(
qq{applying templates on all children of "$current_xml_selection_path":}
        );
        $children = [ $current_xml_node->getChildNodes ];
    }

    $self->_process_with_params( $xsl_node,
				                     $current_xml_node,
                                 $current_xml_selection_path,
											$variables,
											$params );

    # process xsl:sort here

    $self->_indent();

    my $count = 1;
    foreach my $child (@$children)
    {
        my $node_type = $child->getNodeType;

        if ( $node_type == DOCUMENT_TYPE_NODE )
        {

            # skip #
            $self->debug("Skipping Document Type node...");
        }
        elsif ( $node_type == DOCUMENT_FRAGMENT_NODE )
        {

            # skip #
            $self->debug("Skipping Document Fragment node...");
        }
        elsif ( $node_type == NOTATION_NODE )
        {

            # skip #
            $self->debug("Skipping Notation node...");
        }
        else
        {

            my $newselect = "";
            my $newcount  = $count;
            if ( !$select || ( $select eq '.' ) )
            {
                if ( $node_type == ELEMENT_NODE )
                {
                    $newselect = $child->getTagName;
                }
                elsif ( $node_type == ATTRIBUTE_NODE )
                {
                    $newselect = "@$child->getName";
                }
                elsif (( $node_type == TEXT_NODE )
                    || ( $node_type == ENTITY_REFERENCE_NODE ) )
                {
                    $newselect = "text()";
                }
                elsif ( $node_type == PROCESSING_INSTRUCTION_NODE )
                {
                    $newselect = "processing-instruction()";
                }
                elsif ( $node_type == COMMENT_NODE )
                {
                    $newselect = "comment()";
                }
                else
                {
                    my $ref = ref $child;
                    $self->debug("Unknown node encountered: `$ref'");
                }
            }
            else
            {
                $newselect = $select;
                if ( $newselect =~ s/\[(\d+)\]$// )
                {
                    $newcount = $1;
                }
            }

            $self->_select_template(
                $child,                      $newselect,
                $newcount,                   $current_xml_node,
                $current_xml_selection_path, $current_result_node,
                $newvariables,               $params
            );
        }
        $count++;
    }

    $self->_outdent();
}

sub _for_each
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    my $ns = $self->xsl_ns();
    my $select = $xsl_node->getAttribute('select')
      || die "No `select' attribute in for-each element";

    if ( $select =~ /\$/ )
    {

        # replacing occurences of variables:
        foreach my $varname ( keys(%$variables) )
        {
            $select =~ s/[^\\]\$$varname/$$variables{$varname}/g;
        }
    }

    if ( defined $select )
    {
        $self->debug(
qq{applying template for each child $select of "$current_xml_selection_path":}
        );


        my $children = $self->_get_node_set( $select,
					                              $self->xml_document(),
                                             $current_xml_selection_path,
															$current_xml_node, $variables );

		  my $sort = $xsl_node->getElementsByTagName("$ns:sort",0);

        if ( my $nokeys = $sort->getLength() )
		  {
		     $self->debug("going to sort with $nokeys");
		  }

        $self->_indent();
        my $count = 1;
        foreach my $child (@$children)
        {
            my $node_type = $child->getNodeType;

            if ( $node_type == DOCUMENT_TYPE_NODE )
            {

                # skip #
                $self->debug("Skipping Document Type node...");
            }
            elsif ( $node_type == DOCUMENT_FRAGMENT_NODE )
            {

                # skip #
                $self->debug("Skipping Document Fragment node...");
            }
            elsif ( $node_type == NOTATION_NODE )
            {

                # skip #
                $self->debug("Skipping Notation node...");
            }
            else
            {

                $self->_evaluate_template(
                    $xsl_node,
                    $child,
                    "$current_xml_selection_path/$select\[$count\]",
                    $current_result_node,
                    $variables,
                    $oldvariables
                );
            }
            $count++;
        }

        $self->_outdent();
    }
    else
    {
        $self->warn(qq%expected attribute "select" in <${ns}for-each>%);
    }

}

sub _select_template
{
    my ( $self, $child, $select, $count, $current_xml_node,
        $current_xml_selection_path, $current_result_node, $variables,
        $oldvariables )
      = @_;

    my $ref = ref $child;
    $self->debug(
qq{selecting template $select for child type $ref of "$current_xml_selection_path":}
    );

    $self->_indent();

    foreach my $select_part ( split /\|/, $select )
    {
    my $child_xml_selection_path = "$current_xml_selection_path/$select_part";
    my $template                 =
      $self->_match_template( "match", $select_part, $count,
        $child_xml_selection_path );

    if ($template)
    {

        $self->_evaluate_template( $template, $child,
            "$child_xml_selection_path\[$count\]",
            $current_result_node, $variables, $oldvariables );
    }
    else
    {
        $self->debug("skipping template selection...");
    }

 }

    $self->_outdent();
}

sub _evaluate_element
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;
    my ( $ns, $xsl_tag ) = split( ':', $xsl_node->getTagName );

    if ( not defined $xsl_tag )
    {
        $xsl_tag = $ns;
        $ns      = $self->default_ns();
    }
    else
    {
        $ns .= ':';
    }
    $self->debug(
        qq{evaluating element `$xsl_tag' from `$current_xml_selection_path': });
    $self->_indent();

    if ( $ns eq $self->xsl_ns() )
    {
        my @attributes = $xsl_node->getAttributes->getValues;
        $self->debug(qq{This is an xsl tag});
        if ( $xsl_tag eq 'apply-templates' )
        {
            $self->_apply_templates( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );

        }
        elsif ( $xsl_tag eq 'attribute' )
        {
            $self->_attribute( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );

        }
        elsif ( $xsl_tag eq 'call-template' )
        {
            $self->_call_template( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );

        }
        elsif ( $xsl_tag eq 'choose' )
        {
            $self->_choose( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );

        }
        elsif ( $xsl_tag eq 'comment' )
        {
            $self->_comment( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );

        }
        elsif ( $xsl_tag eq 'copy' )
        {
            $self->_copy( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );

        }
        elsif ( $xsl_tag eq 'copy-of' )
        {
            $self->_copy_of( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables );
        }
        elsif ( $xsl_tag eq 'element' )
        {
            $self->_element( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );
        }
        elsif ( $xsl_tag eq 'for-each' )
        {
            $self->_for_each( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );

        }
        elsif ( $xsl_tag eq 'if' )
        {
            $self->_if( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );

            #      } elsif ($xsl_tag eq 'output') {

        }
        elsif ( $xsl_tag eq 'param' )
        {
            $self->_variable( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables, 1 );

        }
        elsif ( $xsl_tag eq 'processing-instruction' )
        {
            $self->_processing_instruction( $xsl_node, $current_result_node );

        }
        elsif ( $xsl_tag eq 'text' )
        {
            $self->_text( $xsl_node, $current_result_node );

        }
        elsif ( $xsl_tag eq 'value-of' )
        {
            $self->_value_of( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables );

        }
        elsif ( $xsl_tag eq 'variable' )
        {
            $self->_variable( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables, 0 );

        }
        elsif ( $xsl_tag eq 'sort' )
        {
            $self->_sort( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables, 0 );
        }
        elsif ( $xsl_tag eq 'fallback' )
        {
            $self->_fallback( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables, 0 );
        }
        elsif ( $xsl_tag eq 'attribute-set' )
        {
            $self->_attribute_set( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables, 0 );
        }
        else
        {
            $self->_add_and_recurse( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );
        }
    }
    else
    {
        $self->debug( $ns . " does not match " . $self->xsl_ns() );

        # not entirely sure if this right but the spec is a bit vague

        if ( $self->is_cdata_section($xsl_tag) )
        {
            $self->debug("This is a CDATA section element");
            $self->_add_cdata_section( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );
        }
        else
        {
            $self->debug("This is a literal element");
            $self->_check_attributes_and_recurse( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );
        }
    }

    $self->_outdent();
}

sub _add_cdata_section
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    my $node = $self->xml_document()->createElement( $xsl_node->getTagName );

    my $cdata = '';

    foreach my $child_node ( $xsl_node->getChildNodes() )
    {
        if ( $child_node->can('asString') )
        {
            $cdata .= $child_node->asString();
        }
        else
        {
            $cdata .= $child_node->getNodeValue();
        }
    }

    $node->addCDATA($cdata);

    $current_result_node->appendChild($node);

}

sub _add_and_recurse
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

# the addition is commented out to prevent unknown xsl: commands to be printed in the result
    $self->_add_node( $xsl_node, $current_result_node );
    $self->_evaluate_template( $xsl_node, $current_xml_node,
        $current_xml_selection_path, $current_result_node, $variables,
        $oldvariables );    #->getLastChild);
}

sub _check_attributes_and_recurse
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    $self->_add_node( $xsl_node, $current_result_node );
    $self->_attribute_value_of(
        $current_result_node->getLastChild, $current_xml_node,
        $current_xml_selection_path,        $variables
    );
    $self->_evaluate_template( $xsl_node, $current_xml_node,
        $current_xml_selection_path, $current_result_node->getLastChild,
        $variables, $oldvariables );
}

sub _element
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    my $name = $xsl_node->getAttribute('name');
    $self->debug(qq{inserting Element named "$name":});
    $self->_indent();

    if ( defined $name )
    {
        my $result = $self->xml_document()->createElement($name);

        $self->_evaluate_template( $xsl_node, $current_xml_node,
            $current_xml_selection_path, $result, $variables, $oldvariables );

	 	  $self->_apply_attribute_set($xsl_node,$result);
        $current_result_node->appendChild($result);
    }
    else
    {
        $self->warn(
            q{expected attribute "name" in <} . $self->xsl_ns() . q{element>} );
    }
    $self->_outdent();
}

sub _apply_attribute_set
{
   my ( $self,$xsl_node, $output_node) = @_;

   my $attr_set = $xsl_node->getAttribute('use-attribute-sets');

   if ($attr_set)
   {
      $self->_indent();
      my $set_name = $attr_set;

      if ( my $set = $self->__attribute_set_($set_name) )
      {
         $self->debug("Adding attribute-set '$set_name'");

         foreach my $attr_name ( keys %{$set} )
         {
           $self->debug(
                        "Adding attribute $attr_name ->" . $set->{$attr_name} );
           $output_node->setAttribute( $attr_name, $set->{$attr_name} );
         }
      }
      $self->_outdent();
   }
}

{
    ######################################################################
    # Auxiliary package for disable-output-escaping
    ######################################################################

    package XML::XSLT::DOM::TextDOE;
    use vars qw( @ISA );
    @ISA = qw( XML::DOM::Text );

    sub print
    {
        my ( $self, $FILE ) = @_;
        $FILE->print( $self->getData );
    }
}

sub _value_of
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables )
      = @_;

    my $select = $xsl_node->getAttribute('select');

    # Need to determine here whether the value is an XPath expression
    # and act accordingly

    my $xml_node;

    if ( defined $select )
    {
        $xml_node = $self->_get_node_set( $select,
					                           $self->xml_document(),
                                          $current_xml_selection_path,
														$current_xml_node,
														$variables );

        $self->debug("stripping node to text:");

        $self->_indent();
        my $text = '';
        $text = $self->__string__( $xml_node->[0] ) if @{$xml_node};
        $self->_outdent();

        if ( $text ne '' )
        {
            my $node = $self->_create_text_node($text);
            if ( $xsl_node->getAttribute('disable-output-escaping') eq 'yes' )
            {
                $self->debug("disabling output escaping");
                bless $node, 'XML::XSLT::DOM::TextDOE';
            }
            $self->_move_node( $node, $current_result_node );
        }
        else
        {
            $self->debug("nothing left..");
        }
    }
    else
    {
        $self->warn( qq{expected attribute "select" in <}
              . $self->xsl_ns()
              . q{value-of>} );
    }
}

# Convenience as we do this a lot.
sub _create_text_node
{
    my ( $self, $text ) = @_;

    return $self->xml_document()->createTextNode($text);
}

sub __strip_node_to_text__
{
    my ( $self, $node ) = @_;

    my $result = "";

    my $node_type = $node->getNodeType;
    if ( $node_type == TEXT_NODE )
    {
        $result = $node->getData;
    }
    elsif (( $node_type == ELEMENT_NODE )
        || ( $node_type == DOCUMENT_FRAGMENT_NODE ) )
    {
        $self->_indent();
        foreach my $child ( $node->getChildNodes )
        {
            $result .= &__strip_node_to_text__( $self, $child );
        }
        $self->_outdent();
    }
    return $result;
}

sub __string__
{
    my ( $self, $node, $depth ) = @_;

    my $result = "";

    if ( defined $node )
    {
        my $ref = ( ref($node) || "not a reference" );
        $self->debug("stripping child nodes ($ref):");

        $self->_indent();

        if ( $ref eq "ARRAY" )
        {
            my $str = $self->__string__( $$node[0], $depth );
            $self->_outdent();
            return $str;
        }
        else
        {
            my $node_type = $node->getNodeType;

            if (   ( $node_type == ELEMENT_NODE )
                || ( $node_type == DOCUMENT_FRAGMENT_NODE )
                || ( $node_type == DOCUMENT_NODE ) )
            {
                foreach my $child ( $node->getChildNodes )
                {
                    $result .= &__string__( $self, $child, 1 );
                }
            }
            elsif ( $node_type == ATTRIBUTE_NODE )
            {
                $result .= $node->getValue;
            }
            elsif (( $node_type == TEXT_NODE )
                || ( $node_type == CDATA_SECTION_NODE )
                || ( $node_type == ENTITY_REFERENCE_NODE ) )
            {
                $result .= $node->getData;
            }
            elsif (
                !$depth
                && (   ( $node_type == PROCESSING_INSTRUCTION_NODE )
                    || ( $node_type == COMMENT_NODE ) )
              )
            {
                $result .= $node->getData;   # COM,PI - only in 'top-level' call
            }
            else
            {

                # just to be consistent
                $self->warn("Can't get string-value for node of type $ref !");
            }
        }

        $self->debug(qq{  "$result"});
        $self->_outdent();
    }
    else
    {
        $self->debug(" no result");
    }

    return $result;
}

sub _move_node
{
    my ( $self, $node, $parent ) = @_;

    $self->debug("moving node..");

    $parent->appendChild($node);
}

# returns an array ref of nodes
sub _get_node_set
{
   my ( $self, $path, $root_node, $current_path, $current_node, $variables,
      $silent )
     = @_;
   $current_path ||= "/";
   $current_node ||= $root_node;
   $silent       ||= 0;

   $self->{VARIABLES} ||= {};
   $variables ||= {};

   %{$variables} = ( %{ $self->{VARIABLES} }, %{$variables} );
   $self->debug(qq{getting node-set "$path" from "$current_path"});

   $self->_indent();

   $path = $self->_expand_abbreviations($path);

   my $return_nodes = [];

   if ( my $varname = $self->_variable_name($path) )
   {
       $self->debug('got a variable');
       $return_nodes = $self->_expand_variable($varname, $variables);
   }
   elsif ( $path =~ /^'([^']*)'$/ )
   {
       # this is for the convenience of _process arguments
       $self->debug("got a literal '$1'");
       $return_nodes = [ $self->_create_text_node($1) ];
   }
   elsif ( $path eq $current_path || $path eq 'self::node()' )
   {
      $self->debug("direct hit!");
      $return_nodes = [$current_node];
   }
   else
   {

      # open external documents first #
      if ($path =~ /^\s*document\s*\(["'](.*?)["']\s*(,\s*(.*)\s*){0,1}\)\s*(.*)$/)
      {
         my $filename = $1;
         my $sec_arg  = $3;
         $path = ( $4 || "" );

         $self->debug(qq{external selection ("$filename")!});

         if ($sec_arg)
         {
            $self->warn("Ignoring second argument of $path");
         }

         ($root_node) = $self->__open_by_filename( $filename, $self->{XSL_BASE} );
      }

      foreach my $path_part ( split( /\|/, $path ) )
      {
         $self->debug("path_part: $path_part");

         if ( my @func_nodes = $self->_process_function( $path_part, $root_node, $current_path, $current_node, $variables, $silent ) )
         {
             push @{$return_nodes}, @func_nodes;
         }
         else
         {
         if ( $path_part =~ /^\// )
         {

            # start from the root #
            $current_node = $root_node;
         }
         elsif ( $path_part =~ /^self\:\:node\(\)\// )
         {    #'#"#'#"
             # remove preceding dot from './etc', which is expanded to 'self::node()'
             # at the top of this subroutine #
            $path_part =~ s/^self\:\:node\(\)//;
         }
         else
         {

            # to facilitate parsing, precede path with a '/' #
            $path_part = "/$path_part";
         }

         $self->debug(qq{using "$path_part":});

         if ( $path_part eq '/' )
         {
            push @{$return_nodes}, @{$current_node};
         }
         else
         {
            push @{$return_nodes},
              @{$self->__get_node_set__($path_part,[$current_node],$silent)};
         }
        }

      }
   }
   $self->_outdent();
   return $return_nodes;
}

# given a path_part and the remaining arguments of _get_node_set
# will return a set of nodes if it is indeed a function call, otherwise
# an empty list

# The builtin functions are implemented as _XSLT_FUNC_ and are
# passed $root_node, $current_path, $current_node, $variables and a list of
# arguments which are themselves array refs of nodes that will have been expanded
# from _get_node_list.
#
sub _process_function
{
    my ( $self, $path_part, $root_node, $current_path, $current_node, $variables, $silent ) = @_;
   my @nodes;

   $self->_indent();
   $self->debug("check to see if we have a function");
   if ( $path_part =~ /^([a-z-]+)\(\s*(.*)\s*\)/ )
   {
       $self->debug("'$path_part' likes like a function call");

       my $func = $1;
       my $args = $2;

       my $meth_name = "_XSLT_FUNC_$func";
       $meth_name =~ s/-/_/g;

       if ( $self->can($meth_name ) )
       {
           $self->debug("got implementation for $func()");
           my @args = $self->_process_function_arguments($args,$root_node, $current_path, $current_node, $variables);
           @nodes = $self->$meth_name($root_node, $current_path, $current_node, $variables, @args);
       }
       else
       {
           $self->debug("$func() either invalid or not implemented");
       }

   }

   $self->_outdent();

    return @nodes;
}

# _process_function_arguments takes a string representing the arguments
# and $root_node, $current_path, $current_node, $variables, splits the
# arguments on comma and whitespace and processes each resulting "path"
# with _get_node_list to derive a list of array refs of nodes that are to be
# passed to the function implementation
#

sub _process_function_arguments
{
    my ( $self, $args, $root_node, $current_path, $current_node, $variables ) = @_;

    my @res;

    $self->_indent();
    $self->debug("processing args");
    foreach my $arg ( split /\s*,\s*/, $args )
    {
        $self->debug("Going to get node set for $arg");
        push @res, $self->_get_node_set($arg, $root_node, $current_path, $current_node, $variables);
    }

    $self->_outdent();

    return @res;
}

# move these elsewhere when we are done

sub _XSLT_FUNC_concat
{
    my ( $self, $root_node, $current_path, $current_node, $variables, @args ) = @_;

    $self->_indent();
    $self->debug("processing concat() with " . @args . " arguments");

   my @nodes; # will only be one

   my $string;
   foreach my $arg ( $self->_arguments_to_strings(@args ))
   {
           $string = "" unless defined $string;
           $string .= $arg if defined $arg;
   }

   if ( defined $string )
   {
       $self->debug("Returning '$string'");
       push @nodes, $self->_create_text_node($string);
   }

   $self->_outdent();
   return @nodes;
}

sub _XSLT_FUNC_translate
{
    my ( $self, $root_node, $current_path, $current_node, $variables, @args ) = @_;

    $self->_indent();
    $self->debug("processing translate() with " . @args . " arguments");

   my @nodes; # will only be one

   if ( @args == 3 )
   {
       my ( $string, $from, $to ) = $self->_arguments_to_strings(@args);

      if ( defined $string && defined $from && defined $to )
      {
          $self->debug("substituting '$to' for '$from' in '$string'");

          $string =~ s/$from/$to/g;
          $self->debug("Returning '$string'");
          push @nodes, $self->_create_text_node($string);
      }
   }

   $self->_outdent();
   return @nodes;
}

# handy for string processing

sub _arguments_to_strings
{
   my ( $self, @args ) = @_;

   my @ret;
   foreach my $arg (@args)
   {
      if ( ref $arg )
      {
         if ( @{$arg} )
         {
            my $string = $self->__strip_node_to_text__( $arg->[0] );
            push @ret, $string;
         }
      }
   }
   return @ret;
}

# given a path it returns a version with common expansions.
sub _expand_abbreviations
{
   my ( $self, $path ) = @_;

   # expand abbriviated syntax
   $path =~ s/current\(\s*\)/./g;
   $path =~ s/\@/attribute\:\:/g;
   $path =~ s/\.\./parent\:\:node\(\)/g;
   $path =~ s/\./self\:\:node\(\)/g;
   $path =~ s/\/\//\/descendant\-or\-self\:\:node\(\)\//g;

   return $path;
}

# This returns an array reference of nodes
# if it is a simple text variable then this will be created as text node first
sub _expand_variable
{
   my ( $self, $varname, $variables ) = @_;

   $self->_indent();
   my $ret = [];
   $self->debug("looking for variable $varname");
   $self->debug( join ' ', keys %{$variables} );
   my $var = $variables->{$varname};
   if ( defined $var )
   {
      if ( ref( $var ) eq 'ARRAY' )
      {

         # node-set array-ref
         $ret = $var;
      }
      elsif ( ref( $var ) eq 'XML::DOM::NodeList' )
      {

         # node-set nodelist
         $ret = [ @{ $var } ];
      }
      elsif ( ref( $var ) eq 'XML::DOM::DocumentFragment' )
      {

         # node-set documentfragment
         $ret = [ $var->getChildNodes() ];
      }
      else
      {
          $self->debug("$varname is literal '$var'");
         # string or number?
         $ret = [$self->_create_text_node($var)];
      }
   }

   return $ret;
}

# given a candidate expression will return an extracted
# variable name if it looks like a variable.
sub _variable_name
{
    my ( $self, $part ) = @_;

    my $rc;

    if ($part && $part =~ /^\$([\w\.\-]+)$/ )
    {
        $rc = $1
    }
    return $rc;
}

# auxiliary function #
sub __get_node_set__
{
    my ( $self, $path, $node, $silent ) = @_;

    # a Qname (?) should actually be: [a-Z_][\w\.\-]*\:[a-Z_][\w\.\-]*

	 my $list = [];

    if ( $path eq "" )
    {

       $self->debug("node found!");
       push @{$list}, @{$node};

    }
    else
    {
           foreach my $item (@$node)
           {
               my $sublist = $self->__try_a_step__( $path, $item, $silent );
               push @{$list}, @{$sublist} ;
           }
	}

   return $list;
}

sub __try_a_step__
{
    my ( $self, $path, $node, $silent ) = @_;


	 $self->_indent();
	 $self->debug("Trying $path >");
    if ( $path =~ s/^\/parent\:\:node\(\)// )
    {

        # /.. #
        $self->debug(qq{getting parent ("$path")});
        return $self->__parent__(  $path, $node, $silent );

    }
    elsif ( $path =~ s/^\/attribute\:\:(\*|[\w\.\:\-]+)// )
    {

        # /@attr #
        $self->debug(qq{getting attribute `$1' ("$path")});
        return $self->__attribute__( $1, $path, $node, $silent );

    }
    elsif ( $path =~
s/^\/descendant\-or\-self\:\:node\(\)\/(child\:\:|)(\*|[\w\.\:\-]+)\[(.+?)\]//
      )
    {

        # //elem[n] #
        $self->debug(qq{getting deep indexed element `$1' `$2' ("$path")});
        $self->_outdent();
        return &__indexed_element__( $self, $1, $2, $path, $node, $silent,
            "deep" );

    }
    elsif ( $path =~ s/^\/descendant\-or\-self\:\:node\(\)\/(\*|[\w\.\:\-]+)// )
    {

        # //elem #
        $self->debug(qq{getting deep element `$1' ("$path")});
        $self->_outdent();
        return &__element__( $self, $1, $path, $node, $silent, "deep" );

    }
    elsif ( $path =~ s/^\/(child\:\:|)(\*|[\w\.\:\-]+)\[(.+?)\]// )
    {

        # /elem[n] #
        $self->debug(qq{getting indexed element `$2' `$3' ("$path")});
        $self->_outdent();
        return &__indexed_element__( $self, $2, $3, $path, $node, $silent );

    }
    elsif ( $path =~ s/^\/(child\:\:|)text\(\)// )
    {

        # /text() #
        $self->debug(qq{getting text ("$path")});
        $self->_outdent();
        return &__get_nodes__( $self, TEXT_NODE, $path, $node, $silent );

    }
    elsif ( $path =~ s/^\/(child\:\:|)processing-instruction\(\)// )
    {

        # /processing-instruction() #
        $self->debug(qq{getting processing instruction ("$path")});
        $self->_outdent();
        return $self->__get_nodes__(PROCESSING_INSTRUCTION_NODE,
					                     $path,
												$node,
                                    $silent );

    }
    elsif ( $path =~ s/^\/(child\:\:|)comment\(\)// )
    {

        # /comment() #
        $self->debug(qq{getting comment ("$path")});
        $self->_outdent();
        return &__get_nodes__( $self, COMMENT_NODE, $path, $node, $silent );

    }
    elsif ( $path =~ s/^\/(child\:\:|)(\*|[\w\.\:\-]+)// )
    {

        # /elem #
        $self->debug(qq{getting element `$2' ("$path")});
        $self->_outdent();
        return &__element__( $self, $2, $path, $node, $silent );

    }
    else
    {
        $self->warn(
            "get-node-from-path: Don't know what to do with path $path !!!");
        $self->_outdent();
        return [];
    }
}

sub __parent__
{
    my ( $self, $path, $node, $silent ) = @_;

    $self->_indent();
    if (   ( $node->getNodeType == DOCUMENT_NODE )
        || ( $node->getNodeType == DOCUMENT_FRAGMENT_NODE ) )
    {
        $self->debug("no parent!");
        $node = [];
    }
    else
    {
        $node = $node->getParentNode;

        $node = &__get_node_set__( $self, $path, [$node], $silent );
    }
    $self->_outdent();

    return $node;
}

sub __indexed_element__
{
   my ( $self, $element, $index, $path, $node, $silent, $deep ) = @_;
   $index ||= 0;
   $deep  ||= "";    # False #

   my $xpath;

   $self->debug("got element $element and index $index at $path");
   if ( $index =~ /^\d+$/ )
   {
      $self->debug("got a numeric index");
      $index--;
   }
   else
   {
      $self->debug("index is an expression");
      if ( $index =~ /^first\s*\(\)/ )
      {
         $index = 0;
      }
      elsif ( $index =~ /^last\s*\(\)/ )
      {
         $index = -1;
      }
      elsif ( $index =~ /attribute::(\S+)/ )
      {
          $xpath = "$element\[\@$1\]";
          $index = 0;
      }
   }

   my @list;
   if ( $xpath )
   {
       $self->debug("tring with expression $xpath");
       @list = $node->findnodes($xpath);
   }
   else
   {
       @list = $node->getElementsByTagName( $element, $deep );
   }

   $self->debug( "got " . @list . " candidate elements" );
   if (@list)
   {
      $self->debug("Getting index item $index");
      $node = $list[$index];
   }
   else
   {
      $node = "";
   }

   $self->_indent();
   if ($node)
   {
      $node = &__get_node_set__( $self, $path, [$node], $silent );
   }
   else
   {
      $self->debug("failed!");
      $node = [];
   }
   $self->_outdent();

   return $node;
}

sub __element__
{
    my ( $self, $element, $path, $node, $silent, $deep ) = @_;
    $deep ||= "";    # False #

    $node = [ $node->getElementsByTagName( $element, $deep ) ];

    $self->_indent();
    if (@$node)
    {
        $node = $self->__get_node_set__( $path, $node, $silent );
    }
    else
    {
        $self->debug("failed!");
    }
    $self->_outdent();

    return $node;
}

sub __attribute__
{
    my ( $self, $attribute, $path, $node, $silent ) = @_;

    $self->_indent();

    if ( $attribute eq '*' )
    {
        $node = [ $node->getAttributes->getValues ];

        if ($node)
        {
            $node = &__get_node_set__( $self, $path, $node, $silent );
        }
        else
        {
            $self->debug("failed!");
        }
    }
    else
    {
        $node = $node->getAttributeNode($attribute);

        if ($node)
        {
            $node = &__get_node_set__( $self, $path, [$node], $silent );
        }
        else
        {
            $self->debug("failed!");
            $node = [];
        }
    }

    $self->_outdent();

    return $node;
}

sub __get_nodes__
{
    my ( $self, $node_type, $path, $node, $silent ) = @_;

    my $result = [];

    $self->_indent();
    foreach my $child ( $node->getChildNodes )
    {
        if ( $child->getNodeType == $node_type )
        {
            push @{$result}, @{$self->__get_node_set__($path,
									                            [$child], $silent )};
        }
    }
    $self->_outdent();

    if ( !@$result )
    {
        $self->debug("failed!");
    }

    return $result;
}

sub _attribute_value_of
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $variables )
      = @_;

    foreach my $attribute ( $xsl_node->getAttributes->getValues )
    {
        my $value = $attribute->getValue;
        study($value);

        #$value =~ s/(\*|\$|\@|\&|\?|\+|\\)/\\$1/g;
        $value =~ s/(\*|\?|\+)/\\$1/g;
        study($value);
        while ( $value =~ /\G[^\\]*\{(.*?[^\\]*)\}/ )
        {
            my $node =
              $self->_get_node_set( $1, $self->xml_document(),
                $current_xml_selection_path, $current_xml_node, $variables );
            if (@$node)
            {
                $self->_indent();
                my $text = $self->__string__( $$node[0] );
                $self->_outdent();
                $value =~ s/(\G[^\\]*)\{(.*?)[^\\]*\}/$1$text/;
            }
            else
            {
                $value =~ s/(\G[^\\]*)\{(.*?)[^\\]*\}/$1/;
            }
        }

        #$value =~ s/\\(\*|\$|\@|\&|\?|\+|\\)/$1/g;
        $value =~ s/\\(\*|\?|\+)/$1/g;
        $value =~ s/\\(\{|\})/$1/g;
        $attribute->setValue($value);
    }
}

sub _processing_instruction
{
    my ( $self, $xsl_node, $current_result_node, $variables, $oldvariables ) =
      @_;

    my $new_PI_name = $xsl_node->getAttribute('name');

    if ( $new_PI_name eq "xml" )
    {
        $self->warn( "<"
              . $self->xsl_ns()
              . "processing-instruction> may not be used to create XML" );
        $self->warn(
            "declaration. Use <" . $self->xsl_ns() . "output> instead..." );
    }
    elsif ($new_PI_name)
    {
        my $text   = $self->__string__($xsl_node);
        my $new_PI =
          $self->xml_document()
          ->createProcessingInstruction( $new_PI_name, $text );

        if ($new_PI)
        {
            $self->_move_node( $new_PI, $current_result_node );
        }
    }
    else
    {
        $self->warn( q{Expected attribute "name" in <}
              . $self->xsl_ns()
              . "processing-instruction> !" );
    }
}

sub _process_with_params
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $variables, $params )
      = @_;

    my @params =
      $xsl_node->getElementsByTagName( $self->xsl_ns() . "with-param" );
    foreach my $param (@params)
    {
        my $varname = $param->getAttribute('name');

        if ($varname)
        {
            my $value = $param->getAttribute('select');

            if ( !$value )
            {

                # process content as template
                $value = $self->xml_document()->createDocumentFragment;

                $self->_evaluate_template( $param, $current_xml_node,
                    $current_xml_selection_path, $value, $variables, {} );
                $$params{$varname} = $value;

            }
            else
            {

                # *** FIXME - should evaluate this as an expression!
                $$params{$varname} = $value;
            }
        }
        else
        {
            $self->warn( q{Expected attribute "name" in <}
                  . $self->xsl_ns()
                  . q{with-param> !} );
        }
    }

}

sub _call_template
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    my $params       = {};
    my $newvariables = defined $variables ? {%$variables} : {};
    my $name         = $xsl_node->getAttribute('name');

    if ($name)
    {
        $self->debug(qq{calling template named "$name"});

        $self->_process_with_params( $xsl_node, $current_xml_node,
            $current_xml_selection_path, $variables, $params );

        $self->_indent();
        my $template = $self->_match_template( "name", $name, 0, '' );

        if ($template)
        {
            $self->_evaluate_template( $template, $current_xml_node,
                $current_xml_selection_path, $current_result_node,
                $newvariables, $params );
        }
        else
        {
            $self->warn("no template named $name found!");
        }
        $self->_outdent();
    }
    else
    {
        $self->warn( q{Expected attribute "name" in <}
              . $self->xsl_ns()
              . q{call-template/>} );
    }
}

sub _choose
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    $self->debug("evaluating choose:");

    $self->_indent();

    my $notdone  = "true";
    my $testwhen = "active";
    foreach my $child ( $xsl_node->getElementsByTagName( '*', 0 ) )
    {
        if (   $notdone
            && $testwhen
            && ( $child->getTagName eq $self->xsl_ns() . "when" ) )
        {
            my $test = $child->getAttribute('test');

            if ($test)
            {
                my $test_succeeds =
                  $self->_evaluate_test( $test, $current_xml_node,
                    $current_xml_selection_path, $variables );
                if ($test_succeeds)
                {
                    $self->_evaluate_template( $child, $current_xml_node,
                        $current_xml_selection_path, $current_result_node,
                        $variables, $oldvariables );
                    $testwhen = "";
                    $notdone  = "";
                }
            }
            else
            {
                $self->warn( q{expected attribute "test" in <}
                      . $self->xsl_ns()
                      . q{when>} );
            }
        }
        elsif ( $notdone
            && ( $child->getTagName eq $self->xsl_ns() . "otherwise" ) )
        {
            $self->_evaluate_template( $child, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );
            $notdone = "";
        }
    }

    if ($notdone)
    {
        $self->debug("nothing done!");
    }

    $self->_outdent();
}

sub _if
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    $self->debug("evaluating if:");

    $self->_indent();

    my $test = $xsl_node->getAttribute('test');

    if ($test)
    {
        my $test_succeeds =
          $self->_evaluate_test( $test, $current_xml_node,
            $current_xml_selection_path, $variables );
        if ($test_succeeds)
        {
            $self->_evaluate_template( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $current_result_node, $variables,
                $oldvariables );
        }
    }
    else
    {
        $self->warn(
            q{expected attribute "test" in <} . $self->xsl_ns() . q{if>} );
    }

    $self->_outdent();
}

sub __evaluate_test__
{
    my ( $self, $test, $path, $node, $variables ) = @_;

    my $rc = 0;
    my $tagname = eval { $node->getTagName() } || '';

    $self->debug(qq{testing with "$test" and $tagname});

	 if ($test =~ /^\s*(\S+?)\s*(<=|>=|!=|<|>|=)\s*(\S+?)\s*$/)
	 {
		 my $lhs       = $1;
         my $test_cond = $2;
		 my $rhs        = $3;
	     $self->debug("Test LHS: $lhs COND: $test_cond RHS: $rhs");

         my $content = $self->_get_first_value($lhs, $path, $node, $variables);
         my $expval = $self->_get_first_value($rhs, $path, $node, $variables);

         $rc =  $self->_evaluate_test_expression($content, $test_cond, $expval);
	 }
    else
    {
       $self->debug("no match for test [$test]");
    }

   return $rc;
}

# convenience for above

sub _get_first_value
{
   my ( $self, $test_path, $path, $node, $variables ) = @_;

   if ( $test_path =~ /^\d+$/ )
   {
       $test_path = "'$test_path'";
   }

   my $content;

   my $nodeset = $self->_get_node_set( $test_path,
                                       $self->xml_document(),
                                       $path,
                                       $node,
                                       $variables );

   if ( @{$nodeset} )
   {
      $content = $self->__string__( $nodeset->[0] );
   }
   else
   {
       $self->debug("didn't get a result for $test_path");
   }

   return $content;

}

=item _evaluate_test_expression

Given two values and a condition return a boolean.

=cut

sub _evaluate_test_expression
{
   my ( $self, $content, $test_cond, $expval ) = @_;

   my $rc = 0;

   if ( defined $content && defined $test_cond && defined $expval )
   {
      my $numeric = ( $content =~ /^\d+$/ && $expval =~ /^\d+$/ ? 1 : 0 );

      $self->debug("evaluating $content $test_cond $expval");

      $test_cond =~ s/\s+//g;

      if ( $test_cond eq '!=' )
      {
         $rc = $numeric ? $content != $expval : $content ne $expval;
      }
      elsif ( $test_cond eq '=' )
      {
         $rc = $numeric ? $content == $expval : $content eq $expval;
      }
      elsif ( $test_cond eq '<' )
      {
         $rc = $numeric ? $content < $expval : $content lt $expval;
      }
      elsif ( $test_cond eq '>' )
      {
         $rc = $numeric ? $content > $expval : $content gt $expval;
      }
      elsif ( $test_cond eq '>=' )
      {
         $rc = $numeric ? $content >= $expval : $content ge $expval;
      }
      elsif ( $test_cond eq '<=' )
      {
         $rc = $numeric ? $content <= $expval : $content le $expval;
      }
      else
      {
         $self->debug("no test matches");
      }
   }
   else
   {
      $self->debug("not all test parts defined");
   }

   return $rc;

}

sub _copy_of
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables )
      = @_;

    my $nodelist;
    my $select = $xsl_node->getAttribute('select');
    $self->debug(qq{evaluating copy-of with select "$select":});

    $self->_indent();
    if ($select)
    {
        $nodelist =
          $self->_get_node_set( $select, $self->xml_document(),
            $current_xml_selection_path, $current_xml_node, $variables );
    }
    else
    {
        $self->warn( q{expected attribute "select" in <}
              . $self->xsl_ns()
              . q{copy-of>} );
    }
    foreach my $node (@$nodelist)
    {
        $self->_add_node( $node, $current_result_node, "deep" );
    }

    $self->_outdent();
}

sub _copy
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    $self->debug("evaluating copy:");

    $self->_indent();
    if ( $current_xml_node->getNodeType == ATTRIBUTE_NODE )
    {
        my $attribute = $current_xml_node->cloneNode(0);
        $current_result_node->setAttributeNode($attribute);
    }
    elsif (( $current_xml_node->getNodeType == COMMENT_NODE )
        || ( $current_xml_node->getNodeType == PROCESSING_INSTRUCTION_NODE ) )
    {
        $self->_add_node( $current_xml_node, $current_result_node );
    }
    else
    {
        $self->_add_node( $current_xml_node, $current_result_node );
		  $self->_apply_attribute_set($xsl_node,$current_result_node->getLastChild());
        $self->_evaluate_template( $xsl_node, $current_xml_node,
            $current_xml_selection_path, $current_result_node->getLastChild,
            $variables, $oldvariables );
    }
    $self->_outdent();
}

sub _text
{

  #=item addText (text)
  #
  #Appends the specified string to the last child if it is a Text node, or else
  #appends a new Text node (with the specified text.)
  #
  #Return Value: the last child if it was a Text node or else the new Text node.
    my ( $self, $xsl_node, $current_result_node ) = @_;

    $self->debug("inserting text:");

    $self->_indent();

    $self->debug("stripping node to text:");

    $self->_indent();
    my $text = $self->__string__($xsl_node);
    $self->_outdent();

    if ( $text ne '' )
    {
        my $node = $self->_create_text_node($text);
        if ( $xsl_node->getAttribute('disable-output-escaping') eq 'yes' )
        {
            $self->debug("disabling output escaping");
            bless $node, 'XML::XSLT::DOM::TextDOE';
        }
        $self->_move_node( $node, $current_result_node );
    }
    else
    {
        $self->debug("nothing left..");
    }

    $current_result_node->normalize();

    $self->_outdent();
}

sub _attribute
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    my $name = $xsl_node->getAttribute('name');
    $self->debug(qq{inserting attribute named "$name":});
    $self->_indent();

    if ($name)
    {
        if ( $name =~ /^xmlns:/ )
        {
            $self->debug("Won't create namespace declaration");
        }
        else
        {
            my $result = $self->xml_document()->createDocumentFragment;

            $self->_evaluate_template( $xsl_node, $current_xml_node,
                $current_xml_selection_path, $result, $variables,
                $oldvariables );

            $self->_indent();
            my $text = $self->fix_attribute_value( $self->__string__($result) );

            $self->_outdent();

            $current_result_node->setAttribute( $name, $text );
            $result->dispose();
        }
    }
    else
    {
        $self->warn( q{expected attribute "name" in <}
              . $self->xsl_ns()
              . q{attribute>} );
    }
    $self->_outdent();
}

sub _comment
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $oldvariables )
      = @_;

    $self->debug("inserting comment:");

    $self->_indent();

    my $result = $self->xml_document()->createDocumentFragment;

    $self->_evaluate_template( $xsl_node, $current_xml_node,
        $current_xml_selection_path, $result, $variables, $oldvariables );

    $self->_indent();
    my $text = $self->__string__($result);
    $self->_outdent();

    $self->_move_node( $self->xml_document()->createComment($text),
        $current_result_node );
    $result->dispose();

    $self->_outdent();
}

sub _variable
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $params, $is_param )
      = @_;

    my $varname = $xsl_node->getAttribute('name');

    if ($varname)
    {
        $self->debug("definition of variable \$$varname:");

        $self->_indent();

        if ( $is_param and exists $$params{$varname} )
        {

            $self->debug("copying from parent-template");
            # copy from parent-template

            $$variables{$varname} = $$params{$varname};

        }
        else
        {
            $self->debug("new variable");

            # new variable definition

            my $value = $xsl_node->getAttribute('select');

            if ( !$value )
            {
                $self->debug("no select - evaluate as template");

                #tough case, evaluate content as template

                $value = $self->xml_document()->createDocumentFragment;

                $self->_evaluate_template( $xsl_node, $current_xml_node,
                    $current_xml_selection_path, $value, $variables, $params );
            }
            else    # either a literal or path
            {
                if ( $value =~ /^'(.*)'$/ )
                {
                    $self->debug('literal value $1');
                    $value = $1;
                }
                else
                {
                    $self->debug("processing as a path");

                    my $node =
                      $self->_get_node_set( $value, $self->xml_document(),
                        $current_xml_selection_path, $current_xml_node,
                        $variables );
                    $value = $self->__string__($node);

                }

            }
            $variables->{$varname} = $value;
        }

        $self->_outdent();
    }
    else
    {
        $self->warn( q{expected attribute "name" in <}
              . $self->xsl_ns()
              . q{param> or <}
              . $self->xsl_ns()
              . q{variable>} );
    }
}

# not implemented - but log it and make it go away

sub _sort
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $params, $is_param )
      = @_;

    $self->debug("dummy process for sort");
}

# Not quite sure how fallback should be implemented as the spec seems a
# little vague to me

sub _fallback
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $params, $is_param )
      = @_;

    $self->debug("dummy process for fallback");
}

# This is a no-op - attribute-sets should not appear within templates and
# we have already processed the stylesheet wide ones.

sub _attribute_set
{
    my ( $self, $xsl_node, $current_xml_node, $current_xml_selection_path,
        $current_result_node, $variables, $params, $is_param )
      = @_;

    $self->debug("in _attribute_set");
}

sub _indent
{
    my ($self) = @_;
    $self->{INDENT} += $self->{INDENT_INCR};

}

sub _outdent
{
    my ($self) = @_;
    $self->{INDENT} -= $self->{INDENT_INCR};
}

sub fix_attribute_value
{
    my ( $self, $text ) = @_;

    # The spec say's that there can't be a literal line break in the
    # attributes value - white space at the beginning or the end is
    # almost certainly an mistake.

    $text =~ s/^\s+//g;
    $text =~ s/\s+$//g;

    if ($text)
    {
        $text =~ s/([\x0A\x0D])/sprintf("\&#%02X;",ord $1)/eg;
    }

    return $text;
}

1;

__DATA__