--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/dummy_foundation/lib/XML/DOM.pm Thu May 28 10:10:03 2009 +0100
@@ -0,0 +1,5065 @@
+################################################################################
+#
+# Perl module: XML::DOM
+#
+# By Enno Derksen <enno@att.com>
+#
+################################################################################
+#
+# To do:
+#
+# * optimize Attr if it only contains 1 Text node to hold the value
+# * fix setDocType!
+#
+# * BUG: setOwnerDocument - does not process default attr values correctly,
+# they still point to the old doc.
+# * change Exception mechanism
+# * maybe: more checking of sysId etc.
+# * NoExpand mode (don't know what else is useful)
+# * various odds and ends: see comments starting with "??"
+# * normalize(1) could also expand CDataSections and EntityReferences
+# * parse a DocumentFragment?
+# * encoding support
+#
+######################################################################
+
+######################################################################
+package XML::DOM;
+######################################################################
+
+use strict;
+use vars qw( $VERSION @ISA @EXPORT
+ $IgnoreReadOnly $SafeMode $TagStyle
+ %DefaultEntities %DecodeDefaultEntity
+ );
+use Carp;
+use XML::RegExp;
+
+BEGIN
+{
+ require XML::Parser;
+ $VERSION = '1.27';
+
+ my $needVersion = '2.23';
+ die "need at least XML::Parser version $needVersion (current=${XML::Parser::VERSION})"
+ unless $XML::Parser::VERSION >= $needVersion;
+
+ @ISA = qw( Exporter );
+
+ # Constants for XML::DOM Node types
+ @EXPORT = qw(
+ UNKNOWN_NODE
+ ELEMENT_NODE
+ ATTRIBUTE_NODE
+ TEXT_NODE
+ CDATA_SECTION_NODE
+ ENTITY_REFERENCE_NODE
+ ENTITY_NODE
+ PROCESSING_INSTRUCTION_NODE
+ COMMENT_NODE
+ DOCUMENT_NODE
+ DOCUMENT_TYPE_NODE
+ DOCUMENT_FRAGMENT_NODE
+ NOTATION_NODE
+ ELEMENT_DECL_NODE
+ ATT_DEF_NODE
+ XML_DECL_NODE
+ ATTLIST_DECL_NODE
+ );
+}
+
+#---- Constant definitions
+
+# Node types
+
+sub UNKNOWN_NODE () { 0 } # not in the DOM Spec
+
+sub ELEMENT_NODE () { 1 }
+sub ATTRIBUTE_NODE () { 2 }
+sub TEXT_NODE () { 3 }
+sub CDATA_SECTION_NODE () { 4 }
+sub ENTITY_REFERENCE_NODE () { 5 }
+sub ENTITY_NODE () { 6 }
+sub PROCESSING_INSTRUCTION_NODE () { 7 }
+sub COMMENT_NODE () { 8 }
+sub DOCUMENT_NODE () { 9 }
+sub DOCUMENT_TYPE_NODE () { 10}
+sub DOCUMENT_FRAGMENT_NODE () { 11}
+sub NOTATION_NODE () { 12}
+
+sub ELEMENT_DECL_NODE () { 13 } # not in the DOM Spec
+sub ATT_DEF_NODE () { 14 } # not in the DOM Spec
+sub XML_DECL_NODE () { 15 } # not in the DOM Spec
+sub ATTLIST_DECL_NODE () { 16 } # not in the DOM Spec
+
+%DefaultEntities =
+(
+ "quot" => '"',
+ "gt" => ">",
+ "lt" => "<",
+ "apos" => "'",
+ "amp" => "&"
+);
+
+%DecodeDefaultEntity =
+(
+ '"' => """,
+ ">" => ">",
+ "<" => "<",
+ "'" => "'",
+ "&" => "&"
+);
+
+#
+# If you don't want DOM warnings to use 'warn', override this method like this:
+#
+# { # start block scope
+# local *XML::DOM::warning = \&my_warn;
+# ... your code here ...
+# } # end block scope (old XML::DOM::warning takes effect again)
+#
+sub warning # static
+{
+ warn @_;
+}
+
+#
+# This method defines several things in the caller's package, so you can use named constants to
+# access the array that holds the member data, i.e. $self->[_Data]. It assumes the caller's package
+# defines a class that is implemented as a blessed array reference.
+# Note that this is very similar to using 'use fields' and 'use base'.
+#
+# E.g. if $fields eq "Name Model", $parent eq "XML::DOM::Node" and
+# XML::DOM::Node had "A B C" as fields and it was called from package "XML::DOM::ElementDecl",
+# then this code would basically do the following:
+#
+# package XML::DOM::ElementDecl;
+#
+# sub _Name () { 3 } # Note that parent class had three fields
+# sub _Model () { 4 }
+#
+# # Maps constant names (without '_') to constant (int) value
+# %HFIELDS = ( %XML::DOM::Node::HFIELDS, Name => _Name, Model => _Model );
+#
+# # Define XML:DOM::ElementDecl as a subclass of XML::DOM::Node
+# @ISA = qw{ XML::DOM::Node };
+#
+# # The following function names can be exported into the user's namespace.
+# @EXPORT_OK = qw{ _Name _Model };
+#
+# # The following function names can be exported into the user's namespace
+# # with: import XML::DOM::ElementDecl qw( :Fields );
+# %EXPORT_TAGS = ( Fields => qw{ _Name _Model } );
+#
+sub def_fields # static
+{
+ my ($fields, $parent) = @_;
+
+ my ($pkg) = caller;
+
+ no strict 'refs';
+
+ my @f = split (/\s+/, $fields);
+ my $n = 0;
+
+ my %hfields;
+ if (defined $parent)
+ {
+ my %pf = %{"$parent\::HFIELDS"};
+ %hfields = %pf;
+
+ $n = scalar (keys %pf);
+ @{"$pkg\::ISA"} = ( $parent );
+ }
+
+ my $i = $n;
+ for (@f)
+ {
+ eval "sub $pkg\::_$_ () { $i }";
+ $hfields{$_} = $i;
+ $i++;
+ }
+ %{"$pkg\::HFIELDS"} = %hfields;
+ @{"$pkg\::EXPORT_OK"} = map { "_$_" } @f;
+
+ ${"$pkg\::EXPORT_TAGS"}{Fields} = [ map { "_$_" } @f ];
+}
+
+# sub blesh
+# {
+# my $hashref = shift;
+# my $class = shift;
+# no strict 'refs';
+# my $self = bless [\%{"$class\::FIELDS"}], $class;
+# if (defined $hashref)
+# {
+# for (keys %$hashref)
+# {
+# $self->{$_} = $hashref->{$_};
+# }
+# }
+# $self;
+# }
+
+# sub blesh2
+# {
+# my $hashref = shift;
+# my $class = shift;
+# no strict 'refs';
+# my $self = bless [\%{"$class\::FIELDS"}], $class;
+# if (defined $hashref)
+# {
+# for (keys %$hashref)
+# {
+# eval { $self->{$_} = $hashref->{$_}; };
+# croak "ERROR in field [$_] $@" if $@;
+# }
+# }
+# $self;
+#}
+
+#
+# CDATA section may not contain "]]>"
+#
+sub encodeCDATA
+{
+ my ($str) = shift;
+ $str =~ s/]]>/]]>/go;
+ $str;
+}
+
+#
+# PI may not contain "?>"
+#
+sub encodeProcessingInstruction
+{
+ my ($str) = shift;
+ $str =~ s/\?>/?>/go;
+ $str;
+}
+
+#
+#?? Not sure if this is right - must prevent double minus somehow...
+#
+sub encodeComment
+{
+ my ($str) = shift;
+ return undef unless defined $str;
+
+ $str =~ s/--/--/go;
+ $str;
+}
+
+#
+# For debugging
+#
+sub toHex
+{
+ my $str = shift;
+ my $len = length($str);
+ my @a = unpack ("C$len", $str);
+ my $s = "";
+ for (@a)
+ {
+ $s .= sprintf ("%02x", $_);
+ }
+ $s;
+}
+
+#
+# 2nd parameter $default: list of Default Entity characters that need to be
+# converted (e.g. "&<" for conversion to "&" and "<" resp.)
+#
+sub encodeText
+{
+ my ($str, $default) = @_;
+ return undef unless defined $str;
+
+ $str =~ s/([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)|([$default])|(]]>)/
+ defined($1) ? XmlUtf8Decode ($1) :
+ defined ($2) ? $DecodeDefaultEntity{$2} : "]]>" /egs;
+
+#?? could there be references that should not be expanded?
+# e.g. should not replace &#nn; ¯ and &abc;
+# $str =~ s/&(?!($ReName|#[0-9]+|#x[0-9a-fA-F]+);)/&/go;
+
+ $str;
+}
+
+#
+# Used by AttDef - default value
+#
+sub encodeAttrValue
+{
+ encodeText (shift, '"&<');
+}
+
+#
+# Converts an integer (Unicode - ISO/IEC 10646) to a UTF-8 encoded character
+# sequence.
+# Used when converting e.g. { or Ͽ to a string value.
+#
+# Algorithm borrowed from expat/xmltok.c/XmlUtf8Encode()
+#
+# not checking for bad characters: < 0, x00-x08, x0B-x0C, x0E-x1F, xFFFE-xFFFF
+#
+sub XmlUtf8Encode
+{
+ my $n = shift;
+ if ($n < 0x80)
+ {
+ return chr ($n);
+ }
+ elsif ($n < 0x800)
+ {
+ return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80));
+ }
+ elsif ($n < 0x10000)
+ {
+ return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80),
+ (($n & 0x3f) | 0x80));
+ }
+ elsif ($n < 0x110000)
+ {
+ return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80),
+ ((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80));
+ }
+ croak "number is too large for Unicode [$n] in &XmlUtf8Encode";
+}
+
+#
+# Opposite of XmlUtf8Decode plus it adds prefix "&#" or "&#x" and suffix ";"
+# The 2nd parameter ($hex) indicates whether the result is hex encoded or not.
+#
+sub XmlUtf8Decode
+{
+ my ($str, $hex) = @_;
+ my $len = length ($str);
+ my $n;
+
+ if ($len == 2)
+ {
+ my @n = unpack "C2", $str;
+ $n = (($n[0] & 0x3f) << 6) + ($n[1] & 0x3f);
+ }
+ elsif ($len == 3)
+ {
+ my @n = unpack "C3", $str;
+ $n = (($n[0] & 0x1f) << 12) + (($n[1] & 0x3f) << 6) +
+ ($n[2] & 0x3f);
+ }
+ elsif ($len == 4)
+ {
+ my @n = unpack "C4", $str;
+ $n = (($n[0] & 0x0f) << 18) + (($n[1] & 0x3f) << 12) +
+ (($n[2] & 0x3f) << 6) + ($n[3] & 0x3f);
+ }
+ elsif ($len == 1) # just to be complete...
+ {
+ $n = ord ($str);
+ }
+ else
+ {
+ croak "bad value [$str] for XmlUtf8Decode";
+ }
+ $hex ? sprintf ("&#x%x;", $n) : "&#$n;";
+}
+
+$IgnoreReadOnly = 0;
+$SafeMode = 1;
+
+sub getIgnoreReadOnly
+{
+ $IgnoreReadOnly;
+}
+
+#
+# The global flag $IgnoreReadOnly is set to the specified value and the old
+# value of $IgnoreReadOnly is returned.
+#
+# To temporarily disable read-only related exceptions (i.e. when parsing
+# XML or temporarily), do the following:
+#
+# my $oldIgnore = XML::DOM::ignoreReadOnly (1);
+# ... do whatever you want ...
+# XML::DOM::ignoreReadOnly ($oldIgnore);
+#
+sub ignoreReadOnly
+{
+ my $i = $IgnoreReadOnly;
+ $IgnoreReadOnly = $_[0];
+ return $i;
+}
+
+#
+# XML spec seems to break its own rules... (see ENTITY xmlpio)
+#
+sub forgiving_isValidName
+{
+ $_[0] =~ /^$XML::RegExp::Name$/o;
+}
+
+#
+# Don't allow names starting with xml (either case)
+#
+sub picky_isValidName
+{
+ $_[0] =~ /^$XML::RegExp::Name$/o and $_[0] !~ /^xml/i;
+}
+
+# Be forgiving by default,
+*isValidName = \&forgiving_isValidName;
+
+sub allowReservedNames # static
+{
+ *isValidName = ($_[0] ? \&forgiving_isValidName : \&picky_isValidName);
+}
+
+sub getAllowReservedNames # static
+{
+ *isValidName == \&forgiving_isValidName;
+}
+
+#
+# Always compress empty tags by default
+# This is used by Element::print.
+#
+$TagStyle = sub { 0 };
+
+sub setTagCompression
+{
+ $TagStyle = shift;
+}
+
+######################################################################
+package XML::DOM::PrintToFileHandle;
+######################################################################
+
+#
+# Used by XML::DOM::Node::printToFileHandle
+#
+
+sub new
+{
+ my($class, $fn) = @_;
+ bless $fn, $class;
+}
+
+sub print
+{
+ my ($self, $str) = @_;
+ print $self $str;
+}
+
+######################################################################
+package XML::DOM::PrintToString;
+######################################################################
+
+use vars qw{ $Singleton };
+
+#
+# Used by XML::DOM::Node::toString to concatenate strings
+#
+
+sub new
+{
+ my($class) = @_;
+ my $str = "";
+ bless \$str, $class;
+}
+
+sub print
+{
+ my ($self, $str) = @_;
+ $$self .= $str;
+}
+
+sub toString
+{
+ my $self = shift;
+ $$self;
+}
+
+sub reset
+{
+ ${$_[0]} = "";
+}
+
+$Singleton = new XML::DOM::PrintToString;
+
+######################################################################
+package XML::DOM::DOMImplementation;
+######################################################################
+
+$XML::DOM::DOMImplementation::Singleton =
+ bless \$XML::DOM::DOMImplementation::Singleton, 'XML::DOM::DOMImplementation';
+
+sub hasFeature
+{
+ my ($self, $feature, $version) = @_;
+
+ $feature eq 'XML' and $version eq '1.0';
+}
+
+
+######################################################################
+package XML::XQL::Node; # forward declaration
+######################################################################
+
+######################################################################
+package XML::DOM::Node;
+######################################################################
+
+use vars qw( @NodeNames @EXPORT @ISA %HFIELDS @EXPORT_OK @EXPORT_TAGS );
+
+BEGIN
+{
+ use XML::DOM::DOMException;
+ import Carp;
+
+ require FileHandle;
+
+ @ISA = qw( Exporter XML::XQL::Node );
+
+ # NOTE: SortKey is used in XML::XQL::Node.
+ # UserData is reserved for users (Hang your data here!)
+ XML::DOM::def_fields ("C A Doc Parent ReadOnly UsedIn Hidden SortKey UserData");
+
+ push (@EXPORT, qw(
+ UNKNOWN_NODE
+ ELEMENT_NODE
+ ATTRIBUTE_NODE
+ TEXT_NODE
+ CDATA_SECTION_NODE
+ ENTITY_REFERENCE_NODE
+ ENTITY_NODE
+ PROCESSING_INSTRUCTION_NODE
+ COMMENT_NODE
+ DOCUMENT_NODE
+ DOCUMENT_TYPE_NODE
+ DOCUMENT_FRAGMENT_NODE
+ NOTATION_NODE
+ ELEMENT_DECL_NODE
+ ATT_DEF_NODE
+ XML_DECL_NODE
+ ATTLIST_DECL_NODE
+ ));
+}
+
+#---- Constant definitions
+
+# Node types
+
+sub UNKNOWN_NODE () {0;} # not in the DOM Spec
+
+sub ELEMENT_NODE () {1;}
+sub ATTRIBUTE_NODE () {2;}
+sub TEXT_NODE () {3;}
+sub CDATA_SECTION_NODE () {4;}
+sub ENTITY_REFERENCE_NODE () {5;}
+sub ENTITY_NODE () {6;}
+sub PROCESSING_INSTRUCTION_NODE () {7;}
+sub COMMENT_NODE () {8;}
+sub DOCUMENT_NODE () {9;}
+sub DOCUMENT_TYPE_NODE () {10;}
+sub DOCUMENT_FRAGMENT_NODE () {11;}
+sub NOTATION_NODE () {12;}
+
+sub ELEMENT_DECL_NODE () {13;} # not in the DOM Spec
+sub ATT_DEF_NODE () {14;} # not in the DOM Spec
+sub XML_DECL_NODE () {15;} # not in the DOM Spec
+sub ATTLIST_DECL_NODE () {16;} # not in the DOM Spec
+
+@NodeNames = (
+ "UNKNOWN_NODE", # not in the DOM Spec!
+
+ "ELEMENT_NODE",
+ "ATTRIBUTE_NODE",
+ "TEXT_NODE",
+ "CDATA_SECTION_NODE",
+ "ENTITY_REFERENCE_NODE",
+ "ENTITY_NODE",
+ "PROCESSING_INSTRUCTION_NODE",
+ "COMMENT_NODE",
+ "DOCUMENT_NODE",
+ "DOCUMENT_TYPE_NODE",
+ "DOCUMENT_FRAGMENT_NODE",
+ "NOTATION_NODE",
+
+ "ELEMENT_DECL_NODE",
+ "ATT_DEF_NODE",
+ "XML_DECL_NODE",
+ "ATTLIST_DECL_NODE"
+ );
+
+sub decoupleUsedIn
+{
+ my $self = shift;
+ undef $self->[_UsedIn]; # was delete
+}
+
+sub getParentNode
+{
+ $_[0]->[_Parent];
+}
+
+sub appendChild
+{
+ my ($self, $node) = @_;
+
+ # REC 7473
+ if ($XML::DOM::SafeMode)
+ {
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+ }
+
+ my $doc = $self->[_Doc];
+
+ if ($node->isDocumentFragmentNode)
+ {
+ if ($XML::DOM::SafeMode)
+ {
+ for my $n (@{$node->[_C]})
+ {
+ croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
+ "nodes belong to different documents")
+ if $doc != $n->[_Doc];
+
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "node is ancestor of parent node")
+ if $n->isAncestor ($self);
+
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "bad node type")
+ if $self->rejectChild ($n);
+ }
+ }
+
+ my @list = @{$node->[_C]}; # don't try to compress this
+ for my $n (@list)
+ {
+ $n->setParentNode ($self);
+ }
+ push @{$self->[_C]}, @list;
+ }
+ else
+ {
+ if ($XML::DOM::SafeMode)
+ {
+ croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
+ "nodes belong to different documents")
+ if $doc != $node->[_Doc];
+
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "node is ancestor of parent node")
+ if $node->isAncestor ($self);
+
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "bad node type")
+ if $self->rejectChild ($node);
+ }
+ $node->setParentNode ($self);
+ push @{$self->[_C]}, $node;
+ }
+ $node;
+}
+
+sub getChildNodes
+{
+ # NOTE: if node can't have children, $self->[_C] is undef.
+ my $kids = $_[0]->[_C];
+
+ # Return a list if called in list context.
+ wantarray ? (defined ($kids) ? @{ $kids } : ()) :
+ (defined ($kids) ? $kids : $XML::DOM::NodeList::EMPTY);
+}
+
+sub hasChildNodes
+{
+ my $kids = $_[0]->[_C];
+ defined ($kids) && @$kids > 0;
+}
+
+# This method is overriden in Document
+sub getOwnerDocument
+{
+ $_[0]->[_Doc];
+}
+
+sub getFirstChild
+{
+ my $kids = $_[0]->[_C];
+ defined $kids ? $kids->[0] : undef;
+}
+
+sub getLastChild
+{
+ my $kids = $_[0]->[_C];
+ defined $kids ? $kids->[-1] : undef;
+}
+
+sub getPreviousSibling
+{
+ my $self = shift;
+
+ my $pa = $self->[_Parent];
+ return undef unless $pa;
+ my $index = $pa->getChildIndex ($self);
+ return undef unless $index;
+
+ $pa->getChildAtIndex ($index - 1);
+}
+
+sub getNextSibling
+{
+ my $self = shift;
+
+ my $pa = $self->[_Parent];
+ return undef unless $pa;
+
+ $pa->getChildAtIndex ($pa->getChildIndex ($self) + 1);
+}
+
+sub insertBefore
+{
+ my ($self, $node, $refNode) = @_;
+
+ return $self->appendChild ($node) unless $refNode; # append at the end
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ my @nodes = ($node);
+ @nodes = @{$node->[_C]}
+ if $node->getNodeType == DOCUMENT_FRAGMENT_NODE;
+
+ my $doc = $self->[_Doc];
+
+ for my $n (@nodes)
+ {
+ croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
+ "nodes belong to different documents")
+ if $doc != $n->[_Doc];
+
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "node is ancestor of parent node")
+ if $n->isAncestor ($self);
+
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "bad node type")
+ if $self->rejectChild ($n);
+ }
+ my $index = $self->getChildIndex ($refNode);
+
+ croak new XML::DOM::DOMException (NOT_FOUND_ERR,
+ "reference node not found")
+ if $index == -1;
+
+ for my $n (@nodes)
+ {
+ $n->setParentNode ($self);
+ }
+
+ splice (@{$self->[_C]}, $index, 0, @nodes);
+ $node;
+}
+
+sub replaceChild
+{
+ my ($self, $node, $refNode) = @_;
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ my @nodes = ($node);
+ @nodes = @{$node->[_C]}
+ if $node->getNodeType == DOCUMENT_FRAGMENT_NODE;
+
+ for my $n (@nodes)
+ {
+ croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
+ "nodes belong to different documents")
+ if $self->[_Doc] != $n->[_Doc];
+
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "node is ancestor of parent node")
+ if $n->isAncestor ($self);
+
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "bad node type")
+ if $self->rejectChild ($n);
+ }
+
+ my $index = $self->getChildIndex ($refNode);
+ croak new XML::DOM::DOMException (NOT_FOUND_ERR,
+ "reference node not found")
+ if $index == -1;
+
+ for my $n (@nodes)
+ {
+ $n->setParentNode ($self);
+ }
+ splice (@{$self->[_C]}, $index, 1, @nodes);
+
+ $refNode->removeChildHoodMemories;
+ $refNode;
+}
+
+sub removeChild
+{
+ my ($self, $node) = @_;
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ my $index = $self->getChildIndex ($node);
+
+ croak new XML::DOM::DOMException (NOT_FOUND_ERR,
+ "reference node not found")
+ if $index == -1;
+
+ splice (@{$self->[_C]}, $index, 1, ());
+
+ $node->removeChildHoodMemories;
+ $node;
+}
+
+# Merge all subsequent Text nodes in this subtree
+sub normalize
+{
+ my ($self) = shift;
+ my $prev = undef; # previous Text node
+
+ return unless defined $self->[_C];
+
+ my @nodes = @{$self->[_C]};
+ my $i = 0;
+ my $n = @nodes;
+ while ($i < $n)
+ {
+ my $node = $self->getChildAtIndex($i);
+ my $type = $node->getNodeType;
+
+ if (defined $prev)
+ {
+ # It should not merge CDATASections. Dom Spec says:
+ # Adjacent CDATASections nodes are not merged by use
+ # of the Element.normalize() method.
+ if ($type == TEXT_NODE)
+ {
+ $prev->appendData ($node->getData);
+ $self->removeChild ($node);
+ $i--;
+ $n--;
+ }
+ else
+ {
+ $prev = undef;
+ if ($type == ELEMENT_NODE)
+ {
+ $node->normalize;
+ if (defined $node->[_A])
+ {
+ for my $attr (@{$node->[_A]->getValues})
+ {
+ $attr->normalize;
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ if ($type == TEXT_NODE)
+ {
+ $prev = $node;
+ }
+ elsif ($type == ELEMENT_NODE)
+ {
+ $node->normalize;
+ if (defined $node->[_A])
+ {
+ for my $attr (@{$node->[_A]->getValues})
+ {
+ $attr->normalize;
+ }
+ }
+ }
+ }
+ $i++;
+ }
+}
+
+#
+# Return all Element nodes in the subtree that have the specified tagName.
+# If tagName is "*", all Element nodes are returned.
+# NOTE: the DOM Spec does not specify a 3rd or 4th parameter
+#
+sub getElementsByTagName
+{
+ my ($self, $tagName, $recurse, $list) = @_;
+ $recurse = 1 unless defined $recurse;
+ $list = (wantarray ? [] : new XML::DOM::NodeList) unless defined $list;
+
+ return unless defined $self->[_C];
+
+ # preorder traversal: check parent node first
+ for my $kid (@{$self->[_C]})
+ {
+ if ($kid->isElementNode)
+ {
+ if ($tagName eq "*" || $tagName eq $kid->getTagName)
+ {
+ push @{$list}, $kid;
+ }
+ $kid->getElementsByTagName ($tagName, $recurse, $list) if $recurse;
+ }
+ }
+ wantarray ? @{ $list } : $list;
+}
+
+sub getNodeValue
+{
+ undef;
+}
+
+sub setNodeValue
+{
+ # no-op
+}
+
+#
+# Redefined by XML::DOM::Element
+#
+sub getAttributes
+{
+ undef;
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub setOwnerDocument
+{
+ my ($self, $doc) = @_;
+ $self->[_Doc] = $doc;
+
+ return unless defined $self->[_C];
+
+ for my $kid (@{$self->[_C]})
+ {
+ $kid->setOwnerDocument ($doc);
+ }
+}
+
+sub cloneChildren
+{
+ my ($self, $node, $deep) = @_;
+ return unless $deep;
+
+ return unless defined $self->[_C];
+
+ local $XML::DOM::IgnoreReadOnly = 1;
+
+ for my $kid (@{$node->[_C]})
+ {
+ my $newNode = $kid->cloneNode ($deep);
+ push @{$self->[_C]}, $newNode;
+ $newNode->setParentNode ($self);
+ }
+}
+
+#
+# For internal use only!
+#
+sub removeChildHoodMemories
+{
+ my ($self) = @_;
+
+ undef $self->[_Parent]; # was delete
+}
+
+#
+# Remove circular dependencies. The Node and its children should
+# not be used afterwards.
+#
+sub dispose
+{
+ my $self = shift;
+
+ $self->removeChildHoodMemories;
+
+ if (defined $self->[_C])
+ {
+ $self->[_C]->dispose;
+ undef $self->[_C]; # was delete
+ }
+ undef $self->[_Doc]; # was delete
+}
+
+#
+# For internal use only!
+#
+sub setParentNode
+{
+ my ($self, $parent) = @_;
+
+ # REC 7473
+ my $oldParent = $self->[_Parent];
+ if (defined $oldParent)
+ {
+ # remove from current parent
+ my $index = $oldParent->getChildIndex ($self);
+
+ # NOTE: we don't have to check if [_C] is defined,
+ # because were removing a child here!
+ splice (@{$oldParent->[_C]}, $index, 1, ());
+
+ $self->removeChildHoodMemories;
+ }
+ $self->[_Parent] = $parent;
+}
+
+#
+# This function can return 3 values:
+# 1: always readOnly
+# 0: never readOnly
+# undef: depends on parent node
+#
+# Returns 1 for DocumentType, Notation, Entity, EntityReference, Attlist,
+# ElementDecl, AttDef.
+# The first 4 are readOnly according to the DOM Spec, the others are always
+# children of DocumentType. (Naturally, children of a readOnly node have to be
+# readOnly as well...)
+# These nodes are always readOnly regardless of who their ancestors are.
+# Other nodes, e.g. Comment, are readOnly only if their parent is readOnly,
+# which basically means that one of its ancestors has to be one of the
+# aforementioned node types.
+# Document and DocumentFragment return 0 for obvious reasons.
+# Attr, Element, CDATASection, Text return 0. The DOM spec says that they can
+# be children of an Entity, but I don't think that that's possible
+# with the current XML::Parser.
+# Attr uses a {ReadOnly} property, which is only set if it's part of a AttDef.
+# Always returns 0 if ignoreReadOnly is set.
+#
+sub isReadOnly
+{
+ # default implementation for Nodes that are always readOnly
+ ! $XML::DOM::IgnoreReadOnly;
+}
+
+sub rejectChild
+{
+ 1;
+}
+
+sub getNodeTypeName
+{
+ $NodeNames[$_[0]->getNodeType];
+}
+
+sub getChildIndex
+{
+ my ($self, $node) = @_;
+ my $i = 0;
+
+ return -1 unless defined $self->[_C];
+
+ for my $kid (@{$self->[_C]})
+ {
+ return $i if $kid == $node;
+ $i++;
+ }
+ -1;
+}
+
+sub getChildAtIndex
+{
+ my $kids = $_[0]->[_C];
+ defined ($kids) ? $kids->[$_[1]] : undef;
+}
+
+sub isAncestor
+{
+ my ($self, $node) = @_;
+
+ do
+ {
+ return 1 if $self == $node;
+ $node = $node->[_Parent];
+ }
+ while (defined $node);
+
+ 0;
+}
+
+#
+# Added for optimization. Overriden in XML::DOM::Text
+#
+sub isTextNode
+{
+ 0;
+}
+
+#
+# Added for optimization. Overriden in XML::DOM::DocumentFragment
+#
+sub isDocumentFragmentNode
+{
+ 0;
+}
+
+#
+# Added for optimization. Overriden in XML::DOM::Element
+#
+sub isElementNode
+{
+ 0;
+}
+
+#
+# Add a Text node with the specified value or append the text to the
+# previous Node if it is a Text node.
+#
+sub addText
+{
+ # REC 9456 (if it was called)
+ my ($self, $str) = @_;
+
+ my $node = ${$self->[_C]}[-1]; # $self->getLastChild
+
+ if (defined ($node) && $node->isTextNode)
+ {
+ # REC 5475 (if it was called)
+ $node->appendData ($str);
+ }
+ else
+ {
+ $node = $self->[_Doc]->createTextNode ($str);
+ $self->appendChild ($node);
+ }
+ $node;
+}
+
+#
+# Add a CDATASection node with the specified value or append the text to the
+# previous Node if it is a CDATASection node.
+#
+sub addCDATA
+{
+ my ($self, $str) = @_;
+
+ my $node = ${$self->[_C]}[-1]; # $self->getLastChild
+
+ if (defined ($node) && $node->getNodeType == CDATA_SECTION_NODE)
+ {
+ $node->appendData ($str);
+ }
+ else
+ {
+ $node = $self->[_Doc]->createCDATASection ($str);
+ $self->appendChild ($node);
+ }
+ $node;
+}
+
+sub removeChildNodes
+{
+ my $self = shift;
+
+ my $cref = $self->[_C];
+ return unless defined $cref;
+
+ my $kid;
+ while ($kid = pop @{$cref})
+ {
+ undef $kid->[_Parent]; # was delete
+ }
+}
+
+sub toString
+{
+ my $self = shift;
+ my $pr = $XML::DOM::PrintToString::Singleton;
+ $pr->reset;
+ $self->print ($pr);
+ $pr->toString;
+}
+
+sub to_sax
+{
+ my $self = shift;
+ unshift @_, 'Handler' if (@_ == 1);
+ my %h = @_;
+
+ my $doch = exists ($h{DocumentHandler}) ? $h{DocumentHandler}
+ : $h{Handler};
+ my $dtdh = exists ($h{DTDHandler}) ? $h{DTDHandler}
+ : $h{Handler};
+ my $enth = exists ($h{EntityResolver}) ? $h{EntityResolver}
+ : $h{Handler};
+
+ $self->_to_sax ($doch, $dtdh, $enth);
+}
+
+sub printToFile
+{
+ my ($self, $fileName) = @_;
+ my $fh = new FileHandle ($fileName, "w") ||
+ croak "printToFile - can't open output file $fileName";
+
+ $self->print ($fh);
+ $fh->close;
+}
+
+#
+# Use print to print to a FileHandle object (see printToFile code)
+#
+sub printToFileHandle
+{
+ my ($self, $FH) = @_;
+ my $pr = new XML::DOM::PrintToFileHandle ($FH);
+ $self->print ($pr);
+}
+
+#
+# Used by AttDef::setDefault to convert unexpanded default attribute value
+#
+sub expandEntityRefs
+{
+ my ($self, $str) = @_;
+ my $doctype = $self->[_Doc]->getDoctype;
+
+ $str =~ s/&($XML::RegExp::Name|(#([0-9]+)|#x([0-9a-fA-F]+)));/
+ defined($2) ? XML::DOM::XmlUtf8Encode ($3 || hex ($4))
+ : expandEntityRef ($1, $doctype)/ego;
+ $str;
+}
+
+sub expandEntityRef
+{
+ my ($entity, $doctype) = @_;
+
+ my $expanded = $XML::DOM::DefaultEntities{$entity};
+ return $expanded if defined $expanded;
+
+ $expanded = $doctype->getEntity ($entity);
+ return $expanded->getValue if (defined $expanded);
+
+#?? is this an error?
+ croak "Could not expand entity reference of [$entity]\n";
+# return "&$entity;"; # entity not found
+}
+
+sub isHidden
+{
+ $_[0]->[_Hidden];
+}
+
+######################################################################
+package XML::DOM::Attr;
+######################################################################
+
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("Name Specified", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+sub new
+{
+ my ($class, $doc, $name, $value, $specified) = @_;
+
+ if ($XML::DOM::SafeMode)
+ {
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad Attr name [$name]")
+ unless XML::DOM::isValidName ($name);
+ }
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_C] = new XML::DOM::NodeList;
+ $self->[_Name] = $name;
+
+ if (defined $value)
+ {
+ $self->setValue ($value);
+ $self->[_Specified] = (defined $specified) ? $specified : 1;
+ }
+ else
+ {
+ $self->[_Specified] = 0;
+ }
+ $self;
+}
+
+sub getNodeType
+{
+ ATTRIBUTE_NODE;
+}
+
+sub isSpecified
+{
+ $_[0]->[_Specified];
+}
+
+sub getName
+{
+ $_[0]->[_Name];
+}
+
+sub getValue
+{
+ my $self = shift;
+ my $value = "";
+
+ for my $kid (@{$self->[_C]})
+ {
+ $value .= $kid->getData;
+ }
+ $value;
+}
+
+sub setValue
+{
+ my ($self, $value) = @_;
+
+ # REC 1147
+ $self->removeChildNodes;
+ $self->appendChild ($self->[_Doc]->createTextNode ($value));
+ $self->[_Specified] = 1;
+}
+
+sub getNodeName
+{
+ $_[0]->getName;
+}
+
+sub getNodeValue
+{
+ $_[0]->getValue;
+}
+
+sub setNodeValue
+{
+ $_[0]->setValue ($_[1]);
+}
+
+sub cloneNode
+{
+ my ($self) = @_; # parameter deep is ignored
+
+ my $node = $self->[_Doc]->createAttribute ($self->getName);
+ $node->[_Specified] = $self->[_Specified];
+ $node->[_ReadOnly] = 1 if $self->[_ReadOnly];
+
+ $node->cloneChildren ($self, 1);
+ $node;
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+#
+
+sub isReadOnly
+{
+ # ReadOnly property is set if it's part of a AttDef
+ ! $XML::DOM::IgnoreReadOnly && defined ($_[0]->[_ReadOnly]);
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $name = $self->[_Name];
+
+ $FILE->print ("$name=\"");
+ for my $kid (@{$self->[_C]})
+ {
+ if ($kid->getNodeType == TEXT_NODE)
+ {
+ $FILE->print (XML::DOM::encodeAttrValue ($kid->getData));
+ }
+ else # ENTITY_REFERENCE_NODE
+ {
+ $kid->print ($FILE);
+ }
+ }
+ $FILE->print ("\"");
+}
+
+sub rejectChild
+{
+ my $t = $_[1]->getNodeType;
+
+ $t != TEXT_NODE
+ && $t != ENTITY_REFERENCE_NODE;
+}
+
+######################################################################
+package XML::DOM::ProcessingInstruction;
+######################################################################
+
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("Target Data", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+sub new
+{
+ my ($class, $doc, $target, $data, $hidden) = @_;
+
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad ProcessingInstruction Target [$target]")
+ unless (XML::DOM::isValidName ($target) && $target !~ /^xml$/io);
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_Target] = $target;
+ $self->[_Data] = $data;
+ $self->[_Hidden] = $hidden;
+ $self;
+}
+
+sub getNodeType
+{
+ PROCESSING_INSTRUCTION_NODE;
+}
+
+sub getTarget
+{
+ $_[0]->[_Target];
+}
+
+sub getData
+{
+ $_[0]->[_Data];
+}
+
+sub setData
+{
+ my ($self, $data) = @_;
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ $self->[_Data] = $data;
+}
+
+sub getNodeName
+{
+ $_[0]->[_Target];
+}
+
+#
+# Same as getData
+#
+sub getNodeValue
+{
+ $_[0]->[_Data];
+}
+
+sub setNodeValue
+{
+ $_[0]->setData ($_[1]);
+}
+
+sub cloneNode
+{
+ my $self = shift;
+ $self->[_Doc]->createProcessingInstruction ($self->getTarget,
+ $self->getData,
+ $self->isHidden);
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub isReadOnly
+{
+ return 0 if $XML::DOM::IgnoreReadOnly;
+
+ my $pa = $_[0]->[_Parent];
+ defined ($pa) ? $pa->isReadOnly : 0;
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ $FILE->print ("<?");
+ $FILE->print ($self->[_Target]);
+ $FILE->print (" ");
+ $FILE->print (XML::DOM::encodeProcessingInstruction ($self->[_Data]));
+ $FILE->print ("?>");
+}
+
+######################################################################
+package XML::DOM::Notation;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("Name Base SysId PubId", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+sub new
+{
+ my ($class, $doc, $name, $base, $sysId, $pubId, $hidden) = @_;
+
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad Notation Name [$name]")
+ unless XML::DOM::isValidName ($name);
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_Name] = $name;
+ $self->[_Base] = $base;
+ $self->[_SysId] = $sysId;
+ $self->[_PubId] = $pubId;
+ $self->[_Hidden] = $hidden;
+ $self;
+}
+
+sub getNodeType
+{
+ NOTATION_NODE;
+}
+
+sub getPubId
+{
+ $_[0]->[_PubId];
+}
+
+sub setPubId
+{
+ $_[0]->[_PubId] = $_[1];
+}
+
+sub getSysId
+{
+ $_[0]->[_SysId];
+}
+
+sub setSysId
+{
+ $_[0]->[_SysId] = $_[1];
+}
+
+sub getName
+{
+ $_[0]->[_Name];
+}
+
+sub setName
+{
+ $_[0]->[_Name] = $_[1];
+}
+
+sub getBase
+{
+ $_[0]->[_Base];
+}
+
+sub getNodeName
+{
+ $_[0]->[_Name];
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $name = $self->[_Name];
+ my $sysId = $self->[_SysId];
+ my $pubId = $self->[_PubId];
+
+ $FILE->print ("<!NOTATION $name ");
+
+ if (defined $pubId)
+ {
+ $FILE->print (" PUBLIC \"$pubId\"");
+ }
+ if (defined $sysId)
+ {
+ $FILE->print (" SYSTEM \"$sysId\"");
+ }
+ $FILE->print (">");
+}
+
+sub cloneNode
+{
+ my ($self) = @_;
+ $self->[_Doc]->createNotation ($self->[_Name], $self->[_Base],
+ $self->[_SysId], $self->[_PubId],
+ $self->[_Hidden]);
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+ $iter->Notation ($self->getName, $self->getBase,
+ $self->getSysId, $self->getPubId);
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+ $dtdh->notation_decl ( { Name => $self->getName,
+ Base => $self->getBase,
+ SystemId => $self->getSysId,
+ PublicId => $self->getPubId });
+}
+
+######################################################################
+package XML::DOM::Entity;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("NotationName Parameter Value Ndata SysId PubId", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+sub new
+{
+ my ($class, $doc, $par, $notationName, $value, $sysId, $pubId, $ndata, $hidden) = @_;
+
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad Entity Name [$notationName]")
+ unless XML::DOM::isValidName ($notationName);
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_NotationName] = $notationName;
+ $self->[_Parameter] = $par;
+ $self->[_Value] = $value;
+ $self->[_Ndata] = $ndata;
+ $self->[_SysId] = $sysId;
+ $self->[_PubId] = $pubId;
+ $self->[_Hidden] = $hidden;
+ $self;
+#?? maybe Value should be a Text node
+}
+
+sub getNodeType
+{
+ ENTITY_NODE;
+}
+
+sub getPubId
+{
+ $_[0]->[_PubId];
+}
+
+sub getSysId
+{
+ $_[0]->[_SysId];
+}
+
+# Dom Spec says:
+# For unparsed entities, the name of the notation for the
+# entity. For parsed entities, this is null.
+
+#?? do we have unparsed entities?
+sub getNotationName
+{
+ $_[0]->[_NotationName];
+}
+
+sub getNodeName
+{
+ $_[0]->[_NotationName];
+}
+
+sub cloneNode
+{
+ my $self = shift;
+ $self->[_Doc]->createEntity ($self->[_Parameter],
+ $self->[_NotationName], $self->[_Value],
+ $self->[_SysId], $self->[_PubId],
+ $self->[_Ndata], $self->[_Hidden]);
+}
+
+sub rejectChild
+{
+ return 1;
+#?? if value is split over subnodes, recode this section
+# also add: C => new XML::DOM::NodeList,
+
+ my $t = $_[1];
+
+ return $t == TEXT_NODE
+ || $t == ENTITY_REFERENCE_NODE
+ || $t == PROCESSING_INSTRUCTION_NODE
+ || $t == COMMENT_NODE
+ || $t == CDATA_SECTION_NODE
+ || $t == ELEMENT_NODE;
+}
+
+sub getValue
+{
+ $_[0]->[_Value];
+}
+
+sub isParameterEntity
+{
+ $_[0]->[_Parameter];
+}
+
+sub getNdata
+{
+ $_[0]->[_Ndata];
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $name = $self->[_NotationName];
+
+ my $par = $self->isParameterEntity ? "% " : "";
+
+ $FILE->print ("<!ENTITY $par$name");
+
+ my $value = $self->[_Value];
+ my $sysId = $self->[_SysId];
+ my $pubId = $self->[_PubId];
+ my $ndata = $self->[_Ndata];
+
+ if (defined $value)
+ {
+#?? Not sure what to do if it contains both single and double quote
+ $value = ($value =~ /\"/) ? "'$value'" : "\"$value\"";
+ $FILE->print (" $value");
+ }
+ if (defined $pubId)
+ {
+ $FILE->print (" PUBLIC \"$pubId\"");
+ }
+ elsif (defined $sysId)
+ {
+ $FILE->print (" SYSTEM");
+ }
+
+ if (defined $sysId)
+ {
+ $FILE->print (" \"$sysId\"");
+ }
+ $FILE->print (" NDATA $ndata") if defined $ndata;
+ $FILE->print (">");
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+ my $name = ($self->isParameterEntity ? '%' : "") . $self->getNotationName;
+ $iter->Entity ($name,
+ $self->getValue, $self->getSysId, $self->getPubId,
+ $self->getNdata);
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+ my $name = ($self->isParameterEntity ? '%' : "") . $self->getNotationName;
+ $dtdh->entity_decl ( { Name => $name,
+ Value => $self->getValue,
+ SystemId => $self->getSysId,
+ PublicId => $self->getPubId,
+ Notation => $self->getNdata } );
+}
+
+######################################################################
+package XML::DOM::EntityReference;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("EntityName Parameter", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+sub new
+{
+ my ($class, $doc, $name, $parameter) = @_;
+
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad Entity Name [$name] in EntityReference")
+ unless XML::DOM::isValidName ($name);
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_EntityName] = $name;
+ $self->[_Parameter] = ($parameter || 0);
+ $self;
+}
+
+sub getNodeType
+{
+ ENTITY_REFERENCE_NODE;
+}
+
+sub getNodeName
+{
+ $_[0]->[_EntityName];
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub getEntityName
+{
+ $_[0]->[_EntityName];
+}
+
+sub isParameterEntity
+{
+ $_[0]->[_Parameter];
+}
+
+sub getData
+{
+ my $self = shift;
+ my $name = $self->[_EntityName];
+ my $parameter = $self->[_Parameter];
+
+ my $data = $self->[_Doc]->expandEntity ($name, $parameter);
+
+ unless (defined $data)
+ {
+#?? this is probably an error
+ my $pc = $parameter ? "%" : "&";
+ $data = "$pc$name;";
+ }
+ $data;
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $name = $self->[_EntityName];
+
+#?? or do we expand the entities?
+
+ my $pc = $self->[_Parameter] ? "%" : "&";
+ $FILE->print ("$pc$name;");
+}
+
+# Dom Spec says:
+# [...] but if such an Entity exists, then
+# the child list of the EntityReference node is the same as that of the
+# Entity node.
+#
+# The resolution of the children of the EntityReference (the replacement
+# value of the referenced Entity) may be lazily evaluated; actions by the
+# user (such as calling the childNodes method on the EntityReference
+# node) are assumed to trigger the evaluation.
+sub getChildNodes
+{
+ my $self = shift;
+ my $entity = $self->[_Doc]->getEntity ($self->[_EntityName]);
+ defined ($entity) ? $entity->getChildNodes : new XML::DOM::NodeList;
+}
+
+sub cloneNode
+{
+ my $self = shift;
+ $self->[_Doc]->createEntityReference ($self->[_EntityName],
+ $self->[_Parameter]);
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+ $iter->EntityRef ($self->getEntityName, $self->isParameterEntity);
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+ my @par = $self->isParameterEntity ? (Parameter => 1) : ();
+#?? not supported by PerlSAX: $self->isParameterEntity
+
+ $doch->entity_reference ( { Name => $self->getEntityName, @par } );
+}
+
+# NOTE: an EntityReference can't really have children, so rejectChild
+# is not reimplemented (i.e. it always returns 0.)
+
+######################################################################
+package XML::DOM::AttDef;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("Name Type Fixed Default Required Implied Quote", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+#------------------------------------------------------------
+# Extra method implementations
+
+# AttDef is not part of DOM Spec
+sub new
+{
+ my ($class, $doc, $name, $attrType, $default, $fixed, $hidden) = @_;
+
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad Attr name in AttDef [$name]")
+ unless XML::DOM::isValidName ($name);
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_Name] = $name;
+ $self->[_Type] = $attrType;
+
+ if (defined $default)
+ {
+ if ($default eq "#REQUIRED")
+ {
+ $self->[_Required] = 1;
+ }
+ elsif ($default eq "#IMPLIED")
+ {
+ $self->[_Implied] = 1;
+ }
+ else
+ {
+ # strip off quotes - see Attlist handler in XML::Parser
+ $default =~ m#^(["'])(.*)['"]$#;
+
+ $self->[_Quote] = $1; # keep track of the quote character
+ $self->[_Default] = $self->setDefault ($2);
+
+#?? should default value be decoded - what if it contains e.g. "&"
+ }
+ }
+ $self->[_Fixed] = $fixed if defined $fixed;
+ $self->[_Hidden] = $hidden if defined $hidden;
+
+ $self;
+}
+
+sub getNodeType
+{
+ ATT_DEF_NODE;
+}
+
+sub getName
+{
+ $_[0]->[_Name];
+}
+
+# So it can be added to a NamedNodeMap
+sub getNodeName
+{
+ $_[0]->[_Name];
+}
+
+sub getType
+{
+ $_[0]->[_Type];
+}
+
+sub setType
+{
+ $_[0]->[_Type] = $_[1];
+}
+
+sub getDefault
+{
+ $_[0]->[_Default];
+}
+
+sub setDefault
+{
+ my ($self, $value) = @_;
+
+ # specified=0, it's the default !
+ my $attr = $self->[_Doc]->createAttribute ($self->[_Name], undef, 0);
+ $attr->[_ReadOnly] = 1;
+
+#?? this should be split over Text and EntityReference nodes, just like other
+# Attr nodes - just expand the text for now
+ $value = $self->expandEntityRefs ($value);
+ $attr->addText ($value);
+#?? reimplement in NoExpand mode!
+
+ $attr;
+}
+
+sub isFixed
+{
+ $_[0]->[_Fixed] || 0;
+}
+
+sub isRequired
+{
+ $_[0]->[_Required] || 0;
+}
+
+sub isImplied
+{
+ $_[0]->[_Implied] || 0;
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $name = $self->[_Name];
+ my $type = $self->[_Type];
+ my $fixed = $self->[_Fixed];
+ my $default = $self->[_Default];
+
+ $FILE->print ("$name $type");
+ $FILE->print (" #FIXED") if defined $fixed;
+
+ if ($self->[_Required])
+ {
+ $FILE->print (" #REQUIRED");
+ }
+ elsif ($self->[_Implied])
+ {
+ $FILE->print (" #IMPLIED");
+ }
+ elsif (defined ($default))
+ {
+ my $quote = $self->[_Quote];
+ $FILE->print (" $quote");
+ for my $kid (@{$default->[_C]})
+ {
+ $kid->print ($FILE);
+ }
+ $FILE->print ($quote);
+ }
+}
+
+sub getDefaultString
+{
+ my $self = shift;
+ my $default;
+
+ if ($self->[_Required])
+ {
+ return "#REQUIRED";
+ }
+ elsif ($self->[_Implied])
+ {
+ return "#IMPLIED";
+ }
+ elsif (defined ($default = $self->[_Default]))
+ {
+ my $quote = $self->[_Quote];
+ $default = $default->toString;
+ return "$quote$default$quote";
+ }
+ undef;
+}
+
+sub cloneNode
+{
+ my $self = shift;
+ my $node = new XML::DOM::AttDef ($self->[_Doc], $self->[_Name], $self->[_Type],
+ undef, $self->[_Fixed]);
+
+ $node->[_Required] = 1 if $self->[_Required];
+ $node->[_Implied] = 1 if $self->[_Implied];
+ $node->[_Fixed] = $self->[_Fixed] if defined $self->[_Fixed];
+ $node->[_Hidden] = $self->[_Hidden] if defined $self->[_Hidden];
+
+ if (defined $self->[_Default])
+ {
+ $node->[_Default] = $self->[_Default]->cloneNode(1);
+ }
+ $node->[_Quote] = $self->[_Quote];
+
+ $node;
+}
+
+sub setOwnerDocument
+{
+ my ($self, $doc) = @_;
+ $self->SUPER::setOwnerDocument ($doc);
+
+ if (defined $self->[_Default])
+ {
+ $self->[_Default]->setOwnerDocument ($doc);
+ }
+}
+
+######################################################################
+package XML::DOM::AttlistDecl;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ import XML::DOM::AttDef qw{ :Fields };
+
+ XML::DOM::def_fields ("ElementName", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+#------------------------------------------------------------
+# Extra method implementations
+
+# AttlistDecl is not part of the DOM Spec
+sub new
+{
+ my ($class, $doc, $name) = @_;
+
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad Element TagName [$name] in AttlistDecl")
+ unless XML::DOM::isValidName ($name);
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_C] = new XML::DOM::NodeList;
+ $self->[_ReadOnly] = 1;
+ $self->[_ElementName] = $name;
+
+ $self->[_A] = new XML::DOM::NamedNodeMap (Doc => $doc,
+ ReadOnly => 1,
+ Parent => $self);
+
+ $self;
+}
+
+sub getNodeType
+{
+ ATTLIST_DECL_NODE;
+}
+
+sub getName
+{
+ $_[0]->[_ElementName];
+}
+
+sub getNodeName
+{
+ $_[0]->[_ElementName];
+}
+
+sub getAttDef
+{
+ my ($self, $attrName) = @_;
+ $self->[_A]->getNamedItem ($attrName);
+}
+
+sub addAttDef
+{
+ my ($self, $attrName, $type, $default, $fixed, $hidden) = @_;
+ my $node = $self->getAttDef ($attrName);
+
+ if (defined $node)
+ {
+ # data will be ignored if already defined
+ my $elemName = $self->getName;
+ XML::DOM::warning ("multiple definitions of attribute $attrName for element $elemName, only first one is recognized");
+ }
+ else
+ {
+ $node = new XML::DOM::AttDef ($self->[_Doc], $attrName, $type,
+ $default, $fixed, $hidden);
+ $self->[_A]->setNamedItem ($node);
+ }
+ $node;
+}
+
+sub getDefaultAttrValue
+{
+ my ($self, $attr) = @_;
+ my $attrNode = $self->getAttDef ($attr);
+ (defined $attrNode) ? $attrNode->getDefault : undef;
+}
+
+sub cloneNode
+{
+ my ($self, $deep) = @_;
+ my $node = $self->[_Doc]->createAttlistDecl ($self->[_ElementName]);
+
+ $node->[_A] = $self->[_A]->cloneNode ($deep);
+ $node;
+}
+
+sub setOwnerDocument
+{
+ my ($self, $doc) = @_;
+ $self->SUPER::setOwnerDocument ($doc);
+
+ $self->[_A]->setOwnerDocument ($doc);
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $name = $self->getName;
+ my @attlist = @{$self->[_A]->getValues};
+
+ my $hidden = 1;
+ for my $att (@attlist)
+ {
+ unless ($att->[_Hidden])
+ {
+ $hidden = 0;
+ last;
+ }
+ }
+
+ unless ($hidden)
+ {
+ $FILE->print ("<!ATTLIST $name");
+
+ if (@attlist == 1)
+ {
+ $FILE->print (" ");
+ $attlist[0]->print ($FILE);
+ }
+ else
+ {
+ for my $attr (@attlist)
+ {
+ next if $attr->[_Hidden];
+
+ $FILE->print ("\x0A ");
+ $attr->print ($FILE);
+ }
+ }
+ $FILE->print (">");
+ }
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+ my $tag = $self->getName;
+ for my $a ($self->[_A]->getValues)
+ {
+ my $default = $a->isImplied ? '#IMPLIED' :
+ ($a->isRequired ? '#REQUIRED' :
+ ($a->[_Quote] . $a->getDefault->getValue . $a->[_Quote]));
+
+ $iter->Attlist ($tag, $a->getName, $a->getType, $default, $a->isFixed);
+ }
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+ my $tag = $self->getName;
+ for my $a ($self->[_A]->getValues)
+ {
+ my $default = $a->isImplied ? '#IMPLIED' :
+ ($a->isRequired ? '#REQUIRED' :
+ ($a->[_Quote] . $a->getDefault->getValue . $a->[_Quote]));
+
+ $dtdh->attlist_decl ({ ElementName => $tag,
+ AttributeName => $a->getName,
+ Type => $a->[_Type],
+ Default => $default,
+ Fixed => $a->isFixed });
+ }
+}
+
+######################################################################
+package XML::DOM::ElementDecl;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("Name Model", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+
+#------------------------------------------------------------
+# Extra method implementations
+
+# ElementDecl is not part of the DOM Spec
+sub new
+{
+ my ($class, $doc, $name, $model, $hidden) = @_;
+
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad Element TagName [$name] in ElementDecl")
+ unless XML::DOM::isValidName ($name);
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_Name] = $name;
+ $self->[_ReadOnly] = 1;
+ $self->[_Model] = $model;
+ $self->[_Hidden] = $hidden;
+ $self;
+}
+
+sub getNodeType
+{
+ ELEMENT_DECL_NODE;
+}
+
+sub getName
+{
+ $_[0]->[_Name];
+}
+
+sub getNodeName
+{
+ $_[0]->[_Name];
+}
+
+sub getModel
+{
+ $_[0]->[_Model];
+}
+
+sub setModel
+{
+ my ($self, $model) = @_;
+
+ $self->[_Model] = $model;
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $name = $self->[_Name];
+ my $model = $self->[_Model];
+
+ $FILE->print ("<!ELEMENT $name $model>")
+ unless $self->[_Hidden];
+}
+
+sub cloneNode
+{
+ my $self = shift;
+ $self->[_Doc]->createElementDecl ($self->[_Name], $self->[_Model],
+ $self->[_Hidden]);
+}
+
+sub to_expat
+{
+#?? add support for Hidden?? (allover, also in _to_sax!!)
+
+ my ($self, $iter) = @_;
+ $iter->Element ($self->getName, $self->getModel);
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+ $dtdh->element_decl ( { Name => $self->getName,
+ Model => $self->getModel } );
+}
+
+######################################################################
+package XML::DOM::Element;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("TagName", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use XML::DOM::NamedNodeMap;
+use Carp;
+
+sub new
+{
+ my ($class, $doc, $tagName) = @_;
+
+ if ($XML::DOM::SafeMode)
+ {
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad Element TagName [$tagName]")
+ unless XML::DOM::isValidName ($tagName);
+ }
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_C] = new XML::DOM::NodeList;
+ $self->[_TagName] = $tagName;
+
+# Now we're creating the NamedNodeMap only when needed (REC 2313 => 1147)
+# $self->[_A] = new XML::DOM::NamedNodeMap (Doc => $doc,
+# Parent => $self);
+
+ $self;
+}
+
+sub getNodeType
+{
+ ELEMENT_NODE;
+}
+
+sub getTagName
+{
+ $_[0]->[_TagName];
+}
+
+sub getNodeName
+{
+ $_[0]->[_TagName];
+}
+
+sub getAttributeNode
+{
+ my ($self, $name) = @_;
+ return undef unless defined $self->[_A];
+
+ $self->getAttributes->{$name};
+}
+
+sub getAttribute
+{
+ my ($self, $name) = @_;
+ my $attr = $self->getAttributeNode ($name);
+ (defined $attr) ? $attr->getValue : "";
+}
+
+sub setAttribute
+{
+ my ($self, $name, $val) = @_;
+
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad Attr Name [$name]")
+ unless XML::DOM::isValidName ($name);
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ my $node = $self->getAttributes->{$name};
+ if (defined $node)
+ {
+ $node->setValue ($val);
+ }
+ else
+ {
+ $node = $self->[_Doc]->createAttribute ($name, $val);
+ $self->[_A]->setNamedItem ($node);
+ }
+}
+
+sub setAttributeNode
+{
+ my ($self, $node) = @_;
+ my $attr = $self->getAttributes;
+ my $name = $node->getNodeName;
+
+ # REC 1147
+ if ($XML::DOM::SafeMode)
+ {
+ croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
+ "nodes belong to different documents")
+ if $self->[_Doc] != $node->[_Doc];
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ my $attrParent = $node->[_UsedIn];
+ croak new XML::DOM::DOMException (INUSE_ATTRIBUTE_ERR,
+ "Attr is already used by another Element")
+ if (defined ($attrParent) && $attrParent != $attr);
+ }
+
+ my $other = $attr->{$name};
+ $attr->removeNamedItem ($name) if defined $other;
+
+ $attr->setNamedItem ($node);
+
+ $other;
+}
+
+sub removeAttributeNode
+{
+ my ($self, $node) = @_;
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ my $attr = $self->[_A];
+ unless (defined $attr)
+ {
+ croak new XML::DOM::DOMException (NOT_FOUND_ERR);
+ return undef;
+ }
+
+ my $name = $node->getNodeName;
+ my $attrNode = $attr->getNamedItem ($name);
+
+#?? should it croak if it's the default value?
+ croak new XML::DOM::DOMException (NOT_FOUND_ERR)
+ unless $node == $attrNode;
+
+ # Not removing anything if it's the default value already
+ return undef unless $node->isSpecified;
+
+ $attr->removeNamedItem ($name);
+
+ # Substitute with default value if it's defined
+ my $default = $self->getDefaultAttrValue ($name);
+ if (defined $default)
+ {
+ local $XML::DOM::IgnoreReadOnly = 1;
+
+ $default = $default->cloneNode (1);
+ $attr->setNamedItem ($default);
+ }
+ $node;
+}
+
+sub removeAttribute
+{
+ my ($self, $name) = @_;
+ my $attr = $self->[_A];
+ unless (defined $attr)
+ {
+ croak new XML::DOM::DOMException (NOT_FOUND_ERR);
+ return;
+ }
+
+ my $node = $attr->getNamedItem ($name);
+ if (defined $node)
+ {
+#?? could use dispose() to remove circular references for gc, but what if
+#?? somebody is referencing it?
+ $self->removeAttributeNode ($node);
+ }
+}
+
+sub cloneNode
+{
+ my ($self, $deep) = @_;
+ my $node = $self->[_Doc]->createElement ($self->getTagName);
+
+ # Always clone the Attr nodes, even if $deep == 0
+ if (defined $self->[_A])
+ {
+ $node->[_A] = $self->[_A]->cloneNode (1); # deep=1
+ $node->[_A]->setParentNode ($node);
+ }
+
+ $node->cloneChildren ($self, $deep);
+ $node;
+}
+
+sub getAttributes
+{
+ $_[0]->[_A] ||= XML::DOM::NamedNodeMap->new (Doc => $_[0]->[_Doc],
+ Parent => $_[0]);
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+# Added for convenience
+sub setTagName
+{
+ my ($self, $tagName) = @_;
+
+ croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
+ "bad Element TagName [$tagName]")
+ unless XML::DOM::isValidName ($tagName);
+
+ $self->[_TagName] = $tagName;
+}
+
+sub isReadOnly
+{
+ 0;
+}
+
+# Added for optimization.
+sub isElementNode
+{
+ 1;
+}
+
+sub rejectChild
+{
+ my $t = $_[1]->getNodeType;
+
+ $t != TEXT_NODE
+ && $t != ENTITY_REFERENCE_NODE
+ && $t != PROCESSING_INSTRUCTION_NODE
+ && $t != COMMENT_NODE
+ && $t != CDATA_SECTION_NODE
+ && $t != ELEMENT_NODE;
+}
+
+sub getDefaultAttrValue
+{
+ my ($self, $attr) = @_;
+ $self->[_Doc]->getDefaultAttrValue ($self->[_TagName], $attr);
+}
+
+sub dispose
+{
+ my $self = shift;
+
+ $self->[_A]->dispose if defined $self->[_A];
+ $self->SUPER::dispose;
+}
+
+sub setOwnerDocument
+{
+ my ($self, $doc) = @_;
+ $self->SUPER::setOwnerDocument ($doc);
+
+ $self->[_A]->setOwnerDocument ($doc) if defined $self->[_A];
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $name = $self->[_TagName];
+
+ $FILE->print ("<$name");
+
+ if (defined $self->[_A])
+ {
+ for my $att (@{$self->[_A]->getValues})
+ {
+ # skip un-specified (default) Attr nodes
+ if ($att->isSpecified)
+ {
+ $FILE->print (" ");
+ $att->print ($FILE);
+ }
+ }
+ }
+
+ my @kids = @{$self->[_C]};
+ if (@kids > 0)
+ {
+ $FILE->print (">");
+ for my $kid (@kids)
+ {
+ $kid->print ($FILE);
+ }
+ $FILE->print ("</$name>");
+ }
+ else
+ {
+ my $style = &$XML::DOM::TagStyle ($name, $self);
+ if ($style == 0)
+ {
+ $FILE->print ("/>");
+ }
+ elsif ($style == 1)
+ {
+ $FILE->print ("></$name>");
+ }
+ else
+ {
+ $FILE->print (" />");
+ }
+ }
+}
+
+sub check
+{
+ my ($self, $checker) = @_;
+ die "Usage: \$xml_dom_elem->check (\$checker)" unless $checker;
+
+ $checker->InitDomElem;
+ $self->to_expat ($checker);
+ $checker->FinalDomElem;
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+
+ my $tag = $self->getTagName;
+ $iter->Start ($tag);
+
+ if (defined $self->[_A])
+ {
+ for my $attr ($self->[_A]->getValues)
+ {
+ $iter->Attr ($tag, $attr->getName, $attr->getValue, $attr->isSpecified);
+ }
+ }
+
+ $iter->EndAttr;
+
+ for my $kid ($self->getChildNodes)
+ {
+ $kid->to_expat ($iter);
+ }
+
+ $iter->End;
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+
+ my $tag = $self->getTagName;
+
+ my @attr = ();
+ my $attrOrder;
+ my $attrDefaulted;
+
+ if (defined $self->[_A])
+ {
+ my @spec = (); # names of specified attributes
+ my @unspec = (); # names of defaulted attributes
+
+ for my $attr ($self->[_A]->getValues)
+ {
+ my $attrName = $attr->getName;
+ push @attr, $attrName, $attr->getValue;
+ if ($attr->isSpecified)
+ {
+ push @spec, $attrName;
+ }
+ else
+ {
+ push @unspec, $attrName;
+ }
+ }
+ $attrOrder = [ @spec, @unspec ];
+ $attrDefaulted = @spec;
+ }
+ $doch->start_element (defined $attrOrder ?
+ { Name => $tag,
+ Attributes => { @attr },
+ AttributeOrder => $attrOrder,
+ Defaulted => $attrDefaulted
+ } :
+ { Name => $tag,
+ Attributes => { @attr }
+ }
+ );
+
+ for my $kid ($self->getChildNodes)
+ {
+ $kid->_to_sax ($doch, $dtdh, $enth);
+ }
+
+ $doch->end_element ( { Name => $tag } );
+}
+
+######################################################################
+package XML::DOM::CharacterData;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("Data", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+
+#
+# CharacterData nodes should never be created directly, only subclassed!
+#
+sub new
+{
+ my ($class, $doc, $data) = @_;
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_Data] = $data;
+ $self;
+}
+
+sub appendData
+{
+ my ($self, $data) = @_;
+
+ if ($XML::DOM::SafeMode)
+ {
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+ }
+ $self->[_Data] .= $data;
+}
+
+sub deleteData
+{
+ my ($self, $offset, $count) = @_;
+
+ croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
+ "bad offset [$offset]")
+ if ($offset < 0 || $offset >= length ($self->[_Data]));
+#?? DOM Spec says >, but >= makes more sense!
+
+ croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
+ "negative count [$count]")
+ if $count < 0;
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ substr ($self->[_Data], $offset, $count) = "";
+}
+
+sub getData
+{
+ $_[0]->[_Data];
+}
+
+sub getLength
+{
+ length $_[0]->[_Data];
+}
+
+sub insertData
+{
+ my ($self, $offset, $data) = @_;
+
+ croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
+ "bad offset [$offset]")
+ if ($offset < 0 || $offset >= length ($self->[_Data]));
+#?? DOM Spec says >, but >= makes more sense!
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ substr ($self->[_Data], $offset, 0) = $data;
+}
+
+sub replaceData
+{
+ my ($self, $offset, $count, $data) = @_;
+
+ croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
+ "bad offset [$offset]")
+ if ($offset < 0 || $offset >= length ($self->[_Data]));
+#?? DOM Spec says >, but >= makes more sense!
+
+ croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
+ "negative count [$count]")
+ if $count < 0;
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ substr ($self->[_Data], $offset, $count) = $data;
+}
+
+sub setData
+{
+ my ($self, $data) = @_;
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ $self->[_Data] = $data;
+}
+
+sub substringData
+{
+ my ($self, $offset, $count) = @_;
+ my $data = $self->[_Data];
+
+ croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
+ "bad offset [$offset]")
+ if ($offset < 0 || $offset >= length ($data));
+#?? DOM Spec says >, but >= makes more sense!
+
+ croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
+ "negative count [$count]")
+ if $count < 0;
+
+ substr ($data, $offset, $count);
+}
+
+sub getNodeValue
+{
+ $_[0]->getData;
+}
+
+sub setNodeValue
+{
+ $_[0]->setData ($_[1]);
+}
+
+######################################################################
+package XML::DOM::CDATASection;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::CharacterData qw( :DEFAULT :Fields );
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("", "XML::DOM::CharacterData");
+}
+
+use XML::DOM::DOMException;
+
+sub getNodeName
+{
+ "#cdata-section";
+}
+
+sub getNodeType
+{
+ CDATA_SECTION_NODE;
+}
+
+sub cloneNode
+{
+ my $self = shift;
+ $self->[_Doc]->createCDATASection ($self->getData);
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub isReadOnly
+{
+ 0;
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+ $FILE->print ("<![CDATA[");
+ $FILE->print (XML::DOM::encodeCDATA ($self->getData));
+ $FILE->print ("]]>");
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+ $iter->CData ($self->getData);
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+ $doch->start_cdata;
+ $doch->characters ( { Data => $self->getData } );
+ $doch->end_cdata;
+}
+
+######################################################################
+package XML::DOM::Comment;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::CharacterData qw( :DEFAULT :Fields );
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("", "XML::DOM::CharacterData");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+#?? setData - could check comment for double minus
+
+sub getNodeType
+{
+ COMMENT_NODE;
+}
+
+sub getNodeName
+{
+ "#comment";
+}
+
+sub cloneNode
+{
+ my $self = shift;
+ $self->[_Doc]->createComment ($self->getData);
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub isReadOnly
+{
+ return 0 if $XML::DOM::IgnoreReadOnly;
+
+ my $pa = $_[0]->[_Parent];
+ defined ($pa) ? $pa->isReadOnly : 0;
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+ my $comment = XML::DOM::encodeComment ($self->[_Data]);
+
+ $FILE->print ("<!--$comment-->");
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+ $iter->Comment ($self->getData);
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+ $doch->Comment ( { Data => $self->getData });
+}
+
+######################################################################
+package XML::DOM::Text;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::CharacterData qw( :DEFAULT :Fields );
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("", "XML::DOM::CharacterData");
+}
+
+use XML::DOM::DOMException;
+use Carp;
+
+sub getNodeType
+{
+ TEXT_NODE;
+}
+
+sub getNodeName
+{
+ "#text";
+}
+
+sub splitText
+{
+ my ($self, $offset) = @_;
+
+ my $data = $self->getData;
+ croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
+ "bad offset [$offset]")
+ if ($offset < 0 || $offset >= length ($data));
+#?? DOM Spec says >, but >= makes more sense!
+
+ croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
+ "node is ReadOnly")
+ if $self->isReadOnly;
+
+ my $rest = substring ($data, $offset);
+
+ $self->setData (substring ($data, 0, $offset));
+ my $node = $self->[_Doc]->createTextNode ($rest);
+
+ # insert new node after this node
+ $self->[_Parent]->insertAfter ($node, $self);
+
+ $node;
+}
+
+sub cloneNode
+{
+ my $self = shift;
+ $self->[_Doc]->createTextNode ($self->getData);
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub isReadOnly
+{
+ 0;
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+ $FILE->print (XML::DOM::encodeText ($self->getData, "<&"));
+}
+
+sub isTextNode
+{
+ 1;
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+ $iter->Char ($self->getData);
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+ $doch->characters ( { Data => $self->getData } );
+}
+
+######################################################################
+package XML::DOM::XMLDecl;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("Version Encoding Standalone", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+
+
+#------------------------------------------------------------
+# Extra method implementations
+
+# XMLDecl is not part of the DOM Spec
+sub new
+{
+ my ($class, $doc, $version, $encoding, $standalone) = @_;
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_Version] = $version if defined $version;
+ $self->[_Encoding] = $encoding if defined $encoding;
+ $self->[_Standalone] = $standalone if defined $standalone;
+
+ $self;
+}
+
+sub setVersion
+{
+ if (defined $_[1])
+ {
+ $_[0]->[_Version] = $_[1];
+ }
+ else
+ {
+ undef $_[0]->[_Version]; # was delete
+ }
+}
+
+sub getVersion
+{
+ $_[0]->[_Version];
+}
+
+sub setEncoding
+{
+ if (defined $_[1])
+ {
+ $_[0]->[_Encoding] = $_[1];
+ }
+ else
+ {
+ undef $_[0]->[_Encoding]; # was delete
+ }
+}
+
+sub getEncoding
+{
+ $_[0]->[_Encoding];
+}
+
+sub setStandalone
+{
+ if (defined $_[1])
+ {
+ $_[0]->[_Standalone] = $_[1];
+ }
+ else
+ {
+ undef $_[0]->[_Standalone]; # was delete
+ }
+}
+
+sub getStandalone
+{
+ $_[0]->[_Standalone];
+}
+
+sub getNodeType
+{
+ XML_DECL_NODE;
+}
+
+sub cloneNode
+{
+ my $self = shift;
+
+ new XML::DOM::XMLDecl ($self->[_Doc], $self->[_Version],
+ $self->[_Encoding], $self->[_Standalone]);
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $version = $self->[_Version];
+ my $encoding = $self->[_Encoding];
+ my $standalone = $self->[_Standalone];
+ $standalone = ($standalone ? "yes" : "no") if defined $standalone;
+
+ $FILE->print ("<?xml");
+ $FILE->print (" version=\"$version\"") if defined $version;
+ $FILE->print (" encoding=\"$encoding\"") if defined $encoding;
+ $FILE->print (" standalone=\"$standalone\"") if defined $standalone;
+ $FILE->print ("?>");
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+ $iter->XMLDecl ($self->getVersion, $self->getEncoding, $self->getStandalone);
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+ $dtdh->xml_decl ( { Version => $self->getVersion,
+ Encoding => $self->getEncoding,
+ Standalone => $self->getStandalone } );
+}
+
+######################################################################
+package XML::DOM::DocumentFragment;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+
+sub new
+{
+ my ($class, $doc) = @_;
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_C] = new XML::DOM::NodeList;
+ $self;
+}
+
+sub getNodeType
+{
+ DOCUMENT_FRAGMENT_NODE;
+}
+
+sub getNodeName
+{
+ "#document-fragment";
+}
+
+sub cloneNode
+{
+ my ($self, $deep) = @_;
+ my $node = $self->[_Doc]->createDocumentFragment;
+
+ $node->cloneChildren ($self, $deep);
+ $node;
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub isReadOnly
+{
+ 0;
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ for my $node (@{$self->[_C]})
+ {
+ $node->print ($FILE);
+ }
+}
+
+sub rejectChild
+{
+ my $t = $_[1]->getNodeType;
+
+ $t != TEXT_NODE
+ && $t != ENTITY_REFERENCE_NODE
+ && $t != PROCESSING_INSTRUCTION_NODE
+ && $t != COMMENT_NODE
+ && $t != CDATA_SECTION_NODE
+ && $t != ELEMENT_NODE;
+}
+
+sub isDocumentFragmentNode
+{
+ 1;
+}
+
+######################################################################
+package XML::DOM::Document;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ XML::DOM::def_fields ("Doctype XmlDecl", "XML::DOM::Node");
+}
+
+use Carp;
+use XML::DOM::NodeList;
+use XML::DOM::DOMException;
+
+sub new
+{
+ my ($class) = @_;
+ my $self = bless [], $class;
+
+ # keep Doc pointer, even though getOwnerDocument returns undef
+ $self->[_Doc] = $self;
+ $self->[_C] = new XML::DOM::NodeList;
+ $self;
+}
+
+sub getNodeType
+{
+ DOCUMENT_NODE;
+}
+
+sub getNodeName
+{
+ "#document";
+}
+
+#?? not sure about keeping a fixed order of these nodes....
+sub getDoctype
+{
+ $_[0]->[_Doctype];
+}
+
+sub getDocumentElement
+{
+ my ($self) = @_;
+ for my $kid (@{$self->[_C]})
+ {
+ return $kid if $kid->isElementNode;
+ }
+ undef;
+}
+
+sub getOwnerDocument
+{
+ undef;
+}
+
+sub getImplementation
+{
+ $XML::DOM::DOMImplementation::Singleton;
+}
+
+#
+# Added extra parameters ($val, $specified) that are passed straight to the
+# Attr constructor
+#
+sub createAttribute
+{
+ new XML::DOM::Attr (@_);
+}
+
+sub createCDATASection
+{
+ new XML::DOM::CDATASection (@_);
+}
+
+sub createComment
+{
+ new XML::DOM::Comment (@_);
+
+}
+
+sub createElement
+{
+ new XML::DOM::Element (@_);
+}
+
+sub createTextNode
+{
+ new XML::DOM::Text (@_);
+}
+
+sub createProcessingInstruction
+{
+ new XML::DOM::ProcessingInstruction (@_);
+}
+
+sub createEntityReference
+{
+ new XML::DOM::EntityReference (@_);
+}
+
+sub createDocumentFragment
+{
+ new XML::DOM::DocumentFragment (@_);
+}
+
+sub createDocumentType
+{
+ new XML::DOM::DocumentType (@_);
+}
+
+sub cloneNode
+{
+ my ($self, $deep) = @_;
+ my $node = new XML::DOM::Document;
+
+ $node->cloneChildren ($self, $deep);
+
+ my $xmlDecl = $self->[_XmlDecl];
+ $node->[_XmlDecl] = $xmlDecl->cloneNode ($deep) if defined $xmlDecl;
+
+ $node;
+}
+
+sub appendChild
+{
+ my ($self, $node) = @_;
+
+ # Extra check: make sure we don't end up with more than one Element.
+ # Don't worry about multiple DocType nodes, because DocumentFragment
+ # can't contain DocType nodes.
+
+ my @nodes = ($node);
+ @nodes = @{$node->[_C]}
+ if $node->getNodeType == DOCUMENT_FRAGMENT_NODE;
+
+ my $elem = 0;
+ for my $n (@nodes)
+ {
+ $elem++ if $n->isElementNode;
+ }
+
+ if ($elem > 0 && defined ($self->getDocumentElement))
+ {
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "document can have only one Element");
+ }
+ $self->SUPER::appendChild ($node);
+}
+
+sub insertBefore
+{
+ my ($self, $node, $refNode) = @_;
+
+ # Extra check: make sure sure we don't end up with more than 1 Elements.
+ # Don't worry about multiple DocType nodes, because DocumentFragment
+ # can't contain DocType nodes.
+
+ my @nodes = ($node);
+ @nodes = @{$node->[_C]}
+ if $node->getNodeType == DOCUMENT_FRAGMENT_NODE;
+
+ my $elem = 0;
+ for my $n (@nodes)
+ {
+ $elem++ if $n->isElementNode;
+ }
+
+ if ($elem > 0 && defined ($self->getDocumentElement))
+ {
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "document can have only one Element");
+ }
+ $self->SUPER::insertBefore ($node, $refNode);
+}
+
+sub replaceChild
+{
+ my ($self, $node, $refNode) = @_;
+
+ # Extra check: make sure sure we don't end up with more than 1 Elements.
+ # Don't worry about multiple DocType nodes, because DocumentFragment
+ # can't contain DocType nodes.
+
+ my @nodes = ($node);
+ @nodes = @{$node->[_C]}
+ if $node->getNodeType == DOCUMENT_FRAGMENT_NODE;
+
+ my $elem = 0;
+ $elem-- if $refNode->isElementNode;
+
+ for my $n (@nodes)
+ {
+ $elem++ if $n->isElementNode;
+ }
+
+ if ($elem > 0 && defined ($self->getDocumentElement))
+ {
+ croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
+ "document can have only one Element");
+ }
+ $self->SUPER::appendChild ($node, $refNode);
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub isReadOnly
+{
+ 0;
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $xmlDecl = $self->getXMLDecl;
+ if (defined $xmlDecl)
+ {
+ $xmlDecl->print ($FILE);
+ $FILE->print ("\x0A");
+ }
+
+ for my $node (@{$self->[_C]})
+ {
+ $node->print ($FILE);
+ $FILE->print ("\x0A");
+ }
+}
+
+sub setDoctype
+{
+ my ($self, $doctype) = @_;
+ my $oldDoctype = $self->[_Doctype];
+ if (defined $oldDoctype)
+ {
+ $self->replaceChild ($doctype, $oldDoctype);
+ }
+ else
+ {
+#?? before root element, but after XmlDecl !
+ $self->appendChild ($doctype);
+ }
+ $_[0]->[_Doctype] = $_[1];
+}
+
+sub removeDoctype
+{
+ my $self = shift;
+ my $doctype = $self->removeChild ($self->[_Doctype]);
+
+ undef $self->[_Doctype]; # was delete
+ $doctype;
+}
+
+sub rejectChild
+{
+ my $t = $_[1]->getNodeType;
+ $t != ELEMENT_NODE
+ && $t != PROCESSING_INSTRUCTION_NODE
+ && $t != COMMENT_NODE
+ && $t != DOCUMENT_TYPE_NODE;
+}
+
+sub expandEntity
+{
+ my ($self, $ent, $param) = @_;
+ my $doctype = $self->getDoctype;
+
+ (defined $doctype) ? $doctype->expandEntity ($ent, $param) : undef;
+}
+
+sub getDefaultAttrValue
+{
+ my ($self, $elem, $attr) = @_;
+
+ my $doctype = $self->getDoctype;
+
+ (defined $doctype) ? $doctype->getDefaultAttrValue ($elem, $attr) : undef;
+}
+
+sub getEntity
+{
+ my ($self, $entity) = @_;
+
+ my $doctype = $self->getDoctype;
+
+ (defined $doctype) ? $doctype->getEntity ($entity) : undef;
+}
+
+sub dispose
+{
+ my $self = shift;
+
+ $self->[_XmlDecl]->dispose if defined $self->[_XmlDecl];
+ undef $self->[_XmlDecl]; # was delete
+ undef $self->[_Doctype]; # was delete
+ $self->SUPER::dispose;
+}
+
+sub setOwnerDocument
+{
+ # Do nothing, you can't change the owner document!
+#?? could throw exception...
+}
+
+sub getXMLDecl
+{
+ $_[0]->[_XmlDecl];
+}
+
+sub setXMLDecl
+{
+ $_[0]->[_XmlDecl] = $_[1];
+}
+
+sub createXMLDecl
+{
+ new XML::DOM::XMLDecl (@_);
+}
+
+sub createNotation
+{
+ new XML::DOM::Notation (@_);
+}
+
+sub createElementDecl
+{
+ new XML::DOM::ElementDecl (@_);
+}
+
+sub createAttlistDecl
+{
+ new XML::DOM::AttlistDecl (@_);
+}
+
+sub createEntity
+{
+ new XML::DOM::Entity (@_);
+}
+
+sub createChecker
+{
+ my $self = shift;
+ my $checker = XML::Checker->new;
+
+ $checker->Init;
+ my $doctype = $self->getDoctype;
+ $doctype->to_expat ($checker) if $doctype;
+ $checker->Final;
+
+ $checker;
+}
+
+sub check
+{
+ my ($self, $checker) = @_;
+ $checker ||= XML::Checker->new;
+
+ $self->to_expat ($checker);
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+
+ $iter->Init;
+
+ for my $kid ($self->getChildNodes)
+ {
+ $kid->to_expat ($iter);
+ }
+ $iter->Final;
+}
+
+sub check_sax
+{
+ my ($self, $checker) = @_;
+ $checker ||= XML::Checker->new;
+
+ $self->to_sax (Handler => $checker);
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+
+ $doch->start_document;
+
+ for my $kid ($self->getChildNodes)
+ {
+ $kid->_to_sax ($doch, $dtdh, $enth);
+ }
+ $doch->end_document;
+}
+
+######################################################################
+package XML::DOM::DocumentType;
+######################################################################
+use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
+
+BEGIN
+{
+ import XML::DOM::Node qw( :DEFAULT :Fields );
+ import XML::DOM::Document qw( :Fields );
+ XML::DOM::def_fields ("Entities Notations Name SysId PubId Internal", "XML::DOM::Node");
+}
+
+use XML::DOM::DOMException;
+use XML::DOM::NamedNodeMap;
+
+sub new
+{
+ my $class = shift;
+ my $doc = shift;
+
+ my $self = bless [], $class;
+
+ $self->[_Doc] = $doc;
+ $self->[_ReadOnly] = 1;
+ $self->[_C] = new XML::DOM::NodeList;
+
+ $self->[_Entities] = new XML::DOM::NamedNodeMap (Doc => $doc,
+ Parent => $self,
+ ReadOnly => 1);
+ $self->[_Notations] = new XML::DOM::NamedNodeMap (Doc => $doc,
+ Parent => $self,
+ ReadOnly => 1);
+ $self->setParams (@_);
+ $self;
+}
+
+sub getNodeType
+{
+ DOCUMENT_TYPE_NODE;
+}
+
+sub getNodeName
+{
+ $_[0]->[_Name];
+}
+
+sub getName
+{
+ $_[0]->[_Name];
+}
+
+sub getEntities
+{
+ $_[0]->[_Entities];
+}
+
+sub getNotations
+{
+ $_[0]->[_Notations];
+}
+
+sub setParentNode
+{
+ my ($self, $parent) = @_;
+ $self->SUPER::setParentNode ($parent);
+
+ $parent->[_Doctype] = $self
+ if $parent->getNodeType == DOCUMENT_NODE;
+}
+
+sub cloneNode
+{
+ my ($self, $deep) = @_;
+
+ my $node = new XML::DOM::DocumentType ($self->[_Doc], $self->[_Name],
+ $self->[_SysId], $self->[_PubId],
+ $self->[_Internal]);
+
+#?? does it make sense to make a shallow copy?
+
+ # clone the NamedNodeMaps
+ $node->[_Entities] = $self->[_Entities]->cloneNode ($deep);
+
+ $node->[_Notations] = $self->[_Notations]->cloneNode ($deep);
+
+ $node->cloneChildren ($self, $deep);
+
+ $node;
+}
+
+#------------------------------------------------------------
+# Extra method implementations
+
+sub getSysId
+{
+ $_[0]->[_SysId];
+}
+
+sub getPubId
+{
+ $_[0]->[_PubId];
+}
+
+sub getInternal
+{
+ $_[0]->[_Internal];
+}
+
+sub setSysId
+{
+ $_[0]->[_SysId] = $_[1];
+}
+
+sub setPubId
+{
+ $_[0]->[_PubId] = $_[1];
+}
+
+sub setInternal
+{
+ $_[0]->[_Internal] = $_[1];
+}
+
+sub setName
+{
+ $_[0]->[_Name] = $_[1];
+}
+
+sub removeChildHoodMemories
+{
+ my ($self, $dontWipeReadOnly) = @_;
+
+ my $parent = $self->[_Parent];
+ if (defined $parent && $parent->getNodeType == DOCUMENT_NODE)
+ {
+ undef $parent->[_Doctype]; # was delete
+ }
+ $self->SUPER::removeChildHoodMemories;
+}
+
+sub dispose
+{
+ my $self = shift;
+
+ $self->[_Entities]->dispose;
+ $self->[_Notations]->dispose;
+ $self->SUPER::dispose;
+}
+
+sub setOwnerDocument
+{
+ my ($self, $doc) = @_;
+ $self->SUPER::setOwnerDocument ($doc);
+
+ $self->[_Entities]->setOwnerDocument ($doc);
+ $self->[_Notations]->setOwnerDocument ($doc);
+}
+
+sub expandEntity
+{
+ my ($self, $ent, $param) = @_;
+
+ my $kid = $self->[_Entities]->getNamedItem ($ent);
+ return $kid->getValue
+ if (defined ($kid) && $param == $kid->isParameterEntity);
+
+ undef; # entity not found
+}
+
+sub getAttlistDecl
+{
+ my ($self, $elemName) = @_;
+ for my $kid (@{$_[0]->[_C]})
+ {
+ return $kid if ($kid->getNodeType == ATTLIST_DECL_NODE &&
+ $kid->getName eq $elemName);
+ }
+ undef; # not found
+}
+
+sub getElementDecl
+{
+ my ($self, $elemName) = @_;
+ for my $kid (@{$_[0]->[_C]})
+ {
+ return $kid if ($kid->getNodeType == ELEMENT_DECL_NODE &&
+ $kid->getName eq $elemName);
+ }
+ undef; # not found
+}
+
+sub addElementDecl
+{
+ my ($self, $name, $model, $hidden) = @_;
+ my $node = $self->getElementDecl ($name);
+
+#?? could warn
+ unless (defined $node)
+ {
+ $node = $self->[_Doc]->createElementDecl ($name, $model, $hidden);
+ $self->appendChild ($node);
+ }
+ $node;
+}
+
+sub addAttlistDecl
+{
+ my ($self, $name) = @_;
+ my $node = $self->getAttlistDecl ($name);
+
+ unless (defined $node)
+ {
+ $node = $self->[_Doc]->createAttlistDecl ($name);
+ $self->appendChild ($node);
+ }
+ $node;
+}
+
+sub addNotation
+{
+ my $self = shift;
+ my $node = $self->[_Doc]->createNotation (@_);
+ $self->[_Notations]->setNamedItem ($node);
+ $node;
+}
+
+sub addEntity
+{
+ my $self = shift;
+ my $node = $self->[_Doc]->createEntity (@_);
+
+ $self->[_Entities]->setNamedItem ($node);
+ $node;
+}
+
+# All AttDefs for a certain Element are merged into a single ATTLIST
+sub addAttDef
+{
+ my $self = shift;
+ my $elemName = shift;
+
+ # create the AttlistDecl if it doesn't exist yet
+ my $attListDecl = $self->addAttlistDecl ($elemName);
+ $attListDecl->addAttDef (@_);
+}
+
+sub getDefaultAttrValue
+{
+ my ($self, $elem, $attr) = @_;
+ my $elemNode = $self->getAttlistDecl ($elem);
+ (defined $elemNode) ? $elemNode->getDefaultAttrValue ($attr) : undef;
+}
+
+sub getEntity
+{
+ my ($self, $entity) = @_;
+ $self->[_Entities]->getNamedItem ($entity);
+}
+
+sub setParams
+{
+ my ($self, $name, $sysid, $pubid, $internal) = @_;
+
+ $self->[_Name] = $name;
+
+#?? not sure if we need to hold on to these...
+ $self->[_SysId] = $sysid if defined $sysid;
+ $self->[_PubId] = $pubid if defined $pubid;
+ $self->[_Internal] = $internal if defined $internal;
+
+ $self;
+}
+
+sub rejectChild
+{
+ # DOM Spec says: DocumentType -- no children
+ not $XML::DOM::IgnoreReadOnly;
+}
+
+sub print
+{
+ my ($self, $FILE) = @_;
+
+ my $name = $self->[_Name];
+
+ my $sysId = $self->[_SysId];
+ my $pubId = $self->[_PubId];
+
+ $FILE->print ("<!DOCTYPE $name");
+ if (defined $pubId)
+ {
+ $FILE->print (" PUBLIC \"$pubId\" \"$sysId\"");
+ }
+ elsif (defined $sysId)
+ {
+ $FILE->print (" SYSTEM \"$sysId\"");
+ }
+
+ my @entities = @{$self->[_Entities]->getValues};
+ my @notations = @{$self->[_Notations]->getValues};
+ my @kids = @{$self->[_C]};
+
+ if (@entities || @notations || @kids)
+ {
+ $FILE->print (" [\x0A");
+
+ for my $kid (@entities)
+ {
+ next if $kid->[_Hidden];
+
+ $FILE->print (" ");
+ $kid->print ($FILE);
+ $FILE->print ("\x0A");
+ }
+
+ for my $kid (@notations)
+ {
+ next if $kid->[_Hidden];
+
+ $FILE->print (" ");
+ $kid->print ($FILE);
+ $FILE->print ("\x0A");
+ }
+
+ for my $kid (@kids)
+ {
+ next if $kid->[_Hidden];
+
+ $FILE->print (" ");
+ $kid->print ($FILE);
+ $FILE->print ("\x0A");
+ }
+ $FILE->print ("]");
+ }
+ $FILE->print (">");
+}
+
+sub to_expat
+{
+ my ($self, $iter) = @_;
+
+ $iter->Doctype ($self->getName, $self->getSysId, $self->getPubId, $self->getInternal);
+
+ for my $ent ($self->getEntities->getValues)
+ {
+ next if $ent->[_Hidden];
+ $ent->to_expat ($iter);
+ }
+
+ for my $nota ($self->getNotations->getValues)
+ {
+ next if $nota->[_Hidden];
+ $nota->to_expat ($iter);
+ }
+
+ for my $kid ($self->getChildNodes)
+ {
+ next if $kid->[_Hidden];
+ $kid->to_expat ($iter);
+ }
+}
+
+sub _to_sax
+{
+ my ($self, $doch, $dtdh, $enth) = @_;
+
+ $dtdh->doctype_decl ( { Name => $self->getName,
+ SystemId => $self->getSysId,
+ PublicId => $self->getPubId,
+ Internal => $self->getInternal });
+
+ for my $ent ($self->getEntities->getValues)
+ {
+ next if $ent->[_Hidden];
+ $ent->_to_sax ($doch, $dtdh, $enth);
+ }
+
+ for my $nota ($self->getNotations->getValues)
+ {
+ next if $nota->[_Hidden];
+ $nota->_to_sax ($doch, $dtdh, $enth);
+ }
+
+ for my $kid ($self->getChildNodes)
+ {
+ next if $kid->[_Hidden];
+ $kid->_to_sax ($doch, $dtdh, $enth);
+ }
+}
+
+######################################################################
+package XML::DOM::Parser;
+######################################################################
+use vars qw ( @ISA );
+@ISA = qw( XML::Parser );
+
+sub new
+{
+ my ($class, %args) = @_;
+
+ $args{Style} = 'Dom';
+ $class->SUPER::new (%args);
+}
+
+# This method needed to be overriden so we can restore some global
+# variables when an exception is thrown
+sub parse
+{
+ my $self = shift;
+
+ local $XML::Parser::Dom::_DP_doc;
+ local $XML::Parser::Dom::_DP_elem;
+ local $XML::Parser::Dom::_DP_doctype;
+ local $XML::Parser::Dom::_DP_in_prolog;
+ local $XML::Parser::Dom::_DP_end_doc;
+ local $XML::Parser::Dom::_DP_saw_doctype;
+ local $XML::Parser::Dom::_DP_in_CDATA;
+ local $XML::Parser::Dom::_DP_keep_CDATA;
+ local $XML::Parser::Dom::_DP_last_text;
+
+
+ # Temporarily disable checks that Expat already does (for performance)
+ local $XML::DOM::SafeMode = 0;
+ # Temporarily disable ReadOnly checks
+ local $XML::DOM::IgnoreReadOnly = 1;
+
+ my $ret;
+ eval {
+ $ret = $self->SUPER::parse (@_);
+ };
+ my $err = $@;
+
+ if ($err)
+ {
+ my $doc = $XML::Parser::Dom::_DP_doc;
+ if ($doc)
+ {
+ $doc->dispose;
+ }
+ die $err;
+ }
+
+ $ret;
+}
+
+my $LWP_USER_AGENT;
+sub set_LWP_UserAgent
+{
+ $LWP_USER_AGENT = shift;
+}
+
+sub parsefile
+{
+ my $self = shift;
+ my $url = shift;
+
+ # Any other URL schemes?
+ if ($url =~ /^(https?|ftp|wais|gopher|file):/)
+ {
+ # Read the file from the web with LWP.
+ #
+ # Note that we read in the entire file, which may not be ideal
+ # for large files. LWP::UserAgent also provides a callback style
+ # request, which we could convert to a stream with a fork()...
+
+ my $result;
+ eval
+ {
+ use LWP::UserAgent;
+
+ my $ua = $self->{LWP_UserAgent};
+ unless (defined $ua)
+ {
+ unless (defined $LWP_USER_AGENT)
+ {
+ $LWP_USER_AGENT = LWP::UserAgent->new;
+
+ # Load proxy settings from environment variables, i.e.:
+ # http_proxy, ftp_proxy, no_proxy etc. (see LWP::UserAgent(3))
+ # You need these to go thru firewalls.
+ $LWP_USER_AGENT->env_proxy;
+ }
+ $ua = $LWP_USER_AGENT;
+ }
+ my $req = new HTTP::Request 'GET', $url;
+ my $response = $LWP_USER_AGENT->request ($req);
+
+ # Parse the result of the HTTP request
+ $result = $self->parse ($response->content, @_);
+ };
+ if ($@)
+ {
+ die "Couldn't parsefile [$url] with LWP: $@";
+ }
+ return $result;
+ }
+ else
+ {
+ return $self->SUPER::parsefile ($url, @_);
+ }
+}
+
+######################################################################
+package XML::Parser::Dom;
+######################################################################
+
+BEGIN
+{
+ import XML::DOM::Node qw( :Fields );
+ import XML::DOM::CharacterData qw( :Fields );
+}
+
+use vars qw( $_DP_doc
+ $_DP_elem
+ $_DP_doctype
+ $_DP_in_prolog
+ $_DP_end_doc
+ $_DP_saw_doctype
+ $_DP_in_CDATA
+ $_DP_keep_CDATA
+ $_DP_last_text
+ $_DP_level
+ $_DP_expand_pent
+ );
+
+# This adds a new Style to the XML::Parser class.
+# From now on you can say: $parser = new XML::Parser ('Style' => 'Dom' );
+# but that is *NOT* how a regular user should use it!
+$XML::Parser::Built_In_Styles{Dom} = 1;
+
+sub Init
+{
+ $_DP_elem = $_DP_doc = new XML::DOM::Document();
+ $_DP_doctype = new XML::DOM::DocumentType ($_DP_doc);
+ $_DP_doc->setDoctype ($_DP_doctype);
+ $_DP_keep_CDATA = $_[0]->{KeepCDATA};
+
+ # Prepare for document prolog
+ $_DP_in_prolog = 1;
+
+ # We haven't passed the root element yet
+ $_DP_end_doc = 0;
+
+ # Expand parameter entities in the DTD by default
+
+ $_DP_expand_pent = defined $_[0]->{ExpandParamEnt} ?
+ $_[0]->{ExpandParamEnt} : 1;
+ if ($_DP_expand_pent)
+ {
+ $_[0]->{DOM_Entity} = {};
+ }
+
+ $_DP_level = 0;
+
+ undef $_DP_last_text;
+}
+
+sub Final
+{
+ unless ($_DP_saw_doctype)
+ {
+ my $doctype = $_DP_doc->removeDoctype;
+ $doctype->dispose;
+ }
+ $_DP_doc;
+}
+
+sub Char
+{
+ my $str = $_[1];
+
+ if ($_DP_in_CDATA && $_DP_keep_CDATA)
+ {
+ undef $_DP_last_text;
+ # Merge text with previous node if possible
+ $_DP_elem->addCDATA ($str);
+ }
+ else
+ {
+ # Merge text with previous node if possible
+ # Used to be: $expat->{DOM_Element}->addText ($str);
+ if ($_DP_last_text)
+ {
+ $_DP_last_text->[_Data] .= $str;
+ }
+ else
+ {
+ $_DP_last_text = $_DP_doc->createTextNode ($str);
+ $_DP_last_text->[_Parent] = $_DP_elem;
+ push @{$_DP_elem->[_C]}, $_DP_last_text;
+ }
+ }
+}
+
+sub Start
+{
+ my ($expat, $elem, @attr) = @_;
+ my $parent = $_DP_elem;
+ my $doc = $_DP_doc;
+
+ if ($parent == $doc)
+ {
+ # End of document prolog, i.e. start of first Element
+ $_DP_in_prolog = 0;
+ }
+
+ undef $_DP_last_text;
+ my $node = $doc->createElement ($elem);
+ $_DP_elem = $node;
+ $parent->appendChild ($node);
+
+ my $n = @attr;
+ return unless $n;
+
+ # Add attributes
+ my $first_default = $expat->specified_attr;
+ my $i = 0;
+ while ($i < $n)
+ {
+ my $specified = $i < $first_default;
+ my $name = $attr[$i++];
+ undef $_DP_last_text;
+ my $attr = $doc->createAttribute ($name, $attr[$i++], $specified);
+ $node->setAttributeNode ($attr);
+ }
+}
+
+sub End
+{
+ $_DP_elem = $_DP_elem->[_Parent];
+ undef $_DP_last_text;
+
+ # Check for end of root element
+ $_DP_end_doc = 1 if ($_DP_elem == $_DP_doc);
+}
+
+# Called at end of file, i.e. whitespace following last closing tag
+# Also for Entity references
+# May also be called at other times...
+sub Default
+{
+ my ($expat, $str) = @_;
+
+# shift; deb ("Default", @_);
+
+ if ($_DP_in_prolog) # still processing Document prolog...
+ {
+#?? could try to store this text later
+#?? I've only seen whitespace here so far
+ }
+ elsif (!$_DP_end_doc) # ignore whitespace at end of Document
+ {
+# if ($expat->{NoExpand})
+# {
+ $str =~ /^&(.+);$/os;
+ return unless defined ($1);
+ # Got a TextDecl (<?xml ...?>) from an external entity here once
+
+ $_DP_elem->appendChild (
+ $_DP_doc->createEntityReference ($1));
+ undef $_DP_last_text;
+# }
+# else
+# {
+# $expat->{DOM_Element}->addText ($str);
+# }
+ }
+}
+
+# XML::Parser 2.19 added support for CdataStart and CdataEnd handlers
+# If they are not defined, the Default handler is called instead
+# with the text "<![CDATA[" and "]]"
+sub CdataStart
+{
+ $_DP_in_CDATA = 1;
+}
+
+sub CdataEnd
+{
+ $_DP_in_CDATA = 0;
+}
+
+my $START_MARKER = "__DOM__START__ENTITY__";
+my $END_MARKER = "__DOM__END__ENTITY__";
+
+sub Comment
+{
+ undef $_DP_last_text;
+
+ # These comments were inserted by ExternEnt handler
+ if ($_[1] =~ /(?:($START_MARKER)|($END_MARKER))/)
+ {
+ if ($1) # START
+ {
+ $_DP_level++;
+ }
+ else
+ {
+ $_DP_level--;
+ }
+ }
+ else
+ {
+ my $comment = $_DP_doc->createComment ($_[1]);
+ $_DP_elem->appendChild ($comment);
+ }
+}
+
+sub deb
+{
+# return;
+
+ my $name = shift;
+ print "$name (" . join(",", map {defined($_)?$_ : "(undef)"} @_) . ")\n";
+}
+
+sub Doctype
+{
+ my $expat = shift;
+# deb ("Doctype", @_);
+
+ $_DP_doctype->setParams (@_);
+ $_DP_saw_doctype = 1;
+}
+
+sub Attlist
+{
+ my $expat = shift;
+# deb ("Attlist", @_);
+
+ $_[5] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0;
+ $_DP_doctype->addAttDef (@_);
+}
+
+sub XMLDecl
+{
+ my $expat = shift;
+# deb ("XMLDecl", @_);
+
+ undef $_DP_last_text;
+ $_DP_doc->setXMLDecl (new XML::DOM::XMLDecl ($_DP_doc, @_));
+}
+
+sub Entity
+{
+ my $expat = shift;
+# deb ("Entity", @_);
+
+ # Parameter Entities names are passed starting with '%'
+ my $parameter = 0;
+ if ($_[0] =~ /^%(.*)/s)
+ {
+ $_[0] = $1;
+ $parameter = 1;
+
+ if (defined $_[2]) # was sysid specified?
+ {
+ # Store the Entity mapping for use in ExternEnt
+ if (exists $expat->{DOM_Entity}->{$_[2]})
+ {
+ # If this ever happens, the name of entity may be the wrong one
+ # when writing out the Document.
+ XML::DOM::warning ("Entity $_[2] is known as %$_[0] and %" .
+ $expat->{DOM_Entity}->{$_[2]});
+ }
+ else
+ {
+ $expat->{DOM_Entity}->{$_[2]} = $_[0];
+ }
+ #?? remove this block when XML::Parser has better support
+ }
+ }
+
+ undef $_DP_last_text;
+
+ $_[5] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0;
+ $_DP_doctype->addEntity ($parameter, @_);
+}
+
+#
+# Unparsed is called when it encounters e.g:
+#
+# <!ENTITY logo SYSTEM "http://server/logo.gif" NDATA gif>
+#
+sub Unparsed
+{
+ Entity (@_); # same as regular ENTITY, as far as DOM is concerned
+}
+
+sub Element
+{
+ shift;
+# deb ("Element", @_);
+
+ undef $_DP_last_text;
+ push @_, "Hidden" unless $_DP_expand_pent || $_DP_level == 0;
+ $_DP_doctype->addElementDecl (@_);
+}
+
+sub Notation
+{
+ shift;
+# deb ("Notation", @_);
+
+ undef $_DP_last_text;
+ $_[4] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0;
+ $_DP_doctype->addNotation (@_);
+}
+
+sub Proc
+{
+ shift;
+# deb ("Proc", @_);
+
+ undef $_DP_last_text;
+ push @_, "Hidden" unless $_DP_expand_pent || $_DP_level == 0;
+ $_DP_elem->appendChild ($_DP_doc->createProcessingInstruction (@_));
+}
+
+#
+# ExternEnt is called when an external entity, such as:
+#
+# <!ENTITY externalEntity PUBLIC "-//Enno//TEXT Enno's description//EN"
+# "http://server/descr.txt">
+#
+# is referenced in the document, e.g. with: &externalEntity;
+# If ExternEnt is not specified, the entity reference is passed to the Default
+# handler as e.g. "&externalEntity;", where an EntityReference object is added.
+#
+# Also for %externalEntity; references in the DTD itself.
+#
+# It can also be called when XML::Parser parses the DOCTYPE header
+# (just before calling the DocType handler), when it contains a
+# reference like "docbook.dtd" below:
+#
+# <!DOCTYPE book PUBLIC "-//Norman Walsh//DTD DocBk XML V3.1.3//EN"
+# "docbook.dtd" [
+# ... rest of DTD ...
+#
+sub ExternEnt
+{
+ my ($expat, $base, $sysid, $pubid) = @_;
+# deb ("ExternEnt", @_);
+
+ # Invoke XML::Parser's default ExternEnt handler
+ my $content;
+ if ($XML::Parser::have_LWP)
+ {
+ $content = XML::Parser::lwp_ext_ent_handler (@_);
+ }
+ else
+ {
+ $content = XML::Parser::file_ext_ent_handler (@_);
+ }
+
+ if ($_DP_expand_pent)
+ {
+ return $content;
+ }
+ else
+ {
+ my $entname = $expat->{DOM_Entity}->{$sysid};
+ if (defined $entname)
+ {
+ $_DP_doctype->appendChild ($_DP_doc->createEntityReference ($entname, 1));
+ # Wrap the contents in special comments, so we know when we reach the
+ # end of parsing the entity. This way we can omit the contents from
+ # the DTD, when ExpandParamEnt is set to 0.
+
+ return "<!-- $START_MARKER sysid=[$sysid] -->" .
+ $content . "<!-- $END_MARKER sysid=[$sysid] -->";
+ }
+ else
+ {
+ # We either read the entity ref'd by the system id in the
+ # <!DOCTYPE> header, or the entity was undefined.
+ # In either case, don't bother with maintaining the entity
+ # reference, just expand the contents.
+ return "<!-- $START_MARKER sysid=[DTD] -->" .
+ $content . "<!-- $END_MARKER sysid=[DTD] -->";
+ }
+ }
+}
+
+1; # module return code
+
+__END__
+
+=head1 NAME
+
+XML::DOM - A perl module for building DOM Level 1 compliant document structures
+
+=head1 SYNOPSIS
+
+ use XML::DOM;
+
+ my $parser = new XML::DOM::Parser;
+ my $doc = $parser->parsefile ("file.xml");
+
+ # print all HREF attributes of all CODEBASE elements
+ my $nodes = $doc->getElementsByTagName ("CODEBASE");
+ my $n = $nodes->getLength;
+
+ for (my $i = 0; $i < $n; $i++)
+ {
+ my $node = $nodes->item ($i);
+ my $href = $node->getAttributeNode ("HREF");
+ print $href->getValue . "\n";
+ }
+
+ # Print doc file
+ $doc->printToFile ("out.xml");
+
+ # Print to string
+ print $doc->toString;
+
+ # Avoid memory leaks - cleanup circular references for garbage collection
+ $doc->dispose;
+
+=head1 DESCRIPTION
+
+This module extends the XML::Parser module by Clark Cooper.
+The XML::Parser module is built on top of XML::Parser::Expat,
+which is a lower level interface to James Clark's expat library.
+
+XML::DOM::Parser is derived from XML::Parser. It parses XML strings or files
+and builds a data structure that conforms to the API of the Document Object
+Model as described at http://www.w3.org/TR/REC-DOM-Level-1.
+See the XML::Parser manpage for other available features of the
+XML::DOM::Parser class.
+Note that the 'Style' property should not be used (it is set internally.)
+
+The XML::Parser I<NoExpand> option is more or less supported, in that it will
+generate EntityReference objects whenever an entity reference is encountered
+in character data. I'm not sure how useful this is. Any comments are welcome.
+
+As described in the synopsis, when you create an XML::DOM::Parser object,
+the parse and parsefile methods create an I<XML::DOM::Document> object
+from the specified input. This Document object can then be examined, modified and
+written back out to a file or converted to a string.
+
+When using XML::DOM with XML::Parser version 2.19 and up, setting the
+XML::DOM::Parser option I<KeepCDATA> to 1 will store CDATASections in
+CDATASection nodes, instead of converting them to Text nodes.
+Subsequent CDATASection nodes will be merged into one. Let me know if this
+is a problem.
+
+When using XML::Parser 2.27 and above, you can suppress expansion of
+parameter entity references (e.g. %pent;) in the DTD, by setting I<ParseParamEnt>
+to 1 and I<ExpandParamEnt> to 0. See L<Hidden Nodes|/_Hidden_Nodes_> for details.
+
+A Document has a tree structure consisting of I<Node> objects. A Node may contain
+other nodes, depending on its type.
+A Document may have Element, Text, Comment, and CDATASection nodes.
+Element nodes may have Attr, Element, Text, Comment, and CDATASection nodes.
+The other nodes may not have any child nodes.
+
+This module adds several node types that are not part of the DOM spec (yet.)
+These are: ElementDecl (for <!ELEMENT ...> declarations), AttlistDecl (for
+<!ATTLIST ...> declarations), XMLDecl (for <?xml ...?> declarations) and AttDef
+(for attribute definitions in an AttlistDecl.)
+
+=head1 XML::DOM Classes
+
+The XML::DOM module stores XML documents in a tree structure with a root node
+of type XML::DOM::Document. Different nodes in tree represent different
+parts of the XML file. The DOM Level 1 Specification defines the following
+node types:
+
+=over 4
+
+=item * L<XML::DOM::Node> - Super class of all node types
+
+=item * L<XML::DOM::Document> - The root of the XML document
+
+=item * L<XML::DOM::DocumentType> - Describes the document structure: <!DOCTYPE root [ ... ]>
+
+=item * L<XML::DOM::Element> - An XML element: <elem attr="val"> ... </elem>
+
+=item * L<XML::DOM::Attr> - An XML element attribute: name="value"
+
+=item * L<XML::DOM::CharacterData> - Super class of Text, Comment and CDATASection
+
+=item * L<XML::DOM::Text> - Text in an XML element
+
+=item * L<XML::DOM::CDATASection> - Escaped block of text: <![CDATA[ text ]]>
+
+=item * L<XML::DOM::Comment> - An XML comment: <!-- comment -->
+
+=item * L<XML::DOM::EntityReference> - Refers to an ENTITY: &ent; or %ent;
+
+=item * L<XML::DOM::Entity> - An ENTITY definition: <!ENTITY ...>
+
+=item * L<XML::DOM::ProcessingInstruction> - <?PI target>
+
+=item * L<XML::DOM::DocumentFragment> - Lightweight node for cut & paste
+
+=item * L<XML::DOM::Notation> - An NOTATION definition: <!NOTATION ...>
+
+=back
+
+In addition, the XML::DOM module contains the following nodes that are not part
+of the DOM Level 1 Specification:
+
+=over 4
+
+=item * L<XML::DOM::ElementDecl> - Defines an element: <!ELEMENT ...>
+
+=item * L<XML::DOM::AttlistDecl> - Defines one or more attributes in an <!ATTLIST ...>
+
+=item * L<XML::DOM::AttDef> - Defines one attribute in an <!ATTLIST ...>
+
+=item * L<XML::DOM::XMLDecl> - An XML declaration: <?xml version="1.0" ...>
+
+=back
+
+Other classes that are part of the DOM Level 1 Spec:
+
+=over 4
+
+=item * L<XML::DOM::Implementation> - Provides information about this implementation. Currently it doesn't do much.
+
+=item * L<XML::DOM::NodeList> - Used internally to store a node's child nodes. Also returned by getElementsByTagName.
+
+=item * L<XML::DOM::NamedNodeMap> - Used internally to store an element's attributes.
+
+=back
+
+Other classes that are not part of the DOM Level 1 Spec:
+
+=over 4
+
+=item * L<XML::DOM::Parser> - An non-validating XML parser that creates XML::DOM::Documents
+
+=item * L<XML::DOM::ValParser> - A validating XML parser that creates XML::DOM::Documents. It uses L<XML::Checker> to check against the DocumentType (DTD)
+
+=item * L<XML::Handler::BuildDOM> - A PerlSAX handler that creates XML::DOM::Documents.
+
+=back
+
+=head1 XML::DOM package
+
+=over 4
+
+=item Constant definitions
+
+The following predefined constants indicate which type of node it is.
+
+=back
+
+ UNKNOWN_NODE (0) The node type is unknown (not part of DOM)
+
+ ELEMENT_NODE (1) The node is an Element.
+ ATTRIBUTE_NODE (2) The node is an Attr.
+ TEXT_NODE (3) The node is a Text node.
+ CDATA_SECTION_NODE (4) The node is a CDATASection.
+ ENTITY_REFERENCE_NODE (5) The node is an EntityReference.
+ ENTITY_NODE (6) The node is an Entity.
+ PROCESSING_INSTRUCTION_NODE (7) The node is a ProcessingInstruction.
+ COMMENT_NODE (8) The node is a Comment.
+ DOCUMENT_NODE (9) The node is a Document.
+ DOCUMENT_TYPE_NODE (10) The node is a DocumentType.
+ DOCUMENT_FRAGMENT_NODE (11) The node is a DocumentFragment.
+ NOTATION_NODE (12) The node is a Notation.
+
+ ELEMENT_DECL_NODE (13) The node is an ElementDecl (not part of DOM)
+ ATT_DEF_NODE (14) The node is an AttDef (not part of DOM)
+ XML_DECL_NODE (15) The node is an XMLDecl (not part of DOM)
+ ATTLIST_DECL_NODE (16) The node is an AttlistDecl (not part of DOM)
+
+ Usage:
+
+ if ($node->getNodeType == ELEMENT_NODE)
+ {
+ print "It's an Element";
+ }
+
+B<Not In DOM Spec>: The DOM Spec does not mention UNKNOWN_NODE and,
+quite frankly, you should never encounter it. The last 4 node types were added
+to support the 4 added node classes.
+
+=head2 Global Variables
+
+=over 4
+
+=item $VERSION
+
+The variable $XML::DOM::VERSION contains the version number of this
+implementation, e.g. "1.07".
+
+=back
+
+=head2 METHODS
+
+These methods are not part of the DOM Level 1 Specification.
+
+=over 4
+
+=item getIgnoreReadOnly and ignoreReadOnly (readOnly)
+
+The DOM Level 1 Spec does not allow you to edit certain sections of the document,
+e.g. the DocumentType, so by default this implementation throws DOMExceptions
+(i.e. NO_MODIFICATION_ALLOWED_ERR) when you try to edit a readonly node.
+These readonly checks can be disabled by (temporarily) setting the global
+IgnoreReadOnly flag.
+
+The ignoreReadOnly method sets the global IgnoreReadOnly flag and returns its
+previous value. The getIgnoreReadOnly method simply returns its current value.
+
+ my $oldIgnore = XML::DOM::ignoreReadOnly (1);
+ eval {
+ ... do whatever you want, catching any other exceptions ...
+ };
+ XML::DOM::ignoreReadOnly ($oldIgnore); # restore previous value
+
+Another way to do it, using a local variable:
+
+ { # start new scope
+ local $XML::DOM::IgnoreReadOnly = 1;
+ ... do whatever you want, don't worry about exceptions ...
+ } # end of scope ($IgnoreReadOnly is set back to its previous value)
+
+
+=item isValidName (name)
+
+Whether the specified name is a valid "Name" as specified in the XML spec.
+Characters with Unicode values > 127 are now also supported.
+
+=item getAllowReservedNames and allowReservedNames (boolean)
+
+The first method returns whether reserved names are allowed.
+The second takes a boolean argument and sets whether reserved names are allowed.
+The initial value is 1 (i.e. allow reserved names.)
+
+The XML spec states that "Names" starting with (X|x)(M|m)(L|l)
+are reserved for future use. (Amusingly enough, the XML version of the XML spec
+(REC-xml-19980210.xml) breaks that very rule by defining an ENTITY with the name
+'xmlpio'.)
+A "Name" in this context means the Name token as found in the BNF rules in the
+XML spec.
+
+XML::DOM only checks for errors when you modify the DOM tree, not when the
+DOM tree is built by the XML::DOM::Parser.
+
+=item setTagCompression (funcref)
+
+There are 3 possible styles for printing empty Element tags:
+
+=over 4
+
+=item Style 0
+
+ <empty/> or <empty attr="val"/>
+
+XML::DOM uses this style by default for all Elements.
+
+=item Style 1
+
+ <empty></empty> or <empty attr="val"></empty>
+
+=item Style 2
+
+ <empty /> or <empty attr="val" />
+
+This style is sometimes desired when using XHTML.
+(Note the extra space before the slash "/")
+See L<http://www.w3.org/TR/xhtml1> Appendix C for more details.
+
+=back
+
+By default XML::DOM compresses all empty Element tags (style 0.)
+You can control which style is used for a particular Element by calling
+XML::DOM::setTagCompression with a reference to a function that takes
+2 arguments. The first is the tag name of the Element, the second is the
+XML::DOM::Element that is being printed.
+The function should return 0, 1 or 2 to indicate which style should be used to
+print the empty tag. E.g.
+
+ XML::DOM::setTagCompression (\&my_tag_compression);
+
+ sub my_tag_compression
+ {
+ my ($tag, $elem) = @_;
+
+ # Print empty br, hr and img tags like this: <br />
+ return 2 if $tag =~ /^(br|hr|img)$/;
+
+ # Print other empty tags like this: <empty></empty>
+ return 1;
+ }
+
+=back
+
+=head1 IMPLEMENTATION DETAILS
+
+=over 4
+
+=item * Perl Mappings
+
+The value undef was used when the DOM Spec said null.
+
+The DOM Spec says: Applications must encode DOMString using UTF-16 (defined in
+Appendix C.3 of [UNICODE] and Amendment 1 of [ISO-10646]).
+In this implementation we use plain old Perl strings encoded in UTF-8 instead of
+UTF-16.
+
+=item * Text and CDATASection nodes
+
+The Expat parser expands EntityReferences and CDataSection sections to
+raw strings and does not indicate where it was found.
+This implementation does therefore convert both to Text nodes at parse time.
+CDATASection and EntityReference nodes that are added to an existing Document
+(by the user) will be preserved.
+
+Also, subsequent Text nodes are always merged at parse time. Text nodes that are
+added later can be merged with the normalize method. Consider using the addText
+method when adding Text nodes.
+
+=item * Printing and toString
+
+When printing (and converting an XML Document to a string) the strings have to
+encoded differently depending on where they occur. E.g. in a CDATASection all
+substrings are allowed except for "]]>". In regular text, certain characters are
+not allowed, e.g. ">" has to be converted to ">".
+These routines should be verified by someone who knows the details.
+
+=item * Quotes
+
+Certain sections in XML are quoted, like attribute values in an Element.
+XML::Parser strips these quotes and the print methods in this implementation
+always uses double quotes, so when parsing and printing a document, single quotes
+may be converted to double quotes. The default value of an attribute definition
+(AttDef) in an AttlistDecl, however, will maintain its quotes.
+
+=item * AttlistDecl
+
+Attribute declarations for a certain Element are always merged into a single
+AttlistDecl object.
+
+=item * Comments
+
+Comments in the DOCTYPE section are not kept in the right place. They will become
+child nodes of the Document.
+
+=item * Hidden Nodes
+
+Previous versions of XML::DOM would expand parameter entity references
+(like B<%pent;>), so when printing the DTD, it would print the contents
+of the external entity, instead of the parameter entity reference.
+With this release (1.27), you can prevent this by setting the XML::DOM::Parser
+options ParseParamEnt => 1 and ExpandParamEnt => 0.
+
+When it is parsing the contents of the external entities, it *DOES* still add
+the nodes to the DocumentType, but it marks these nodes by setting
+the 'Hidden' property. In addition, it adds an EntityReference node to the
+DocumentType node.
+
+When printing the DocumentType node (or when using to_expat() or to_sax()),
+the 'Hidden' nodes are suppressed, so you will see the parameter entity
+reference instead of the contents of the external entities. See test case
+t/dom_extent.t for an example.
+
+The reason for adding the 'Hidden' nodes to the DocumentType node, is that
+the nodes may contain <!ENTITY> definitions that are referenced further
+in the document. (Simply not adding the nodes to the DocumentType could
+cause such entity references to be expanded incorrectly.)
+
+Note that you need XML::Parser 2.27 or higher for this to work correctly.
+
+=back
+
+=head1 SEE ALSO
+
+The Japanese version of this document by Takanori Kawai (Hippo2000)
+at L<http://member.nifty.ne.jp/hippo2000/perltips/xml/dom.htm>
+
+The DOM Level 1 specification at L<http://www.w3.org/TR/REC-DOM-Level-1>
+
+The XML spec (Extensible Markup Language 1.0) at L<http://www.w3.org/TR/REC-xml>
+
+The L<XML::Parser> and L<XML::Parser::Expat> manual pages.
+
+=head1 CAVEATS
+
+The method getElementsByTagName() does not return a "live" NodeList.
+Whether this is an actual caveat is debatable, but a few people on the
+www-dom mailing list seemed to think so. I haven't decided yet. It's a pain
+to implement, it slows things down and the benefits seem marginal.
+Let me know what you think.
+
+(To subscribe to the www-dom mailing list send an email with the subject
+"subscribe" to www-dom-request@w3.org. I only look here occasionally, so don't
+send bug reports or suggestions about XML::DOM to this list, send them
+to enno@att.com instead.)
+
+=head1 AUTHOR
+
+Send bug reports, hints, tips, suggestions to Enno Derksen at
+<F<enno@att.com>>.
+
+Thanks to Clark Cooper for his help with the initial version.
+
+=cut