File Coverage

blib/lib/XML/LibXML/Enhanced.pm

Criterion	Covered	Total	%
statement	22	42	52.3
branch	0	4	0.0
condition	0	3	0.0
subroutine	8	15	53.3
pod			n/a
total	30	64	46.8

use strict;
use warnings;

our $VERSION = "0.01";

=head1 NAME

XML::LibXML::Enhanced - adds convenience methods to XML::LibXML and LibXSLT

=head1 SYNOPSIS

  use XML::LibXML::Enhanced;

  my $xml = XML::LibXML::Singleton->instance;
  my $xsl = XML::LibXSLT::Singleton->instance;

  my $doc = $xml->parse_xml_string("");

  my $root = $doc->getDocumentElement;

  $root->appendHash({ name => 'Michael', email => '[e-mail]' });

=head1 DESCRIPTION

=head1 ADDED FUNCTIONS

=over 4

=item $xml = parse_xml_file($filename)

=item $xml = parse_xml_string($string)

=item $xml = parse_xml_chunk($string)

Parses a file or string, and returns an XML::LibXML::Document
(parse_xml_file(), parse_xml_string()) or
XML::LibXML::DocumentFragment (parse_xml_chunk()).

That is, the equivalent of
XML::LibXML::Singleton->instance->parse_file($filename), etc.

=item $xsl = parse_xslt_file($filename)

=item $xsl = parse_xslt_string($string)

Parses a file or string, and returns an XML::LibXSLT::Stylesheet.
(L.)

That is, the equivalent of
XML::LibXSLT::Singleton->instance->parse_stylesheet(XML::LibXML::Singleton->instance->parse_file($filename)),
etc.

=back

=cut

package XML::LibXML::Enhanced;

use base qw(Exporter);
use vars qw(@EXPORT_OK);

@EXPORT_OK = qw(
    parse_xml_file  parse_xml_string  parse_xml_chunk
    parse_xslt_file parse_xslt_string promote
);

sub parse_xml_file {
    if (wantarray) {
	return map {
	    XML::LibXML::Singleton->instance->parse_file($_)
	} @_;
    }
    else {
	return XML::LibXML::Singleton->instance->parse_file($_[0]);
    }
}

sub parse_xml_string {
    return XML::LibXML::Singleton->instance->parse_string(@_);
}

sub parse_xml_chunk {
    return XML::LibXML::Singleton->instance->parse_balanced_chunk(@_);
}

sub parse_xslt_file {
    if (wantarray) {
	return map {
	    XML::LibXSLT::Singleton->instance->parse_stylesheet(parse_xml_file($_))
	} @_;
    }
    else {
	return XML::LibXSLT::Singleton->instance->parse_stylesheet(parse_xml_file($_[0]));
    }
}

sub parse_xslt_string {
    return XML::LibXSLT::Singleton->instance->parse_stylesheet(parse_xml_string(@_));
}

sub promote {
    return XML::LibXSLT::xpath_to_string(@_);
}

=head1 ADDED CLASSES

=head2 XML::LibXML::Singleton

Singleton version of XML::LibXML; get an instance via
Cinstance>.

Note that the methods C and C have
been called on the returned object; see C for futher
details.

=cut

package XML::LibXML::Singleton;

use base qw(XML::LibXML Class::Singleton);

sub _new_instance {
    my ($proto, @args) = @_;

    my $class = ref($proto) || $proto;

    my $self = $class->SUPER::new(@args);

    $self->load_ext_dtd(0);
    $self->validation(0);

    $self;
}

=head2 XML::LibXSLT::Singleton

Singleton version of XML::LibXSLT; get an instance via
Cinstance>.

=cut

package XML::LibXSLT::Singleton;

use base qw(XML::LibXSLT Class::Singleton);

=head1 ADDED METHODS

=head2 TO XML::LibXML::Node

=over 4

=cut

package XML::LibXML::Node;

use Carp;
use XML::LibXML qw(XML_ELEMENT_NODE XML_TEXT_NODE);
use HTML::Entities;
use Data::Eacherator qw(eacherator);

=item $n->appendHash( $hash [, $values_are_text ])

Converts C<$hash> to an XML element, and adds it to C<$n>.  (That is,
the opposite of C<$hash = $n-EtoHash>.)

