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 '"' => """, 107 ">" => ">", 108 "<" => "<", 109 "'" => "'", 110 "&" => "&" 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/]]>/]]>/go; 228 $str; 229} 230 231# 232# PI may not contain "?>" 233# 234sub encodeProcessingInstruction 235{ 236 my ($str) = shift; 237 $str =~ s/\?>/?>/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/--/--/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 "&" and "<" 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} : "]]>" /egs; 281 282#?? could there be references that should not be expanded? 283# e.g. should not replace &#nn; ¯ and &abc; 284# $str =~ s/&(?!($ReName|#[0-9]+|#x[0-9a-fA-F]+);)/&/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. { or Ͽ 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. "&" 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 ">". 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