1################################################################################
2#
3# Perl module: XML::DOM
4#
5# By Enno Derksen <enno@att.com>
6#
7################################################################################
8#
9# To do:
10#
11# * optimize Attr if it only contains 1 Text node to hold the value
12# * fix setDocType!
13#
14# * BUG: setOwnerDocument - does not process default attr values correctly,
15#   they still point to the old doc.
16# * change Exception mechanism
17# * maybe: more checking of sysId etc.
18# * NoExpand mode (don't know what else is useful)
19# * various odds and ends: see comments starting with "??"
20# * normalize(1) could also expand CDataSections and EntityReferences
21# * parse a DocumentFragment?
22# * encoding support
23#
24######################################################################
25
26######################################################################
27package XML::DOM;
28######################################################################
29
30use strict;
31use vars qw( $VERSION @ISA @EXPORT
32	     $IgnoreReadOnly $SafeMode $TagStyle
33	     %DefaultEntities %DecodeDefaultEntity
34	   );
35use Carp;
36use XML::RegExp;
37
38BEGIN
39{
40    require XML::Parser;
41    $VERSION = '1.27';
42
43    my $needVersion = '2.23';
44    die "need at least XML::Parser version $needVersion (current=${XML::Parser::VERSION})"
45	unless $XML::Parser::VERSION >= $needVersion;
46
47    @ISA = qw( Exporter );
48
49    # Constants for XML::DOM Node types
50    @EXPORT = qw(
51	     UNKNOWN_NODE
52	     ELEMENT_NODE
53	     ATTRIBUTE_NODE
54	     TEXT_NODE
55	     CDATA_SECTION_NODE
56	     ENTITY_REFERENCE_NODE
57	     ENTITY_NODE
58	     PROCESSING_INSTRUCTION_NODE
59	     COMMENT_NODE
60	     DOCUMENT_NODE
61	     DOCUMENT_TYPE_NODE
62	     DOCUMENT_FRAGMENT_NODE
63	     NOTATION_NODE
64	     ELEMENT_DECL_NODE
65	     ATT_DEF_NODE
66	     XML_DECL_NODE
67	     ATTLIST_DECL_NODE
68	    );
69}
70
71#---- Constant definitions
72
73# Node types
74
75sub UNKNOWN_NODE                () { 0 }		# not in the DOM Spec
76
77sub ELEMENT_NODE                () { 1 }
78sub ATTRIBUTE_NODE              () { 2 }
79sub TEXT_NODE                   () { 3 }
80sub CDATA_SECTION_NODE          () { 4 }
81sub ENTITY_REFERENCE_NODE       () { 5 }
82sub ENTITY_NODE                 () { 6 }
83sub PROCESSING_INSTRUCTION_NODE () { 7 }
84sub COMMENT_NODE                () { 8 }
85sub DOCUMENT_NODE               () { 9 }
86sub DOCUMENT_TYPE_NODE          () { 10}
87sub DOCUMENT_FRAGMENT_NODE      () { 11}
88sub NOTATION_NODE               () { 12}
89
90sub ELEMENT_DECL_NODE		() { 13 }	# not in the DOM Spec
91sub ATT_DEF_NODE 		() { 14 }	# not in the DOM Spec
92sub XML_DECL_NODE 		() { 15 }	# not in the DOM Spec
93sub ATTLIST_DECL_NODE		() { 16 }	# not in the DOM Spec
94
95%DefaultEntities =
96(
97 "quot"		=> '"',
98 "gt"		=> ">",
99 "lt"		=> "<",
100 "apos"		=> "'",
101 "amp"		=> "&"
102);
103
104%DecodeDefaultEntity =
105(
106 '"' => "&quot;",
107 ">" => "&gt;",
108 "<" => "&lt;",
109 "'" => "&apos;",
110 "&" => "&amp;"
111);
112
113#
114# If you don't want DOM warnings to use 'warn', override this method like this:
115#
116# { # start block scope
117#	local *XML::DOM::warning = \&my_warn;
118#	... your code here ...
119# } # end block scope (old XML::DOM::warning takes effect again)
120#
121sub warning	# static
122{
123    warn @_;
124}
125
126#
127# This method defines several things in the caller's package, so you can use named constants to
128# access the array that holds the member data, i.e. $self->[_Data]. It assumes the caller's package
129# defines a class that is implemented as a blessed array reference.
130# Note that this is very similar to using 'use fields' and 'use base'.
131#
132# E.g. if $fields eq "Name Model", $parent eq "XML::DOM::Node" and
133# XML::DOM::Node had "A B C" as fields and it was called from package "XML::DOM::ElementDecl",
134# then this code would basically do the following:
135#
136# package XML::DOM::ElementDecl;
137#
138# sub _Name  () { 3 }	# Note that parent class had three fields
139# sub _Model () { 4 }
140#
141# # Maps constant names (without '_') to constant (int) value
142# %HFIELDS = ( %XML::DOM::Node::HFIELDS, Name => _Name, Model => _Model );
143#
144# # Define XML:DOM::ElementDecl as a subclass of XML::DOM::Node
145# @ISA = qw{ XML::DOM::Node };
146#
147# # The following function names can be exported into the user's namespace.
148# @EXPORT_OK = qw{ _Name _Model };
149#
150# # The following function names can be exported into the user's namespace
151# # with: import XML::DOM::ElementDecl qw( :Fields );
152# %EXPORT_TAGS = ( Fields => qw{ _Name _Model } );
153#
154sub def_fields	# static
155{
156    my ($fields, $parent) = @_;
157
158    my ($pkg) = caller;
159
160    no strict 'refs';
161
162    my @f = split (/\s+/, $fields);
163    my $n = 0;
164
165    my %hfields;
166    if (defined $parent)
167    {
168	my %pf = %{"$parent\::HFIELDS"};
169	%hfields = %pf;
170
171	$n = scalar (keys %pf);
172	@{"$pkg\::ISA"} = ( $parent );
173    }
174
175    my $i = $n;
176    for (@f)
177    {
178	eval "sub $pkg\::_$_ () { $i }";
179	$hfields{$_} = $i;
180	$i++;
181    }
182    %{"$pkg\::HFIELDS"} = %hfields;
183    @{"$pkg\::EXPORT_OK"} = map { "_$_" } @f;
184
185    ${"$pkg\::EXPORT_TAGS"}{Fields} = [ map { "_$_" } @f ];
186}
187
188# sub blesh
189# {
190#     my $hashref = shift;
191#     my $class = shift;
192#     no strict 'refs';
193#     my $self = bless [\%{"$class\::FIELDS"}], $class;
194#     if (defined $hashref)
195#     {
196# 	for (keys %$hashref)
197# 	{
198# 	    $self->{$_} = $hashref->{$_};
199# 	}
200#     }
201#     $self;
202# }
203
204# sub blesh2
205# {
206#     my $hashref = shift;
207#     my $class = shift;
208#     no strict 'refs';
209#     my $self = bless [\%{"$class\::FIELDS"}], $class;
210#     if (defined $hashref)
211#     {
212# 	for (keys %$hashref)
213# 	{
214# 	    eval { $self->{$_} = $hashref->{$_}; };
215# 	    croak "ERROR in field [$_] $@" if $@;
216# 	}
217#     }
218#     $self;
219#}
220
221#
222# CDATA section may not contain "]]>"
223#
224sub encodeCDATA
225{
226    my ($str) = shift;
227    $str =~ s/]]>/]]&gt;/go;
228    $str;
229}
230
231#
232# PI may not contain "?>"
233#
234sub encodeProcessingInstruction
235{
236    my ($str) = shift;
237    $str =~ s/\?>/?&gt;/go;
238    $str;
239}
240
241#
242#?? Not sure if this is right - must prevent double minus somehow...
243#
244sub encodeComment
245{
246    my ($str) = shift;
247    return undef unless defined $str;
248
249    $str =~ s/--/&#45;&#45;/go;
250    $str;
251}
252
253#
254# For debugging
255#
256sub toHex
257{
258    my $str = shift;
259    my $len = length($str);
260    my @a = unpack ("C$len", $str);
261    my $s = "";
262    for (@a)
263    {
264	$s .= sprintf ("%02x", $_);
265    }
266    $s;
267}
268
269#
270# 2nd parameter $default: list of Default Entity characters that need to be
271# converted (e.g. "&<" for conversion to "&amp;" and "&lt;" resp.)
272#
273sub encodeText
274{
275    my ($str, $default) = @_;
276    return undef unless defined $str;
277
278    $str =~ s/([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)|([$default])|(]]>)/
279	defined($1) ? XmlUtf8Decode ($1) :
280	defined ($2) ? $DecodeDefaultEntity{$2} : "]]&gt;" /egs;
281
282#?? could there be references that should not be expanded?
283# e.g. should not replace &#nn; &#xAF; and &abc;
284#    $str =~ s/&(?!($ReName|#[0-9]+|#x[0-9a-fA-F]+);)/&amp;/go;
285
286    $str;
287}
288
289#
290# Used by AttDef - default value
291#
292sub encodeAttrValue
293{
294    encodeText (shift, '"&<');
295}
296
297#
298# Converts an integer (Unicode - ISO/IEC 10646) to a UTF-8 encoded character
299# sequence.
300# Used when converting e.g. &#123; or &#x3ff; to a string value.
301#
302# Algorithm borrowed from expat/xmltok.c/XmlUtf8Encode()
303#
304# not checking for bad characters: < 0, x00-x08, x0B-x0C, x0E-x1F, xFFFE-xFFFF
305#
306sub XmlUtf8Encode
307{
308    my $n = shift;
309    if ($n < 0x80)
310    {
311	return chr ($n);
312    }
313    elsif ($n < 0x800)
314    {
315	return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80));
316    }
317    elsif ($n < 0x10000)
318    {
319	return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80),
320		     (($n & 0x3f) | 0x80));
321    }
322    elsif ($n < 0x110000)
323    {
324	return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80),
325		     ((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80));
326    }
327    croak "number is too large for Unicode [$n] in &XmlUtf8Encode";
328}
329
330#
331# Opposite of XmlUtf8Decode plus it adds prefix "&#" or "&#x" and suffix ";"
332# The 2nd parameter ($hex) indicates whether the result is hex encoded or not.
333#
334sub XmlUtf8Decode
335{
336    my ($str, $hex) = @_;
337    my $len = length ($str);
338    my $n;
339
340    if ($len == 2)
341    {
342	my @n = unpack "C2", $str;
343	$n = (($n[0] & 0x3f) << 6) + ($n[1] & 0x3f);
344    }
345    elsif ($len == 3)
346    {
347	my @n = unpack "C3", $str;
348	$n = (($n[0] & 0x1f) << 12) + (($n[1] & 0x3f) << 6) +
349		($n[2] & 0x3f);
350    }
351    elsif ($len == 4)
352    {
353	my @n = unpack "C4", $str;
354	$n = (($n[0] & 0x0f) << 18) + (($n[1] & 0x3f) << 12) +
355		(($n[2] & 0x3f) << 6) + ($n[3] & 0x3f);
356    }
357    elsif ($len == 1)	# just to be complete...
358    {
359	$n = ord ($str);
360    }
361    else
362    {
363	croak "bad value [$str] for XmlUtf8Decode";
364    }
365    $hex ? sprintf ("&#x%x;", $n) : "&#$n;";
366}
367
368$IgnoreReadOnly = 0;
369$SafeMode = 1;
370
371sub getIgnoreReadOnly
372{
373    $IgnoreReadOnly;
374}
375
376#
377# The global flag $IgnoreReadOnly is set to the specified value and the old
378# value of $IgnoreReadOnly is returned.
379#
380# To temporarily disable read-only related exceptions (i.e. when parsing
381# XML or temporarily), do the following:
382#
383# my $oldIgnore = XML::DOM::ignoreReadOnly (1);
384# ... do whatever you want ...
385# XML::DOM::ignoreReadOnly ($oldIgnore);
386#
387sub ignoreReadOnly
388{
389    my $i = $IgnoreReadOnly;
390    $IgnoreReadOnly = $_[0];
391    return $i;
392}
393
394#
395# XML spec seems to break its own rules... (see ENTITY xmlpio)
396#
397sub forgiving_isValidName
398{
399    $_[0] =~ /^$XML::RegExp::Name$/o;
400}
401
402#
403# Don't allow names starting with xml (either case)
404#
405sub picky_isValidName
406{
407    $_[0] =~ /^$XML::RegExp::Name$/o and $_[0] !~ /^xml/i;
408}
409
410# Be forgiving by default,
411*isValidName = \&forgiving_isValidName;
412
413sub allowReservedNames		# static
414{
415    *isValidName = ($_[0] ? \&forgiving_isValidName : \&picky_isValidName);
416}
417
418sub getAllowReservedNames	# static
419{
420    *isValidName == \&forgiving_isValidName;
421}
422
423#
424# Always compress empty tags by default
425# This is used by Element::print.
426#
427$TagStyle = sub { 0 };
428
429sub setTagCompression
430{
431    $TagStyle = shift;
432}
433
434######################################################################
435package XML::DOM::PrintToFileHandle;
436######################################################################
437
438#
439# Used by XML::DOM::Node::printToFileHandle
440#
441
442sub new
443{
444    my($class, $fn) = @_;
445    bless $fn, $class;
446}
447
448sub print
449{
450    my ($self, $str) = @_;
451    print $self $str;
452}
453
454######################################################################
455package XML::DOM::PrintToString;
456######################################################################
457
458use vars qw{ $Singleton };
459
460#
461# Used by XML::DOM::Node::toString to concatenate strings
462#
463
464sub new
465{
466    my($class) = @_;
467    my $str = "";
468    bless \$str, $class;
469}
470
471sub print
472{
473    my ($self, $str) = @_;
474    $$self .= $str;
475}
476
477sub toString
478{
479    my $self = shift;
480    $$self;
481}
482
483sub reset
484{
485    ${$_[0]} = "";
486}
487
488$Singleton = new XML::DOM::PrintToString;
489
490######################################################################
491package XML::DOM::DOMImplementation;
492######################################################################
493
494$XML::DOM::DOMImplementation::Singleton =
495  bless \$XML::DOM::DOMImplementation::Singleton, 'XML::DOM::DOMImplementation';
496
497sub hasFeature
498{
499    my ($self, $feature, $version) = @_;
500
501    $feature eq 'XML' and $version eq '1.0';
502}
503
504
505######################################################################
506package XML::XQL::Node;		# forward declaration
507######################################################################
508
509######################################################################
510package XML::DOM::Node;
511######################################################################
512
513use vars qw( @NodeNames @EXPORT @ISA %HFIELDS @EXPORT_OK @EXPORT_TAGS );
514
515BEGIN
516{
517  use XML::DOM::DOMException;
518  import Carp;
519
520  require FileHandle;
521
522  @ISA = qw( Exporter XML::XQL::Node );
523
524  # NOTE: SortKey is used in XML::XQL::Node.
525  #       UserData is reserved for users (Hang your data here!)
526  XML::DOM::def_fields ("C A Doc Parent ReadOnly UsedIn Hidden SortKey UserData");
527
528  push (@EXPORT, qw(
529		    UNKNOWN_NODE
530		    ELEMENT_NODE
531		    ATTRIBUTE_NODE
532		    TEXT_NODE
533		    CDATA_SECTION_NODE
534		    ENTITY_REFERENCE_NODE
535		    ENTITY_NODE
536		    PROCESSING_INSTRUCTION_NODE
537		    COMMENT_NODE
538		    DOCUMENT_NODE
539		    DOCUMENT_TYPE_NODE
540		    DOCUMENT_FRAGMENT_NODE
541		    NOTATION_NODE
542		    ELEMENT_DECL_NODE
543		    ATT_DEF_NODE
544		    XML_DECL_NODE
545		    ATTLIST_DECL_NODE
546		   ));
547}
548
549#---- Constant definitions
550
551# Node types
552
553sub UNKNOWN_NODE                () {0;}		# not in the DOM Spec
554
555sub ELEMENT_NODE                () {1;}
556sub ATTRIBUTE_NODE              () {2;}
557sub TEXT_NODE                   () {3;}
558sub CDATA_SECTION_NODE          () {4;}
559sub ENTITY_REFERENCE_NODE       () {5;}
560sub ENTITY_NODE                 () {6;}
561sub PROCESSING_INSTRUCTION_NODE () {7;}
562sub COMMENT_NODE                () {8;}
563sub DOCUMENT_NODE               () {9;}
564sub DOCUMENT_TYPE_NODE          () {10;}
565sub DOCUMENT_FRAGMENT_NODE      () {11;}
566sub NOTATION_NODE               () {12;}
567
568sub ELEMENT_DECL_NODE		() {13;}	# not in the DOM Spec
569sub ATT_DEF_NODE 		() {14;}	# not in the DOM Spec
570sub XML_DECL_NODE 		() {15;}	# not in the DOM Spec
571sub ATTLIST_DECL_NODE		() {16;}	# not in the DOM Spec
572
573@NodeNames = (
574	      "UNKNOWN_NODE",	# not in the DOM Spec!
575
576	      "ELEMENT_NODE",
577	      "ATTRIBUTE_NODE",
578	      "TEXT_NODE",
579	      "CDATA_SECTION_NODE",
580	      "ENTITY_REFERENCE_NODE",
581	      "ENTITY_NODE",
582	      "PROCESSING_INSTRUCTION_NODE",
583	      "COMMENT_NODE",
584	      "DOCUMENT_NODE",
585	      "DOCUMENT_TYPE_NODE",
586	      "DOCUMENT_FRAGMENT_NODE",
587	      "NOTATION_NODE",
588
589	      "ELEMENT_DECL_NODE",
590	      "ATT_DEF_NODE",
591	      "XML_DECL_NODE",
592	      "ATTLIST_DECL_NODE"
593	     );
594
595sub decoupleUsedIn
596{
597    my $self = shift;
598    undef $self->[_UsedIn]; # was delete
599}
600
601sub getParentNode
602{
603    $_[0]->[_Parent];
604}
605
606sub appendChild
607{
608    my ($self, $node) = @_;
609
610    # REC 7473
611    if ($XML::DOM::SafeMode)
612    {
613	croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
614					  "node is ReadOnly")
615	    if $self->isReadOnly;
616    }
617
618    my $doc = $self->[_Doc];
619
620    if ($node->isDocumentFragmentNode)
621    {
622	if ($XML::DOM::SafeMode)
623	{
624	    for my $n (@{$node->[_C]})
625	    {
626		croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
627						  "nodes belong to different documents")
628		    if $doc != $n->[_Doc];
629
630		croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
631						  "node is ancestor of parent node")
632		    if $n->isAncestor ($self);
633
634		croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
635						  "bad node type")
636		    if $self->rejectChild ($n);
637	    }
638	}
639
640	my @list = @{$node->[_C]};	# don't try to compress this
641	for my $n (@list)
642	{
643	    $n->setParentNode ($self);
644	}
645	push @{$self->[_C]}, @list;
646    }
647    else
648    {
649	if ($XML::DOM::SafeMode)
650	{
651	    croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
652						  "nodes belong to different documents")
653		if $doc != $node->[_Doc];
654
655	    croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
656						  "node is ancestor of parent node")
657		if $node->isAncestor ($self);
658
659	    croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
660						  "bad node type")
661		if $self->rejectChild ($node);
662	}
663	$node->setParentNode ($self);
664	push @{$self->[_C]}, $node;
665    }
666    $node;
667}
668
669sub getChildNodes
670{
671    # NOTE: if node can't have children, $self->[_C] is undef.
672    my $kids = $_[0]->[_C];
673
674    # Return a list if called in list context.
675    wantarray ? (defined ($kids) ? @{ $kids } : ()) :
676	        (defined ($kids) ? $kids : $XML::DOM::NodeList::EMPTY);
677}
678
679sub hasChildNodes
680{
681    my $kids = $_[0]->[_C];
682    defined ($kids) && @$kids > 0;
683}
684
685# This method is overriden in Document
686sub getOwnerDocument
687{
688    $_[0]->[_Doc];
689}
690
691sub getFirstChild
692{
693    my $kids = $_[0]->[_C];
694    defined $kids ? $kids->[0] : undef;
695}
696
697sub getLastChild
698{
699    my $kids = $_[0]->[_C];
700    defined $kids ? $kids->[-1] : undef;
701}
702
703sub getPreviousSibling
704{
705    my $self = shift;
706
707    my $pa = $self->[_Parent];
708    return undef unless $pa;
709    my $index = $pa->getChildIndex ($self);
710    return undef unless $index;
711
712    $pa->getChildAtIndex ($index - 1);
713}
714
715sub getNextSibling
716{
717    my $self = shift;
718
719    my $pa = $self->[_Parent];
720    return undef unless $pa;
721
722    $pa->getChildAtIndex ($pa->getChildIndex ($self) + 1);
723}
724
725sub insertBefore
726{
727    my ($self, $node, $refNode) = @_;
728
729    return $self->appendChild ($node) unless $refNode;	# append at the end
730
731    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
732				      "node is ReadOnly")
733	if $self->isReadOnly;
734
735    my @nodes = ($node);
736    @nodes = @{$node->[_C]}
737	if $node->getNodeType == DOCUMENT_FRAGMENT_NODE;
738
739    my $doc = $self->[_Doc];
740
741    for my $n (@nodes)
742    {
743	croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
744					  "nodes belong to different documents")
745	    if $doc != $n->[_Doc];
746
747	croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
748					  "node is ancestor of parent node")
749	    if $n->isAncestor ($self);
750
751	croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
752					  "bad node type")
753	    if $self->rejectChild ($n);
754    }
755    my $index = $self->getChildIndex ($refNode);
756
757    croak new XML::DOM::DOMException (NOT_FOUND_ERR,
758				      "reference node not found")
759	if $index == -1;
760
761    for my $n (@nodes)
762    {
763	$n->setParentNode ($self);
764    }
765
766    splice (@{$self->[_C]}, $index, 0, @nodes);
767    $node;
768}
769
770sub replaceChild
771{
772    my ($self, $node, $refNode) = @_;
773
774    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
775				      "node is ReadOnly")
776	if $self->isReadOnly;
777
778    my @nodes = ($node);
779    @nodes = @{$node->[_C]}
780	if $node->getNodeType == DOCUMENT_FRAGMENT_NODE;
781
782    for my $n (@nodes)
783    {
784	croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
785					  "nodes belong to different documents")
786	    if $self->[_Doc] != $n->[_Doc];
787
788	croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
789					  "node is ancestor of parent node")
790	    if $n->isAncestor ($self);
791
792	croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
793					  "bad node type")
794	    if $self->rejectChild ($n);
795    }
796
797    my $index = $self->getChildIndex ($refNode);
798    croak new XML::DOM::DOMException (NOT_FOUND_ERR,
799				      "reference node not found")
800	if $index == -1;
801
802    for my $n (@nodes)
803    {
804	$n->setParentNode ($self);
805    }
806    splice (@{$self->[_C]}, $index, 1, @nodes);
807
808    $refNode->removeChildHoodMemories;
809    $refNode;
810}
811
812sub removeChild
813{
814    my ($self, $node) = @_;
815
816    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
817				      "node is ReadOnly")
818	if $self->isReadOnly;
819
820    my $index = $self->getChildIndex ($node);
821
822    croak new XML::DOM::DOMException (NOT_FOUND_ERR,
823				      "reference node not found")
824	if $index == -1;
825
826    splice (@{$self->[_C]}, $index, 1, ());
827
828    $node->removeChildHoodMemories;
829    $node;
830}
831
832# Merge all subsequent Text nodes in this subtree
833sub normalize
834{
835    my ($self) = shift;
836    my $prev = undef;	# previous Text node
837
838    return unless defined $self->[_C];
839
840    my @nodes = @{$self->[_C]};
841    my $i = 0;
842    my $n = @nodes;
843    while ($i < $n)
844    {
845	my $node = $self->getChildAtIndex($i);
846	my $type = $node->getNodeType;
847
848	if (defined $prev)
849	{
850	    # It should not merge CDATASections. Dom Spec says:
851	    #  Adjacent CDATASections nodes are not merged by use
852	    #  of the Element.normalize() method.
853	    if ($type == TEXT_NODE)
854	    {
855		$prev->appendData ($node->getData);
856		$self->removeChild ($node);
857		$i--;
858		$n--;
859	    }
860	    else
861	    {
862		$prev = undef;
863		if ($type == ELEMENT_NODE)
864		{
865		    $node->normalize;
866		    if (defined $node->[_A])
867		    {
868			for my $attr (@{$node->[_A]->getValues})
869			{
870			    $attr->normalize;
871			}
872		    }
873		}
874	    }
875	}
876	else
877	{
878	    if ($type == TEXT_NODE)
879	    {
880		$prev = $node;
881	    }
882	    elsif ($type == ELEMENT_NODE)
883	    {
884		$node->normalize;
885		if (defined $node->[_A])
886		{
887		    for my $attr (@{$node->[_A]->getValues})
888		    {
889			$attr->normalize;
890		    }
891		}
892	    }
893	}
894	$i++;
895    }
896}
897
898#
899# Return all Element nodes in the subtree that have the specified tagName.
900# If tagName is "*", all Element nodes are returned.
901# NOTE: the DOM Spec does not specify a 3rd or 4th parameter
902#
903sub getElementsByTagName
904{
905    my ($self, $tagName, $recurse, $list) = @_;
906    $recurse = 1 unless defined $recurse;
907    $list = (wantarray ? [] : new XML::DOM::NodeList) unless defined $list;
908
909    return unless defined $self->[_C];
910
911    # preorder traversal: check parent node first
912    for my $kid (@{$self->[_C]})
913    {
914	if ($kid->isElementNode)
915	{
916	    if ($tagName eq "*" || $tagName eq $kid->getTagName)
917	    {
918		push @{$list}, $kid;
919	    }
920	    $kid->getElementsByTagName ($tagName, $recurse, $list) if $recurse;
921	}
922    }
923    wantarray ? @{ $list } : $list;
924}
925
926sub getNodeValue
927{
928    undef;
929}
930
931sub setNodeValue
932{
933    # no-op
934}
935
936#
937# Redefined by XML::DOM::Element
938#
939sub getAttributes
940{
941    undef;
942}
943
944#------------------------------------------------------------
945# Extra method implementations
946
947sub setOwnerDocument
948{
949    my ($self, $doc) = @_;
950    $self->[_Doc] = $doc;
951
952    return unless defined $self->[_C];
953
954    for my $kid (@{$self->[_C]})
955    {
956	$kid->setOwnerDocument ($doc);
957    }
958}
959
960sub cloneChildren
961{
962    my ($self, $node, $deep) = @_;
963    return unless $deep;
964
965    return unless defined $self->[_C];
966
967    local $XML::DOM::IgnoreReadOnly = 1;
968
969    for my $kid (@{$node->[_C]})
970    {
971	my $newNode = $kid->cloneNode ($deep);
972	push @{$self->[_C]}, $newNode;
973	$newNode->setParentNode ($self);
974    }
975}
976
977#
978# For internal use only!
979#
980sub removeChildHoodMemories
981{
982    my ($self) = @_;
983
984    undef $self->[_Parent]; # was delete
985}
986
987#
988# Remove circular dependencies. The Node and its children should
989# not be used afterwards.
990#
991sub dispose
992{
993    my $self = shift;
994
995    $self->removeChildHoodMemories;
996
997    if (defined $self->[_C])
998    {
999	$self->[_C]->dispose;
1000	undef $self->[_C]; # was delete
1001    }
1002    undef $self->[_Doc]; # was delete
1003}
1004
1005#
1006# For internal use only!
1007#
1008sub setParentNode
1009{
1010    my ($self, $parent) = @_;
1011
1012    # REC 7473
1013    my $oldParent = $self->[_Parent];
1014    if (defined $oldParent)
1015    {
1016	# remove from current parent
1017	my $index = $oldParent->getChildIndex ($self);
1018
1019	# NOTE: we don't have to check if [_C] is defined,
1020	# because were removing a child here!
1021	splice (@{$oldParent->[_C]}, $index, 1, ());
1022
1023	$self->removeChildHoodMemories;
1024    }
1025    $self->[_Parent] = $parent;
1026}
1027
1028#
1029# This function can return 3 values:
1030# 1: always readOnly
1031# 0: never readOnly
1032# undef: depends on parent node
1033#
1034# Returns 1 for DocumentType, Notation, Entity, EntityReference, Attlist,
1035# ElementDecl, AttDef.
1036# The first 4 are readOnly according to the DOM Spec, the others are always
1037# children of DocumentType. (Naturally, children of a readOnly node have to be
1038# readOnly as well...)
1039# These nodes are always readOnly regardless of who their ancestors are.
1040# Other nodes, e.g. Comment, are readOnly only if their parent is readOnly,
1041# which basically means that one of its ancestors has to be one of the
1042# aforementioned node types.
1043# Document and DocumentFragment return 0 for obvious reasons.
1044# Attr, Element, CDATASection, Text return 0. The DOM spec says that they can
1045# be children of an Entity, but I don't think that that's possible
1046# with the current XML::Parser.
1047# Attr uses a {ReadOnly} property, which is only set if it's part of a AttDef.
1048# Always returns 0 if ignoreReadOnly is set.
1049#
1050sub isReadOnly
1051{
1052    # default implementation for Nodes that are always readOnly
1053    ! $XML::DOM::IgnoreReadOnly;
1054}
1055
1056sub rejectChild
1057{
1058    1;
1059}
1060
1061sub getNodeTypeName
1062{
1063    $NodeNames[$_[0]->getNodeType];
1064}
1065
1066sub getChildIndex
1067{
1068    my ($self, $node) = @_;
1069    my $i = 0;
1070
1071    return -1 unless defined $self->[_C];
1072
1073    for my $kid (@{$self->[_C]})
1074    {
1075	return $i if $kid == $node;
1076	$i++;
1077    }
1078    -1;
1079}
1080
1081sub getChildAtIndex
1082{
1083    my $kids = $_[0]->[_C];
1084    defined ($kids) ? $kids->[$_[1]] : undef;
1085}
1086
1087sub isAncestor
1088{
1089    my ($self, $node) = @_;
1090
1091    do
1092    {
1093	return 1 if $self == $node;
1094	$node = $node->[_Parent];
1095    }
1096    while (defined $node);
1097
1098    0;
1099}
1100
1101#
1102# Added for optimization. Overriden in XML::DOM::Text
1103#
1104sub isTextNode
1105{
1106    0;
1107}
1108
1109#
1110# Added for optimization. Overriden in XML::DOM::DocumentFragment
1111#
1112sub isDocumentFragmentNode
1113{
1114    0;
1115}
1116
1117#
1118# Added for optimization. Overriden in XML::DOM::Element
1119#
1120sub isElementNode
1121{
1122    0;
1123}
1124
1125#
1126# Add a Text node with the specified value or append the text to the
1127# previous Node if it is a Text node.
1128#
1129sub addText
1130{
1131    # REC 9456 (if it was called)
1132    my ($self, $str) = @_;
1133
1134    my $node = ${$self->[_C]}[-1];	# $self->getLastChild
1135
1136    if (defined ($node) && $node->isTextNode)
1137    {
1138	# REC 5475 (if it was called)
1139	$node->appendData ($str);
1140    }
1141    else
1142    {
1143	$node = $self->[_Doc]->createTextNode ($str);
1144	$self->appendChild ($node);
1145    }
1146    $node;
1147}
1148
1149#
1150# Add a CDATASection node with the specified value or append the text to the
1151# previous Node if it is a CDATASection node.
1152#
1153sub addCDATA
1154{
1155    my ($self, $str) = @_;
1156
1157    my $node = ${$self->[_C]}[-1];	# $self->getLastChild
1158
1159    if (defined ($node) && $node->getNodeType == CDATA_SECTION_NODE)
1160    {
1161	$node->appendData ($str);
1162    }
1163    else
1164    {
1165	$node = $self->[_Doc]->createCDATASection ($str);
1166	$self->appendChild ($node);
1167    }
1168    $node;
1169}
1170
1171sub removeChildNodes
1172{
1173    my $self = shift;
1174
1175    my $cref = $self->[_C];
1176    return unless defined $cref;
1177
1178    my $kid;
1179    while ($kid = pop @{$cref})
1180    {
1181	undef $kid->[_Parent]; # was delete
1182    }
1183}
1184
1185sub toString
1186{
1187    my $self = shift;
1188    my $pr = $XML::DOM::PrintToString::Singleton;
1189    $pr->reset;
1190    $self->print ($pr);
1191    $pr->toString;
1192}
1193
1194sub to_sax
1195{
1196    my $self = shift;
1197    unshift @_, 'Handler' if (@_ == 1);
1198    my %h = @_;
1199
1200    my $doch = exists ($h{DocumentHandler}) ? $h{DocumentHandler}
1201					    : $h{Handler};
1202    my $dtdh = exists ($h{DTDHandler}) ? $h{DTDHandler}
1203				       : $h{Handler};
1204    my $enth = exists ($h{EntityResolver}) ? $h{EntityResolver}
1205					   : $h{Handler};
1206
1207    $self->_to_sax ($doch, $dtdh, $enth);
1208}
1209
1210sub printToFile
1211{
1212    my ($self, $fileName) = @_;
1213    my $fh = new FileHandle ($fileName, "w") ||
1214	croak "printToFile - can't open output file $fileName";
1215
1216    $self->print ($fh);
1217    $fh->close;
1218}
1219
1220#
1221# Use print to print to a FileHandle object (see printToFile code)
1222#
1223sub printToFileHandle
1224{
1225    my ($self, $FH) = @_;
1226    my $pr = new XML::DOM::PrintToFileHandle ($FH);
1227    $self->print ($pr);
1228}
1229
1230#
1231# Used by AttDef::setDefault to convert unexpanded default attribute value
1232#
1233sub expandEntityRefs
1234{
1235    my ($self, $str) = @_;
1236    my $doctype = $self->[_Doc]->getDoctype;
1237
1238    $str =~ s/&($XML::RegExp::Name|(#([0-9]+)|#x([0-9a-fA-F]+)));/
1239	defined($2) ? XML::DOM::XmlUtf8Encode ($3 || hex ($4))
1240		    : expandEntityRef ($1, $doctype)/ego;
1241    $str;
1242}
1243
1244sub expandEntityRef
1245{
1246    my ($entity, $doctype) = @_;
1247
1248    my $expanded = $XML::DOM::DefaultEntities{$entity};
1249    return $expanded if defined $expanded;
1250
1251    $expanded = $doctype->getEntity ($entity);
1252    return $expanded->getValue if (defined $expanded);
1253
1254#?? is this an error?
1255    croak "Could not expand entity reference of [$entity]\n";
1256#    return "&$entity;";	# entity not found
1257}
1258
1259sub isHidden
1260{
1261    $_[0]->[_Hidden];
1262}
1263
1264######################################################################
1265package XML::DOM::Attr;
1266######################################################################
1267
1268use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
1269
1270BEGIN
1271{
1272    import XML::DOM::Node qw( :DEFAULT :Fields );
1273    XML::DOM::def_fields ("Name Specified", "XML::DOM::Node");
1274}
1275
1276use XML::DOM::DOMException;
1277use Carp;
1278
1279sub new
1280{
1281    my ($class, $doc, $name, $value, $specified) = @_;
1282
1283    if ($XML::DOM::SafeMode)
1284    {
1285	croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
1286					  "bad Attr name [$name]")
1287	    unless XML::DOM::isValidName ($name);
1288    }
1289
1290    my $self = bless [], $class;
1291
1292    $self->[_Doc] = $doc;
1293    $self->[_C] = new XML::DOM::NodeList;
1294    $self->[_Name] = $name;
1295
1296    if (defined $value)
1297    {
1298	$self->setValue ($value);
1299	$self->[_Specified] = (defined $specified) ? $specified : 1;
1300    }
1301    else
1302    {
1303	$self->[_Specified] = 0;
1304    }
1305    $self;
1306}
1307
1308sub getNodeType
1309{
1310    ATTRIBUTE_NODE;
1311}
1312
1313sub isSpecified
1314{
1315    $_[0]->[_Specified];
1316}
1317
1318sub getName
1319{
1320    $_[0]->[_Name];
1321}
1322
1323sub getValue
1324{
1325    my $self = shift;
1326    my $value = "";
1327
1328    for my $kid (@{$self->[_C]})
1329    {
1330	$value .= $kid->getData;
1331    }
1332    $value;
1333}
1334
1335sub setValue
1336{
1337    my ($self, $value) = @_;
1338
1339    # REC 1147
1340    $self->removeChildNodes;
1341    $self->appendChild ($self->[_Doc]->createTextNode ($value));
1342    $self->[_Specified] = 1;
1343}
1344
1345sub getNodeName
1346{
1347    $_[0]->getName;
1348}
1349
1350sub getNodeValue
1351{
1352    $_[0]->getValue;
1353}
1354
1355sub setNodeValue
1356{
1357    $_[0]->setValue ($_[1]);
1358}
1359
1360sub cloneNode
1361{
1362    my ($self) = @_;	# parameter deep is ignored
1363
1364    my $node = $self->[_Doc]->createAttribute ($self->getName);
1365    $node->[_Specified] = $self->[_Specified];
1366    $node->[_ReadOnly] = 1 if $self->[_ReadOnly];
1367
1368    $node->cloneChildren ($self, 1);
1369    $node;
1370}
1371
1372#------------------------------------------------------------
1373# Extra method implementations
1374#
1375
1376sub isReadOnly
1377{
1378    # ReadOnly property is set if it's part of a AttDef
1379    ! $XML::DOM::IgnoreReadOnly && defined ($_[0]->[_ReadOnly]);
1380}
1381
1382sub print
1383{
1384    my ($self, $FILE) = @_;
1385
1386    my $name = $self->[_Name];
1387
1388    $FILE->print ("$name=\"");
1389    for my $kid (@{$self->[_C]})
1390    {
1391	if ($kid->getNodeType == TEXT_NODE)
1392	{
1393	    $FILE->print (XML::DOM::encodeAttrValue ($kid->getData));
1394	}
1395	else	# ENTITY_REFERENCE_NODE
1396	{
1397	    $kid->print ($FILE);
1398	}
1399    }
1400    $FILE->print ("\"");
1401}
1402
1403sub rejectChild
1404{
1405    my $t = $_[1]->getNodeType;
1406
1407    $t != TEXT_NODE
1408    && $t != ENTITY_REFERENCE_NODE;
1409}
1410
1411######################################################################
1412package XML::DOM::ProcessingInstruction;
1413######################################################################
1414
1415use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
1416BEGIN
1417{
1418    import XML::DOM::Node qw( :DEFAULT :Fields );
1419    XML::DOM::def_fields ("Target Data", "XML::DOM::Node");
1420}
1421
1422use XML::DOM::DOMException;
1423use Carp;
1424
1425sub new
1426{
1427    my ($class, $doc, $target, $data, $hidden) = @_;
1428
1429    croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
1430			      "bad ProcessingInstruction Target [$target]")
1431	unless (XML::DOM::isValidName ($target) && $target !~ /^xml$/io);
1432
1433    my $self = bless [], $class;
1434
1435    $self->[_Doc] = $doc;
1436    $self->[_Target] = $target;
1437    $self->[_Data] = $data;
1438    $self->[_Hidden] = $hidden;
1439    $self;
1440}
1441
1442sub getNodeType
1443{
1444    PROCESSING_INSTRUCTION_NODE;
1445}
1446
1447sub getTarget
1448{
1449    $_[0]->[_Target];
1450}
1451
1452sub getData
1453{
1454    $_[0]->[_Data];
1455}
1456
1457sub setData
1458{
1459    my ($self, $data) = @_;
1460
1461    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
1462				      "node is ReadOnly")
1463	if $self->isReadOnly;
1464
1465    $self->[_Data] = $data;
1466}
1467
1468sub getNodeName
1469{
1470    $_[0]->[_Target];
1471}
1472
1473#
1474# Same as getData
1475#
1476sub getNodeValue
1477{
1478    $_[0]->[_Data];
1479}
1480
1481sub setNodeValue
1482{
1483    $_[0]->setData ($_[1]);
1484}
1485
1486sub cloneNode
1487{
1488    my $self = shift;
1489    $self->[_Doc]->createProcessingInstruction ($self->getTarget,
1490						$self->getData,
1491						$self->isHidden);
1492}
1493
1494#------------------------------------------------------------
1495# Extra method implementations
1496
1497sub isReadOnly
1498{
1499    return 0 if $XML::DOM::IgnoreReadOnly;
1500
1501    my $pa = $_[0]->[_Parent];
1502    defined ($pa) ? $pa->isReadOnly : 0;
1503}
1504
1505sub print
1506{
1507    my ($self, $FILE) = @_;
1508
1509    $FILE->print ("<?");
1510    $FILE->print ($self->[_Target]);
1511    $FILE->print (" ");
1512    $FILE->print (XML::DOM::encodeProcessingInstruction ($self->[_Data]));
1513    $FILE->print ("?>");
1514}
1515
1516######################################################################
1517package XML::DOM::Notation;
1518######################################################################
1519use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
1520
1521BEGIN
1522{
1523    import XML::DOM::Node qw( :DEFAULT :Fields );
1524    XML::DOM::def_fields ("Name Base SysId PubId", "XML::DOM::Node");
1525}
1526
1527use XML::DOM::DOMException;
1528use Carp;
1529
1530sub new
1531{
1532    my ($class, $doc, $name, $base, $sysId, $pubId, $hidden) = @_;
1533
1534    croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
1535				      "bad Notation Name [$name]")
1536	unless XML::DOM::isValidName ($name);
1537
1538    my $self = bless [], $class;
1539
1540    $self->[_Doc] = $doc;
1541    $self->[_Name] = $name;
1542    $self->[_Base] = $base;
1543    $self->[_SysId] = $sysId;
1544    $self->[_PubId] = $pubId;
1545    $self->[_Hidden] = $hidden;
1546    $self;
1547}
1548
1549sub getNodeType
1550{
1551    NOTATION_NODE;
1552}
1553
1554sub getPubId
1555{
1556    $_[0]->[_PubId];
1557}
1558
1559sub setPubId
1560{
1561    $_[0]->[_PubId] = $_[1];
1562}
1563
1564sub getSysId
1565{
1566    $_[0]->[_SysId];
1567}
1568
1569sub setSysId
1570{
1571    $_[0]->[_SysId] = $_[1];
1572}
1573
1574sub getName
1575{
1576    $_[0]->[_Name];
1577}
1578
1579sub setName
1580{
1581    $_[0]->[_Name] = $_[1];
1582}
1583
1584sub getBase
1585{
1586    $_[0]->[_Base];
1587}
1588
1589sub getNodeName
1590{
1591    $_[0]->[_Name];
1592}
1593
1594sub print
1595{
1596    my ($self, $FILE) = @_;
1597
1598    my $name = $self->[_Name];
1599    my $sysId = $self->[_SysId];
1600    my $pubId = $self->[_PubId];
1601
1602    $FILE->print ("<!NOTATION $name ");
1603
1604    if (defined $pubId)
1605    {
1606	$FILE->print (" PUBLIC \"$pubId\"");
1607    }
1608    if (defined $sysId)
1609    {
1610	$FILE->print (" SYSTEM \"$sysId\"");
1611    }
1612    $FILE->print (">");
1613}
1614
1615sub cloneNode
1616{
1617    my ($self) = @_;
1618    $self->[_Doc]->createNotation ($self->[_Name], $self->[_Base],
1619				   $self->[_SysId], $self->[_PubId],
1620				   $self->[_Hidden]);
1621}
1622
1623sub to_expat
1624{
1625    my ($self, $iter) = @_;
1626    $iter->Notation ($self->getName, $self->getBase,
1627		     $self->getSysId, $self->getPubId);
1628}
1629
1630sub _to_sax
1631{
1632    my ($self, $doch, $dtdh, $enth) = @_;
1633    $dtdh->notation_decl ( { Name => $self->getName,
1634			     Base => $self->getBase,
1635			     SystemId => $self->getSysId,
1636			     PublicId => $self->getPubId });
1637}
1638
1639######################################################################
1640package XML::DOM::Entity;
1641######################################################################
1642use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
1643
1644BEGIN
1645{
1646    import XML::DOM::Node qw( :DEFAULT :Fields );
1647    XML::DOM::def_fields ("NotationName Parameter Value Ndata SysId PubId", "XML::DOM::Node");
1648}
1649
1650use XML::DOM::DOMException;
1651use Carp;
1652
1653sub new
1654{
1655    my ($class, $doc, $par, $notationName, $value, $sysId, $pubId, $ndata, $hidden) = @_;
1656
1657    croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
1658				      "bad Entity Name [$notationName]")
1659	unless XML::DOM::isValidName ($notationName);
1660
1661    my $self = bless [], $class;
1662
1663    $self->[_Doc] = $doc;
1664    $self->[_NotationName] = $notationName;
1665    $self->[_Parameter] = $par;
1666    $self->[_Value] = $value;
1667    $self->[_Ndata] = $ndata;
1668    $self->[_SysId] = $sysId;
1669    $self->[_PubId] = $pubId;
1670    $self->[_Hidden] = $hidden;
1671    $self;
1672#?? maybe Value should be a Text node
1673}
1674
1675sub getNodeType
1676{
1677    ENTITY_NODE;
1678}
1679
1680sub getPubId
1681{
1682    $_[0]->[_PubId];
1683}
1684
1685sub getSysId
1686{
1687    $_[0]->[_SysId];
1688}
1689
1690# Dom Spec says:
1691#  For unparsed entities, the name of the notation for the
1692#  entity. For parsed entities, this is null.
1693
1694#?? do we have unparsed entities?
1695sub getNotationName
1696{
1697    $_[0]->[_NotationName];
1698}
1699
1700sub getNodeName
1701{
1702    $_[0]->[_NotationName];
1703}
1704
1705sub cloneNode
1706{
1707    my $self = shift;
1708    $self->[_Doc]->createEntity ($self->[_Parameter],
1709				 $self->[_NotationName], $self->[_Value],
1710				 $self->[_SysId], $self->[_PubId],
1711				 $self->[_Ndata], $self->[_Hidden]);
1712}
1713
1714sub rejectChild
1715{
1716    return 1;
1717#?? if value is split over subnodes, recode this section
1718# also add:				   C => new XML::DOM::NodeList,
1719
1720    my $t = $_[1];
1721
1722    return $t == TEXT_NODE
1723	|| $t == ENTITY_REFERENCE_NODE
1724	|| $t == PROCESSING_INSTRUCTION_NODE
1725	|| $t == COMMENT_NODE
1726	|| $t == CDATA_SECTION_NODE
1727	|| $t == ELEMENT_NODE;
1728}
1729
1730sub getValue
1731{
1732    $_[0]->[_Value];
1733}
1734
1735sub isParameterEntity
1736{
1737    $_[0]->[_Parameter];
1738}
1739
1740sub getNdata
1741{
1742    $_[0]->[_Ndata];
1743}
1744
1745sub print
1746{
1747    my ($self, $FILE) = @_;
1748
1749    my $name = $self->[_NotationName];
1750
1751    my $par = $self->isParameterEntity ? "% " : "";
1752
1753    $FILE->print ("<!ENTITY $par$name");
1754
1755    my $value = $self->[_Value];
1756    my $sysId = $self->[_SysId];
1757    my $pubId = $self->[_PubId];
1758    my $ndata = $self->[_Ndata];
1759
1760    if (defined $value)
1761    {
1762#?? Not sure what to do if it contains both single and double quote
1763	$value = ($value =~ /\"/) ? "'$value'" : "\"$value\"";
1764	$FILE->print (" $value");
1765    }
1766    if (defined $pubId)
1767    {
1768	$FILE->print (" PUBLIC \"$pubId\"");
1769    }
1770    elsif (defined $sysId)
1771    {
1772	$FILE->print (" SYSTEM");
1773    }
1774
1775    if (defined $sysId)
1776    {
1777	$FILE->print (" \"$sysId\"");
1778    }
1779    $FILE->print (" NDATA $ndata") if defined $ndata;
1780    $FILE->print (">");
1781}
1782
1783sub to_expat
1784{
1785    my ($self, $iter) = @_;
1786    my $name = ($self->isParameterEntity ? '%' : "") . $self->getNotationName;
1787    $iter->Entity ($name,
1788		   $self->getValue, $self->getSysId, $self->getPubId,
1789		   $self->getNdata);
1790}
1791
1792sub _to_sax
1793{
1794    my ($self, $doch, $dtdh, $enth) = @_;
1795    my $name = ($self->isParameterEntity ? '%' : "") . $self->getNotationName;
1796    $dtdh->entity_decl ( { Name => $name,
1797			   Value => $self->getValue,
1798			   SystemId => $self->getSysId,
1799			   PublicId => $self->getPubId,
1800			   Notation => $self->getNdata } );
1801}
1802
1803######################################################################
1804package XML::DOM::EntityReference;
1805######################################################################
1806use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
1807
1808BEGIN
1809{
1810    import XML::DOM::Node qw( :DEFAULT :Fields );
1811    XML::DOM::def_fields ("EntityName Parameter", "XML::DOM::Node");
1812}
1813
1814use XML::DOM::DOMException;
1815use Carp;
1816
1817sub new
1818{
1819    my ($class, $doc, $name, $parameter) = @_;
1820
1821    croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
1822		      "bad Entity Name [$name] in EntityReference")
1823	unless XML::DOM::isValidName ($name);
1824
1825    my $self = bless [], $class;
1826
1827    $self->[_Doc] = $doc;
1828    $self->[_EntityName] = $name;
1829    $self->[_Parameter] = ($parameter || 0);
1830    $self;
1831}
1832
1833sub getNodeType
1834{
1835    ENTITY_REFERENCE_NODE;
1836}
1837
1838sub getNodeName
1839{
1840    $_[0]->[_EntityName];
1841}
1842
1843#------------------------------------------------------------
1844# Extra method implementations
1845
1846sub getEntityName
1847{
1848    $_[0]->[_EntityName];
1849}
1850
1851sub isParameterEntity
1852{
1853    $_[0]->[_Parameter];
1854}
1855
1856sub getData
1857{
1858    my $self = shift;
1859    my $name = $self->[_EntityName];
1860    my $parameter = $self->[_Parameter];
1861
1862    my $data = $self->[_Doc]->expandEntity ($name, $parameter);
1863
1864    unless (defined $data)
1865    {
1866#?? this is probably an error
1867	my $pc = $parameter ? "%" : "&";
1868	$data = "$pc$name;";
1869    }
1870    $data;
1871}
1872
1873sub print
1874{
1875    my ($self, $FILE) = @_;
1876
1877    my $name = $self->[_EntityName];
1878
1879#?? or do we expand the entities?
1880
1881    my $pc = $self->[_Parameter] ? "%" : "&";
1882    $FILE->print ("$pc$name;");
1883}
1884
1885# Dom Spec says:
1886#     [...] but if such an Entity exists, then
1887#     the child list of the EntityReference node is the same as that of the
1888#     Entity node.
1889#
1890#     The resolution of the children of the EntityReference (the replacement
1891#     value of the referenced Entity) may be lazily evaluated; actions by the
1892#     user (such as calling the childNodes method on the EntityReference
1893#     node) are assumed to trigger the evaluation.
1894sub getChildNodes
1895{
1896    my $self = shift;
1897    my $entity = $self->[_Doc]->getEntity ($self->[_EntityName]);
1898    defined ($entity) ? $entity->getChildNodes : new XML::DOM::NodeList;
1899}
1900
1901sub cloneNode
1902{
1903    my $self = shift;
1904    $self->[_Doc]->createEntityReference ($self->[_EntityName],
1905					 $self->[_Parameter]);
1906}
1907
1908sub to_expat
1909{
1910    my ($self, $iter) = @_;
1911    $iter->EntityRef ($self->getEntityName, $self->isParameterEntity);
1912}
1913
1914sub _to_sax
1915{
1916    my ($self, $doch, $dtdh, $enth) = @_;
1917    my @par = $self->isParameterEntity ? (Parameter => 1) : ();
1918#?? not supported by PerlSAX: $self->isParameterEntity
1919
1920    $doch->entity_reference ( { Name => $self->getEntityName, @par } );
1921}
1922
1923# NOTE: an EntityReference can't really have children, so rejectChild
1924# is not reimplemented (i.e. it always returns 0.)
1925
1926######################################################################
1927package XML::DOM::AttDef;
1928######################################################################
1929use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
1930
1931BEGIN
1932{
1933    import XML::DOM::Node qw( :DEFAULT :Fields );
1934    XML::DOM::def_fields ("Name Type Fixed Default Required Implied Quote", "XML::DOM::Node");
1935}
1936
1937use XML::DOM::DOMException;
1938use Carp;
1939
1940#------------------------------------------------------------
1941# Extra method implementations
1942
1943# AttDef is not part of DOM Spec
1944sub new
1945{
1946    my ($class, $doc, $name, $attrType, $default, $fixed, $hidden) = @_;
1947
1948    croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
1949				      "bad Attr name in AttDef [$name]")
1950	unless XML::DOM::isValidName ($name);
1951
1952    my $self = bless [], $class;
1953
1954    $self->[_Doc] = $doc;
1955    $self->[_Name] = $name;
1956    $self->[_Type] = $attrType;
1957
1958    if (defined $default)
1959    {
1960	if ($default eq "#REQUIRED")
1961	{
1962	    $self->[_Required] = 1;
1963	}
1964	elsif ($default eq "#IMPLIED")
1965	{
1966	    $self->[_Implied] = 1;
1967	}
1968	else
1969	{
1970	    # strip off quotes - see Attlist handler in XML::Parser
1971	    $default =~ m#^(["'])(.*)['"]$#;
1972
1973	    $self->[_Quote] = $1;	# keep track of the quote character
1974	    $self->[_Default] = $self->setDefault ($2);
1975
1976#?? should default value be decoded - what if it contains e.g. "&amp;"
1977	}
1978    }
1979    $self->[_Fixed] = $fixed if defined $fixed;
1980    $self->[_Hidden] = $hidden if defined $hidden;
1981
1982    $self;
1983}
1984
1985sub getNodeType
1986{
1987    ATT_DEF_NODE;
1988}
1989
1990sub getName
1991{
1992    $_[0]->[_Name];
1993}
1994
1995# So it can be added to a NamedNodeMap
1996sub getNodeName
1997{
1998    $_[0]->[_Name];
1999}
2000
2001sub getType
2002{
2003    $_[0]->[_Type];
2004}
2005
2006sub setType
2007{
2008    $_[0]->[_Type] = $_[1];
2009}
2010
2011sub getDefault
2012{
2013    $_[0]->[_Default];
2014}
2015
2016sub setDefault
2017{
2018    my ($self, $value) = @_;
2019
2020    # specified=0, it's the default !
2021    my $attr = $self->[_Doc]->createAttribute ($self->[_Name], undef, 0);
2022    $attr->[_ReadOnly] = 1;
2023
2024#?? this should be split over Text and EntityReference nodes, just like other
2025# Attr nodes - just expand the text for now
2026    $value = $self->expandEntityRefs ($value);
2027    $attr->addText ($value);
2028#?? reimplement in NoExpand mode!
2029
2030    $attr;
2031}
2032
2033sub isFixed
2034{
2035    $_[0]->[_Fixed] || 0;
2036}
2037
2038sub isRequired
2039{
2040    $_[0]->[_Required] || 0;
2041}
2042
2043sub isImplied
2044{
2045    $_[0]->[_Implied] || 0;
2046}
2047
2048sub print
2049{
2050    my ($self, $FILE) = @_;
2051
2052    my $name = $self->[_Name];
2053    my $type = $self->[_Type];
2054    my $fixed = $self->[_Fixed];
2055    my $default = $self->[_Default];
2056
2057    $FILE->print ("$name $type");
2058    $FILE->print (" #FIXED") if defined $fixed;
2059
2060    if ($self->[_Required])
2061    {
2062	$FILE->print (" #REQUIRED");
2063    }
2064    elsif ($self->[_Implied])
2065    {
2066	$FILE->print (" #IMPLIED");
2067    }
2068    elsif (defined ($default))
2069    {
2070	my $quote = $self->[_Quote];
2071	$FILE->print (" $quote");
2072	for my $kid (@{$default->[_C]})
2073	{
2074	    $kid->print ($FILE);
2075	}
2076	$FILE->print ($quote);
2077    }
2078}
2079
2080sub getDefaultString
2081{
2082    my $self = shift;
2083    my $default;
2084
2085    if ($self->[_Required])
2086    {
2087	return "#REQUIRED";
2088    }
2089    elsif ($self->[_Implied])
2090    {
2091	return "#IMPLIED";
2092    }
2093    elsif (defined ($default = $self->[_Default]))
2094    {
2095	my $quote = $self->[_Quote];
2096	$default = $default->toString;
2097	return "$quote$default$quote";
2098    }
2099    undef;
2100}
2101
2102sub cloneNode
2103{
2104    my $self = shift;
2105    my $node = new XML::DOM::AttDef ($self->[_Doc], $self->[_Name], $self->[_Type],
2106				     undef, $self->[_Fixed]);
2107
2108    $node->[_Required] = 1 if $self->[_Required];
2109    $node->[_Implied] = 1 if $self->[_Implied];
2110    $node->[_Fixed] = $self->[_Fixed] if defined $self->[_Fixed];
2111    $node->[_Hidden] = $self->[_Hidden] if defined $self->[_Hidden];
2112
2113    if (defined $self->[_Default])
2114    {
2115	$node->[_Default] = $self->[_Default]->cloneNode(1);
2116    }
2117    $node->[_Quote] = $self->[_Quote];
2118
2119    $node;
2120}
2121
2122sub setOwnerDocument
2123{
2124    my ($self, $doc) = @_;
2125    $self->SUPER::setOwnerDocument ($doc);
2126
2127    if (defined $self->[_Default])
2128    {
2129	$self->[_Default]->setOwnerDocument ($doc);
2130    }
2131}
2132
2133######################################################################
2134package XML::DOM::AttlistDecl;
2135######################################################################
2136use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
2137
2138BEGIN
2139{
2140    import XML::DOM::Node qw( :DEFAULT :Fields );
2141    import XML::DOM::AttDef qw{ :Fields };
2142
2143    XML::DOM::def_fields ("ElementName", "XML::DOM::Node");
2144}
2145
2146use XML::DOM::DOMException;
2147use Carp;
2148
2149#------------------------------------------------------------
2150# Extra method implementations
2151
2152# AttlistDecl is not part of the DOM Spec
2153sub new
2154{
2155    my ($class, $doc, $name) = @_;
2156
2157    croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
2158			      "bad Element TagName [$name] in AttlistDecl")
2159	unless XML::DOM::isValidName ($name);
2160
2161    my $self = bless [], $class;
2162
2163    $self->[_Doc] = $doc;
2164    $self->[_C] = new XML::DOM::NodeList;
2165    $self->[_ReadOnly] = 1;
2166    $self->[_ElementName] = $name;
2167
2168    $self->[_A] = new XML::DOM::NamedNodeMap (Doc	=> $doc,
2169					      ReadOnly	=> 1,
2170					      Parent	=> $self);
2171
2172    $self;
2173}
2174
2175sub getNodeType
2176{
2177    ATTLIST_DECL_NODE;
2178}
2179
2180sub getName
2181{
2182    $_[0]->[_ElementName];
2183}
2184
2185sub getNodeName
2186{
2187    $_[0]->[_ElementName];
2188}
2189
2190sub getAttDef
2191{
2192    my ($self, $attrName) = @_;
2193    $self->[_A]->getNamedItem ($attrName);
2194}
2195
2196sub addAttDef
2197{
2198    my ($self, $attrName, $type, $default, $fixed, $hidden) = @_;
2199    my $node = $self->getAttDef ($attrName);
2200
2201    if (defined $node)
2202    {
2203	# data will be ignored if already defined
2204	my $elemName = $self->getName;
2205	XML::DOM::warning ("multiple definitions of attribute $attrName for element $elemName, only first one is recognized");
2206    }
2207    else
2208    {
2209	$node = new XML::DOM::AttDef ($self->[_Doc], $attrName, $type,
2210				      $default, $fixed, $hidden);
2211	$self->[_A]->setNamedItem ($node);
2212    }
2213    $node;
2214}
2215
2216sub getDefaultAttrValue
2217{
2218    my ($self, $attr) = @_;
2219    my $attrNode = $self->getAttDef ($attr);
2220    (defined $attrNode) ? $attrNode->getDefault : undef;
2221}
2222
2223sub cloneNode
2224{
2225    my ($self, $deep) = @_;
2226    my $node = $self->[_Doc]->createAttlistDecl ($self->[_ElementName]);
2227
2228    $node->[_A] = $self->[_A]->cloneNode ($deep);
2229    $node;
2230}
2231
2232sub setOwnerDocument
2233{
2234    my ($self, $doc) = @_;
2235    $self->SUPER::setOwnerDocument ($doc);
2236
2237    $self->[_A]->setOwnerDocument ($doc);
2238}
2239
2240sub print
2241{
2242    my ($self, $FILE) = @_;
2243
2244    my $name = $self->getName;
2245    my @attlist = @{$self->[_A]->getValues};
2246
2247    my $hidden = 1;
2248    for my $att (@attlist)
2249    {
2250	unless ($att->[_Hidden])
2251	{
2252	    $hidden = 0;
2253	    last;
2254	}
2255    }
2256
2257    unless ($hidden)
2258    {
2259	$FILE->print ("<!ATTLIST $name");
2260
2261	if (@attlist == 1)
2262	{
2263	    $FILE->print (" ");
2264	    $attlist[0]->print ($FILE);
2265	}
2266	else
2267	{
2268	    for my $attr (@attlist)
2269	    {
2270		next if $attr->[_Hidden];
2271
2272		$FILE->print ("\x0A  ");
2273		$attr->print ($FILE);
2274	    }
2275	}
2276	$FILE->print (">");
2277    }
2278}
2279
2280sub to_expat
2281{
2282    my ($self, $iter) = @_;
2283    my $tag = $self->getName;
2284    for my $a ($self->[_A]->getValues)
2285    {
2286	my $default = $a->isImplied ? '#IMPLIED' :
2287	    ($a->isRequired ? '#REQUIRED' :
2288	     ($a->[_Quote] . $a->getDefault->getValue . $a->[_Quote]));
2289
2290	$iter->Attlist ($tag, $a->getName, $a->getType, $default, $a->isFixed);
2291    }
2292}
2293
2294sub _to_sax
2295{
2296    my ($self, $doch, $dtdh, $enth) = @_;
2297    my $tag = $self->getName;
2298    for my $a ($self->[_A]->getValues)
2299    {
2300	my $default = $a->isImplied ? '#IMPLIED' :
2301	    ($a->isRequired ? '#REQUIRED' :
2302	     ($a->[_Quote] . $a->getDefault->getValue . $a->[_Quote]));
2303
2304	$dtdh->attlist_decl ({ ElementName => $tag,
2305			       AttributeName => $a->getName,
2306			       Type => $a->[_Type],
2307			       Default => $default,
2308			       Fixed => $a->isFixed });
2309    }
2310}
2311
2312######################################################################
2313package XML::DOM::ElementDecl;
2314######################################################################
2315use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
2316
2317BEGIN
2318{
2319    import XML::DOM::Node qw( :DEFAULT :Fields );
2320    XML::DOM::def_fields ("Name Model", "XML::DOM::Node");
2321}
2322
2323use XML::DOM::DOMException;
2324use Carp;
2325
2326
2327#------------------------------------------------------------
2328# Extra method implementations
2329
2330# ElementDecl is not part of the DOM Spec
2331sub new
2332{
2333    my ($class, $doc, $name, $model, $hidden) = @_;
2334
2335    croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
2336			      "bad Element TagName [$name] in ElementDecl")
2337	unless XML::DOM::isValidName ($name);
2338
2339    my $self = bless [], $class;
2340
2341    $self->[_Doc] = $doc;
2342    $self->[_Name] = $name;
2343    $self->[_ReadOnly] = 1;
2344    $self->[_Model] = $model;
2345    $self->[_Hidden] = $hidden;
2346    $self;
2347}
2348
2349sub getNodeType
2350{
2351    ELEMENT_DECL_NODE;
2352}
2353
2354sub getName
2355{
2356    $_[0]->[_Name];
2357}
2358
2359sub getNodeName
2360{
2361    $_[0]->[_Name];
2362}
2363
2364sub getModel
2365{
2366    $_[0]->[_Model];
2367}
2368
2369sub setModel
2370{
2371    my ($self, $model) = @_;
2372
2373    $self->[_Model] = $model;
2374}
2375
2376sub print
2377{
2378    my ($self, $FILE) = @_;
2379
2380    my $name = $self->[_Name];
2381    my $model = $self->[_Model];
2382
2383    $FILE->print ("<!ELEMENT $name $model>")
2384	unless $self->[_Hidden];
2385}
2386
2387sub cloneNode
2388{
2389    my $self = shift;
2390    $self->[_Doc]->createElementDecl ($self->[_Name], $self->[_Model],
2391				      $self->[_Hidden]);
2392}
2393
2394sub to_expat
2395{
2396#?? add support for Hidden?? (allover, also in _to_sax!!)
2397
2398    my ($self, $iter) = @_;
2399    $iter->Element ($self->getName, $self->getModel);
2400}
2401
2402sub _to_sax
2403{
2404    my ($self, $doch, $dtdh, $enth) = @_;
2405    $dtdh->element_decl ( { Name => $self->getName,
2406			    Model => $self->getModel } );
2407}
2408
2409######################################################################
2410package XML::DOM::Element;
2411######################################################################
2412use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
2413
2414BEGIN
2415{
2416    import XML::DOM::Node qw( :DEFAULT :Fields );
2417    XML::DOM::def_fields ("TagName", "XML::DOM::Node");
2418}
2419
2420use XML::DOM::DOMException;
2421use XML::DOM::NamedNodeMap;
2422use Carp;
2423
2424sub new
2425{
2426    my ($class, $doc, $tagName) = @_;
2427
2428    if ($XML::DOM::SafeMode)
2429    {
2430	croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
2431				      "bad Element TagName [$tagName]")
2432	    unless XML::DOM::isValidName ($tagName);
2433    }
2434
2435    my $self = bless [], $class;
2436
2437    $self->[_Doc] = $doc;
2438    $self->[_C] = new XML::DOM::NodeList;
2439    $self->[_TagName] = $tagName;
2440
2441# Now we're creating the NamedNodeMap only when needed (REC 2313 => 1147)
2442#    $self->[_A] = new XML::DOM::NamedNodeMap (Doc	=> $doc,
2443#					     Parent	=> $self);
2444
2445    $self;
2446}
2447
2448sub getNodeType
2449{
2450    ELEMENT_NODE;
2451}
2452
2453sub getTagName
2454{
2455    $_[0]->[_TagName];
2456}
2457
2458sub getNodeName
2459{
2460    $_[0]->[_TagName];
2461}
2462
2463sub getAttributeNode
2464{
2465    my ($self, $name) = @_;
2466    return undef unless defined $self->[_A];
2467
2468    $self->getAttributes->{$name};
2469}
2470
2471sub getAttribute
2472{
2473    my ($self, $name) = @_;
2474    my $attr = $self->getAttributeNode ($name);
2475    (defined $attr) ? $attr->getValue : "";
2476}
2477
2478sub setAttribute
2479{
2480    my ($self, $name, $val) = @_;
2481
2482    croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
2483				      "bad Attr Name [$name]")
2484	unless XML::DOM::isValidName ($name);
2485
2486    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
2487				      "node is ReadOnly")
2488	if $self->isReadOnly;
2489
2490    my $node = $self->getAttributes->{$name};
2491    if (defined $node)
2492    {
2493	$node->setValue ($val);
2494    }
2495    else
2496    {
2497	$node = $self->[_Doc]->createAttribute ($name, $val);
2498	$self->[_A]->setNamedItem ($node);
2499    }
2500}
2501
2502sub setAttributeNode
2503{
2504    my ($self, $node) = @_;
2505    my $attr = $self->getAttributes;
2506    my $name = $node->getNodeName;
2507
2508    # REC 1147
2509    if ($XML::DOM::SafeMode)
2510    {
2511	croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR,
2512					  "nodes belong to different documents")
2513	    if $self->[_Doc] != $node->[_Doc];
2514
2515	croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
2516					  "node is ReadOnly")
2517	    if $self->isReadOnly;
2518
2519	my $attrParent = $node->[_UsedIn];
2520	croak new XML::DOM::DOMException (INUSE_ATTRIBUTE_ERR,
2521					  "Attr is already used by another Element")
2522	    if (defined ($attrParent) && $attrParent != $attr);
2523    }
2524
2525    my $other = $attr->{$name};
2526    $attr->removeNamedItem ($name) if defined $other;
2527
2528    $attr->setNamedItem ($node);
2529
2530    $other;
2531}
2532
2533sub removeAttributeNode
2534{
2535    my ($self, $node) = @_;
2536
2537    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
2538				      "node is ReadOnly")
2539	if $self->isReadOnly;
2540
2541    my $attr = $self->[_A];
2542    unless (defined $attr)
2543    {
2544	croak new XML::DOM::DOMException (NOT_FOUND_ERR);
2545	return undef;
2546    }
2547
2548    my $name = $node->getNodeName;
2549    my $attrNode = $attr->getNamedItem ($name);
2550
2551#?? should it croak if it's the default value?
2552    croak new XML::DOM::DOMException (NOT_FOUND_ERR)
2553	unless $node == $attrNode;
2554
2555    # Not removing anything if it's the default value already
2556    return undef unless $node->isSpecified;
2557
2558    $attr->removeNamedItem ($name);
2559
2560    # Substitute with default value if it's defined
2561    my $default = $self->getDefaultAttrValue ($name);
2562    if (defined $default)
2563    {
2564	local $XML::DOM::IgnoreReadOnly = 1;
2565
2566	$default = $default->cloneNode (1);
2567	$attr->setNamedItem ($default);
2568    }
2569    $node;
2570}
2571
2572sub removeAttribute
2573{
2574    my ($self, $name) = @_;
2575    my $attr = $self->[_A];
2576    unless (defined $attr)
2577    {
2578	croak new XML::DOM::DOMException (NOT_FOUND_ERR);
2579	return;
2580    }
2581
2582    my $node = $attr->getNamedItem ($name);
2583    if (defined $node)
2584    {
2585#?? could use dispose() to remove circular references for gc, but what if
2586#?? somebody is referencing it?
2587	$self->removeAttributeNode ($node);
2588    }
2589}
2590
2591sub cloneNode
2592{
2593    my ($self, $deep) = @_;
2594    my $node = $self->[_Doc]->createElement ($self->getTagName);
2595
2596    # Always clone the Attr nodes, even if $deep == 0
2597    if (defined $self->[_A])
2598    {
2599	$node->[_A] = $self->[_A]->cloneNode (1);	# deep=1
2600	$node->[_A]->setParentNode ($node);
2601    }
2602
2603    $node->cloneChildren ($self, $deep);
2604    $node;
2605}
2606
2607sub getAttributes
2608{
2609    $_[0]->[_A] ||= XML::DOM::NamedNodeMap->new (Doc	=> $_[0]->[_Doc],
2610						 Parent	=> $_[0]);
2611}
2612
2613#------------------------------------------------------------
2614# Extra method implementations
2615
2616# Added for convenience
2617sub setTagName
2618{
2619    my ($self, $tagName) = @_;
2620
2621    croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR,
2622				      "bad Element TagName [$tagName]")
2623        unless XML::DOM::isValidName ($tagName);
2624
2625    $self->[_TagName] = $tagName;
2626}
2627
2628sub isReadOnly
2629{
2630    0;
2631}
2632
2633# Added for optimization.
2634sub isElementNode
2635{
2636    1;
2637}
2638
2639sub rejectChild
2640{
2641    my $t = $_[1]->getNodeType;
2642
2643    $t != TEXT_NODE
2644    && $t != ENTITY_REFERENCE_NODE
2645    && $t != PROCESSING_INSTRUCTION_NODE
2646    && $t != COMMENT_NODE
2647    && $t != CDATA_SECTION_NODE
2648    && $t != ELEMENT_NODE;
2649}
2650
2651sub getDefaultAttrValue
2652{
2653    my ($self, $attr) = @_;
2654    $self->[_Doc]->getDefaultAttrValue ($self->[_TagName], $attr);
2655}
2656
2657sub dispose
2658{
2659    my $self = shift;
2660
2661    $self->[_A]->dispose if defined $self->[_A];
2662    $self->SUPER::dispose;
2663}
2664
2665sub setOwnerDocument
2666{
2667    my ($self, $doc) = @_;
2668    $self->SUPER::setOwnerDocument ($doc);
2669
2670    $self->[_A]->setOwnerDocument ($doc) if defined $self->[_A];
2671}
2672
2673sub print
2674{
2675    my ($self, $FILE) = @_;
2676
2677    my $name = $self->[_TagName];
2678
2679    $FILE->print ("<$name");
2680
2681    if (defined $self->[_A])
2682    {
2683	for my $att (@{$self->[_A]->getValues})
2684	{
2685	    # skip un-specified (default) Attr nodes
2686	    if ($att->isSpecified)
2687	    {
2688		$FILE->print (" ");
2689		$att->print ($FILE);
2690	    }
2691	}
2692    }
2693
2694    my @kids = @{$self->[_C]};
2695    if (@kids > 0)
2696    {
2697	$FILE->print (">");
2698	for my $kid (@kids)
2699	{
2700	    $kid->print ($FILE);
2701	}
2702	$FILE->print ("</$name>");
2703    }
2704    else
2705    {
2706	my $style = &$XML::DOM::TagStyle ($name, $self);
2707	if ($style == 0)
2708	{
2709	    $FILE->print ("/>");
2710	}
2711	elsif ($style == 1)
2712	{
2713	    $FILE->print ("></$name>");
2714	}
2715	else
2716	{
2717	    $FILE->print (" />");
2718	}
2719    }
2720}
2721
2722sub check
2723{
2724    my ($self, $checker) = @_;
2725    die "Usage: \$xml_dom_elem->check (\$checker)" unless $checker;
2726
2727    $checker->InitDomElem;
2728    $self->to_expat ($checker);
2729    $checker->FinalDomElem;
2730}
2731
2732sub to_expat
2733{
2734    my ($self, $iter) = @_;
2735
2736    my $tag = $self->getTagName;
2737    $iter->Start ($tag);
2738
2739    if (defined $self->[_A])
2740    {
2741	for my $attr ($self->[_A]->getValues)
2742	{
2743	    $iter->Attr ($tag, $attr->getName, $attr->getValue, $attr->isSpecified);
2744	}
2745    }
2746
2747    $iter->EndAttr;
2748
2749    for my $kid ($self->getChildNodes)
2750    {
2751	$kid->to_expat ($iter);
2752    }
2753
2754    $iter->End;
2755}
2756
2757sub _to_sax
2758{
2759    my ($self, $doch, $dtdh, $enth) = @_;
2760
2761    my $tag = $self->getTagName;
2762
2763    my @attr = ();
2764    my $attrOrder;
2765    my $attrDefaulted;
2766
2767    if (defined $self->[_A])
2768    {
2769	my @spec = ();		# names of specified attributes
2770	my @unspec = ();	# names of defaulted attributes
2771
2772	for my $attr ($self->[_A]->getValues)
2773	{
2774	    my $attrName = $attr->getName;
2775	    push @attr, $attrName, $attr->getValue;
2776	    if ($attr->isSpecified)
2777	    {
2778		push @spec, $attrName;
2779	    }
2780	    else
2781	    {
2782		push @unspec, $attrName;
2783	    }
2784	}
2785	$attrOrder = [ @spec, @unspec ];
2786	$attrDefaulted = @spec;
2787    }
2788    $doch->start_element (defined $attrOrder ?
2789			  { Name => $tag,
2790			    Attributes => { @attr },
2791			    AttributeOrder => $attrOrder,
2792			    Defaulted => $attrDefaulted
2793			  } :
2794			  { Name => $tag,
2795			    Attributes => { @attr }
2796			  }
2797			 );
2798
2799    for my $kid ($self->getChildNodes)
2800    {
2801	$kid->_to_sax ($doch, $dtdh, $enth);
2802    }
2803
2804    $doch->end_element ( { Name => $tag } );
2805}
2806
2807######################################################################
2808package XML::DOM::CharacterData;
2809######################################################################
2810use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
2811
2812BEGIN
2813{
2814    import XML::DOM::Node qw( :DEFAULT :Fields );
2815    XML::DOM::def_fields ("Data", "XML::DOM::Node");
2816}
2817
2818use XML::DOM::DOMException;
2819use Carp;
2820
2821
2822#
2823# CharacterData nodes should never be created directly, only subclassed!
2824#
2825sub new
2826{
2827    my ($class, $doc, $data) = @_;
2828    my $self = bless [], $class;
2829
2830    $self->[_Doc] = $doc;
2831    $self->[_Data] = $data;
2832    $self;
2833}
2834
2835sub appendData
2836{
2837    my ($self, $data) = @_;
2838
2839    if ($XML::DOM::SafeMode)
2840    {
2841	croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
2842					  "node is ReadOnly")
2843	    if $self->isReadOnly;
2844    }
2845    $self->[_Data] .= $data;
2846}
2847
2848sub deleteData
2849{
2850    my ($self, $offset, $count) = @_;
2851
2852    croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
2853				      "bad offset [$offset]")
2854	if ($offset < 0 || $offset >= length ($self->[_Data]));
2855#?? DOM Spec says >, but >= makes more sense!
2856
2857    croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
2858				      "negative count [$count]")
2859	if $count < 0;
2860
2861    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
2862				      "node is ReadOnly")
2863	if $self->isReadOnly;
2864
2865    substr ($self->[_Data], $offset, $count) = "";
2866}
2867
2868sub getData
2869{
2870    $_[0]->[_Data];
2871}
2872
2873sub getLength
2874{
2875    length $_[0]->[_Data];
2876}
2877
2878sub insertData
2879{
2880    my ($self, $offset, $data) = @_;
2881
2882    croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
2883				      "bad offset [$offset]")
2884	if ($offset < 0 || $offset >= length ($self->[_Data]));
2885#?? DOM Spec says >, but >= makes more sense!
2886
2887    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
2888				      "node is ReadOnly")
2889	if $self->isReadOnly;
2890
2891    substr ($self->[_Data], $offset, 0) = $data;
2892}
2893
2894sub replaceData
2895{
2896    my ($self, $offset, $count, $data) = @_;
2897
2898    croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
2899				      "bad offset [$offset]")
2900	if ($offset < 0 || $offset >= length ($self->[_Data]));
2901#?? DOM Spec says >, but >= makes more sense!
2902
2903    croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
2904				      "negative count [$count]")
2905	if $count < 0;
2906
2907    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
2908				      "node is ReadOnly")
2909	if $self->isReadOnly;
2910
2911    substr ($self->[_Data], $offset, $count) = $data;
2912}
2913
2914sub setData
2915{
2916    my ($self, $data) = @_;
2917
2918    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
2919				      "node is ReadOnly")
2920	if $self->isReadOnly;
2921
2922    $self->[_Data] = $data;
2923}
2924
2925sub substringData
2926{
2927    my ($self, $offset, $count) = @_;
2928    my $data = $self->[_Data];
2929
2930    croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
2931				      "bad offset [$offset]")
2932	if ($offset < 0 || $offset >= length ($data));
2933#?? DOM Spec says >, but >= makes more sense!
2934
2935    croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
2936				      "negative count [$count]")
2937	if $count < 0;
2938
2939    substr ($data, $offset, $count);
2940}
2941
2942sub getNodeValue
2943{
2944    $_[0]->getData;
2945}
2946
2947sub setNodeValue
2948{
2949    $_[0]->setData ($_[1]);
2950}
2951
2952######################################################################
2953package XML::DOM::CDATASection;
2954######################################################################
2955use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
2956
2957BEGIN
2958{
2959    import XML::DOM::CharacterData qw( :DEFAULT :Fields );
2960    import XML::DOM::Node qw( :DEFAULT :Fields );
2961    XML::DOM::def_fields ("", "XML::DOM::CharacterData");
2962}
2963
2964use XML::DOM::DOMException;
2965
2966sub getNodeName
2967{
2968    "#cdata-section";
2969}
2970
2971sub getNodeType
2972{
2973    CDATA_SECTION_NODE;
2974}
2975
2976sub cloneNode
2977{
2978    my $self = shift;
2979    $self->[_Doc]->createCDATASection ($self->getData);
2980}
2981
2982#------------------------------------------------------------
2983# Extra method implementations
2984
2985sub isReadOnly
2986{
2987    0;
2988}
2989
2990sub print
2991{
2992    my ($self, $FILE) = @_;
2993    $FILE->print ("<![CDATA[");
2994    $FILE->print (XML::DOM::encodeCDATA ($self->getData));
2995    $FILE->print ("]]>");
2996}
2997
2998sub to_expat
2999{
3000    my ($self, $iter) = @_;
3001    $iter->CData ($self->getData);
3002}
3003
3004sub _to_sax
3005{
3006    my ($self, $doch, $dtdh, $enth) = @_;
3007    $doch->start_cdata;
3008    $doch->characters ( { Data => $self->getData } );
3009    $doch->end_cdata;
3010}
3011
3012######################################################################
3013package XML::DOM::Comment;
3014######################################################################
3015use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
3016
3017BEGIN
3018{
3019    import XML::DOM::CharacterData qw( :DEFAULT :Fields );
3020    import XML::DOM::Node qw( :DEFAULT :Fields );
3021    XML::DOM::def_fields ("", "XML::DOM::CharacterData");
3022}
3023
3024use XML::DOM::DOMException;
3025use Carp;
3026
3027#?? setData - could check comment for double minus
3028
3029sub getNodeType
3030{
3031    COMMENT_NODE;
3032}
3033
3034sub getNodeName
3035{
3036    "#comment";
3037}
3038
3039sub cloneNode
3040{
3041    my $self = shift;
3042    $self->[_Doc]->createComment ($self->getData);
3043}
3044
3045#------------------------------------------------------------
3046# Extra method implementations
3047
3048sub isReadOnly
3049{
3050    return 0 if $XML::DOM::IgnoreReadOnly;
3051
3052    my $pa = $_[0]->[_Parent];
3053    defined ($pa) ? $pa->isReadOnly : 0;
3054}
3055
3056sub print
3057{
3058    my ($self, $FILE) = @_;
3059    my $comment = XML::DOM::encodeComment ($self->[_Data]);
3060
3061    $FILE->print ("<!--$comment-->");
3062}
3063
3064sub to_expat
3065{
3066    my ($self, $iter) = @_;
3067    $iter->Comment ($self->getData);
3068}
3069
3070sub _to_sax
3071{
3072    my ($self, $doch, $dtdh, $enth) = @_;
3073    $doch->Comment ( { Data => $self->getData });
3074}
3075
3076######################################################################
3077package XML::DOM::Text;
3078######################################################################
3079use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
3080
3081BEGIN
3082{
3083    import XML::DOM::CharacterData qw( :DEFAULT :Fields );
3084    import XML::DOM::Node qw( :DEFAULT :Fields );
3085    XML::DOM::def_fields ("", "XML::DOM::CharacterData");
3086}
3087
3088use XML::DOM::DOMException;
3089use Carp;
3090
3091sub getNodeType
3092{
3093    TEXT_NODE;
3094}
3095
3096sub getNodeName
3097{
3098    "#text";
3099}
3100
3101sub splitText
3102{
3103    my ($self, $offset) = @_;
3104
3105    my $data = $self->getData;
3106    croak new XML::DOM::DOMException (INDEX_SIZE_ERR,
3107				      "bad offset [$offset]")
3108	if ($offset < 0 || $offset >= length ($data));
3109#?? DOM Spec says >, but >= makes more sense!
3110
3111    croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR,
3112				      "node is ReadOnly")
3113	if $self->isReadOnly;
3114
3115    my $rest = substring ($data, $offset);
3116
3117    $self->setData (substring ($data, 0, $offset));
3118    my $node = $self->[_Doc]->createTextNode ($rest);
3119
3120    # insert new node after this node
3121    $self->[_Parent]->insertAfter ($node, $self);
3122
3123    $node;
3124}
3125
3126sub cloneNode
3127{
3128    my $self = shift;
3129    $self->[_Doc]->createTextNode ($self->getData);
3130}
3131
3132#------------------------------------------------------------
3133# Extra method implementations
3134
3135sub isReadOnly
3136{
3137    0;
3138}
3139
3140sub print
3141{
3142    my ($self, $FILE) = @_;
3143    $FILE->print (XML::DOM::encodeText ($self->getData, "<&"));
3144}
3145
3146sub isTextNode
3147{
3148    1;
3149}
3150
3151sub to_expat
3152{
3153    my ($self, $iter) = @_;
3154    $iter->Char ($self->getData);
3155}
3156
3157sub _to_sax
3158{
3159    my ($self, $doch, $dtdh, $enth) = @_;
3160    $doch->characters ( { Data => $self->getData } );
3161}
3162
3163######################################################################
3164package XML::DOM::XMLDecl;
3165######################################################################
3166use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
3167
3168BEGIN
3169{
3170    import XML::DOM::Node qw( :DEFAULT :Fields );
3171    XML::DOM::def_fields ("Version Encoding Standalone", "XML::DOM::Node");
3172}
3173
3174use XML::DOM::DOMException;
3175
3176
3177#------------------------------------------------------------
3178# Extra method implementations
3179
3180# XMLDecl is not part of the DOM Spec
3181sub new
3182{
3183    my ($class, $doc, $version, $encoding, $standalone) = @_;
3184
3185    my $self = bless [], $class;
3186
3187    $self->[_Doc] = $doc;
3188    $self->[_Version] = $version if defined $version;
3189    $self->[_Encoding] = $encoding if defined $encoding;
3190    $self->[_Standalone] = $standalone if defined $standalone;
3191
3192    $self;
3193}
3194
3195sub setVersion
3196{
3197    if (defined $_[1])
3198    {
3199	$_[0]->[_Version] = $_[1];
3200    }
3201    else
3202    {
3203	undef $_[0]->[_Version]; # was delete
3204    }
3205}
3206
3207sub getVersion
3208{
3209    $_[0]->[_Version];
3210}
3211
3212sub setEncoding
3213{
3214    if (defined $_[1])
3215    {
3216	$_[0]->[_Encoding] = $_[1];
3217    }
3218    else
3219    {
3220	undef $_[0]->[_Encoding]; # was delete
3221    }
3222}
3223
3224sub getEncoding
3225{
3226    $_[0]->[_Encoding];
3227}
3228
3229sub setStandalone
3230{
3231    if (defined $_[1])
3232    {
3233	$_[0]->[_Standalone] = $_[1];
3234    }
3235    else
3236    {
3237	undef $_[0]->[_Standalone]; # was delete
3238    }
3239}
3240
3241sub getStandalone
3242{
3243    $_[0]->[_Standalone];
3244}
3245
3246sub getNodeType
3247{
3248    XML_DECL_NODE;
3249}
3250
3251sub cloneNode
3252{
3253    my $self = shift;
3254
3255    new XML::DOM::XMLDecl ($self->[_Doc], $self->[_Version],
3256			   $self->[_Encoding], $self->[_Standalone]);
3257}
3258
3259sub print
3260{
3261    my ($self, $FILE) = @_;
3262
3263    my $version = $self->[_Version];
3264    my $encoding = $self->[_Encoding];
3265    my $standalone = $self->[_Standalone];
3266    $standalone = ($standalone ? "yes" : "no") if defined $standalone;
3267
3268    $FILE->print ("<?xml");
3269    $FILE->print (" version=\"$version\"")	 if defined $version;
3270    $FILE->print (" encoding=\"$encoding\"")	 if defined $encoding;
3271    $FILE->print (" standalone=\"$standalone\"") if defined $standalone;
3272    $FILE->print ("?>");
3273}
3274
3275sub to_expat
3276{
3277    my ($self, $iter) = @_;
3278    $iter->XMLDecl ($self->getVersion, $self->getEncoding, $self->getStandalone);
3279}
3280
3281sub _to_sax
3282{
3283    my ($self, $doch, $dtdh, $enth) = @_;
3284    $dtdh->xml_decl ( { Version => $self->getVersion,
3285			Encoding => $self->getEncoding,
3286			Standalone => $self->getStandalone } );
3287}
3288
3289######################################################################
3290package XML::DOM::DocumentFragment;
3291######################################################################
3292use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
3293
3294BEGIN
3295{
3296    import XML::DOM::Node qw( :DEFAULT :Fields );
3297    XML::DOM::def_fields ("", "XML::DOM::Node");
3298}
3299
3300use XML::DOM::DOMException;
3301
3302sub new
3303{
3304    my ($class, $doc) = @_;
3305    my $self = bless [], $class;
3306
3307    $self->[_Doc] = $doc;
3308    $self->[_C] = new XML::DOM::NodeList;
3309    $self;
3310}
3311
3312sub getNodeType
3313{
3314    DOCUMENT_FRAGMENT_NODE;
3315}
3316
3317sub getNodeName
3318{
3319    "#document-fragment";
3320}
3321
3322sub cloneNode
3323{
3324    my ($self, $deep) = @_;
3325    my $node = $self->[_Doc]->createDocumentFragment;
3326
3327    $node->cloneChildren ($self, $deep);
3328    $node;
3329}
3330
3331#------------------------------------------------------------
3332# Extra method implementations
3333
3334sub isReadOnly
3335{
3336    0;
3337}
3338
3339sub print
3340{
3341    my ($self, $FILE) = @_;
3342
3343    for my $node (@{$self->[_C]})
3344    {
3345	$node->print ($FILE);
3346    }
3347}
3348
3349sub rejectChild
3350{
3351    my $t = $_[1]->getNodeType;
3352
3353    $t != TEXT_NODE
3354	&& $t != ENTITY_REFERENCE_NODE
3355	&& $t != PROCESSING_INSTRUCTION_NODE
3356	&& $t != COMMENT_NODE
3357	&& $t != CDATA_SECTION_NODE
3358	&& $t != ELEMENT_NODE;
3359}
3360
3361sub isDocumentFragmentNode
3362{
3363    1;
3364}
3365
3366######################################################################
3367package XML::DOM::Document;
3368######################################################################
3369use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
3370
3371BEGIN
3372{
3373    import XML::DOM::Node qw( :DEFAULT :Fields );
3374    XML::DOM::def_fields ("Doctype XmlDecl", "XML::DOM::Node");
3375}
3376
3377use Carp;
3378use XML::DOM::NodeList;
3379use XML::DOM::DOMException;
3380
3381sub new
3382{
3383    my ($class) = @_;
3384    my $self = bless [], $class;
3385
3386    # keep Doc pointer, even though getOwnerDocument returns undef
3387    $self->[_Doc] = $self;
3388    $self->[_C] = new XML::DOM::NodeList;
3389    $self;
3390}
3391
3392sub getNodeType
3393{
3394    DOCUMENT_NODE;
3395}
3396
3397sub getNodeName
3398{
3399    "#document";
3400}
3401
3402#?? not sure about keeping a fixed order of these nodes....
3403sub getDoctype
3404{
3405    $_[0]->[_Doctype];
3406}
3407
3408sub getDocumentElement
3409{
3410    my ($self) = @_;
3411    for my $kid (@{$self->[_C]})
3412    {
3413	return $kid if $kid->isElementNode;
3414    }
3415    undef;
3416}
3417
3418sub getOwnerDocument
3419{
3420    undef;
3421}
3422
3423sub getImplementation
3424{
3425    $XML::DOM::DOMImplementation::Singleton;
3426}
3427
3428#
3429# Added extra parameters ($val, $specified) that are passed straight to the
3430# Attr constructor
3431#
3432sub createAttribute
3433{
3434    new XML::DOM::Attr (@_);
3435}
3436
3437sub createCDATASection
3438{
3439    new XML::DOM::CDATASection (@_);
3440}
3441
3442sub createComment
3443{
3444    new XML::DOM::Comment (@_);
3445
3446}
3447
3448sub createElement
3449{
3450    new XML::DOM::Element (@_);
3451}
3452
3453sub createTextNode
3454{
3455    new XML::DOM::Text (@_);
3456}
3457
3458sub createProcessingInstruction
3459{
3460    new XML::DOM::ProcessingInstruction (@_);
3461}
3462
3463sub createEntityReference
3464{
3465    new XML::DOM::EntityReference (@_);
3466}
3467
3468sub createDocumentFragment
3469{
3470    new XML::DOM::DocumentFragment (@_);
3471}
3472
3473sub createDocumentType
3474{
3475    new XML::DOM::DocumentType (@_);
3476}
3477
3478sub cloneNode
3479{
3480    my ($self, $deep) = @_;
3481    my $node = new XML::DOM::Document;
3482
3483    $node->cloneChildren ($self, $deep);
3484
3485    my $xmlDecl = $self->[_XmlDecl];
3486    $node->[_XmlDecl] = $xmlDecl->cloneNode ($deep) if defined $xmlDecl;
3487
3488    $node;
3489}
3490
3491sub appendChild
3492{
3493    my ($self, $node) = @_;
3494
3495    # Extra check: make sure we don't end up with more than one Element.
3496    # Don't worry about multiple DocType nodes, because DocumentFragment
3497    # can't contain DocType nodes.
3498
3499    my @nodes = ($node);
3500    @nodes = @{$node->[_C]}
3501        if $node->getNodeType == DOCUMENT_FRAGMENT_NODE;
3502
3503    my $elem = 0;
3504    for my $n (@nodes)
3505    {
3506	$elem++ if $n->isElementNode;
3507    }
3508
3509    if ($elem > 0 && defined ($self->getDocumentElement))
3510    {
3511	croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
3512					  "document can have only one Element");
3513    }
3514    $self->SUPER::appendChild ($node);
3515}
3516
3517sub insertBefore
3518{
3519    my ($self, $node, $refNode) = @_;
3520
3521    # Extra check: make sure sure we don't end up with more than 1 Elements.
3522    # Don't worry about multiple DocType nodes, because DocumentFragment
3523    # can't contain DocType nodes.
3524
3525    my @nodes = ($node);
3526    @nodes = @{$node->[_C]}
3527	if $node->getNodeType == DOCUMENT_FRAGMENT_NODE;
3528
3529    my $elem = 0;
3530    for my $n (@nodes)
3531    {
3532	$elem++ if $n->isElementNode;
3533    }
3534
3535    if ($elem > 0 && defined ($self->getDocumentElement))
3536    {
3537	croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
3538					  "document can have only one Element");
3539    }
3540    $self->SUPER::insertBefore ($node, $refNode);
3541}
3542
3543sub replaceChild
3544{
3545    my ($self, $node, $refNode) = @_;
3546
3547    # Extra check: make sure sure we don't end up with more than 1 Elements.
3548    # Don't worry about multiple DocType nodes, because DocumentFragment
3549    # can't contain DocType nodes.
3550
3551    my @nodes = ($node);
3552    @nodes = @{$node->[_C]}
3553	if $node->getNodeType == DOCUMENT_FRAGMENT_NODE;
3554
3555    my $elem = 0;
3556    $elem-- if $refNode->isElementNode;
3557
3558    for my $n (@nodes)
3559    {
3560	$elem++ if $n->isElementNode;
3561    }
3562
3563    if ($elem > 0 && defined ($self->getDocumentElement))
3564    {
3565	croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR,
3566					  "document can have only one Element");
3567    }
3568    $self->SUPER::appendChild ($node, $refNode);
3569}
3570
3571#------------------------------------------------------------
3572# Extra method implementations
3573
3574sub isReadOnly
3575{
3576    0;
3577}
3578
3579sub print
3580{
3581    my ($self, $FILE) = @_;
3582
3583    my $xmlDecl = $self->getXMLDecl;
3584    if (defined $xmlDecl)
3585    {
3586	$xmlDecl->print ($FILE);
3587	$FILE->print ("\x0A");
3588    }
3589
3590    for my $node (@{$self->[_C]})
3591    {
3592	$node->print ($FILE);
3593	$FILE->print ("\x0A");
3594    }
3595}
3596
3597sub setDoctype
3598{
3599    my ($self, $doctype) = @_;
3600    my $oldDoctype = $self->[_Doctype];
3601    if (defined $oldDoctype)
3602    {
3603	$self->replaceChild ($doctype, $oldDoctype);
3604    }
3605    else
3606    {
3607#?? before root element, but after XmlDecl !
3608	$self->appendChild ($doctype);
3609    }
3610    $_[0]->[_Doctype] = $_[1];
3611}
3612
3613sub removeDoctype
3614{
3615    my $self = shift;
3616    my $doctype = $self->removeChild ($self->[_Doctype]);
3617
3618    undef $self->[_Doctype]; # was delete
3619    $doctype;
3620}
3621
3622sub rejectChild
3623{
3624    my $t = $_[1]->getNodeType;
3625    $t != ELEMENT_NODE
3626	&& $t != PROCESSING_INSTRUCTION_NODE
3627	&& $t != COMMENT_NODE
3628	&& $t != DOCUMENT_TYPE_NODE;
3629}
3630
3631sub expandEntity
3632{
3633    my ($self, $ent, $param) = @_;
3634    my $doctype = $self->getDoctype;
3635
3636    (defined $doctype) ? $doctype->expandEntity ($ent, $param) : undef;
3637}
3638
3639sub getDefaultAttrValue
3640{
3641    my ($self, $elem, $attr) = @_;
3642
3643    my $doctype = $self->getDoctype;
3644
3645    (defined $doctype) ? $doctype->getDefaultAttrValue ($elem, $attr) : undef;
3646}
3647
3648sub getEntity
3649{
3650    my ($self, $entity) = @_;
3651
3652    my $doctype = $self->getDoctype;
3653
3654    (defined $doctype) ? $doctype->getEntity ($entity) : undef;
3655}
3656
3657sub dispose
3658{
3659    my $self = shift;
3660
3661    $self->[_XmlDecl]->dispose if defined $self->[_XmlDecl];
3662    undef $self->[_XmlDecl]; # was delete
3663    undef $self->[_Doctype]; # was delete
3664    $self->SUPER::dispose;
3665}
3666
3667sub setOwnerDocument
3668{
3669    # Do nothing, you can't change the owner document!
3670#?? could throw exception...
3671}
3672
3673sub getXMLDecl
3674{
3675    $_[0]->[_XmlDecl];
3676}
3677
3678sub setXMLDecl
3679{
3680    $_[0]->[_XmlDecl] = $_[1];
3681}
3682
3683sub createXMLDecl
3684{
3685    new XML::DOM::XMLDecl (@_);
3686}
3687
3688sub createNotation
3689{
3690    new XML::DOM::Notation (@_);
3691}
3692
3693sub createElementDecl
3694{
3695    new XML::DOM::ElementDecl (@_);
3696}
3697
3698sub createAttlistDecl
3699{
3700    new XML::DOM::AttlistDecl (@_);
3701}
3702
3703sub createEntity
3704{
3705    new XML::DOM::Entity (@_);
3706}
3707
3708sub createChecker
3709{
3710    my $self = shift;
3711    my $checker = XML::Checker->new;
3712
3713    $checker->Init;
3714    my $doctype = $self->getDoctype;
3715    $doctype->to_expat ($checker) if $doctype;
3716    $checker->Final;
3717
3718    $checker;
3719}
3720
3721sub check
3722{
3723    my ($self, $checker) = @_;
3724    $checker ||= XML::Checker->new;
3725
3726    $self->to_expat ($checker);
3727}
3728
3729sub to_expat
3730{
3731    my ($self, $iter) = @_;
3732
3733    $iter->Init;
3734
3735    for my $kid ($self->getChildNodes)
3736    {
3737	$kid->to_expat ($iter);
3738    }
3739    $iter->Final;
3740}
3741
3742sub check_sax
3743{
3744    my ($self, $checker) = @_;
3745    $checker ||= XML::Checker->new;
3746
3747    $self->to_sax (Handler => $checker);
3748}
3749
3750sub _to_sax
3751{
3752    my ($self, $doch, $dtdh, $enth) = @_;
3753
3754    $doch->start_document;
3755
3756    for my $kid ($self->getChildNodes)
3757    {
3758	$kid->_to_sax ($doch, $dtdh, $enth);
3759    }
3760    $doch->end_document;
3761}
3762
3763######################################################################
3764package XML::DOM::DocumentType;
3765######################################################################
3766use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS };
3767
3768BEGIN
3769{
3770    import XML::DOM::Node qw( :DEFAULT :Fields );
3771    import XML::DOM::Document qw( :Fields );
3772    XML::DOM::def_fields ("Entities Notations Name SysId PubId Internal", "XML::DOM::Node");
3773}
3774
3775use XML::DOM::DOMException;
3776use XML::DOM::NamedNodeMap;
3777
3778sub new
3779{
3780    my $class = shift;
3781    my $doc = shift;
3782
3783    my $self = bless [], $class;
3784
3785    $self->[_Doc] = $doc;
3786    $self->[_ReadOnly] = 1;
3787    $self->[_C] = new XML::DOM::NodeList;
3788
3789    $self->[_Entities] =  new XML::DOM::NamedNodeMap (Doc	=> $doc,
3790						      Parent	=> $self,
3791						      ReadOnly	=> 1);
3792    $self->[_Notations] = new XML::DOM::NamedNodeMap (Doc	=> $doc,
3793						      Parent	=> $self,
3794						      ReadOnly	=> 1);
3795    $self->setParams (@_);
3796    $self;
3797}
3798
3799sub getNodeType
3800{
3801    DOCUMENT_TYPE_NODE;
3802}
3803
3804sub getNodeName
3805{
3806    $_[0]->[_Name];
3807}
3808
3809sub getName
3810{
3811    $_[0]->[_Name];
3812}
3813
3814sub getEntities
3815{
3816    $_[0]->[_Entities];
3817}
3818
3819sub getNotations
3820{
3821    $_[0]->[_Notations];
3822}
3823
3824sub setParentNode
3825{
3826    my ($self, $parent) = @_;
3827    $self->SUPER::setParentNode ($parent);
3828
3829    $parent->[_Doctype] = $self
3830	if $parent->getNodeType == DOCUMENT_NODE;
3831}
3832
3833sub cloneNode
3834{
3835    my ($self, $deep) = @_;
3836
3837    my $node = new XML::DOM::DocumentType ($self->[_Doc], $self->[_Name],
3838					   $self->[_SysId], $self->[_PubId],
3839					   $self->[_Internal]);
3840
3841#?? does it make sense to make a shallow copy?
3842
3843    # clone the NamedNodeMaps
3844    $node->[_Entities] = $self->[_Entities]->cloneNode ($deep);
3845
3846    $node->[_Notations] = $self->[_Notations]->cloneNode ($deep);
3847
3848    $node->cloneChildren ($self, $deep);
3849
3850    $node;
3851}
3852
3853#------------------------------------------------------------
3854# Extra method implementations
3855
3856sub getSysId
3857{
3858    $_[0]->[_SysId];
3859}
3860
3861sub getPubId
3862{
3863    $_[0]->[_PubId];
3864}
3865
3866sub getInternal
3867{
3868    $_[0]->[_Internal];
3869}
3870
3871sub setSysId
3872{
3873    $_[0]->[_SysId] = $_[1];
3874}
3875
3876sub setPubId
3877{
3878    $_[0]->[_PubId] = $_[1];
3879}
3880
3881sub setInternal
3882{
3883    $_[0]->[_Internal] = $_[1];
3884}
3885
3886sub setName
3887{
3888    $_[0]->[_Name] = $_[1];
3889}
3890
3891sub removeChildHoodMemories
3892{
3893    my ($self, $dontWipeReadOnly) = @_;
3894
3895    my $parent = $self->[_Parent];
3896    if (defined $parent && $parent->getNodeType == DOCUMENT_NODE)
3897    {
3898	undef $parent->[_Doctype]; # was delete
3899    }
3900    $self->SUPER::removeChildHoodMemories;
3901}
3902
3903sub dispose
3904{
3905    my $self = shift;
3906
3907    $self->[_Entities]->dispose;
3908    $self->[_Notations]->dispose;
3909    $self->SUPER::dispose;
3910}
3911
3912sub setOwnerDocument
3913{
3914    my ($self, $doc) = @_;
3915    $self->SUPER::setOwnerDocument ($doc);
3916
3917    $self->[_Entities]->setOwnerDocument ($doc);
3918    $self->[_Notations]->setOwnerDocument ($doc);
3919}
3920
3921sub expandEntity
3922{
3923    my ($self, $ent, $param) = @_;
3924
3925    my $kid = $self->[_Entities]->getNamedItem ($ent);
3926    return $kid->getValue
3927	if (defined ($kid) && $param == $kid->isParameterEntity);
3928
3929    undef;	# entity not found
3930}
3931
3932sub getAttlistDecl
3933{
3934    my ($self, $elemName) = @_;
3935    for my $kid (@{$_[0]->[_C]})
3936    {
3937	return $kid if ($kid->getNodeType == ATTLIST_DECL_NODE &&
3938			$kid->getName eq $elemName);
3939    }
3940    undef;	# not found
3941}
3942
3943sub getElementDecl
3944{
3945    my ($self, $elemName) = @_;
3946    for my $kid (@{$_[0]->[_C]})
3947    {
3948	return $kid if ($kid->getNodeType == ELEMENT_DECL_NODE &&
3949			$kid->getName eq $elemName);
3950    }
3951    undef;	# not found
3952}
3953
3954sub addElementDecl
3955{
3956    my ($self, $name, $model, $hidden) = @_;
3957    my $node = $self->getElementDecl ($name);
3958
3959#?? could warn
3960    unless (defined $node)
3961    {
3962	$node = $self->[_Doc]->createElementDecl ($name, $model, $hidden);
3963	$self->appendChild ($node);
3964    }
3965    $node;
3966}
3967
3968sub addAttlistDecl
3969{
3970    my ($self, $name) = @_;
3971    my $node = $self->getAttlistDecl ($name);
3972
3973    unless (defined $node)
3974    {
3975	$node = $self->[_Doc]->createAttlistDecl ($name);
3976	$self->appendChild ($node);
3977    }
3978    $node;
3979}
3980
3981sub addNotation
3982{
3983    my $self = shift;
3984    my $node = $self->[_Doc]->createNotation (@_);
3985    $self->[_Notations]->setNamedItem ($node);
3986    $node;
3987}
3988
3989sub addEntity
3990{
3991    my $self = shift;
3992    my $node = $self->[_Doc]->createEntity (@_);
3993
3994    $self->[_Entities]->setNamedItem ($node);
3995    $node;
3996}
3997
3998# All AttDefs for a certain Element are merged into a single ATTLIST
3999sub addAttDef
4000{
4001    my $self = shift;
4002    my $elemName = shift;
4003
4004    # create the AttlistDecl if it doesn't exist yet
4005    my $attListDecl = $self->addAttlistDecl ($elemName);
4006    $attListDecl->addAttDef (@_);
4007}
4008
4009sub getDefaultAttrValue
4010{
4011    my ($self, $elem, $attr) = @_;
4012    my $elemNode = $self->getAttlistDecl ($elem);
4013    (defined $elemNode) ? $elemNode->getDefaultAttrValue ($attr) : undef;
4014}
4015
4016sub getEntity
4017{
4018    my ($self, $entity) = @_;
4019    $self->[_Entities]->getNamedItem ($entity);
4020}
4021
4022sub setParams
4023{
4024    my ($self, $name, $sysid, $pubid, $internal) = @_;
4025
4026    $self->[_Name] = $name;
4027
4028#?? not sure if we need to hold on to these...
4029    $self->[_SysId] = $sysid if defined $sysid;
4030    $self->[_PubId] = $pubid if defined $pubid;
4031    $self->[_Internal] = $internal if defined $internal;
4032
4033    $self;
4034}
4035
4036sub rejectChild
4037{
4038    # DOM Spec says: DocumentType -- no children
4039    not $XML::DOM::IgnoreReadOnly;
4040}
4041
4042sub print
4043{
4044    my ($self, $FILE) = @_;
4045
4046    my $name = $self->[_Name];
4047
4048    my $sysId = $self->[_SysId];
4049    my $pubId = $self->[_PubId];
4050
4051    $FILE->print ("<!DOCTYPE $name");
4052    if (defined $pubId)
4053    {
4054	$FILE->print (" PUBLIC \"$pubId\" \"$sysId\"");
4055    }
4056    elsif (defined $sysId)
4057    {
4058	$FILE->print (" SYSTEM \"$sysId\"");
4059    }
4060
4061    my @entities = @{$self->[_Entities]->getValues};
4062    my @notations = @{$self->[_Notations]->getValues};
4063    my @kids = @{$self->[_C]};
4064
4065    if (@entities || @notations || @kids)
4066    {
4067	$FILE->print (" [\x0A");
4068
4069	for my $kid (@entities)
4070	{
4071	    next if $kid->[_Hidden];
4072
4073	    $FILE->print (" ");
4074	    $kid->print ($FILE);
4075	    $FILE->print ("\x0A");
4076	}
4077
4078	for my $kid (@notations)
4079	{
4080	    next if $kid->[_Hidden];
4081
4082	    $FILE->print (" ");
4083	    $kid->print ($FILE);
4084	    $FILE->print ("\x0A");
4085	}
4086
4087	for my $kid (@kids)
4088	{
4089	    next if $kid->[_Hidden];
4090
4091	    $FILE->print (" ");
4092	    $kid->print ($FILE);
4093	    $FILE->print ("\x0A");
4094	}
4095	$FILE->print ("]");
4096    }
4097    $FILE->print (">");
4098}
4099
4100sub to_expat
4101{
4102    my ($self, $iter) = @_;
4103
4104    $iter->Doctype ($self->getName, $self->getSysId, $self->getPubId, $self->getInternal);
4105
4106    for my $ent ($self->getEntities->getValues)
4107    {
4108	next if $ent->[_Hidden];
4109	$ent->to_expat ($iter);
4110    }
4111
4112    for my $nota ($self->getNotations->getValues)
4113    {
4114	next if $nota->[_Hidden];
4115	$nota->to_expat ($iter);
4116    }
4117
4118    for my $kid ($self->getChildNodes)
4119    {
4120	next if $kid->[_Hidden];
4121	$kid->to_expat ($iter);
4122    }
4123}
4124
4125sub _to_sax
4126{
4127    my ($self, $doch, $dtdh, $enth) = @_;
4128
4129    $dtdh->doctype_decl ( { Name => $self->getName,
4130			    SystemId => $self->getSysId,
4131			    PublicId => $self->getPubId,
4132			    Internal => $self->getInternal });
4133
4134    for my $ent ($self->getEntities->getValues)
4135    {
4136	next if $ent->[_Hidden];
4137	$ent->_to_sax ($doch, $dtdh, $enth);
4138    }
4139
4140    for my $nota ($self->getNotations->getValues)
4141    {
4142	next if $nota->[_Hidden];
4143	$nota->_to_sax ($doch, $dtdh, $enth);
4144    }
4145
4146    for my $kid ($self->getChildNodes)
4147    {
4148	next if $kid->[_Hidden];
4149	$kid->_to_sax ($doch, $dtdh, $enth);
4150    }
4151}
4152
4153######################################################################
4154package XML::DOM::Parser;
4155######################################################################
4156use vars qw ( @ISA );
4157@ISA = qw( XML::Parser );
4158
4159sub new
4160{
4161    my ($class, %args) = @_;
4162
4163    $args{Style} = 'Dom';
4164    $class->SUPER::new (%args);
4165}
4166
4167# This method needed to be overriden so we can restore some global
4168# variables when an exception is thrown
4169sub parse
4170{
4171    my $self = shift;
4172
4173    local $XML::Parser::Dom::_DP_doc;
4174    local $XML::Parser::Dom::_DP_elem;
4175    local $XML::Parser::Dom::_DP_doctype;
4176    local $XML::Parser::Dom::_DP_in_prolog;
4177    local $XML::Parser::Dom::_DP_end_doc;
4178    local $XML::Parser::Dom::_DP_saw_doctype;
4179    local $XML::Parser::Dom::_DP_in_CDATA;
4180    local $XML::Parser::Dom::_DP_keep_CDATA;
4181    local $XML::Parser::Dom::_DP_last_text;
4182
4183
4184    # Temporarily disable checks that Expat already does (for performance)
4185    local $XML::DOM::SafeMode = 0;
4186    # Temporarily disable ReadOnly checks
4187    local $XML::DOM::IgnoreReadOnly = 1;
4188
4189    my $ret;
4190    eval {
4191	$ret = $self->SUPER::parse (@_);
4192    };
4193    my $err = $@;
4194
4195    if ($err)
4196    {
4197	my $doc = $XML::Parser::Dom::_DP_doc;
4198	if ($doc)
4199	{
4200	    $doc->dispose;
4201	}
4202	die $err;
4203    }
4204
4205    $ret;
4206}
4207
4208my $LWP_USER_AGENT;
4209sub set_LWP_UserAgent
4210{
4211    $LWP_USER_AGENT = shift;
4212}
4213
4214sub parsefile
4215{
4216    my $self = shift;
4217    my $url = shift;
4218
4219    # Any other URL schemes?
4220    if ($url =~ /^(https?|ftp|wais|gopher|file):/)
4221    {
4222	# Read the file from the web with LWP.
4223	#
4224	# Note that we read in the entire file, which may not be ideal
4225	# for large files. LWP::UserAgent also provides a callback style
4226	# request, which we could convert to a stream with a fork()...
4227
4228	my $result;
4229	eval
4230	{
4231	    use LWP::UserAgent;
4232
4233	    my $ua = $self->{LWP_UserAgent};
4234	    unless (defined $ua)
4235	    {
4236		unless (defined $LWP_USER_AGENT)
4237		{
4238		    $LWP_USER_AGENT = LWP::UserAgent->new;
4239
4240		    # Load proxy settings from environment variables, i.e.:
4241		    # http_proxy, ftp_proxy, no_proxy etc. (see LWP::UserAgent(3))
4242		    # You need these to go thru firewalls.
4243		    $LWP_USER_AGENT->env_proxy;
4244		}
4245		$ua = $LWP_USER_AGENT;
4246	    }
4247	    my $req = new HTTP::Request 'GET', $url;
4248	    my $response = $LWP_USER_AGENT->request ($req);
4249
4250	    # Parse the result of the HTTP request
4251	    $result = $self->parse ($response->content, @_);
4252	};
4253	if ($@)
4254	{
4255	    die "Couldn't parsefile [$url] with LWP: $@";
4256	}
4257	return $result;
4258    }
4259    else
4260    {
4261	return $self->SUPER::parsefile ($url, @_);
4262    }
4263}
4264
4265######################################################################
4266package XML::Parser::Dom;
4267######################################################################
4268
4269BEGIN
4270{
4271    import XML::DOM::Node qw( :Fields );
4272    import XML::DOM::CharacterData qw( :Fields );
4273}
4274
4275use vars qw( $_DP_doc
4276	     $_DP_elem
4277	     $_DP_doctype
4278	     $_DP_in_prolog
4279	     $_DP_end_doc
4280	     $_DP_saw_doctype
4281	     $_DP_in_CDATA
4282	     $_DP_keep_CDATA
4283	     $_DP_last_text
4284	     $_DP_level
4285	     $_DP_expand_pent
4286	   );
4287
4288# This adds a new Style to the XML::Parser class.
4289# From now on you can say: $parser = new XML::Parser ('Style' => 'Dom' );
4290# but that is *NOT* how a regular user should use it!
4291$XML::Parser::Built_In_Styles{Dom} = 1;
4292
4293sub Init
4294{
4295    $_DP_elem = $_DP_doc = new XML::DOM::Document();
4296    $_DP_doctype = new XML::DOM::DocumentType ($_DP_doc);
4297    $_DP_doc->setDoctype ($_DP_doctype);
4298    $_DP_keep_CDATA = $_[0]->{KeepCDATA};
4299
4300    # Prepare for document prolog
4301    $_DP_in_prolog = 1;
4302
4303    # We haven't passed the root element yet
4304    $_DP_end_doc = 0;
4305
4306    # Expand parameter entities in the DTD by default
4307
4308    $_DP_expand_pent = defined $_[0]->{ExpandParamEnt} ?
4309					$_[0]->{ExpandParamEnt} : 1;
4310    if ($_DP_expand_pent)
4311    {
4312	$_[0]->{DOM_Entity} = {};
4313    }
4314
4315    $_DP_level = 0;
4316
4317    undef $_DP_last_text;
4318}
4319
4320sub Final
4321{
4322    unless ($_DP_saw_doctype)
4323    {
4324	my $doctype = $_DP_doc->removeDoctype;
4325	$doctype->dispose;
4326    }
4327    $_DP_doc;
4328}
4329
4330sub Char
4331{
4332    my $str = $_[1];
4333
4334    if ($_DP_in_CDATA && $_DP_keep_CDATA)
4335    {
4336	undef $_DP_last_text;
4337	# Merge text with previous node if possible
4338	$_DP_elem->addCDATA ($str);
4339    }
4340    else
4341    {
4342	# Merge text with previous node if possible
4343	# Used to be:	$expat->{DOM_Element}->addText ($str);
4344	if ($_DP_last_text)
4345	{
4346	    $_DP_last_text->[_Data] .= $str;
4347	}
4348	else
4349	{
4350	    $_DP_last_text = $_DP_doc->createTextNode ($str);
4351	    $_DP_last_text->[_Parent] = $_DP_elem;
4352	    push @{$_DP_elem->[_C]}, $_DP_last_text;
4353	}
4354    }
4355}
4356
4357sub Start
4358{
4359    my ($expat, $elem, @attr) = @_;
4360    my $parent = $_DP_elem;
4361    my $doc = $_DP_doc;
4362
4363    if ($parent == $doc)
4364    {
4365	# End of document prolog, i.e. start of first Element
4366	$_DP_in_prolog = 0;
4367    }
4368
4369    undef $_DP_last_text;
4370    my $node = $doc->createElement ($elem);
4371    $_DP_elem = $node;
4372    $parent->appendChild ($node);
4373
4374    my $n = @attr;
4375    return unless $n;
4376
4377    # Add attributes
4378    my $first_default = $expat->specified_attr;
4379    my $i = 0;
4380    while ($i < $n)
4381    {
4382	my $specified = $i < $first_default;
4383	my $name = $attr[$i++];
4384	undef $_DP_last_text;
4385	my $attr = $doc->createAttribute ($name, $attr[$i++], $specified);
4386	$node->setAttributeNode ($attr);
4387    }
4388}
4389
4390sub End
4391{
4392    $_DP_elem = $_DP_elem->[_Parent];
4393    undef $_DP_last_text;
4394
4395    # Check for end of root element
4396    $_DP_end_doc = 1 if ($_DP_elem == $_DP_doc);
4397}
4398
4399# Called at end of file, i.e. whitespace following last closing tag
4400# Also for Entity references
4401# May also be called at other times...
4402sub Default
4403{
4404    my ($expat, $str) = @_;
4405
4406#    shift; deb ("Default", @_);
4407
4408    if ($_DP_in_prolog)	# still processing Document prolog...
4409    {
4410#?? could try to store this text later
4411#?? I've only seen whitespace here so far
4412    }
4413    elsif (!$_DP_end_doc)	# ignore whitespace at end of Document
4414    {
4415#	if ($expat->{NoExpand})
4416#	{
4417	    $str =~ /^&(.+);$/os;
4418	    return unless defined ($1);
4419	    # Got a TextDecl (<?xml ...?>) from an external entity here once
4420
4421	    $_DP_elem->appendChild (
4422			$_DP_doc->createEntityReference ($1));
4423	    undef $_DP_last_text;
4424#	}
4425#	else
4426#	{
4427#	    $expat->{DOM_Element}->addText ($str);
4428#	}
4429    }
4430}
4431
4432# XML::Parser 2.19 added support for CdataStart and CdataEnd handlers
4433# If they are not defined, the Default handler is called instead
4434# with the text "<![CDATA[" and "]]"
4435sub CdataStart
4436{
4437    $_DP_in_CDATA = 1;
4438}
4439
4440sub CdataEnd
4441{
4442    $_DP_in_CDATA = 0;
4443}
4444
4445my $START_MARKER = "__DOM__START__ENTITY__";
4446my $END_MARKER = "__DOM__END__ENTITY__";
4447
4448sub Comment
4449{
4450    undef $_DP_last_text;
4451
4452    # These comments were inserted by ExternEnt handler
4453    if ($_[1] =~ /(?:($START_MARKER)|($END_MARKER))/)
4454    {
4455	if ($1)	 # START
4456	{
4457	    $_DP_level++;
4458	}
4459	else
4460	{
4461	    $_DP_level--;
4462	}
4463    }
4464    else
4465    {
4466	my $comment = $_DP_doc->createComment ($_[1]);
4467	$_DP_elem->appendChild ($comment);
4468    }
4469}
4470
4471sub deb
4472{
4473#    return;
4474
4475    my $name = shift;
4476    print "$name (" . join(",", map {defined($_)?$_ : "(undef)"} @_) . ")\n";
4477}
4478
4479sub Doctype
4480{
4481    my $expat = shift;
4482#    deb ("Doctype", @_);
4483
4484    $_DP_doctype->setParams (@_);
4485    $_DP_saw_doctype = 1;
4486}
4487
4488sub Attlist
4489{
4490    my $expat = shift;
4491#    deb ("Attlist", @_);
4492
4493    $_[5] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0;
4494    $_DP_doctype->addAttDef (@_);
4495}
4496
4497sub XMLDecl
4498{
4499    my $expat = shift;
4500#    deb ("XMLDecl", @_);
4501
4502    undef $_DP_last_text;
4503    $_DP_doc->setXMLDecl (new XML::DOM::XMLDecl ($_DP_doc, @_));
4504}
4505
4506sub Entity
4507{
4508    my $expat = shift;
4509#    deb ("Entity", @_);
4510
4511    # Parameter Entities names are passed starting with '%'
4512    my $parameter = 0;
4513    if ($_[0] =~ /^%(.*)/s)
4514    {
4515	$_[0] = $1;
4516	$parameter = 1;
4517
4518	if (defined $_[2])	# was sysid specified?
4519	{
4520	    # Store the Entity mapping for use in ExternEnt
4521	    if (exists $expat->{DOM_Entity}->{$_[2]})
4522	    {
4523		# If this ever happens, the name of entity may be the wrong one
4524		# when writing out the Document.
4525		XML::DOM::warning ("Entity $_[2] is known as %$_[0] and %" .
4526				   $expat->{DOM_Entity}->{$_[2]});
4527	    }
4528	    else
4529	    {
4530		$expat->{DOM_Entity}->{$_[2]} = $_[0];
4531	    }
4532	    #?? remove this block when XML::Parser has better support
4533	}
4534    }
4535
4536    undef $_DP_last_text;
4537
4538    $_[5] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0;
4539    $_DP_doctype->addEntity ($parameter, @_);
4540}
4541
4542#
4543# Unparsed is called when it encounters e.g:
4544#
4545#   <!ENTITY logo SYSTEM "http://server/logo.gif" NDATA gif>
4546#
4547sub Unparsed
4548{
4549    Entity (@_);	# same as regular ENTITY, as far as DOM is concerned
4550}
4551
4552sub Element
4553{
4554    shift;
4555#    deb ("Element", @_);
4556
4557    undef $_DP_last_text;
4558    push @_, "Hidden" unless $_DP_expand_pent || $_DP_level == 0;
4559    $_DP_doctype->addElementDecl (@_);
4560}
4561
4562sub Notation
4563{
4564    shift;
4565#    deb ("Notation", @_);
4566
4567    undef $_DP_last_text;
4568    $_[4] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0;
4569    $_DP_doctype->addNotation (@_);
4570}
4571
4572sub Proc
4573{
4574    shift;
4575#    deb ("Proc", @_);
4576
4577    undef $_DP_last_text;
4578    push @_, "Hidden" unless $_DP_expand_pent || $_DP_level == 0;
4579    $_DP_elem->appendChild ($_DP_doc->createProcessingInstruction (@_));
4580}
4581
4582#
4583# ExternEnt is called when an external entity, such as:
4584#
4585#	<!ENTITY externalEntity PUBLIC "-//Enno//TEXT Enno's description//EN"
4586#	                        "http://server/descr.txt">
4587#
4588# is referenced in the document, e.g. with: &externalEntity;
4589# If ExternEnt is not specified, the entity reference is passed to the Default
4590# handler as e.g. "&externalEntity;", where an EntityReference object is added.
4591#
4592# Also for %externalEntity; references in the DTD itself.
4593#
4594# It can also be called when XML::Parser parses the DOCTYPE header
4595# (just before calling the DocType handler), when it contains a
4596# reference like "docbook.dtd" below:
4597#
4598#    <!DOCTYPE book PUBLIC "-//Norman Walsh//DTD DocBk XML V3.1.3//EN"
4599#	"docbook.dtd" [
4600#     ... rest of DTD ...
4601#
4602sub ExternEnt
4603{
4604    my ($expat, $base, $sysid, $pubid) = @_;
4605#    deb ("ExternEnt", @_);
4606
4607    # Invoke XML::Parser's default ExternEnt handler
4608    my $content;
4609    if ($XML::Parser::have_LWP)
4610    {
4611	$content = XML::Parser::lwp_ext_ent_handler (@_);
4612    }
4613    else
4614    {
4615	$content = XML::Parser::file_ext_ent_handler (@_);
4616    }
4617
4618    if ($_DP_expand_pent)
4619    {
4620	return $content;
4621    }
4622    else
4623    {
4624	my $entname = $expat->{DOM_Entity}->{$sysid};
4625	if (defined $entname)
4626	{
4627	    $_DP_doctype->appendChild ($_DP_doc->createEntityReference ($entname, 1));
4628            # Wrap the contents in special comments, so we know when we reach the
4629	    # end of parsing the entity. This way we can omit the contents from
4630	    # the DTD, when ExpandParamEnt is set to 0.
4631
4632	    return "<!-- $START_MARKER sysid=[$sysid] -->" .
4633		$content . "<!-- $END_MARKER sysid=[$sysid] -->";
4634	}
4635	else
4636	{
4637	    # We either read the entity ref'd by the system id in the
4638	    # <!DOCTYPE> header, or the entity was undefined.
4639	    # In either case, don't bother with maintaining the entity
4640	    # reference, just expand the contents.
4641	    return "<!-- $START_MARKER sysid=[DTD] -->" .
4642		$content . "<!-- $END_MARKER sysid=[DTD] -->";
4643	}
4644    }
4645}
4646
46471; # module return code
4648
4649__END__
4650
4651=head1 NAME
4652
4653XML::DOM - A perl module for building DOM Level 1 compliant document structures
4654
4655=head1 SYNOPSIS
4656
4657 use XML::DOM;
4658
4659 my $parser = new XML::DOM::Parser;
4660 my $doc = $parser->parsefile ("file.xml");
4661
4662 # print all HREF attributes of all CODEBASE elements
4663 my $nodes = $doc->getElementsByTagName ("CODEBASE");
4664 my $n = $nodes->getLength;
4665
4666 for (my $i = 0; $i < $n; $i++)
4667 {
4668     my $node = $nodes->item ($i);
4669     my $href = $node->getAttributeNode ("HREF");
4670     print $href->getValue . "\n";
4671 }
4672
4673 # Print doc file
4674 $doc->printToFile ("out.xml");
4675
4676 # Print to string
4677 print $doc->toString;
4678
4679 # Avoid memory leaks - cleanup circular references for garbage collection
4680 $doc->dispose;
4681
4682=head1 DESCRIPTION
4683
4684This module extends the XML::Parser module by Clark Cooper.
4685The XML::Parser module is built on top of XML::Parser::Expat,
4686which is a lower level interface to James Clark's expat library.
4687
4688XML::DOM::Parser is derived from XML::Parser. It parses XML strings or files
4689and builds a data structure that conforms to the API of the Document Object
4690Model as described at http://www.w3.org/TR/REC-DOM-Level-1.
4691See the XML::Parser manpage for other available features of the
4692XML::DOM::Parser class.
4693Note that the 'Style' property should not be used (it is set internally.)
4694
4695The XML::Parser I<NoExpand> option is more or less supported, in that it will
4696generate EntityReference objects whenever an entity reference is encountered
4697in character data. I'm not sure how useful this is. Any comments are welcome.
4698
4699As described in the synopsis, when you create an XML::DOM::Parser object,
4700the parse and parsefile methods create an I<XML::DOM::Document> object
4701from the specified input. This Document object can then be examined, modified and
4702written back out to a file or converted to a string.
4703
4704When using XML::DOM with XML::Parser version 2.19 and up, setting the
4705XML::DOM::Parser option I<KeepCDATA> to 1 will store CDATASections in
4706CDATASection nodes, instead of converting them to Text nodes.
4707Subsequent CDATASection nodes will be merged into one. Let me know if this
4708is a problem.
4709
4710When using XML::Parser 2.27 and above, you can suppress expansion of
4711parameter entity references (e.g. %pent;) in the DTD, by setting I<ParseParamEnt>
4712to 1 and I<ExpandParamEnt> to 0. See L<Hidden Nodes|/_Hidden_Nodes_> for details.
4713
4714A Document has a tree structure consisting of I<Node> objects. A Node may contain
4715other nodes, depending on its type.
4716A Document may have Element, Text, Comment, and CDATASection nodes.
4717Element nodes may have Attr, Element, Text, Comment, and CDATASection nodes.
4718The other nodes may not have any child nodes.
4719
4720This module adds several node types that are not part of the DOM spec (yet.)
4721These are: ElementDecl (for <!ELEMENT ...> declarations), AttlistDecl (for
4722<!ATTLIST ...> declarations), XMLDecl (for <?xml ...?> declarations) and AttDef
4723(for attribute definitions in an AttlistDecl.)
4724
4725=head1 XML::DOM Classes
4726
4727The XML::DOM module stores XML documents in a tree structure with a root node
4728of type XML::DOM::Document. Different nodes in tree represent different
4729parts of the XML file. The DOM Level 1 Specification defines the following
4730node types:
4731
4732=over 4
4733
4734=item * L<XML::DOM::Node> - Super class of all node types
4735
4736=item * L<XML::DOM::Document> - The root of the XML document
4737
4738=item * L<XML::DOM::DocumentType> - Describes the document structure: <!DOCTYPE root [ ... ]>
4739
4740=item * L<XML::DOM::Element> - An XML element: <elem attr="val"> ... </elem>
4741
4742=item * L<XML::DOM::Attr> - An XML element attribute: name="value"
4743
4744=item * L<XML::DOM::CharacterData> - Super class of Text, Comment and CDATASection
4745
4746=item * L<XML::DOM::Text> - Text in an XML element
4747
4748=item * L<XML::DOM::CDATASection> - Escaped block of text: <![CDATA[ text ]]>
4749
4750=item * L<XML::DOM::Comment> - An XML comment: <!-- comment -->
4751
4752=item * L<XML::DOM::EntityReference> - Refers to an ENTITY: &ent; or %ent;
4753
4754=item * L<XML::DOM::Entity> - An ENTITY definition: <!ENTITY ...>
4755
4756=item * L<XML::DOM::ProcessingInstruction> - <?PI target>
4757
4758=item * L<XML::DOM::DocumentFragment> - Lightweight node for cut & paste
4759
4760=item * L<XML::DOM::Notation> - An NOTATION definition: <!NOTATION ...>
4761
4762=back
4763
4764In addition, the XML::DOM module contains the following nodes that are not part
4765of the DOM Level 1 Specification:
4766
4767=over 4
4768
4769=item * L<XML::DOM::ElementDecl> - Defines an element: <!ELEMENT ...>
4770
4771=item * L<XML::DOM::AttlistDecl> - Defines one or more attributes in an <!ATTLIST ...>
4772
4773=item * L<XML::DOM::AttDef> - Defines one attribute in an <!ATTLIST ...>
4774
4775=item * L<XML::DOM::XMLDecl> - An XML declaration: <?xml version="1.0" ...>
4776
4777=back
4778
4779Other classes that are part of the DOM Level 1 Spec:
4780
4781=over 4
4782
4783=item * L<XML::DOM::Implementation> - Provides information about this implementation. Currently it doesn't do much.
4784
4785=item * L<XML::DOM::NodeList> - Used internally to store a node's child nodes. Also returned by getElementsByTagName.
4786
4787=item * L<XML::DOM::NamedNodeMap> - Used internally to store an element's attributes.
4788
4789=back
4790
4791Other classes that are not part of the DOM Level 1 Spec:
4792
4793=over 4
4794
4795=item * L<XML::DOM::Parser> - An non-validating XML parser that creates XML::DOM::Documents
4796
4797=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)
4798
4799=item * L<XML::Handler::BuildDOM> - A PerlSAX handler that creates XML::DOM::Documents.
4800
4801=back
4802
4803=head1 XML::DOM package
4804
4805=over 4
4806
4807=item Constant definitions
4808
4809The following predefined constants indicate which type of node it is.
4810
4811=back
4812
4813 UNKNOWN_NODE (0)                The node type is unknown (not part of DOM)
4814
4815 ELEMENT_NODE (1)                The node is an Element.
4816 ATTRIBUTE_NODE (2)              The node is an Attr.
4817 TEXT_NODE (3)                   The node is a Text node.
4818 CDATA_SECTION_NODE (4)          The node is a CDATASection.
4819 ENTITY_REFERENCE_NODE (5)       The node is an EntityReference.
4820 ENTITY_NODE (6)                 The node is an Entity.
4821 PROCESSING_INSTRUCTION_NODE (7) The node is a ProcessingInstruction.
4822 COMMENT_NODE (8)                The node is a Comment.
4823 DOCUMENT_NODE (9)               The node is a Document.
4824 DOCUMENT_TYPE_NODE (10)         The node is a DocumentType.
4825 DOCUMENT_FRAGMENT_NODE (11)     The node is a DocumentFragment.
4826 NOTATION_NODE (12)              The node is a Notation.
4827
4828 ELEMENT_DECL_NODE (13)		 The node is an ElementDecl (not part of DOM)
4829 ATT_DEF_NODE (14)		 The node is an AttDef (not part of DOM)
4830 XML_DECL_NODE (15)		 The node is an XMLDecl (not part of DOM)
4831 ATTLIST_DECL_NODE (16)		 The node is an AttlistDecl (not part of DOM)
4832
4833 Usage:
4834
4835   if ($node->getNodeType == ELEMENT_NODE)
4836   {
4837       print "It's an Element";
4838   }
4839
4840B<Not In DOM Spec>: The DOM Spec does not mention UNKNOWN_NODE and,
4841quite frankly, you should never encounter it. The last 4 node types were added
4842to support the 4 added node classes.
4843
4844=head2 Global Variables
4845
4846=over 4
4847
4848=item $VERSION
4849
4850The variable $XML::DOM::VERSION contains the version number of this
4851implementation, e.g. "1.07".
4852
4853=back
4854
4855=head2 METHODS
4856
4857These methods are not part of the DOM Level 1 Specification.
4858
4859=over 4
4860
4861=item getIgnoreReadOnly and ignoreReadOnly (readOnly)
4862
4863The DOM Level 1 Spec does not allow you to edit certain sections of the document,
4864e.g. the DocumentType, so by default this implementation throws DOMExceptions
4865(i.e. NO_MODIFICATION_ALLOWED_ERR) when you try to edit a readonly node.
4866These readonly checks can be disabled by (temporarily) setting the global
4867IgnoreReadOnly flag.
4868
4869The ignoreReadOnly method sets the global IgnoreReadOnly flag and returns its
4870previous value. The getIgnoreReadOnly method simply returns its current value.
4871
4872 my $oldIgnore = XML::DOM::ignoreReadOnly (1);
4873 eval {
4874 ... do whatever you want, catching any other exceptions ...
4875 };
4876 XML::DOM::ignoreReadOnly ($oldIgnore);     # restore previous value
4877
4878Another way to do it, using a local variable:
4879
4880 { # start new scope
4881    local $XML::DOM::IgnoreReadOnly = 1;
4882    ... do whatever you want, don't worry about exceptions ...
4883 } # end of scope ($IgnoreReadOnly is set back to its previous value)
4884
4885
4886=item isValidName (name)
4887
4888Whether the specified name is a valid "Name" as specified in the XML spec.
4889Characters with Unicode values > 127 are now also supported.
4890
4891=item getAllowReservedNames and allowReservedNames (boolean)
4892
4893The first method returns whether reserved names are allowed.
4894The second takes a boolean argument and sets whether reserved names are allowed.
4895The initial value is 1 (i.e. allow reserved names.)
4896
4897The XML spec states that "Names" starting with (X|x)(M|m)(L|l)
4898are reserved for future use. (Amusingly enough, the XML version of the XML spec
4899(REC-xml-19980210.xml) breaks that very rule by defining an ENTITY with the name
4900'xmlpio'.)
4901A "Name" in this context means the Name token as found in the BNF rules in the
4902XML spec.
4903
4904XML::DOM only checks for errors when you modify the DOM tree, not when the
4905DOM tree is built by the XML::DOM::Parser.
4906
4907=item setTagCompression (funcref)
4908
4909There are 3 possible styles for printing empty Element tags:
4910
4911=over 4
4912
4913=item Style 0
4914
4915 <empty/> or <empty attr="val"/>
4916
4917XML::DOM uses this style by default for all Elements.
4918
4919=item Style 1
4920
4921  <empty></empty> or <empty attr="val"></empty>
4922
4923=item Style 2
4924
4925  <empty /> or <empty attr="val" />
4926
4927This style is sometimes desired when using XHTML.
4928(Note the extra space before the slash "/")
4929See L<http://www.w3.org/TR/xhtml1> Appendix C for more details.
4930
4931=back
4932
4933By default XML::DOM compresses all empty Element tags (style 0.)
4934You can control which style is used for a particular Element by calling
4935XML::DOM::setTagCompression with a reference to a function that takes
49362 arguments. The first is the tag name of the Element, the second is the
4937XML::DOM::Element that is being printed.
4938The function should return 0, 1 or 2 to indicate which style should be used to
4939print the empty tag. E.g.
4940
4941 XML::DOM::setTagCompression (\&my_tag_compression);
4942
4943 sub my_tag_compression
4944 {
4945    my ($tag, $elem) = @_;
4946
4947    # Print empty br, hr and img tags like this: <br />
4948    return 2 if $tag =~ /^(br|hr|img)$/;
4949
4950    # Print other empty tags like this: <empty></empty>
4951    return 1;
4952 }
4953
4954=back
4955
4956=head1 IMPLEMENTATION DETAILS
4957
4958=over 4
4959
4960=item * Perl Mappings
4961
4962The value undef was used when the DOM Spec said null.
4963
4964The DOM Spec says: Applications must encode DOMString using UTF-16 (defined in
4965Appendix C.3 of [UNICODE] and Amendment 1 of [ISO-10646]).
4966In this implementation we use plain old Perl strings encoded in UTF-8 instead of
4967UTF-16.
4968
4969=item * Text and CDATASection nodes
4970
4971The Expat parser expands EntityReferences and CDataSection sections to
4972raw strings and does not indicate where it was found.
4973This implementation does therefore convert both to Text nodes at parse time.
4974CDATASection and EntityReference nodes that are added to an existing Document
4975(by the user) will be preserved.
4976
4977Also, subsequent Text nodes are always merged at parse time. Text nodes that are
4978added later can be merged with the normalize method. Consider using the addText
4979method when adding Text nodes.
4980
4981=item * Printing and toString
4982
4983When printing (and converting an XML Document to a string) the strings have to
4984encoded differently depending on where they occur. E.g. in a CDATASection all
4985substrings are allowed except for "]]>". In regular text, certain characters are
4986not allowed, e.g. ">" has to be converted to "&gt;".
4987These routines should be verified by someone who knows the details.
4988
4989=item * Quotes
4990
4991Certain sections in XML are quoted, like attribute values in an Element.
4992XML::Parser strips these quotes and the print methods in this implementation
4993always uses double quotes, so when parsing and printing a document, single quotes
4994may be converted to double quotes. The default value of an attribute definition
4995(AttDef) in an AttlistDecl, however, will maintain its quotes.
4996
4997=item * AttlistDecl
4998
4999Attribute declarations for a certain Element are always merged into a single
5000AttlistDecl object.
5001
5002=item * Comments
5003
5004Comments in the DOCTYPE section are not kept in the right place. They will become
5005child nodes of the Document.
5006
5007=item * Hidden Nodes
5008
5009Previous versions of XML::DOM would expand parameter entity references
5010(like B<%pent;>), so when printing the DTD, it would print the contents
5011of the external entity, instead of the parameter entity reference.
5012With this release (1.27), you can prevent this by setting the XML::DOM::Parser
5013options ParseParamEnt => 1 and ExpandParamEnt => 0.
5014
5015When it is parsing the contents of the external entities, it *DOES* still add
5016the nodes to the DocumentType, but it marks these nodes by setting
5017the 'Hidden' property. In addition, it adds an EntityReference node to the
5018DocumentType node.
5019
5020When printing the DocumentType node (or when using to_expat() or to_sax()),
5021the 'Hidden' nodes are suppressed, so you will see the parameter entity
5022reference instead of the contents of the external entities. See test case
5023t/dom_extent.t for an example.
5024
5025The reason for adding the 'Hidden' nodes to the DocumentType node, is that
5026the nodes may contain <!ENTITY> definitions that are referenced further
5027in the document. (Simply not adding the nodes to the DocumentType could
5028cause such entity references to be expanded incorrectly.)
5029
5030Note that you need XML::Parser 2.27 or higher for this to work correctly.
5031
5032=back
5033
5034=head1 SEE ALSO
5035
5036The Japanese version of this document by Takanori Kawai (Hippo2000)
5037at L<http://member.nifty.ne.jp/hippo2000/perltips/xml/dom.htm>
5038
5039The DOM Level 1 specification at L<http://www.w3.org/TR/REC-DOM-Level-1>
5040
5041The XML spec (Extensible Markup Language 1.0) at L<http://www.w3.org/TR/REC-xml>
5042
5043The L<XML::Parser> and L<XML::Parser::Expat> manual pages.
5044
5045=head1 CAVEATS
5046
5047The method getElementsByTagName() does not return a "live" NodeList.
5048Whether this is an actual caveat is debatable, but a few people on the
5049www-dom mailing list seemed to think so. I haven't decided yet. It's a pain
5050to implement, it slows things down and the benefits seem marginal.
5051Let me know what you think.
5052
5053(To subscribe to the www-dom mailing list send an email with the subject
5054"subscribe" to www-dom-request@w3.org. I only look here occasionally, so don't
5055send bug reports or suggestions about XML::DOM to this list, send them
5056to enno@att.com instead.)
5057
5058=head1 AUTHOR
5059
5060Send bug reports, hints, tips, suggestions to Enno Derksen at
5061<F<enno@att.com>>.
5062
5063Thanks to Clark Cooper for his help with the initial version.
5064
5065=cut
5066