home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / DOM.pm < prev    next >
Encoding:
Perl POD Document  |  2003-07-29  |  112.9 KB  |  5,126 lines

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