If C<$values_are_text> is 1, the values of the hash are treated as
text, and are XML-encoded (C<&> to C<&> and so forth) before being
added to the node.

If C<$values_are_text> is 0 or undefined, the values of the hash are
treated as XML, and are parsed before being added to the node.  In
this case, the key values must be either be well-formed XML, or
well-balanced XML chunks.  (i.e. "" is okay, but not
"".)  If neither is true, a comment will be inserted in the place
of value--C.

For example, if

  $hash = {
    name => "Clive",
    email => "[e-mail]",
  };

and

  $node

is




then

  $node->appendHash($hash);

results in the C<$node>


      Clive
      [e-mail]


NOTE: attribute names (i.e. key values) are lowercased.

=cut

sub appendHash {
    my ($self, $data, $values_are_text) = @_;

    my $doc = $self->getOwnerDocument;

    my $iter = eacherator($data);

    while (my ($k, $v) = $iter->()) {

	my $n = $doc->createElement($k);

	if ((defined $v) && ($v ne '') && !ref($v)) {

	    if ($values_are_text) {
		$n->appendChild($doc->createTextNode($v));
	    }

	    else {
		my $c = eval {
		    XML::LibXML::Singleton->instance->parse_balanced_chunk($v);
		};
		if ($@) {
		    $n->appendChild(
			$doc->createComment("NOT BALANCED XML")
		    );
		}
		else {
		    $n->appendChild(
			$doc->adoptNode($c)
		    );
		}
	    }
	}

	$self->appendChild($n);
    }

    $data; # because $n->appendChild($c) returns $c
}

=item $n->appendAttributeHash( $hash )

Adds attributes to node C<$n>.

=cut

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

    my $iter = eacherator($data);

    while (my ($k, $v) = $iter->()) {
	$self->setAttribute($k, $v);
    }

    $data;
}

=item $h = $n->toHash( [ $values_are_text ] )

Returns a simple hash reference representation of node C<$n>.  (That
is, the opposite of C<$n-EappendHash($h)>.)

If C<$values_are_text> is 1, an XML decoding of the values is
performed.  (C<&> to C<&>, etc.)

If C<$values_are_text> is 0 or undefined, then no transformation of
the values are performed.

For example, when C is called on the C node


    Michael
    [e-mail]


the return value will be

  {
    name => 'Michael',
    email => '[e-mail]',
  }

B:

=over 4

=item o

order is not necessarily preserved, and if two or more tags of the
same name are present, only one will be present in the hash.

=item o

attributes are discarded.

=back

=cut

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

    # The grep below filters out non element nodes because we need to
    # skip text nodes in the event of mixed content.

    my $hash = {
	map {
	    $_->nodeName, $_->childrenToString
	}
	grep {
	    $_->nodeType == XML_ELEMENT_NODE
	}
	$self->childNodes
    };

    if ($values_are_text) {

	# createTextNode() encodes its argument; we need to perform
	# the reverse process here.  (& => &, and so on.)

	foreach (values %$hash) {
	    $_ = decode_entities($_);
	}

    }

    return $hash;
}

=item $h = $n->toAttributeHash

=cut

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

    return { map { $_->nodeName, $_->value } $self->attributes };
}

=item $n->appendRow($hash [, $name ])

Similar to C except that the appended hash is added
as child of a C<$name> element.  That is, if C<$n> is the node
"", C<$n-EappendRow({ name =E 'Michael' }, "row")> results
in



      Michael



C<$name> defaults to "row".

=cut

sub appendRow {
    my ($self, $hash, $name, $values_are_text) = @_;

    $name = "row" unless defined $name;
    $values_are_text = 0 unless defined $values_are_text;

    my $doc = $self->getOwnerDocument;
    my $row = $doc->createElement(lc($name));

    $row->appendHash($hash, $values_are_text);

    return $self->appendChild($row);
}

=item $s = $n->childrenToString

Like C except that only the node's I are
stringified--the opening and closing tags of the node itself are
omitted.  (This may create a "balanced chunk.")

=cut

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

    return join('', map { defined $_->toString ? $_->toString : '' } $self->childNodes);
}

=back

=head1 AUTHOR

Michael Stillwell

=cut

1;

__END__