XML-XSLT
view release on metacpan or search on metacpan
lib/XML/XSLT.pm view on Meta::CPAN
##############################################################################
#
# Perl module: XML::XSLT
#
# By Geert Josten, gjosten@sci.kun.nl
# and Egon Willighagen, egonw@sci.kun.nl
#
# $Log: XSLT.pm,v $
# Revision 1.25 2004/02/19 08:38:40 gellyfish
# * Fixed overlapping attribute-sets
# * Allow multiple nodes for processing-instruction() etc
# * Added test for for-each
#
# Revision 1.24 2004/02/18 08:34:38 gellyfish
# * Fixed select on "comment()" "processing-instruction()" etc
# * Added test for select
#
# Revision 1.23 2004/02/17 10:06:12 gellyfish
# * Added test for xsl:copy
#
# Revision 1.22 2004/02/17 08:52:29 gellyfish
# * 'use-attribute-sets' works in xsl:copy and recursively
#
# Revision 1.21 2004/02/16 10:29:20 gellyfish
# * Fixed variable implementation to handle non literals
# * refactored test implementation
# * added tests
#
# Revision 1.20 2003/06/24 16:34:51 gellyfish
# * Allowed both name and match attributes in templates
# * Lost redefinition warning with perl 5.8
#
# Revision 1.19 2002/02/18 09:05:14 gellyfish
# Refactoring
#
# Revision 1.18 2002/01/16 21:05:27 gellyfish
# * Added the manpage as an example
# * Started to properly implement omit-xml-declaration
#
# Revision 1.17 2002/01/13 10:35:00 gellyfish
# Updated pod
#
# Revision 1.16 2002/01/09 09:17:40 gellyfish
# * added test for <xsl:text>
# * Stylesheet whitespace stripping as per spec and altered tests ...
#
# Revision 1.15 2002/01/08 10:11:47 gellyfish
# * First cut at cdata-section-element
# * test for above
#
# Revision 1.14 2001/12/24 16:00:19 gellyfish
# * Version released to CPAN
#
# Revision 1.13 2001/12/20 09:21:42 gellyfish
# More refactoring
#
# Revision 1.12 2001/12/19 21:06:31 gellyfish
# * Some refactoring and style changes
#
# Revision 1.11 2001/12/19 09:11:14 gellyfish
# * Added more accessors for object attributes
# * Fixed potentially broken usage of $variables in _evaluate_template
#
# Revision 1.10 2001/12/18 09:10:10 gellyfish
# Implemented attribute-sets
#
# Revision 1.9 2001/12/17 22:32:12 gellyfish
# * Added Test::More to Makefile.PL
# * Added _indent and _outdent methods
# * Placed __get_attribute_sets in transform()
#
# Revision 1.8 2001/12/17 11:32:08 gellyfish
# * Rolled in various patches
# * Added new tests
#
#
###############################################################################
=head1 NAME
XML::XSLT - A perl module for processing XSLT
=cut
######################################################################
package XML::XSLT;
######################################################################
use strict;
use XML::DOM 1.25;
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.48';
@ISA = qw( Exporter );
@EXPORT_OK = qw( &transform &serve );
lib/XML/XSLT.pm view on Meta::CPAN
$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;
}
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;
}
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(),
lib/XML/XSLT.pm view on Meta::CPAN
{
$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();
( run in 0.515 second using v1.01-cache-2.11-cpan-39bf76dae61 )