view release on metacpan or  search on metacpan

lib/XML/LibXML/LazyBuilder.pm  view on Meta::CPAN

package XML::LibXML::LazyBuilder;

use 5.008000;
use strict;
use warnings FATAL => 'all';

use Carp         ();
use Scalar::Util ();
use XML::LibXML  ();

# consider using Exporter::Lite - djt
require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use XML::LibXML::LazyBuilder ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	DOM E P C D F DTD
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
);

our $VERSION = '0.08';

# This is a map of all the DOM level 3 node names for
# non-element/attribute nodes. Note how there is no provision for
# processing instructions.
my %NODES = (
    '#cdata-section'     => 1,
    '#comment'           => 1,
    '#document'          => 1,
    '#document-fragment' => 1,
    '#text'              => 1,
);

# Note this is and will remain a stub until appropriate behaviour can
# be worked out.

# (Perhaps a name of ?foo for processing instructions?)

# nah, special methods for non-element nodes!



# Preloaded methods go here.


# This predicate is an alternative to using UNIVERSAL::isa as a
# function (which is a no-no); it will return true if a blessed
# reference is derived from a built-in reference type.

sub _is_really {
    my ($obj, $type) = @_;
    return unless defined $obj and ref $obj;
    return Scalar::Util::blessed($obj) ? $obj->isa($type) : ref $obj eq $type;
}

sub DOM ($;$$) {
    my ($sub, $ver, $enc) = @_;

    my $dom = XML::LibXML::Document->new ($ver || "1.0", $enc || "utf-8");

    # this whole $dom $sub thing is cracking me up ;) -- djt
    my $node = $sub->($dom);

    if (_is_really($node, 'XML::LibXML::DocumentFragment')) {
        # "Appending a document fragment node to a document node not
        # supported yet!", says XML::LibXML, so we work around it.

        for my $child ($node->childNodes) {
            #warn $child->ownerDocument;
            $child->unbindNode;
            if ($child->nodeType == 1) {
                if (my $root = $dom->documentElement) {
                    unless ($root->isSameNode($child)) {
                        Carp::croak("Trying to insert a second root element");
                    }
                }
                else {
                    $dom->setDocumentElement($child);
                }
            }
            else {
                $dom->appendChild($child);
            }
        }
    }
    elsif (_is_really($node, 'XML::LibXML::Element')) {
        # NO-OP: Elements get attached to the root from inside the E