| line | stmt | bran | cond | sub | pod | time | code | 
| 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 | 21 |  |  | 21 |  | 14525 | use strict; | 
|  | 21 |  |  |  |  | 24 |  | 
|  | 21 |  |  |  |  | 630 |  | 
| 31 |  |  |  |  |  |  |  | 
| 32 | 21 |  |  |  |  | 1549 | use vars qw( $VERSION @ISA @EXPORT | 
| 33 |  |  |  |  |  |  | $IgnoreReadOnly $SafeMode $TagStyle | 
| 34 |  |  |  |  |  |  | %DefaultEntities %DecodeDefaultEntity | 
| 35 | 21 |  |  | 21 |  | 63 | ); | 
|  | 21 |  |  |  |  | 20 |  | 
| 36 | 21 |  |  | 21 |  | 69 | use Carp; | 
|  | 21 |  |  |  |  | 24 |  | 
|  | 21 |  |  |  |  | 1146 |  | 
| 37 | 21 |  |  | 21 |  | 8177 | use XML::RegExp; | 
|  | 21 |  |  |  |  | 8509 |  | 
|  | 21 |  |  |  |  | 1720 |  | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | BEGIN | 
| 40 |  |  |  |  |  |  | { | 
| 41 | 21 |  |  | 21 |  | 14522 | require XML::Parser; | 
| 42 | 0 |  |  |  |  |  | $VERSION = '1.46'; | 
| 43 |  |  |  |  |  |  |  | 
| 44 | 0 |  |  |  |  |  | my $needVersion = '2.28'; | 
| 45 | 0 | 0 |  |  |  |  | die "need at least XML::Parser version $needVersion (current=${XML::Parser::VERSION})" | 
| 46 |  |  |  |  |  |  | unless $XML::Parser::VERSION >= $needVersion; | 
| 47 |  |  |  |  |  |  |  | 
| 48 | 0 |  |  |  |  |  | @ISA = qw( Exporter ); | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | # Constants for XML::DOM Node types | 
| 51 | 0 |  |  |  |  |  | @EXPORT = qw( | 
| 52 |  |  |  |  |  |  | UNKNOWN_NODE | 
| 53 |  |  |  |  |  |  | ELEMENT_NODE | 
| 54 |  |  |  |  |  |  | ATTRIBUTE_NODE | 
| 55 |  |  |  |  |  |  | TEXT_NODE | 
| 56 |  |  |  |  |  |  | CDATA_SECTION_NODE | 
| 57 |  |  |  |  |  |  | ENTITY_REFERENCE_NODE | 
| 58 |  |  |  |  |  |  | ENTITY_NODE | 
| 59 |  |  |  |  |  |  | PROCESSING_INSTRUCTION_NODE | 
| 60 |  |  |  |  |  |  | COMMENT_NODE | 
| 61 |  |  |  |  |  |  | DOCUMENT_NODE | 
| 62 |  |  |  |  |  |  | DOCUMENT_TYPE_NODE | 
| 63 |  |  |  |  |  |  | DOCUMENT_FRAGMENT_NODE | 
| 64 |  |  |  |  |  |  | NOTATION_NODE | 
| 65 |  |  |  |  |  |  | ELEMENT_DECL_NODE | 
| 66 |  |  |  |  |  |  | ATT_DEF_NODE | 
| 67 |  |  |  |  |  |  | XML_DECL_NODE | 
| 68 |  |  |  |  |  |  | ATTLIST_DECL_NODE | 
| 69 |  |  |  |  |  |  | ); | 
| 70 |  |  |  |  |  |  | } | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | #---- Constant definitions | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | # Node types | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | sub UNKNOWN_NODE                () { 0 }		# not in the DOM Spec | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | sub ELEMENT_NODE                () { 1 } | 
| 79 |  |  |  |  |  |  | sub ATTRIBUTE_NODE              () { 2 } | 
| 80 |  |  |  |  |  |  | sub TEXT_NODE                   () { 3 } | 
| 81 |  |  |  |  |  |  | sub CDATA_SECTION_NODE          () { 4 } | 
| 82 |  |  |  |  |  |  | sub ENTITY_REFERENCE_NODE       () { 5 } | 
| 83 |  |  |  |  |  |  | sub ENTITY_NODE                 () { 6 } | 
| 84 |  |  |  |  |  |  | sub PROCESSING_INSTRUCTION_NODE () { 7 } | 
| 85 |  |  |  |  |  |  | sub COMMENT_NODE                () { 8 } | 
| 86 |  |  |  |  |  |  | sub DOCUMENT_NODE               () { 9 } | 
| 87 |  |  |  |  |  |  | sub DOCUMENT_TYPE_NODE          () { 10} | 
| 88 |  |  |  |  |  |  | sub DOCUMENT_FRAGMENT_NODE      () { 11} | 
| 89 |  |  |  |  |  |  | sub NOTATION_NODE               () { 12} | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | sub ELEMENT_DECL_NODE		() { 13 }	# not in the DOM Spec | 
| 92 |  |  |  |  |  |  | sub ATT_DEF_NODE 		() { 14 }	# not in the DOM Spec | 
| 93 |  |  |  |  |  |  | sub XML_DECL_NODE 		() { 15 }	# not in the DOM Spec | 
| 94 |  |  |  |  |  |  | sub ATTLIST_DECL_NODE		() { 16 }	# not in the DOM Spec | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | %DefaultEntities = | 
| 97 |  |  |  |  |  |  | ( | 
| 98 |  |  |  |  |  |  | "quot"		=> '"', | 
| 99 |  |  |  |  |  |  | "gt"		=> ">", | 
| 100 |  |  |  |  |  |  | "lt"		=> "<", | 
| 101 |  |  |  |  |  |  | "apos"		=> "'", | 
| 102 |  |  |  |  |  |  | "amp"		=> "&" | 
| 103 |  |  |  |  |  |  | ); | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | %DecodeDefaultEntity = | 
| 106 |  |  |  |  |  |  | ( | 
| 107 |  |  |  |  |  |  | '"' => """, | 
| 108 |  |  |  |  |  |  | ">" => ">", | 
| 109 |  |  |  |  |  |  | "<" => "<", | 
| 110 |  |  |  |  |  |  | "'" => "'", | 
| 111 |  |  |  |  |  |  | "&" => "&" | 
| 112 |  |  |  |  |  |  | ); | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | # | 
| 115 |  |  |  |  |  |  | # If you don't want DOM warnings to use 'warn', override this method like this: | 
| 116 |  |  |  |  |  |  | # | 
| 117 |  |  |  |  |  |  | # { # start block scope | 
| 118 |  |  |  |  |  |  | #	local *XML::DOM::warning = \&my_warn; | 
| 119 |  |  |  |  |  |  | #	... your code here ... | 
| 120 |  |  |  |  |  |  | # } # end block scope (old XML::DOM::warning takes effect again) | 
| 121 |  |  |  |  |  |  | # | 
| 122 |  |  |  |  |  |  | sub warning	# static | 
| 123 |  |  |  |  |  |  | { | 
| 124 |  |  |  |  |  |  | warn @_; | 
| 125 |  |  |  |  |  |  | } | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | # | 
| 128 |  |  |  |  |  |  | # This method defines several things in the caller's package, so you can use named constants to | 
| 129 |  |  |  |  |  |  | # access the array that holds the member data, i.e. $self->[_Data]. It assumes the caller's package | 
| 130 |  |  |  |  |  |  | # defines a class that is implemented as a blessed array reference. | 
| 131 |  |  |  |  |  |  | # Note that this is very similar to using 'use fields' and 'use base'. | 
| 132 |  |  |  |  |  |  | # | 
| 133 |  |  |  |  |  |  | # E.g. if $fields eq "Name Model", $parent eq "XML::DOM::Node" and | 
| 134 |  |  |  |  |  |  | # XML::DOM::Node had "A B C" as fields and it was called from package "XML::DOM::ElementDecl", | 
| 135 |  |  |  |  |  |  | # then this code would basically do the following: | 
| 136 |  |  |  |  |  |  | # | 
| 137 |  |  |  |  |  |  | # package XML::DOM::ElementDecl; | 
| 138 |  |  |  |  |  |  | # | 
| 139 |  |  |  |  |  |  | # sub _Name  () { 3 }	# Note that parent class had three fields | 
| 140 |  |  |  |  |  |  | # sub _Model () { 4 } | 
| 141 |  |  |  |  |  |  | # | 
| 142 |  |  |  |  |  |  | # # Maps constant names (without '_') to constant (int) value | 
| 143 |  |  |  |  |  |  | # %HFIELDS = ( %XML::DOM::Node::HFIELDS, Name => _Name, Model => _Model ); | 
| 144 |  |  |  |  |  |  | # | 
| 145 |  |  |  |  |  |  | # # Define XML:DOM::ElementDecl as a subclass of XML::DOM::Node | 
| 146 |  |  |  |  |  |  | # @ISA = qw{ XML::DOM::Node }; | 
| 147 |  |  |  |  |  |  | # | 
| 148 |  |  |  |  |  |  | # # The following function names can be exported into the user's namespace. | 
| 149 |  |  |  |  |  |  | # @EXPORT_OK = qw{ _Name _Model }; | 
| 150 |  |  |  |  |  |  | # | 
| 151 |  |  |  |  |  |  | # # The following function names can be exported into the user's namespace | 
| 152 |  |  |  |  |  |  | # # with: import XML::DOM::ElementDecl qw( :Fields ); | 
| 153 |  |  |  |  |  |  | # %EXPORT_TAGS = ( Fields => qw{ _Name _Model } ); | 
| 154 |  |  |  |  |  |  | # | 
| 155 |  |  |  |  |  |  | sub def_fields	# static | 
| 156 |  |  |  |  |  |  | { | 
| 157 |  |  |  |  |  |  | my ($fields, $parent) = @_; | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | my ($pkg) = caller; | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | no strict 'refs'; | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | my @f = split (/\s+/, $fields); | 
| 164 |  |  |  |  |  |  | my $n = 0; | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | my %hfields; | 
| 167 |  |  |  |  |  |  | if (defined $parent) | 
| 168 |  |  |  |  |  |  | { | 
| 169 |  |  |  |  |  |  | my %pf = %{"$parent\::HFIELDS"}; | 
| 170 |  |  |  |  |  |  | %hfields = %pf; | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | $n = scalar (keys %pf); | 
| 173 |  |  |  |  |  |  | @{"$pkg\::ISA"} = ( $parent ); | 
| 174 |  |  |  |  |  |  | } | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  | my $i = $n; | 
| 177 |  |  |  |  |  |  | for (@f) | 
| 178 |  |  |  |  |  |  | { | 
| 179 |  |  |  |  |  |  | eval "sub $pkg\::_$_ () { $i }"; | 
| 180 |  |  |  |  |  |  | $hfields{$_} = $i; | 
| 181 |  |  |  |  |  |  | $i++; | 
| 182 |  |  |  |  |  |  | } | 
| 183 |  |  |  |  |  |  | %{"$pkg\::HFIELDS"} = %hfields; | 
| 184 |  |  |  |  |  |  | @{"$pkg\::EXPORT_OK"} = map { "_$_" } @f; | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | ${"$pkg\::EXPORT_TAGS"}{Fields} = [ map { "_$_" } @f ]; | 
| 187 |  |  |  |  |  |  | } | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | # sub blesh | 
| 190 |  |  |  |  |  |  | # { | 
| 191 |  |  |  |  |  |  | #     my $hashref = shift; | 
| 192 |  |  |  |  |  |  | #     my $class = shift; | 
| 193 |  |  |  |  |  |  | #     no strict 'refs'; | 
| 194 |  |  |  |  |  |  | #     my $self = bless [\%{"$class\::FIELDS"}], $class; | 
| 195 |  |  |  |  |  |  | #     if (defined $hashref) | 
| 196 |  |  |  |  |  |  | #     { | 
| 197 |  |  |  |  |  |  | # 	for (keys %$hashref) | 
| 198 |  |  |  |  |  |  | # 	{ | 
| 199 |  |  |  |  |  |  | # 	    $self->{$_} = $hashref->{$_}; | 
| 200 |  |  |  |  |  |  | # 	} | 
| 201 |  |  |  |  |  |  | #     } | 
| 202 |  |  |  |  |  |  | #     $self; | 
| 203 |  |  |  |  |  |  | # } | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  | # sub blesh2 | 
| 206 |  |  |  |  |  |  | # { | 
| 207 |  |  |  |  |  |  | #     my $hashref = shift; | 
| 208 |  |  |  |  |  |  | #     my $class = shift; | 
| 209 |  |  |  |  |  |  | #     no strict 'refs'; | 
| 210 |  |  |  |  |  |  | #     my $self = bless [\%{"$class\::FIELDS"}], $class; | 
| 211 |  |  |  |  |  |  | #     if (defined $hashref) | 
| 212 |  |  |  |  |  |  | #     { | 
| 213 |  |  |  |  |  |  | # 	for (keys %$hashref) | 
| 214 |  |  |  |  |  |  | # 	{ | 
| 215 |  |  |  |  |  |  | # 	    eval { $self->{$_} = $hashref->{$_}; }; | 
| 216 |  |  |  |  |  |  | # 	    croak "ERROR in field [$_] $@" if $@; | 
| 217 |  |  |  |  |  |  | # 	} | 
| 218 |  |  |  |  |  |  | #     } | 
| 219 |  |  |  |  |  |  | #     $self; | 
| 220 |  |  |  |  |  |  | #} | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  | # | 
| 223 |  |  |  |  |  |  | # CDATA section may not contain "]]>" | 
| 224 |  |  |  |  |  |  | # | 
| 225 |  |  |  |  |  |  | sub encodeCDATA | 
| 226 |  |  |  |  |  |  | { | 
| 227 |  |  |  |  |  |  | my ($str) = shift; | 
| 228 |  |  |  |  |  |  | $str =~ s/]]>/]]>/go; | 
| 229 |  |  |  |  |  |  | $str; | 
| 230 |  |  |  |  |  |  | } | 
| 231 |  |  |  |  |  |  |  | 
| 232 |  |  |  |  |  |  | # | 
| 233 |  |  |  |  |  |  | # PI may not contain "?>" | 
| 234 |  |  |  |  |  |  | # | 
| 235 |  |  |  |  |  |  | sub encodeProcessingInstruction | 
| 236 |  |  |  |  |  |  | { | 
| 237 |  |  |  |  |  |  | my ($str) = shift; | 
| 238 |  |  |  |  |  |  | $str =~ s/\?>/?>/go; | 
| 239 |  |  |  |  |  |  | $str; | 
| 240 |  |  |  |  |  |  | } | 
| 241 |  |  |  |  |  |  |  | 
| 242 |  |  |  |  |  |  | # | 
| 243 |  |  |  |  |  |  | #?? Not sure if this is right - must prevent double minus somehow... | 
| 244 |  |  |  |  |  |  | # | 
| 245 |  |  |  |  |  |  | sub encodeComment | 
| 246 |  |  |  |  |  |  | { | 
| 247 |  |  |  |  |  |  | my ($str) = shift; | 
| 248 |  |  |  |  |  |  | return undef unless defined $str; | 
| 249 |  |  |  |  |  |  |  | 
| 250 |  |  |  |  |  |  | $str =~ s/--/--/go; | 
| 251 |  |  |  |  |  |  | $str; | 
| 252 |  |  |  |  |  |  | } | 
| 253 |  |  |  |  |  |  |  | 
| 254 |  |  |  |  |  |  | # | 
| 255 |  |  |  |  |  |  | # For debugging | 
| 256 |  |  |  |  |  |  | # | 
| 257 |  |  |  |  |  |  | sub toHex | 
| 258 |  |  |  |  |  |  | { | 
| 259 |  |  |  |  |  |  | my $str = shift; | 
| 260 |  |  |  |  |  |  | my $len = length($str); | 
| 261 |  |  |  |  |  |  | my @a = unpack ("C$len", $str); | 
| 262 |  |  |  |  |  |  | my $s = ""; | 
| 263 |  |  |  |  |  |  | for (@a) | 
| 264 |  |  |  |  |  |  | { | 
| 265 |  |  |  |  |  |  | $s .= sprintf ("%02x", $_); | 
| 266 |  |  |  |  |  |  | } | 
| 267 |  |  |  |  |  |  | $s; | 
| 268 |  |  |  |  |  |  | } | 
| 269 |  |  |  |  |  |  |  | 
| 270 |  |  |  |  |  |  | # | 
| 271 |  |  |  |  |  |  | # 2nd parameter $default: list of Default Entity characters that need to be | 
| 272 |  |  |  |  |  |  | # converted (e.g. "&<" for conversion to "&" and "<" resp.) | 
| 273 |  |  |  |  |  |  | # | 
| 274 |  |  |  |  |  |  | sub encodeText | 
| 275 |  |  |  |  |  |  | { | 
| 276 |  |  |  |  |  |  | my ($str, $default) = @_; | 
| 277 |  |  |  |  |  |  | return undef unless defined $str; | 
| 278 |  |  |  |  |  |  |  | 
| 279 |  |  |  |  |  |  | if ($] >= 5.006) { | 
| 280 |  |  |  |  |  |  | $str =~ s/([$default])|(]]>)/ | 
| 281 |  |  |  |  |  |  | defined ($1) ? $DecodeDefaultEntity{$1} : "]]>" /egs; | 
| 282 |  |  |  |  |  |  | } | 
| 283 |  |  |  |  |  |  | else { | 
| 284 |  |  |  |  |  |  | $str =~ s/([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)|([$default])|(]]>)/ | 
| 285 |  |  |  |  |  |  | defined($1) ? XmlUtf8Decode ($1) : | 
| 286 |  |  |  |  |  |  | defined ($2) ? $DecodeDefaultEntity{$2} : "]]>" /egs; | 
| 287 |  |  |  |  |  |  | } | 
| 288 |  |  |  |  |  |  |  | 
| 289 |  |  |  |  |  |  | #?? could there be references that should not be expanded? | 
| 290 |  |  |  |  |  |  | # e.g. should not replace nn; ¯ and &abc; | 
| 291 |  |  |  |  |  |  | #    $str =~ s/&(?!($ReName|#[0-9]+|#x[0-9a-fA-F]+);)/&/go; | 
| 292 |  |  |  |  |  |  |  | 
| 293 |  |  |  |  |  |  | $str; | 
| 294 |  |  |  |  |  |  | } | 
| 295 |  |  |  |  |  |  |  | 
| 296 |  |  |  |  |  |  | # | 
| 297 |  |  |  |  |  |  | # Used by AttDef - default value | 
| 298 |  |  |  |  |  |  | # | 
| 299 |  |  |  |  |  |  | sub encodeAttrValue | 
| 300 |  |  |  |  |  |  | { | 
| 301 |  |  |  |  |  |  | encodeText (shift, '"&<>'); | 
| 302 |  |  |  |  |  |  | } | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  | # | 
| 305 |  |  |  |  |  |  | # Converts an integer (Unicode - ISO/IEC 10646) to a UTF-8 encoded character | 
| 306 |  |  |  |  |  |  | # sequence. | 
| 307 |  |  |  |  |  |  | # Used when converting e.g. { or Ͽ to a string value. | 
| 308 |  |  |  |  |  |  | # | 
| 309 |  |  |  |  |  |  | # Algorithm borrowed from expat/xmltok.c/XmlUtf8Encode() | 
| 310 |  |  |  |  |  |  | # | 
| 311 |  |  |  |  |  |  | # not checking for bad characters: < 0, x00-x08, x0B-x0C, x0E-x1F, xFFFE-xFFFF | 
| 312 |  |  |  |  |  |  | # | 
| 313 |  |  |  |  |  |  | sub XmlUtf8Encode | 
| 314 |  |  |  |  |  |  | { | 
| 315 |  |  |  |  |  |  | my $n = shift; | 
| 316 |  |  |  |  |  |  | if ($n < 0x80) | 
| 317 |  |  |  |  |  |  | { | 
| 318 |  |  |  |  |  |  | return chr ($n); | 
| 319 |  |  |  |  |  |  | } | 
| 320 |  |  |  |  |  |  | elsif ($n < 0x800) | 
| 321 |  |  |  |  |  |  | { | 
| 322 |  |  |  |  |  |  | return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80)); | 
| 323 |  |  |  |  |  |  | } | 
| 324 |  |  |  |  |  |  | elsif ($n < 0x10000) | 
| 325 |  |  |  |  |  |  | { | 
| 326 |  |  |  |  |  |  | return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80), | 
| 327 |  |  |  |  |  |  | (($n & 0x3f) | 0x80)); | 
| 328 |  |  |  |  |  |  | } | 
| 329 |  |  |  |  |  |  | elsif ($n < 0x110000) | 
| 330 |  |  |  |  |  |  | { | 
| 331 |  |  |  |  |  |  | return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80), | 
| 332 |  |  |  |  |  |  | ((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80)); | 
| 333 |  |  |  |  |  |  | } | 
| 334 |  |  |  |  |  |  | croak "number is too large for Unicode [$n] in &XmlUtf8Encode"; | 
| 335 |  |  |  |  |  |  | } | 
| 336 |  |  |  |  |  |  |  | 
| 337 |  |  |  |  |  |  | # | 
| 338 |  |  |  |  |  |  | # Opposite of XmlUtf8Decode plus it adds prefix "" or "" and suffix ";" | 
| 339 |  |  |  |  |  |  | # The 2nd parameter ($hex) indicates whether the result is hex encoded or not. | 
| 340 |  |  |  |  |  |  | # | 
| 341 |  |  |  |  |  |  | sub XmlUtf8Decode | 
| 342 |  |  |  |  |  |  | { | 
| 343 |  |  |  |  |  |  | my ($str, $hex) = @_; | 
| 344 |  |  |  |  |  |  | my $len = length ($str); | 
| 345 |  |  |  |  |  |  | my $n; | 
| 346 |  |  |  |  |  |  |  | 
| 347 |  |  |  |  |  |  | if ($len == 2) | 
| 348 |  |  |  |  |  |  | { | 
| 349 |  |  |  |  |  |  | my @n = unpack "C2", $str; | 
| 350 |  |  |  |  |  |  | $n = (($n[0] & 0x3f) << 6) + ($n[1] & 0x3f); | 
| 351 |  |  |  |  |  |  | } | 
| 352 |  |  |  |  |  |  | elsif ($len == 3) | 
| 353 |  |  |  |  |  |  | { | 
| 354 |  |  |  |  |  |  | my @n = unpack "C3", $str; | 
| 355 |  |  |  |  |  |  | $n = (($n[0] & 0x1f) << 12) + (($n[1] & 0x3f) << 6) + | 
| 356 |  |  |  |  |  |  | ($n[2] & 0x3f); | 
| 357 |  |  |  |  |  |  | } | 
| 358 |  |  |  |  |  |  | elsif ($len == 4) | 
| 359 |  |  |  |  |  |  | { | 
| 360 |  |  |  |  |  |  | my @n = unpack "C4", $str; | 
| 361 |  |  |  |  |  |  | $n = (($n[0] & 0x0f) << 18) + (($n[1] & 0x3f) << 12) + | 
| 362 |  |  |  |  |  |  | (($n[2] & 0x3f) << 6) + ($n[3] & 0x3f); | 
| 363 |  |  |  |  |  |  | } | 
| 364 |  |  |  |  |  |  | elsif ($len == 1)	# just to be complete... | 
| 365 |  |  |  |  |  |  | { | 
| 366 |  |  |  |  |  |  | $n = ord ($str); | 
| 367 |  |  |  |  |  |  | } | 
| 368 |  |  |  |  |  |  | else | 
| 369 |  |  |  |  |  |  | { | 
| 370 |  |  |  |  |  |  | croak "bad value [$str] for XmlUtf8Decode"; | 
| 371 |  |  |  |  |  |  | } | 
| 372 |  |  |  |  |  |  | $hex ? sprintf ("%x;", $n) : "$n;"; | 
| 373 |  |  |  |  |  |  | } | 
| 374 |  |  |  |  |  |  |  | 
| 375 |  |  |  |  |  |  | $IgnoreReadOnly = 0; | 
| 376 |  |  |  |  |  |  | $SafeMode = 1; | 
| 377 |  |  |  |  |  |  |  | 
| 378 |  |  |  |  |  |  | sub getIgnoreReadOnly | 
| 379 |  |  |  |  |  |  | { | 
| 380 |  |  |  |  |  |  | $IgnoreReadOnly; | 
| 381 |  |  |  |  |  |  | } | 
| 382 |  |  |  |  |  |  |  | 
| 383 |  |  |  |  |  |  | # | 
| 384 |  |  |  |  |  |  | # The global flag $IgnoreReadOnly is set to the specified value and the old | 
| 385 |  |  |  |  |  |  | # value of $IgnoreReadOnly is returned. | 
| 386 |  |  |  |  |  |  | # | 
| 387 |  |  |  |  |  |  | # To temporarily disable read-only related exceptions (i.e. when parsing | 
| 388 |  |  |  |  |  |  | # XML or temporarily), do the following: | 
| 389 |  |  |  |  |  |  | # | 
| 390 |  |  |  |  |  |  | # my $oldIgnore = XML::DOM::ignoreReadOnly (1); | 
| 391 |  |  |  |  |  |  | # ... do whatever you want ... | 
| 392 |  |  |  |  |  |  | # XML::DOM::ignoreReadOnly ($oldIgnore); | 
| 393 |  |  |  |  |  |  | # | 
| 394 |  |  |  |  |  |  | sub ignoreReadOnly | 
| 395 |  |  |  |  |  |  | { | 
| 396 |  |  |  |  |  |  | my $i = $IgnoreReadOnly; | 
| 397 |  |  |  |  |  |  | $IgnoreReadOnly = $_[0]; | 
| 398 |  |  |  |  |  |  | return $i; | 
| 399 |  |  |  |  |  |  | } | 
| 400 |  |  |  |  |  |  |  | 
| 401 |  |  |  |  |  |  | # | 
| 402 |  |  |  |  |  |  | # XML spec seems to break its own rules... (see ENTITY xmlpio) | 
| 403 |  |  |  |  |  |  | # | 
| 404 |  |  |  |  |  |  | sub forgiving_isValidName | 
| 405 |  |  |  |  |  |  | { | 
| 406 |  |  |  |  |  |  | use bytes;  # XML::RegExp expressed in terms encoded UTF8 | 
| 407 |  |  |  |  |  |  | $_[0] =~ /^$XML::RegExp::Name$/o; | 
| 408 |  |  |  |  |  |  | } | 
| 409 |  |  |  |  |  |  |  | 
| 410 |  |  |  |  |  |  | # | 
| 411 |  |  |  |  |  |  | # Don't allow names starting with xml (either case) | 
| 412 |  |  |  |  |  |  | # | 
| 413 |  |  |  |  |  |  | sub picky_isValidName | 
| 414 |  |  |  |  |  |  | { | 
| 415 |  |  |  |  |  |  | use bytes;  # XML::RegExp expressed in terms encoded UTF8 | 
| 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 $encoding = $self->getXMLDecl()->getEncoding(); | 
| 1222 |  |  |  |  |  |  | my $fh = new FileHandle ($fileName, ">:encoding($encoding)") || | 
| 1223 |  |  |  |  |  |  | croak "printToFile - can't open output file $fileName"; | 
| 1224 |  |  |  |  |  |  |  | 
| 1225 |  |  |  |  |  |  | $self->print ($fh); | 
| 1226 |  |  |  |  |  |  | $fh->close; | 
| 1227 |  |  |  |  |  |  | } | 
| 1228 |  |  |  |  |  |  |  | 
| 1229 |  |  |  |  |  |  | # | 
| 1230 |  |  |  |  |  |  | # Use print to print to a FileHandle object (see printToFile code) | 
| 1231 |  |  |  |  |  |  | # | 
| 1232 |  |  |  |  |  |  | sub printToFileHandle | 
| 1233 |  |  |  |  |  |  | { | 
| 1234 |  |  |  |  |  |  | my ($self, $FH) = @_; | 
| 1235 |  |  |  |  |  |  | my $pr = new XML::DOM::PrintToFileHandle ($FH); | 
| 1236 |  |  |  |  |  |  | $self->print ($pr); | 
| 1237 |  |  |  |  |  |  | } | 
| 1238 |  |  |  |  |  |  |  | 
| 1239 |  |  |  |  |  |  | # | 
| 1240 |  |  |  |  |  |  | # Used by AttDef::setDefault to convert unexpanded default attribute value | 
| 1241 |  |  |  |  |  |  | # | 
| 1242 |  |  |  |  |  |  | sub expandEntityRefs | 
| 1243 |  |  |  |  |  |  | { | 
| 1244 |  |  |  |  |  |  | my ($self, $str) = @_; | 
| 1245 |  |  |  |  |  |  | my $doctype = $self->[_Doc]->getDoctype; | 
| 1246 |  |  |  |  |  |  |  | 
| 1247 |  |  |  |  |  |  | use bytes;  # XML::RegExp expressed in terms encoded UTF8 | 
| 1248 |  |  |  |  |  |  | $str =~ s/&($XML::RegExp::Name|(#([0-9]+)|#x([0-9a-fA-F]+)));/ | 
| 1249 |  |  |  |  |  |  | defined($2) ? XML::DOM::XmlUtf8Encode ($3 || hex ($4)) | 
| 1250 |  |  |  |  |  |  | : expandEntityRef ($1, $doctype)/ego; | 
| 1251 |  |  |  |  |  |  | $str; | 
| 1252 |  |  |  |  |  |  | } | 
| 1253 |  |  |  |  |  |  |  | 
| 1254 |  |  |  |  |  |  | sub expandEntityRef | 
| 1255 |  |  |  |  |  |  | { | 
| 1256 |  |  |  |  |  |  | my ($entity, $doctype) = @_; | 
| 1257 |  |  |  |  |  |  |  | 
| 1258 |  |  |  |  |  |  | my $expanded = $XML::DOM::DefaultEntities{$entity}; | 
| 1259 |  |  |  |  |  |  | return $expanded if defined $expanded; | 
| 1260 |  |  |  |  |  |  |  | 
| 1261 |  |  |  |  |  |  | $expanded = $doctype->getEntity ($entity); | 
| 1262 |  |  |  |  |  |  | return $expanded->getValue if (defined $expanded); | 
| 1263 |  |  |  |  |  |  |  | 
| 1264 |  |  |  |  |  |  | #?? is this an error? | 
| 1265 |  |  |  |  |  |  | croak "Could not expand entity reference of [$entity]\n"; | 
| 1266 |  |  |  |  |  |  | #    return "&$entity;";	# entity not found | 
| 1267 |  |  |  |  |  |  | } | 
| 1268 |  |  |  |  |  |  |  | 
| 1269 |  |  |  |  |  |  | sub isHidden | 
| 1270 |  |  |  |  |  |  | { | 
| 1271 |  |  |  |  |  |  | $_[0]->[_Hidden]; | 
| 1272 |  |  |  |  |  |  | } | 
| 1273 |  |  |  |  |  |  |  | 
| 1274 |  |  |  |  |  |  | ###################################################################### | 
| 1275 |  |  |  |  |  |  | package XML::DOM::Attr; | 
| 1276 |  |  |  |  |  |  | ###################################################################### | 
| 1277 |  |  |  |  |  |  |  | 
| 1278 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 1279 |  |  |  |  |  |  |  | 
| 1280 |  |  |  |  |  |  | BEGIN | 
| 1281 |  |  |  |  |  |  | { | 
| 1282 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 1283 |  |  |  |  |  |  | XML::DOM::def_fields ("Name Specified", "XML::DOM::Node"); | 
| 1284 |  |  |  |  |  |  | } | 
| 1285 |  |  |  |  |  |  |  | 
| 1286 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 1287 |  |  |  |  |  |  | use Carp; | 
| 1288 |  |  |  |  |  |  |  | 
| 1289 |  |  |  |  |  |  | sub new | 
| 1290 |  |  |  |  |  |  | { | 
| 1291 |  |  |  |  |  |  | my ($class, $doc, $name, $value, $specified) = @_; | 
| 1292 |  |  |  |  |  |  |  | 
| 1293 |  |  |  |  |  |  | if ($XML::DOM::SafeMode) | 
| 1294 |  |  |  |  |  |  | { | 
| 1295 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 1296 |  |  |  |  |  |  | "bad Attr name [$name]") | 
| 1297 |  |  |  |  |  |  | unless XML::DOM::isValidName ($name); | 
| 1298 |  |  |  |  |  |  | } | 
| 1299 |  |  |  |  |  |  |  | 
| 1300 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 1301 |  |  |  |  |  |  |  | 
| 1302 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 1303 |  |  |  |  |  |  | $self->[_C] = new XML::DOM::NodeList; | 
| 1304 |  |  |  |  |  |  | $self->[_Name] = $name; | 
| 1305 |  |  |  |  |  |  |  | 
| 1306 |  |  |  |  |  |  | if (defined $value) | 
| 1307 |  |  |  |  |  |  | { | 
| 1308 |  |  |  |  |  |  | $self->setValue ($value); | 
| 1309 |  |  |  |  |  |  | $self->[_Specified] = (defined $specified) ? $specified : 1; | 
| 1310 |  |  |  |  |  |  | } | 
| 1311 |  |  |  |  |  |  | else | 
| 1312 |  |  |  |  |  |  | { | 
| 1313 |  |  |  |  |  |  | $self->[_Specified] = 0; | 
| 1314 |  |  |  |  |  |  | } | 
| 1315 |  |  |  |  |  |  | $self; | 
| 1316 |  |  |  |  |  |  | } | 
| 1317 |  |  |  |  |  |  |  | 
| 1318 |  |  |  |  |  |  | sub getNodeType | 
| 1319 |  |  |  |  |  |  | { | 
| 1320 |  |  |  |  |  |  | ATTRIBUTE_NODE; | 
| 1321 |  |  |  |  |  |  | } | 
| 1322 |  |  |  |  |  |  |  | 
| 1323 |  |  |  |  |  |  | sub isSpecified | 
| 1324 |  |  |  |  |  |  | { | 
| 1325 |  |  |  |  |  |  | $_[0]->[_Specified]; | 
| 1326 |  |  |  |  |  |  | } | 
| 1327 |  |  |  |  |  |  |  | 
| 1328 |  |  |  |  |  |  | sub getName | 
| 1329 |  |  |  |  |  |  | { | 
| 1330 |  |  |  |  |  |  | $_[0]->[_Name]; | 
| 1331 |  |  |  |  |  |  | } | 
| 1332 |  |  |  |  |  |  |  | 
| 1333 |  |  |  |  |  |  | sub getValue | 
| 1334 |  |  |  |  |  |  | { | 
| 1335 |  |  |  |  |  |  | my $self = shift; | 
| 1336 |  |  |  |  |  |  | my $value = ""; | 
| 1337 |  |  |  |  |  |  |  | 
| 1338 |  |  |  |  |  |  | for my $kid (@{$self->[_C]}) | 
| 1339 |  |  |  |  |  |  | { | 
| 1340 |  |  |  |  |  |  | $value .= $kid->getData if defined $kid->getData; | 
| 1341 |  |  |  |  |  |  | } | 
| 1342 |  |  |  |  |  |  | $value; | 
| 1343 |  |  |  |  |  |  | } | 
| 1344 |  |  |  |  |  |  |  | 
| 1345 |  |  |  |  |  |  | sub setValue | 
| 1346 |  |  |  |  |  |  | { | 
| 1347 |  |  |  |  |  |  | my ($self, $value) = @_; | 
| 1348 |  |  |  |  |  |  |  | 
| 1349 |  |  |  |  |  |  | # REC 1147 | 
| 1350 |  |  |  |  |  |  | $self->removeChildNodes; | 
| 1351 |  |  |  |  |  |  | $self->appendChild ($self->[_Doc]->createTextNode ($value)); | 
| 1352 |  |  |  |  |  |  | $self->[_Specified] = 1; | 
| 1353 |  |  |  |  |  |  | } | 
| 1354 |  |  |  |  |  |  |  | 
| 1355 |  |  |  |  |  |  | sub getNodeName | 
| 1356 |  |  |  |  |  |  | { | 
| 1357 |  |  |  |  |  |  | $_[0]->getName; | 
| 1358 |  |  |  |  |  |  | } | 
| 1359 |  |  |  |  |  |  |  | 
| 1360 |  |  |  |  |  |  | sub getNodeValue | 
| 1361 |  |  |  |  |  |  | { | 
| 1362 |  |  |  |  |  |  | $_[0]->getValue; | 
| 1363 |  |  |  |  |  |  | } | 
| 1364 |  |  |  |  |  |  |  | 
| 1365 |  |  |  |  |  |  | sub setNodeValue | 
| 1366 |  |  |  |  |  |  | { | 
| 1367 |  |  |  |  |  |  | $_[0]->setValue ($_[1]); | 
| 1368 |  |  |  |  |  |  | } | 
| 1369 |  |  |  |  |  |  |  | 
| 1370 |  |  |  |  |  |  | sub cloneNode | 
| 1371 |  |  |  |  |  |  | { | 
| 1372 |  |  |  |  |  |  | my ($self) = @_;	# parameter deep is ignored | 
| 1373 |  |  |  |  |  |  |  | 
| 1374 |  |  |  |  |  |  | my $node = $self->[_Doc]->createAttribute ($self->getName); | 
| 1375 |  |  |  |  |  |  | $node->[_Specified] = $self->[_Specified]; | 
| 1376 |  |  |  |  |  |  | $node->[_ReadOnly] = 1 if $self->[_ReadOnly]; | 
| 1377 |  |  |  |  |  |  |  | 
| 1378 |  |  |  |  |  |  | $node->cloneChildren ($self, 1); | 
| 1379 |  |  |  |  |  |  | $node; | 
| 1380 |  |  |  |  |  |  | } | 
| 1381 |  |  |  |  |  |  |  | 
| 1382 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 1383 |  |  |  |  |  |  | # Extra method implementations | 
| 1384 |  |  |  |  |  |  | # | 
| 1385 |  |  |  |  |  |  |  | 
| 1386 |  |  |  |  |  |  | sub isReadOnly | 
| 1387 |  |  |  |  |  |  | { | 
| 1388 |  |  |  |  |  |  | # ReadOnly property is set if it's part of a AttDef | 
| 1389 |  |  |  |  |  |  | ! $XML::DOM::IgnoreReadOnly && defined ($_[0]->[_ReadOnly]); | 
| 1390 |  |  |  |  |  |  | } | 
| 1391 |  |  |  |  |  |  |  | 
| 1392 |  |  |  |  |  |  | sub print | 
| 1393 |  |  |  |  |  |  | { | 
| 1394 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 1395 |  |  |  |  |  |  |  | 
| 1396 |  |  |  |  |  |  | my $name = $self->[_Name]; | 
| 1397 |  |  |  |  |  |  |  | 
| 1398 |  |  |  |  |  |  | $FILE->print ("$name=\""); | 
| 1399 |  |  |  |  |  |  | for my $kid (@{$self->[_C]}) | 
| 1400 |  |  |  |  |  |  | { | 
| 1401 |  |  |  |  |  |  | if ($kid->getNodeType == TEXT_NODE) | 
| 1402 |  |  |  |  |  |  | { | 
| 1403 |  |  |  |  |  |  | $FILE->print (XML::DOM::encodeAttrValue ($kid->getData)); | 
| 1404 |  |  |  |  |  |  | } | 
| 1405 |  |  |  |  |  |  | else	# ENTITY_REFERENCE_NODE | 
| 1406 |  |  |  |  |  |  | { | 
| 1407 |  |  |  |  |  |  | $kid->print ($FILE); | 
| 1408 |  |  |  |  |  |  | } | 
| 1409 |  |  |  |  |  |  | } | 
| 1410 |  |  |  |  |  |  | $FILE->print ("\""); | 
| 1411 |  |  |  |  |  |  | } | 
| 1412 |  |  |  |  |  |  |  | 
| 1413 |  |  |  |  |  |  | sub rejectChild | 
| 1414 |  |  |  |  |  |  | { | 
| 1415 |  |  |  |  |  |  | my $t = $_[1]->getNodeType; | 
| 1416 |  |  |  |  |  |  |  | 
| 1417 |  |  |  |  |  |  | $t != TEXT_NODE | 
| 1418 |  |  |  |  |  |  | && $t != ENTITY_REFERENCE_NODE; | 
| 1419 |  |  |  |  |  |  | } | 
| 1420 |  |  |  |  |  |  |  | 
| 1421 |  |  |  |  |  |  | ###################################################################### | 
| 1422 |  |  |  |  |  |  | package XML::DOM::ProcessingInstruction; | 
| 1423 |  |  |  |  |  |  | ###################################################################### | 
| 1424 |  |  |  |  |  |  |  | 
| 1425 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 1426 |  |  |  |  |  |  | BEGIN | 
| 1427 |  |  |  |  |  |  | { | 
| 1428 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 1429 |  |  |  |  |  |  | XML::DOM::def_fields ("Target Data", "XML::DOM::Node"); | 
| 1430 |  |  |  |  |  |  | } | 
| 1431 |  |  |  |  |  |  |  | 
| 1432 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 1433 |  |  |  |  |  |  | use Carp; | 
| 1434 |  |  |  |  |  |  |  | 
| 1435 |  |  |  |  |  |  | sub new | 
| 1436 |  |  |  |  |  |  | { | 
| 1437 |  |  |  |  |  |  | my ($class, $doc, $target, $data, $hidden) = @_; | 
| 1438 |  |  |  |  |  |  |  | 
| 1439 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 1440 |  |  |  |  |  |  | "bad ProcessingInstruction Target [$target]") | 
| 1441 |  |  |  |  |  |  | unless (XML::DOM::isValidName ($target) && $target !~ /^xml$/io); | 
| 1442 |  |  |  |  |  |  |  | 
| 1443 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 1444 |  |  |  |  |  |  |  | 
| 1445 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 1446 |  |  |  |  |  |  | $self->[_Target] = $target; | 
| 1447 |  |  |  |  |  |  | $self->[_Data] = $data; | 
| 1448 |  |  |  |  |  |  | $self->[_Hidden] = $hidden; | 
| 1449 |  |  |  |  |  |  | $self; | 
| 1450 |  |  |  |  |  |  | } | 
| 1451 |  |  |  |  |  |  |  | 
| 1452 |  |  |  |  |  |  | sub getNodeType | 
| 1453 |  |  |  |  |  |  | { | 
| 1454 |  |  |  |  |  |  | PROCESSING_INSTRUCTION_NODE; | 
| 1455 |  |  |  |  |  |  | } | 
| 1456 |  |  |  |  |  |  |  | 
| 1457 |  |  |  |  |  |  | sub getTarget | 
| 1458 |  |  |  |  |  |  | { | 
| 1459 |  |  |  |  |  |  | $_[0]->[_Target]; | 
| 1460 |  |  |  |  |  |  | } | 
| 1461 |  |  |  |  |  |  |  | 
| 1462 |  |  |  |  |  |  | sub getData | 
| 1463 |  |  |  |  |  |  | { | 
| 1464 |  |  |  |  |  |  | $_[0]->[_Data]; | 
| 1465 |  |  |  |  |  |  | } | 
| 1466 |  |  |  |  |  |  |  | 
| 1467 |  |  |  |  |  |  | sub setData | 
| 1468 |  |  |  |  |  |  | { | 
| 1469 |  |  |  |  |  |  | my ($self, $data) = @_; | 
| 1470 |  |  |  |  |  |  |  | 
| 1471 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, | 
| 1472 |  |  |  |  |  |  | "node is ReadOnly") | 
| 1473 |  |  |  |  |  |  | if $self->isReadOnly; | 
| 1474 |  |  |  |  |  |  |  | 
| 1475 |  |  |  |  |  |  | $self->[_Data] = $data; | 
| 1476 |  |  |  |  |  |  | } | 
| 1477 |  |  |  |  |  |  |  | 
| 1478 |  |  |  |  |  |  | sub getNodeName | 
| 1479 |  |  |  |  |  |  | { | 
| 1480 |  |  |  |  |  |  | $_[0]->[_Target]; | 
| 1481 |  |  |  |  |  |  | } | 
| 1482 |  |  |  |  |  |  |  | 
| 1483 |  |  |  |  |  |  | # | 
| 1484 |  |  |  |  |  |  | # Same as getData | 
| 1485 |  |  |  |  |  |  | # | 
| 1486 |  |  |  |  |  |  | sub getNodeValue | 
| 1487 |  |  |  |  |  |  | { | 
| 1488 |  |  |  |  |  |  | $_[0]->[_Data]; | 
| 1489 |  |  |  |  |  |  | } | 
| 1490 |  |  |  |  |  |  |  | 
| 1491 |  |  |  |  |  |  | sub setNodeValue | 
| 1492 |  |  |  |  |  |  | { | 
| 1493 |  |  |  |  |  |  | $_[0]->setData ($_[1]); | 
| 1494 |  |  |  |  |  |  | } | 
| 1495 |  |  |  |  |  |  |  | 
| 1496 |  |  |  |  |  |  | sub cloneNode | 
| 1497 |  |  |  |  |  |  | { | 
| 1498 |  |  |  |  |  |  | my $self = shift; | 
| 1499 |  |  |  |  |  |  | $self->[_Doc]->createProcessingInstruction ($self->getTarget, | 
| 1500 |  |  |  |  |  |  | $self->getData, | 
| 1501 |  |  |  |  |  |  | $self->isHidden); | 
| 1502 |  |  |  |  |  |  | } | 
| 1503 |  |  |  |  |  |  |  | 
| 1504 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 1505 |  |  |  |  |  |  | # Extra method implementations | 
| 1506 |  |  |  |  |  |  |  | 
| 1507 |  |  |  |  |  |  | sub isReadOnly | 
| 1508 |  |  |  |  |  |  | { | 
| 1509 |  |  |  |  |  |  | return 0 if $XML::DOM::IgnoreReadOnly; | 
| 1510 |  |  |  |  |  |  |  | 
| 1511 |  |  |  |  |  |  | my $pa = $_[0]->[_Parent]; | 
| 1512 |  |  |  |  |  |  | defined ($pa) ? $pa->isReadOnly : 0; | 
| 1513 |  |  |  |  |  |  | } | 
| 1514 |  |  |  |  |  |  |  | 
| 1515 |  |  |  |  |  |  | sub print | 
| 1516 |  |  |  |  |  |  | { | 
| 1517 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 1518 |  |  |  |  |  |  |  | 
| 1519 |  |  |  |  |  |  | $FILE->print (""); | 
| 1520 |  |  |  |  |  |  | $FILE->print ($self->[_Target]); | 
| 1521 |  |  |  |  |  |  | $FILE->print (" "); | 
| 1522 |  |  |  |  |  |  | $FILE->print (XML::DOM::encodeProcessingInstruction ($self->[_Data])); | 
| 1523 |  |  |  |  |  |  | $FILE->print ("?>"); | 
| 1524 |  |  |  |  |  |  | } | 
| 1525 |  |  |  |  |  |  |  | 
| 1526 |  |  |  |  |  |  | sub _to_sax { | 
| 1527 |  |  |  |  |  |  | my ($self, $doch) = @_; | 
| 1528 |  |  |  |  |  |  | $doch->processing_instruction({Target => $self->getTarget, Data => $self->getData}); | 
| 1529 |  |  |  |  |  |  | } | 
| 1530 |  |  |  |  |  |  |  | 
| 1531 |  |  |  |  |  |  | ###################################################################### | 
| 1532 |  |  |  |  |  |  | package XML::DOM::Notation; | 
| 1533 |  |  |  |  |  |  | ###################################################################### | 
| 1534 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 1535 |  |  |  |  |  |  |  | 
| 1536 |  |  |  |  |  |  | BEGIN | 
| 1537 |  |  |  |  |  |  | { | 
| 1538 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 1539 |  |  |  |  |  |  | XML::DOM::def_fields ("Name Base SysId PubId", "XML::DOM::Node"); | 
| 1540 |  |  |  |  |  |  | } | 
| 1541 |  |  |  |  |  |  |  | 
| 1542 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 1543 |  |  |  |  |  |  | use Carp; | 
| 1544 |  |  |  |  |  |  |  | 
| 1545 |  |  |  |  |  |  | sub new | 
| 1546 |  |  |  |  |  |  | { | 
| 1547 |  |  |  |  |  |  | my ($class, $doc, $name, $base, $sysId, $pubId, $hidden) = @_; | 
| 1548 |  |  |  |  |  |  |  | 
| 1549 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 1550 |  |  |  |  |  |  | "bad Notation Name [$name]") | 
| 1551 |  |  |  |  |  |  | unless XML::DOM::isValidName ($name); | 
| 1552 |  |  |  |  |  |  |  | 
| 1553 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 1554 |  |  |  |  |  |  |  | 
| 1555 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 1556 |  |  |  |  |  |  | $self->[_Name] = $name; | 
| 1557 |  |  |  |  |  |  | $self->[_Base] = $base; | 
| 1558 |  |  |  |  |  |  | $self->[_SysId] = $sysId; | 
| 1559 |  |  |  |  |  |  | $self->[_PubId] = $pubId; | 
| 1560 |  |  |  |  |  |  | $self->[_Hidden] = $hidden; | 
| 1561 |  |  |  |  |  |  | $self; | 
| 1562 |  |  |  |  |  |  | } | 
| 1563 |  |  |  |  |  |  |  | 
| 1564 |  |  |  |  |  |  | sub getNodeType | 
| 1565 |  |  |  |  |  |  | { | 
| 1566 |  |  |  |  |  |  | NOTATION_NODE; | 
| 1567 |  |  |  |  |  |  | } | 
| 1568 |  |  |  |  |  |  |  | 
| 1569 |  |  |  |  |  |  | sub getPubId | 
| 1570 |  |  |  |  |  |  | { | 
| 1571 |  |  |  |  |  |  | $_[0]->[_PubId]; | 
| 1572 |  |  |  |  |  |  | } | 
| 1573 |  |  |  |  |  |  |  | 
| 1574 |  |  |  |  |  |  | sub setPubId | 
| 1575 |  |  |  |  |  |  | { | 
| 1576 |  |  |  |  |  |  | $_[0]->[_PubId] = $_[1]; | 
| 1577 |  |  |  |  |  |  | } | 
| 1578 |  |  |  |  |  |  |  | 
| 1579 |  |  |  |  |  |  | sub getSysId | 
| 1580 |  |  |  |  |  |  | { | 
| 1581 |  |  |  |  |  |  | $_[0]->[_SysId]; | 
| 1582 |  |  |  |  |  |  | } | 
| 1583 |  |  |  |  |  |  |  | 
| 1584 |  |  |  |  |  |  | sub setSysId | 
| 1585 |  |  |  |  |  |  | { | 
| 1586 |  |  |  |  |  |  | $_[0]->[_SysId] = $_[1]; | 
| 1587 |  |  |  |  |  |  | } | 
| 1588 |  |  |  |  |  |  |  | 
| 1589 |  |  |  |  |  |  | sub getName | 
| 1590 |  |  |  |  |  |  | { | 
| 1591 |  |  |  |  |  |  | $_[0]->[_Name]; | 
| 1592 |  |  |  |  |  |  | } | 
| 1593 |  |  |  |  |  |  |  | 
| 1594 |  |  |  |  |  |  | sub setName | 
| 1595 |  |  |  |  |  |  | { | 
| 1596 |  |  |  |  |  |  | $_[0]->[_Name] = $_[1]; | 
| 1597 |  |  |  |  |  |  | } | 
| 1598 |  |  |  |  |  |  |  | 
| 1599 |  |  |  |  |  |  | sub getBase | 
| 1600 |  |  |  |  |  |  | { | 
| 1601 |  |  |  |  |  |  | $_[0]->[_Base]; | 
| 1602 |  |  |  |  |  |  | } | 
| 1603 |  |  |  |  |  |  |  | 
| 1604 |  |  |  |  |  |  | sub getNodeName | 
| 1605 |  |  |  |  |  |  | { | 
| 1606 |  |  |  |  |  |  | $_[0]->[_Name]; | 
| 1607 |  |  |  |  |  |  | } | 
| 1608 |  |  |  |  |  |  |  | 
| 1609 |  |  |  |  |  |  | sub print | 
| 1610 |  |  |  |  |  |  | { | 
| 1611 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 1612 |  |  |  |  |  |  |  | 
| 1613 |  |  |  |  |  |  | my $name = $self->[_Name]; | 
| 1614 |  |  |  |  |  |  | my $sysId = $self->[_SysId]; | 
| 1615 |  |  |  |  |  |  | my $pubId = $self->[_PubId]; | 
| 1616 |  |  |  |  |  |  |  | 
| 1617 |  |  |  |  |  |  | $FILE->print (" | 
| 1618 |  |  |  |  |  |  |  | 
| 1619 |  |  |  |  |  |  | if (defined $pubId) | 
| 1620 |  |  |  |  |  |  | { | 
| 1621 |  |  |  |  |  |  | $FILE->print (" PUBLIC \"$pubId\""); | 
| 1622 |  |  |  |  |  |  | } | 
| 1623 |  |  |  |  |  |  | if (defined $sysId) | 
| 1624 |  |  |  |  |  |  | { | 
| 1625 |  |  |  |  |  |  | $FILE->print (" SYSTEM \"$sysId\""); | 
| 1626 |  |  |  |  |  |  | } | 
| 1627 |  |  |  |  |  |  | $FILE->print (">"); | 
| 1628 |  |  |  |  |  |  | } | 
| 1629 |  |  |  |  |  |  |  | 
| 1630 |  |  |  |  |  |  | sub cloneNode | 
| 1631 |  |  |  |  |  |  | { | 
| 1632 |  |  |  |  |  |  | my ($self) = @_; | 
| 1633 |  |  |  |  |  |  | $self->[_Doc]->createNotation ($self->[_Name], $self->[_Base], | 
| 1634 |  |  |  |  |  |  | $self->[_SysId], $self->[_PubId], | 
| 1635 |  |  |  |  |  |  | $self->[_Hidden]); | 
| 1636 |  |  |  |  |  |  | } | 
| 1637 |  |  |  |  |  |  |  | 
| 1638 |  |  |  |  |  |  | sub to_expat | 
| 1639 |  |  |  |  |  |  | { | 
| 1640 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 1641 |  |  |  |  |  |  | $iter->Notation ($self->getName, $self->getBase, | 
| 1642 |  |  |  |  |  |  | $self->getSysId, $self->getPubId); | 
| 1643 |  |  |  |  |  |  | } | 
| 1644 |  |  |  |  |  |  |  | 
| 1645 |  |  |  |  |  |  | sub _to_sax | 
| 1646 |  |  |  |  |  |  | { | 
| 1647 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 1648 |  |  |  |  |  |  | $dtdh->notation_decl ( { Name => $self->getName, | 
| 1649 |  |  |  |  |  |  | Base => $self->getBase, | 
| 1650 |  |  |  |  |  |  | SystemId => $self->getSysId, | 
| 1651 |  |  |  |  |  |  | PublicId => $self->getPubId }); | 
| 1652 |  |  |  |  |  |  | } | 
| 1653 |  |  |  |  |  |  |  | 
| 1654 |  |  |  |  |  |  | ###################################################################### | 
| 1655 |  |  |  |  |  |  | package XML::DOM::Entity; | 
| 1656 |  |  |  |  |  |  | ###################################################################### | 
| 1657 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 1658 |  |  |  |  |  |  |  | 
| 1659 |  |  |  |  |  |  | BEGIN | 
| 1660 |  |  |  |  |  |  | { | 
| 1661 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 1662 |  |  |  |  |  |  | XML::DOM::def_fields ("NotationName Parameter Value Ndata SysId PubId", "XML::DOM::Node"); | 
| 1663 |  |  |  |  |  |  | } | 
| 1664 |  |  |  |  |  |  |  | 
| 1665 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 1666 |  |  |  |  |  |  | use Carp; | 
| 1667 |  |  |  |  |  |  |  | 
| 1668 |  |  |  |  |  |  | sub new | 
| 1669 |  |  |  |  |  |  | { | 
| 1670 |  |  |  |  |  |  | my ($class, $doc, $notationName, $value, $sysId, $pubId, $ndata, $isParam, $hidden) = @_; | 
| 1671 |  |  |  |  |  |  |  | 
| 1672 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 1673 |  |  |  |  |  |  | "bad Entity Name [$notationName]") | 
| 1674 |  |  |  |  |  |  | unless XML::DOM::isValidName ($notationName); | 
| 1675 |  |  |  |  |  |  |  | 
| 1676 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 1677 |  |  |  |  |  |  |  | 
| 1678 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 1679 |  |  |  |  |  |  | $self->[_NotationName] = $notationName; | 
| 1680 |  |  |  |  |  |  | $self->[_Parameter] = $isParam; | 
| 1681 |  |  |  |  |  |  | $self->[_Value] = $value; | 
| 1682 |  |  |  |  |  |  | $self->[_Ndata] = $ndata; | 
| 1683 |  |  |  |  |  |  | $self->[_SysId] = $sysId; | 
| 1684 |  |  |  |  |  |  | $self->[_PubId] = $pubId; | 
| 1685 |  |  |  |  |  |  | $self->[_Hidden] = $hidden; | 
| 1686 |  |  |  |  |  |  | $self; | 
| 1687 |  |  |  |  |  |  | #?? maybe Value should be a Text node | 
| 1688 |  |  |  |  |  |  | } | 
| 1689 |  |  |  |  |  |  |  | 
| 1690 |  |  |  |  |  |  | sub getNodeType | 
| 1691 |  |  |  |  |  |  | { | 
| 1692 |  |  |  |  |  |  | ENTITY_NODE; | 
| 1693 |  |  |  |  |  |  | } | 
| 1694 |  |  |  |  |  |  |  | 
| 1695 |  |  |  |  |  |  | sub getPubId | 
| 1696 |  |  |  |  |  |  | { | 
| 1697 |  |  |  |  |  |  | $_[0]->[_PubId]; | 
| 1698 |  |  |  |  |  |  | } | 
| 1699 |  |  |  |  |  |  |  | 
| 1700 |  |  |  |  |  |  | sub getSysId | 
| 1701 |  |  |  |  |  |  | { | 
| 1702 |  |  |  |  |  |  | $_[0]->[_SysId]; | 
| 1703 |  |  |  |  |  |  | } | 
| 1704 |  |  |  |  |  |  |  | 
| 1705 |  |  |  |  |  |  | # Dom Spec says: | 
| 1706 |  |  |  |  |  |  | #  For unparsed entities, the name of the notation for the | 
| 1707 |  |  |  |  |  |  | #  entity. For parsed entities, this is null. | 
| 1708 |  |  |  |  |  |  |  | 
| 1709 |  |  |  |  |  |  | #?? do we have unparsed entities? | 
| 1710 |  |  |  |  |  |  | sub getNotationName | 
| 1711 |  |  |  |  |  |  | { | 
| 1712 |  |  |  |  |  |  | $_[0]->[_NotationName]; | 
| 1713 |  |  |  |  |  |  | } | 
| 1714 |  |  |  |  |  |  |  | 
| 1715 |  |  |  |  |  |  | sub getNodeName | 
| 1716 |  |  |  |  |  |  | { | 
| 1717 |  |  |  |  |  |  | $_[0]->[_NotationName]; | 
| 1718 |  |  |  |  |  |  | } | 
| 1719 |  |  |  |  |  |  |  | 
| 1720 |  |  |  |  |  |  | sub cloneNode | 
| 1721 |  |  |  |  |  |  | { | 
| 1722 |  |  |  |  |  |  | my $self = shift; | 
| 1723 |  |  |  |  |  |  | $self->[_Doc]->createEntity ($self->[_NotationName], $self->[_Value], | 
| 1724 |  |  |  |  |  |  | $self->[_SysId], $self->[_PubId], | 
| 1725 |  |  |  |  |  |  | $self->[_Ndata], $self->[_Parameter], $self->[_Hidden]); | 
| 1726 |  |  |  |  |  |  | } | 
| 1727 |  |  |  |  |  |  |  | 
| 1728 |  |  |  |  |  |  | sub rejectChild | 
| 1729 |  |  |  |  |  |  | { | 
| 1730 |  |  |  |  |  |  | return 1; | 
| 1731 |  |  |  |  |  |  | #?? if value is split over subnodes, recode this section | 
| 1732 |  |  |  |  |  |  | # also add:				   C => new XML::DOM::NodeList, | 
| 1733 |  |  |  |  |  |  |  | 
| 1734 |  |  |  |  |  |  | my $t = $_[1]; | 
| 1735 |  |  |  |  |  |  |  | 
| 1736 |  |  |  |  |  |  | return $t == TEXT_NODE | 
| 1737 |  |  |  |  |  |  | || $t == ENTITY_REFERENCE_NODE | 
| 1738 |  |  |  |  |  |  | || $t == PROCESSING_INSTRUCTION_NODE | 
| 1739 |  |  |  |  |  |  | || $t == COMMENT_NODE | 
| 1740 |  |  |  |  |  |  | || $t == CDATA_SECTION_NODE | 
| 1741 |  |  |  |  |  |  | || $t == ELEMENT_NODE; | 
| 1742 |  |  |  |  |  |  | } | 
| 1743 |  |  |  |  |  |  |  | 
| 1744 |  |  |  |  |  |  | sub getValue | 
| 1745 |  |  |  |  |  |  | { | 
| 1746 |  |  |  |  |  |  | $_[0]->[_Value]; | 
| 1747 |  |  |  |  |  |  | } | 
| 1748 |  |  |  |  |  |  |  | 
| 1749 |  |  |  |  |  |  | sub isParameterEntity | 
| 1750 |  |  |  |  |  |  | { | 
| 1751 |  |  |  |  |  |  | $_[0]->[_Parameter]; | 
| 1752 |  |  |  |  |  |  | } | 
| 1753 |  |  |  |  |  |  |  | 
| 1754 |  |  |  |  |  |  | sub getNdata | 
| 1755 |  |  |  |  |  |  | { | 
| 1756 |  |  |  |  |  |  | $_[0]->[_Ndata]; | 
| 1757 |  |  |  |  |  |  | } | 
| 1758 |  |  |  |  |  |  |  | 
| 1759 |  |  |  |  |  |  | sub print | 
| 1760 |  |  |  |  |  |  | { | 
| 1761 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 1762 |  |  |  |  |  |  |  | 
| 1763 |  |  |  |  |  |  | my $name = $self->[_NotationName]; | 
| 1764 |  |  |  |  |  |  |  | 
| 1765 |  |  |  |  |  |  | my $par = $self->isParameterEntity ? "% " : ""; | 
| 1766 |  |  |  |  |  |  |  | 
| 1767 |  |  |  |  |  |  | $FILE->print (" | 
| 1768 |  |  |  |  |  |  |  | 
| 1769 |  |  |  |  |  |  | my $value = $self->[_Value]; | 
| 1770 |  |  |  |  |  |  | my $sysId = $self->[_SysId]; | 
| 1771 |  |  |  |  |  |  | my $pubId = $self->[_PubId]; | 
| 1772 |  |  |  |  |  |  | my $ndata = $self->[_Ndata]; | 
| 1773 |  |  |  |  |  |  |  | 
| 1774 |  |  |  |  |  |  | if (defined $value) | 
| 1775 |  |  |  |  |  |  | { | 
| 1776 |  |  |  |  |  |  | #?? Not sure what to do if it contains both single and double quote | 
| 1777 |  |  |  |  |  |  | $value = ($value =~ /\"/) ? "'$value'" : "\"$value\""; | 
| 1778 |  |  |  |  |  |  | $FILE->print (" $value"); | 
| 1779 |  |  |  |  |  |  | } | 
| 1780 |  |  |  |  |  |  | if (defined $pubId) | 
| 1781 |  |  |  |  |  |  | { | 
| 1782 |  |  |  |  |  |  | $FILE->print (" PUBLIC \"$pubId\""); | 
| 1783 |  |  |  |  |  |  | } | 
| 1784 |  |  |  |  |  |  | elsif (defined $sysId) | 
| 1785 |  |  |  |  |  |  | { | 
| 1786 |  |  |  |  |  |  | $FILE->print (" SYSTEM"); | 
| 1787 |  |  |  |  |  |  | } | 
| 1788 |  |  |  |  |  |  |  | 
| 1789 |  |  |  |  |  |  | if (defined $sysId) | 
| 1790 |  |  |  |  |  |  | { | 
| 1791 |  |  |  |  |  |  | $FILE->print (" \"$sysId\""); | 
| 1792 |  |  |  |  |  |  | } | 
| 1793 |  |  |  |  |  |  | $FILE->print (" NDATA $ndata") if defined $ndata; | 
| 1794 |  |  |  |  |  |  | $FILE->print (">"); | 
| 1795 |  |  |  |  |  |  | } | 
| 1796 |  |  |  |  |  |  |  | 
| 1797 |  |  |  |  |  |  | sub to_expat | 
| 1798 |  |  |  |  |  |  | { | 
| 1799 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 1800 |  |  |  |  |  |  | my $name = ($self->isParameterEntity ? '%' : "") . $self->getNotationName; | 
| 1801 |  |  |  |  |  |  | $iter->Entity ($name, | 
| 1802 |  |  |  |  |  |  | $self->getValue, $self->getSysId, $self->getPubId, | 
| 1803 |  |  |  |  |  |  | $self->getNdata); | 
| 1804 |  |  |  |  |  |  | } | 
| 1805 |  |  |  |  |  |  |  | 
| 1806 |  |  |  |  |  |  | sub _to_sax | 
| 1807 |  |  |  |  |  |  | { | 
| 1808 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 1809 |  |  |  |  |  |  | my $name = ($self->isParameterEntity ? '%' : "") . $self->getNotationName; | 
| 1810 |  |  |  |  |  |  | $dtdh->entity_decl ( { Name => $name, | 
| 1811 |  |  |  |  |  |  | Value => $self->getValue, | 
| 1812 |  |  |  |  |  |  | SystemId => $self->getSysId, | 
| 1813 |  |  |  |  |  |  | PublicId => $self->getPubId, | 
| 1814 |  |  |  |  |  |  | Notation => $self->getNdata } ); | 
| 1815 |  |  |  |  |  |  | } | 
| 1816 |  |  |  |  |  |  |  | 
| 1817 |  |  |  |  |  |  | ###################################################################### | 
| 1818 |  |  |  |  |  |  | package XML::DOM::EntityReference; | 
| 1819 |  |  |  |  |  |  | ###################################################################### | 
| 1820 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 1821 |  |  |  |  |  |  |  | 
| 1822 |  |  |  |  |  |  | BEGIN | 
| 1823 |  |  |  |  |  |  | { | 
| 1824 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 1825 |  |  |  |  |  |  | XML::DOM::def_fields ("EntityName Parameter NoExpand", "XML::DOM::Node"); | 
| 1826 |  |  |  |  |  |  | } | 
| 1827 |  |  |  |  |  |  |  | 
| 1828 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 1829 |  |  |  |  |  |  | use Carp; | 
| 1830 |  |  |  |  |  |  |  | 
| 1831 |  |  |  |  |  |  | sub new | 
| 1832 |  |  |  |  |  |  | { | 
| 1833 |  |  |  |  |  |  | my ($class, $doc, $name, $parameter, $noExpand) = @_; | 
| 1834 |  |  |  |  |  |  |  | 
| 1835 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 1836 |  |  |  |  |  |  | "bad Entity Name [$name] in EntityReference") | 
| 1837 |  |  |  |  |  |  | unless XML::DOM::isValidName ($name); | 
| 1838 |  |  |  |  |  |  |  | 
| 1839 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 1840 |  |  |  |  |  |  |  | 
| 1841 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 1842 |  |  |  |  |  |  | $self->[_EntityName] = $name; | 
| 1843 |  |  |  |  |  |  | $self->[_Parameter] = ($parameter || 0); | 
| 1844 |  |  |  |  |  |  | $self->[_NoExpand] = ($noExpand || 0); | 
| 1845 |  |  |  |  |  |  |  | 
| 1846 |  |  |  |  |  |  | $self; | 
| 1847 |  |  |  |  |  |  | } | 
| 1848 |  |  |  |  |  |  |  | 
| 1849 |  |  |  |  |  |  | sub getNodeType | 
| 1850 |  |  |  |  |  |  | { | 
| 1851 |  |  |  |  |  |  | ENTITY_REFERENCE_NODE; | 
| 1852 |  |  |  |  |  |  | } | 
| 1853 |  |  |  |  |  |  |  | 
| 1854 |  |  |  |  |  |  | sub getNodeName | 
| 1855 |  |  |  |  |  |  | { | 
| 1856 |  |  |  |  |  |  | $_[0]->[_EntityName]; | 
| 1857 |  |  |  |  |  |  | } | 
| 1858 |  |  |  |  |  |  |  | 
| 1859 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 1860 |  |  |  |  |  |  | # Extra method implementations | 
| 1861 |  |  |  |  |  |  |  | 
| 1862 |  |  |  |  |  |  | sub getEntityName | 
| 1863 |  |  |  |  |  |  | { | 
| 1864 |  |  |  |  |  |  | $_[0]->[_EntityName]; | 
| 1865 |  |  |  |  |  |  | } | 
| 1866 |  |  |  |  |  |  |  | 
| 1867 |  |  |  |  |  |  | sub isParameterEntity | 
| 1868 |  |  |  |  |  |  | { | 
| 1869 |  |  |  |  |  |  | $_[0]->[_Parameter]; | 
| 1870 |  |  |  |  |  |  | } | 
| 1871 |  |  |  |  |  |  |  | 
| 1872 |  |  |  |  |  |  | sub getData | 
| 1873 |  |  |  |  |  |  | { | 
| 1874 |  |  |  |  |  |  | my $self = shift; | 
| 1875 |  |  |  |  |  |  | my $name = $self->[_EntityName]; | 
| 1876 |  |  |  |  |  |  | my $parameter = $self->[_Parameter]; | 
| 1877 |  |  |  |  |  |  |  | 
| 1878 |  |  |  |  |  |  | my $data; | 
| 1879 |  |  |  |  |  |  | if ($self->[_NoExpand]) { | 
| 1880 |  |  |  |  |  |  | $data = "&$name;" if $name; | 
| 1881 |  |  |  |  |  |  | } else { | 
| 1882 |  |  |  |  |  |  | $data = $self->[_Doc]->expandEntity ($name, $parameter); | 
| 1883 |  |  |  |  |  |  | } | 
| 1884 |  |  |  |  |  |  |  | 
| 1885 |  |  |  |  |  |  | unless (defined $data) | 
| 1886 |  |  |  |  |  |  | { | 
| 1887 |  |  |  |  |  |  | #?? this is probably an error, but perhaps requires check to NoExpand | 
| 1888 |  |  |  |  |  |  | # will fix it? | 
| 1889 |  |  |  |  |  |  | my $pc = $parameter ? "%" : "&"; | 
| 1890 |  |  |  |  |  |  | $data = "$pc$name;"; | 
| 1891 |  |  |  |  |  |  | } | 
| 1892 |  |  |  |  |  |  | $data; | 
| 1893 |  |  |  |  |  |  | } | 
| 1894 |  |  |  |  |  |  |  | 
| 1895 |  |  |  |  |  |  | sub print | 
| 1896 |  |  |  |  |  |  | { | 
| 1897 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 1898 |  |  |  |  |  |  |  | 
| 1899 |  |  |  |  |  |  | my $name = $self->[_EntityName]; | 
| 1900 |  |  |  |  |  |  |  | 
| 1901 |  |  |  |  |  |  | #?? or do we expand the entities? | 
| 1902 |  |  |  |  |  |  |  | 
| 1903 |  |  |  |  |  |  | my $pc = $self->[_Parameter] ? "%" : "&"; | 
| 1904 |  |  |  |  |  |  | $FILE->print ("$pc$name;"); | 
| 1905 |  |  |  |  |  |  | } | 
| 1906 |  |  |  |  |  |  |  | 
| 1907 |  |  |  |  |  |  | # Dom Spec says: | 
| 1908 |  |  |  |  |  |  | #     [...] but if such an Entity exists, then | 
| 1909 |  |  |  |  |  |  | #     the child list of the EntityReference node is the same as that of the | 
| 1910 |  |  |  |  |  |  | #     Entity node. | 
| 1911 |  |  |  |  |  |  | # | 
| 1912 |  |  |  |  |  |  | #     The resolution of the children of the EntityReference (the replacement | 
| 1913 |  |  |  |  |  |  | #     value of the referenced Entity) may be lazily evaluated; actions by the | 
| 1914 |  |  |  |  |  |  | #     user (such as calling the childNodes method on the EntityReference | 
| 1915 |  |  |  |  |  |  | #     node) are assumed to trigger the evaluation. | 
| 1916 |  |  |  |  |  |  | sub getChildNodes | 
| 1917 |  |  |  |  |  |  | { | 
| 1918 |  |  |  |  |  |  | my $self = shift; | 
| 1919 |  |  |  |  |  |  | my $entity = $self->[_Doc]->getEntity ($self->[_EntityName]); | 
| 1920 |  |  |  |  |  |  | defined ($entity) ? $entity->getChildNodes : new XML::DOM::NodeList; | 
| 1921 |  |  |  |  |  |  | } | 
| 1922 |  |  |  |  |  |  |  | 
| 1923 |  |  |  |  |  |  | sub cloneNode | 
| 1924 |  |  |  |  |  |  | { | 
| 1925 |  |  |  |  |  |  | my $self = shift; | 
| 1926 |  |  |  |  |  |  | $self->[_Doc]->createEntityReference ($self->[_EntityName], | 
| 1927 |  |  |  |  |  |  | $self->[_Parameter], | 
| 1928 |  |  |  |  |  |  | $self->[_NoExpand], | 
| 1929 |  |  |  |  |  |  | ); | 
| 1930 |  |  |  |  |  |  | } | 
| 1931 |  |  |  |  |  |  |  | 
| 1932 |  |  |  |  |  |  | sub to_expat | 
| 1933 |  |  |  |  |  |  | { | 
| 1934 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 1935 |  |  |  |  |  |  | $iter->EntityRef ($self->getEntityName, $self->isParameterEntity); | 
| 1936 |  |  |  |  |  |  | } | 
| 1937 |  |  |  |  |  |  |  | 
| 1938 |  |  |  |  |  |  | sub _to_sax | 
| 1939 |  |  |  |  |  |  | { | 
| 1940 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 1941 |  |  |  |  |  |  | my @par = $self->isParameterEntity ? (Parameter => 1) : (); | 
| 1942 |  |  |  |  |  |  | #?? not supported by PerlSAX: $self->isParameterEntity | 
| 1943 |  |  |  |  |  |  |  | 
| 1944 |  |  |  |  |  |  | $doch->entity_reference ( { Name => $self->getEntityName, @par } ); | 
| 1945 |  |  |  |  |  |  | } | 
| 1946 |  |  |  |  |  |  |  | 
| 1947 |  |  |  |  |  |  | # NOTE: an EntityReference can't really have children, so rejectChild | 
| 1948 |  |  |  |  |  |  | # is not reimplemented (i.e. it always returns 0.) | 
| 1949 |  |  |  |  |  |  |  | 
| 1950 |  |  |  |  |  |  | ###################################################################### | 
| 1951 |  |  |  |  |  |  | package XML::DOM::AttDef; | 
| 1952 |  |  |  |  |  |  | ###################################################################### | 
| 1953 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 1954 |  |  |  |  |  |  |  | 
| 1955 |  |  |  |  |  |  | BEGIN | 
| 1956 |  |  |  |  |  |  | { | 
| 1957 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 1958 |  |  |  |  |  |  | XML::DOM::def_fields ("Name Type Fixed Default Required Implied Quote", "XML::DOM::Node"); | 
| 1959 |  |  |  |  |  |  | } | 
| 1960 |  |  |  |  |  |  |  | 
| 1961 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 1962 |  |  |  |  |  |  | use Carp; | 
| 1963 |  |  |  |  |  |  |  | 
| 1964 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 1965 |  |  |  |  |  |  | # Extra method implementations | 
| 1966 |  |  |  |  |  |  |  | 
| 1967 |  |  |  |  |  |  | # AttDef is not part of DOM Spec | 
| 1968 |  |  |  |  |  |  | sub new | 
| 1969 |  |  |  |  |  |  | { | 
| 1970 |  |  |  |  |  |  | my ($class, $doc, $name, $attrType, $default, $fixed, $hidden) = @_; | 
| 1971 |  |  |  |  |  |  |  | 
| 1972 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 1973 |  |  |  |  |  |  | "bad Attr name in AttDef [$name]") | 
| 1974 |  |  |  |  |  |  | unless XML::DOM::isValidName ($name); | 
| 1975 |  |  |  |  |  |  |  | 
| 1976 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 1977 |  |  |  |  |  |  |  | 
| 1978 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 1979 |  |  |  |  |  |  | $self->[_Name] = $name; | 
| 1980 |  |  |  |  |  |  | $self->[_Type] = $attrType; | 
| 1981 |  |  |  |  |  |  |  | 
| 1982 |  |  |  |  |  |  | if (defined $default) | 
| 1983 |  |  |  |  |  |  | { | 
| 1984 |  |  |  |  |  |  | if ($default eq "#REQUIRED") | 
| 1985 |  |  |  |  |  |  | { | 
| 1986 |  |  |  |  |  |  | $self->[_Required] = 1; | 
| 1987 |  |  |  |  |  |  | } | 
| 1988 |  |  |  |  |  |  | elsif ($default eq "#IMPLIED") | 
| 1989 |  |  |  |  |  |  | { | 
| 1990 |  |  |  |  |  |  | $self->[_Implied] = 1; | 
| 1991 |  |  |  |  |  |  | } | 
| 1992 |  |  |  |  |  |  | else | 
| 1993 |  |  |  |  |  |  | { | 
| 1994 |  |  |  |  |  |  | # strip off quotes - see Attlist handler in XML::Parser | 
| 1995 |  |  |  |  |  |  | # this regexp doesn't work with 5.8.0 unicode | 
| 1996 |  |  |  |  |  |  | #	    $default =~ m#^(["'])(.*)['"]$#; | 
| 1997 |  |  |  |  |  |  | #	    $self->[_Quote] = $1;	# keep track of the quote character | 
| 1998 |  |  |  |  |  |  | #	    $self->[_Default] = $self->setDefault ($2); | 
| 1999 |  |  |  |  |  |  |  | 
| 2000 |  |  |  |  |  |  | # workaround for 5.8.0 unicode | 
| 2001 |  |  |  |  |  |  | $default =~ s!^(["'])!!; | 
| 2002 |  |  |  |  |  |  | $self->[_Quote] = $1; | 
| 2003 |  |  |  |  |  |  | $default =~ s!(["'])$!!; | 
| 2004 |  |  |  |  |  |  | $self->[_Default] = $self->setDefault ($default); | 
| 2005 |  |  |  |  |  |  |  | 
| 2006 |  |  |  |  |  |  | #?? should default value be decoded - what if it contains e.g. "&" | 
| 2007 |  |  |  |  |  |  | } | 
| 2008 |  |  |  |  |  |  | } | 
| 2009 |  |  |  |  |  |  | $self->[_Fixed] = $fixed if defined $fixed; | 
| 2010 |  |  |  |  |  |  | $self->[_Hidden] = $hidden if defined $hidden; | 
| 2011 |  |  |  |  |  |  |  | 
| 2012 |  |  |  |  |  |  | $self; | 
| 2013 |  |  |  |  |  |  | } | 
| 2014 |  |  |  |  |  |  |  | 
| 2015 |  |  |  |  |  |  | sub getNodeType | 
| 2016 |  |  |  |  |  |  | { | 
| 2017 |  |  |  |  |  |  | ATT_DEF_NODE; | 
| 2018 |  |  |  |  |  |  | } | 
| 2019 |  |  |  |  |  |  |  | 
| 2020 |  |  |  |  |  |  | sub getName | 
| 2021 |  |  |  |  |  |  | { | 
| 2022 |  |  |  |  |  |  | $_[0]->[_Name]; | 
| 2023 |  |  |  |  |  |  | } | 
| 2024 |  |  |  |  |  |  |  | 
| 2025 |  |  |  |  |  |  | # So it can be added to a NamedNodeMap | 
| 2026 |  |  |  |  |  |  | sub getNodeName | 
| 2027 |  |  |  |  |  |  | { | 
| 2028 |  |  |  |  |  |  | $_[0]->[_Name]; | 
| 2029 |  |  |  |  |  |  | } | 
| 2030 |  |  |  |  |  |  |  | 
| 2031 |  |  |  |  |  |  | sub getType | 
| 2032 |  |  |  |  |  |  | { | 
| 2033 |  |  |  |  |  |  | $_[0]->[_Type]; | 
| 2034 |  |  |  |  |  |  | } | 
| 2035 |  |  |  |  |  |  |  | 
| 2036 |  |  |  |  |  |  | sub setType | 
| 2037 |  |  |  |  |  |  | { | 
| 2038 |  |  |  |  |  |  | $_[0]->[_Type] = $_[1]; | 
| 2039 |  |  |  |  |  |  | } | 
| 2040 |  |  |  |  |  |  |  | 
| 2041 |  |  |  |  |  |  | sub getDefault | 
| 2042 |  |  |  |  |  |  | { | 
| 2043 |  |  |  |  |  |  | $_[0]->[_Default]; | 
| 2044 |  |  |  |  |  |  | } | 
| 2045 |  |  |  |  |  |  |  | 
| 2046 |  |  |  |  |  |  | sub setDefault | 
| 2047 |  |  |  |  |  |  | { | 
| 2048 |  |  |  |  |  |  | my ($self, $value) = @_; | 
| 2049 |  |  |  |  |  |  |  | 
| 2050 |  |  |  |  |  |  | # specified=0, it's the default ! | 
| 2051 |  |  |  |  |  |  | my $attr = $self->[_Doc]->createAttribute ($self->[_Name], undef, 0); | 
| 2052 |  |  |  |  |  |  | $attr->[_ReadOnly] = 1; | 
| 2053 |  |  |  |  |  |  |  | 
| 2054 |  |  |  |  |  |  | #?? this should be split over Text and EntityReference nodes, just like other | 
| 2055 |  |  |  |  |  |  | # Attr nodes - just expand the text for now | 
| 2056 |  |  |  |  |  |  | $value = $self->expandEntityRefs ($value); | 
| 2057 |  |  |  |  |  |  | $attr->addText ($value); | 
| 2058 |  |  |  |  |  |  | #?? reimplement in NoExpand mode! | 
| 2059 |  |  |  |  |  |  |  | 
| 2060 |  |  |  |  |  |  | $attr; | 
| 2061 |  |  |  |  |  |  | } | 
| 2062 |  |  |  |  |  |  |  | 
| 2063 |  |  |  |  |  |  | sub isFixed | 
| 2064 |  |  |  |  |  |  | { | 
| 2065 |  |  |  |  |  |  | $_[0]->[_Fixed] || 0; | 
| 2066 |  |  |  |  |  |  | } | 
| 2067 |  |  |  |  |  |  |  | 
| 2068 |  |  |  |  |  |  | sub isRequired | 
| 2069 |  |  |  |  |  |  | { | 
| 2070 |  |  |  |  |  |  | $_[0]->[_Required] || 0; | 
| 2071 |  |  |  |  |  |  | } | 
| 2072 |  |  |  |  |  |  |  | 
| 2073 |  |  |  |  |  |  | sub isImplied | 
| 2074 |  |  |  |  |  |  | { | 
| 2075 |  |  |  |  |  |  | $_[0]->[_Implied] || 0; | 
| 2076 |  |  |  |  |  |  | } | 
| 2077 |  |  |  |  |  |  |  | 
| 2078 |  |  |  |  |  |  | sub print | 
| 2079 |  |  |  |  |  |  | { | 
| 2080 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 2081 |  |  |  |  |  |  |  | 
| 2082 |  |  |  |  |  |  | my $name = $self->[_Name]; | 
| 2083 |  |  |  |  |  |  | my $type = $self->[_Type]; | 
| 2084 |  |  |  |  |  |  | my $fixed = $self->[_Fixed]; | 
| 2085 |  |  |  |  |  |  | my $default = $self->[_Default]; | 
| 2086 |  |  |  |  |  |  |  | 
| 2087 |  |  |  |  |  |  | #    $FILE->print ("$name $type"); | 
| 2088 |  |  |  |  |  |  | # replaced line above with the two lines below | 
| 2089 |  |  |  |  |  |  | # seems to be a bug in perl 5.6.0 that causes | 
| 2090 |  |  |  |  |  |  | # test 3 of dom_jp_attr.t to fail? | 
| 2091 |  |  |  |  |  |  | $FILE->print ($name); | 
| 2092 |  |  |  |  |  |  | $FILE->print (" $type"); | 
| 2093 |  |  |  |  |  |  |  | 
| 2094 |  |  |  |  |  |  | $FILE->print (" #FIXED") if defined $fixed; | 
| 2095 |  |  |  |  |  |  |  | 
| 2096 |  |  |  |  |  |  | if ($self->[_Required]) | 
| 2097 |  |  |  |  |  |  | { | 
| 2098 |  |  |  |  |  |  | $FILE->print (" #REQUIRED"); | 
| 2099 |  |  |  |  |  |  | } | 
| 2100 |  |  |  |  |  |  | elsif ($self->[_Implied]) | 
| 2101 |  |  |  |  |  |  | { | 
| 2102 |  |  |  |  |  |  | $FILE->print (" #IMPLIED"); | 
| 2103 |  |  |  |  |  |  | } | 
| 2104 |  |  |  |  |  |  | elsif (defined ($default)) | 
| 2105 |  |  |  |  |  |  | { | 
| 2106 |  |  |  |  |  |  | my $quote = $self->[_Quote]; | 
| 2107 |  |  |  |  |  |  | $FILE->print (" $quote"); | 
| 2108 |  |  |  |  |  |  | for my $kid (@{$default->[_C]}) | 
| 2109 |  |  |  |  |  |  | { | 
| 2110 |  |  |  |  |  |  | $kid->print ($FILE); | 
| 2111 |  |  |  |  |  |  | } | 
| 2112 |  |  |  |  |  |  | $FILE->print ($quote); | 
| 2113 |  |  |  |  |  |  | } | 
| 2114 |  |  |  |  |  |  | } | 
| 2115 |  |  |  |  |  |  |  | 
| 2116 |  |  |  |  |  |  | sub getDefaultString | 
| 2117 |  |  |  |  |  |  | { | 
| 2118 |  |  |  |  |  |  | my $self = shift; | 
| 2119 |  |  |  |  |  |  | my $default; | 
| 2120 |  |  |  |  |  |  |  | 
| 2121 |  |  |  |  |  |  | if ($self->[_Required]) | 
| 2122 |  |  |  |  |  |  | { | 
| 2123 |  |  |  |  |  |  | return "#REQUIRED"; | 
| 2124 |  |  |  |  |  |  | } | 
| 2125 |  |  |  |  |  |  | elsif ($self->[_Implied]) | 
| 2126 |  |  |  |  |  |  | { | 
| 2127 |  |  |  |  |  |  | return "#IMPLIED"; | 
| 2128 |  |  |  |  |  |  | } | 
| 2129 |  |  |  |  |  |  | elsif (defined ($default = $self->[_Default])) | 
| 2130 |  |  |  |  |  |  | { | 
| 2131 |  |  |  |  |  |  | my $quote = $self->[_Quote]; | 
| 2132 |  |  |  |  |  |  | $default = $default->toString; | 
| 2133 |  |  |  |  |  |  | return "$quote$default$quote"; | 
| 2134 |  |  |  |  |  |  | } | 
| 2135 |  |  |  |  |  |  | undef; | 
| 2136 |  |  |  |  |  |  | } | 
| 2137 |  |  |  |  |  |  |  | 
| 2138 |  |  |  |  |  |  | sub cloneNode | 
| 2139 |  |  |  |  |  |  | { | 
| 2140 |  |  |  |  |  |  | my $self = shift; | 
| 2141 |  |  |  |  |  |  | my $node = new XML::DOM::AttDef ($self->[_Doc], $self->[_Name], $self->[_Type], | 
| 2142 |  |  |  |  |  |  | undef, $self->[_Fixed]); | 
| 2143 |  |  |  |  |  |  |  | 
| 2144 |  |  |  |  |  |  | $node->[_Required] = 1 if $self->[_Required]; | 
| 2145 |  |  |  |  |  |  | $node->[_Implied] = 1 if $self->[_Implied]; | 
| 2146 |  |  |  |  |  |  | $node->[_Fixed] = $self->[_Fixed] if defined $self->[_Fixed]; | 
| 2147 |  |  |  |  |  |  | $node->[_Hidden] = $self->[_Hidden] if defined $self->[_Hidden]; | 
| 2148 |  |  |  |  |  |  |  | 
| 2149 |  |  |  |  |  |  | if (defined $self->[_Default]) | 
| 2150 |  |  |  |  |  |  | { | 
| 2151 |  |  |  |  |  |  | $node->[_Default] = $self->[_Default]->cloneNode(1); | 
| 2152 |  |  |  |  |  |  | } | 
| 2153 |  |  |  |  |  |  | $node->[_Quote] = $self->[_Quote]; | 
| 2154 |  |  |  |  |  |  |  | 
| 2155 |  |  |  |  |  |  | $node; | 
| 2156 |  |  |  |  |  |  | } | 
| 2157 |  |  |  |  |  |  |  | 
| 2158 |  |  |  |  |  |  | sub setOwnerDocument | 
| 2159 |  |  |  |  |  |  | { | 
| 2160 |  |  |  |  |  |  | my ($self, $doc) = @_; | 
| 2161 |  |  |  |  |  |  | $self->SUPER::setOwnerDocument ($doc); | 
| 2162 |  |  |  |  |  |  |  | 
| 2163 |  |  |  |  |  |  | if (defined $self->[_Default]) | 
| 2164 |  |  |  |  |  |  | { | 
| 2165 |  |  |  |  |  |  | $self->[_Default]->setOwnerDocument ($doc); | 
| 2166 |  |  |  |  |  |  | } | 
| 2167 |  |  |  |  |  |  | } | 
| 2168 |  |  |  |  |  |  |  | 
| 2169 |  |  |  |  |  |  | ###################################################################### | 
| 2170 |  |  |  |  |  |  | package XML::DOM::AttlistDecl; | 
| 2171 |  |  |  |  |  |  | ###################################################################### | 
| 2172 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 2173 |  |  |  |  |  |  |  | 
| 2174 |  |  |  |  |  |  | BEGIN | 
| 2175 |  |  |  |  |  |  | { | 
| 2176 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 2177 |  |  |  |  |  |  | import XML::DOM::AttDef qw{ :Fields }; | 
| 2178 |  |  |  |  |  |  |  | 
| 2179 |  |  |  |  |  |  | XML::DOM::def_fields ("ElementName", "XML::DOM::Node"); | 
| 2180 |  |  |  |  |  |  | } | 
| 2181 |  |  |  |  |  |  |  | 
| 2182 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 2183 |  |  |  |  |  |  | use Carp; | 
| 2184 |  |  |  |  |  |  |  | 
| 2185 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 2186 |  |  |  |  |  |  | # Extra method implementations | 
| 2187 |  |  |  |  |  |  |  | 
| 2188 |  |  |  |  |  |  | # AttlistDecl is not part of the DOM Spec | 
| 2189 |  |  |  |  |  |  | sub new | 
| 2190 |  |  |  |  |  |  | { | 
| 2191 |  |  |  |  |  |  | my ($class, $doc, $name) = @_; | 
| 2192 |  |  |  |  |  |  |  | 
| 2193 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 2194 |  |  |  |  |  |  | "bad Element TagName [$name] in AttlistDecl") | 
| 2195 |  |  |  |  |  |  | unless XML::DOM::isValidName ($name); | 
| 2196 |  |  |  |  |  |  |  | 
| 2197 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 2198 |  |  |  |  |  |  |  | 
| 2199 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 2200 |  |  |  |  |  |  | $self->[_C] = new XML::DOM::NodeList; | 
| 2201 |  |  |  |  |  |  | $self->[_ReadOnly] = 1; | 
| 2202 |  |  |  |  |  |  | $self->[_ElementName] = $name; | 
| 2203 |  |  |  |  |  |  |  | 
| 2204 |  |  |  |  |  |  | $self->[_A] = new XML::DOM::NamedNodeMap (Doc	=> $doc, | 
| 2205 |  |  |  |  |  |  | ReadOnly	=> 1, | 
| 2206 |  |  |  |  |  |  | Parent	=> $self); | 
| 2207 |  |  |  |  |  |  |  | 
| 2208 |  |  |  |  |  |  | $self; | 
| 2209 |  |  |  |  |  |  | } | 
| 2210 |  |  |  |  |  |  |  | 
| 2211 |  |  |  |  |  |  | sub getNodeType | 
| 2212 |  |  |  |  |  |  | { | 
| 2213 |  |  |  |  |  |  | ATTLIST_DECL_NODE; | 
| 2214 |  |  |  |  |  |  | } | 
| 2215 |  |  |  |  |  |  |  | 
| 2216 |  |  |  |  |  |  | sub getName | 
| 2217 |  |  |  |  |  |  | { | 
| 2218 |  |  |  |  |  |  | $_[0]->[_ElementName]; | 
| 2219 |  |  |  |  |  |  | } | 
| 2220 |  |  |  |  |  |  |  | 
| 2221 |  |  |  |  |  |  | sub getNodeName | 
| 2222 |  |  |  |  |  |  | { | 
| 2223 |  |  |  |  |  |  | $_[0]->[_ElementName]; | 
| 2224 |  |  |  |  |  |  | } | 
| 2225 |  |  |  |  |  |  |  | 
| 2226 |  |  |  |  |  |  | sub getAttDef | 
| 2227 |  |  |  |  |  |  | { | 
| 2228 |  |  |  |  |  |  | my ($self, $attrName) = @_; | 
| 2229 |  |  |  |  |  |  | $self->[_A]->getNamedItem ($attrName); | 
| 2230 |  |  |  |  |  |  | } | 
| 2231 |  |  |  |  |  |  |  | 
| 2232 |  |  |  |  |  |  | sub addAttDef | 
| 2233 |  |  |  |  |  |  | { | 
| 2234 |  |  |  |  |  |  | my ($self, $attrName, $type, $default, $fixed, $hidden) = @_; | 
| 2235 |  |  |  |  |  |  | my $node = $self->getAttDef ($attrName); | 
| 2236 |  |  |  |  |  |  |  | 
| 2237 |  |  |  |  |  |  | if (defined $node) | 
| 2238 |  |  |  |  |  |  | { | 
| 2239 |  |  |  |  |  |  | # data will be ignored if already defined | 
| 2240 |  |  |  |  |  |  | my $elemName = $self->getName; | 
| 2241 |  |  |  |  |  |  | XML::DOM::warning ("multiple definitions of attribute $attrName for element $elemName, only first one is recognized"); | 
| 2242 |  |  |  |  |  |  | } | 
| 2243 |  |  |  |  |  |  | else | 
| 2244 |  |  |  |  |  |  | { | 
| 2245 |  |  |  |  |  |  | $node = new XML::DOM::AttDef ($self->[_Doc], $attrName, $type, | 
| 2246 |  |  |  |  |  |  | $default, $fixed, $hidden); | 
| 2247 |  |  |  |  |  |  | $self->[_A]->setNamedItem ($node); | 
| 2248 |  |  |  |  |  |  | } | 
| 2249 |  |  |  |  |  |  | $node; | 
| 2250 |  |  |  |  |  |  | } | 
| 2251 |  |  |  |  |  |  |  | 
| 2252 |  |  |  |  |  |  | sub getDefaultAttrValue | 
| 2253 |  |  |  |  |  |  | { | 
| 2254 |  |  |  |  |  |  | my ($self, $attr) = @_; | 
| 2255 |  |  |  |  |  |  | my $attrNode = $self->getAttDef ($attr); | 
| 2256 |  |  |  |  |  |  | (defined $attrNode) ? $attrNode->getDefault : undef; | 
| 2257 |  |  |  |  |  |  | } | 
| 2258 |  |  |  |  |  |  |  | 
| 2259 |  |  |  |  |  |  | sub cloneNode | 
| 2260 |  |  |  |  |  |  | { | 
| 2261 |  |  |  |  |  |  | my ($self, $deep) = @_; | 
| 2262 |  |  |  |  |  |  | my $node = $self->[_Doc]->createAttlistDecl ($self->[_ElementName]); | 
| 2263 |  |  |  |  |  |  |  | 
| 2264 |  |  |  |  |  |  | $node->[_A] = $self->[_A]->cloneNode ($deep); | 
| 2265 |  |  |  |  |  |  | $node; | 
| 2266 |  |  |  |  |  |  | } | 
| 2267 |  |  |  |  |  |  |  | 
| 2268 |  |  |  |  |  |  | sub setOwnerDocument | 
| 2269 |  |  |  |  |  |  | { | 
| 2270 |  |  |  |  |  |  | my ($self, $doc) = @_; | 
| 2271 |  |  |  |  |  |  | $self->SUPER::setOwnerDocument ($doc); | 
| 2272 |  |  |  |  |  |  |  | 
| 2273 |  |  |  |  |  |  | $self->[_A]->setOwnerDocument ($doc); | 
| 2274 |  |  |  |  |  |  | } | 
| 2275 |  |  |  |  |  |  |  | 
| 2276 |  |  |  |  |  |  | sub print | 
| 2277 |  |  |  |  |  |  | { | 
| 2278 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 2279 |  |  |  |  |  |  |  | 
| 2280 |  |  |  |  |  |  | my $name = $self->getName; | 
| 2281 |  |  |  |  |  |  | my @attlist = @{$self->[_A]->getValues}; | 
| 2282 |  |  |  |  |  |  |  | 
| 2283 |  |  |  |  |  |  | my $hidden = 1; | 
| 2284 |  |  |  |  |  |  | for my $att (@attlist) | 
| 2285 |  |  |  |  |  |  | { | 
| 2286 |  |  |  |  |  |  | unless ($att->[_Hidden]) | 
| 2287 |  |  |  |  |  |  | { | 
| 2288 |  |  |  |  |  |  | $hidden = 0; | 
| 2289 |  |  |  |  |  |  | last; | 
| 2290 |  |  |  |  |  |  | } | 
| 2291 |  |  |  |  |  |  | } | 
| 2292 |  |  |  |  |  |  |  | 
| 2293 |  |  |  |  |  |  | unless ($hidden) | 
| 2294 |  |  |  |  |  |  | { | 
| 2295 |  |  |  |  |  |  | $FILE->print (" | 
| 2296 |  |  |  |  |  |  |  | 
| 2297 |  |  |  |  |  |  | if (@attlist == 1) | 
| 2298 |  |  |  |  |  |  | { | 
| 2299 |  |  |  |  |  |  | $FILE->print (" "); | 
| 2300 |  |  |  |  |  |  | $attlist[0]->print ($FILE); | 
| 2301 |  |  |  |  |  |  | } | 
| 2302 |  |  |  |  |  |  | else | 
| 2303 |  |  |  |  |  |  | { | 
| 2304 |  |  |  |  |  |  | for my $attr (@attlist) | 
| 2305 |  |  |  |  |  |  | { | 
| 2306 |  |  |  |  |  |  | next if $attr->[_Hidden]; | 
| 2307 |  |  |  |  |  |  |  | 
| 2308 |  |  |  |  |  |  | $FILE->print ("\x0A  "); | 
| 2309 |  |  |  |  |  |  | $attr->print ($FILE); | 
| 2310 |  |  |  |  |  |  | } | 
| 2311 |  |  |  |  |  |  | } | 
| 2312 |  |  |  |  |  |  | $FILE->print (">"); | 
| 2313 |  |  |  |  |  |  | } | 
| 2314 |  |  |  |  |  |  | } | 
| 2315 |  |  |  |  |  |  |  | 
| 2316 |  |  |  |  |  |  | sub to_expat | 
| 2317 |  |  |  |  |  |  | { | 
| 2318 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 2319 |  |  |  |  |  |  | my $tag = $self->getName; | 
| 2320 |  |  |  |  |  |  | for my $a ($self->[_A]->getValues) | 
| 2321 |  |  |  |  |  |  | { | 
| 2322 |  |  |  |  |  |  | my $default = $a->isImplied ? '#IMPLIED' : | 
| 2323 |  |  |  |  |  |  | ($a->isRequired ? '#REQUIRED' : | 
| 2324 |  |  |  |  |  |  | ($a->[_Quote] . $a->getDefault->getValue . $a->[_Quote])); | 
| 2325 |  |  |  |  |  |  |  | 
| 2326 |  |  |  |  |  |  | $iter->Attlist ($tag, $a->getName, $a->getType, $default, $a->isFixed); | 
| 2327 |  |  |  |  |  |  | } | 
| 2328 |  |  |  |  |  |  | } | 
| 2329 |  |  |  |  |  |  |  | 
| 2330 |  |  |  |  |  |  | sub _to_sax | 
| 2331 |  |  |  |  |  |  | { | 
| 2332 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 2333 |  |  |  |  |  |  | my $tag = $self->getName; | 
| 2334 |  |  |  |  |  |  | for my $a ($self->[_A]->getValues) | 
| 2335 |  |  |  |  |  |  | { | 
| 2336 |  |  |  |  |  |  | my $default = $a->isImplied ? '#IMPLIED' : | 
| 2337 |  |  |  |  |  |  | ($a->isRequired ? '#REQUIRED' : | 
| 2338 |  |  |  |  |  |  | ($a->[_Quote] . $a->getDefault->getValue . $a->[_Quote])); | 
| 2339 |  |  |  |  |  |  |  | 
| 2340 |  |  |  |  |  |  | $dtdh->attlist_decl ({ ElementName => $tag, | 
| 2341 |  |  |  |  |  |  | AttributeName => $a->getName, | 
| 2342 |  |  |  |  |  |  | Type => $a->[_Type], | 
| 2343 |  |  |  |  |  |  | Default => $default, | 
| 2344 |  |  |  |  |  |  | Fixed => $a->isFixed }); | 
| 2345 |  |  |  |  |  |  | } | 
| 2346 |  |  |  |  |  |  | } | 
| 2347 |  |  |  |  |  |  |  | 
| 2348 |  |  |  |  |  |  | ###################################################################### | 
| 2349 |  |  |  |  |  |  | package XML::DOM::ElementDecl; | 
| 2350 |  |  |  |  |  |  | ###################################################################### | 
| 2351 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 2352 |  |  |  |  |  |  |  | 
| 2353 |  |  |  |  |  |  | BEGIN | 
| 2354 |  |  |  |  |  |  | { | 
| 2355 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 2356 |  |  |  |  |  |  | XML::DOM::def_fields ("Name Model", "XML::DOM::Node"); | 
| 2357 |  |  |  |  |  |  | } | 
| 2358 |  |  |  |  |  |  |  | 
| 2359 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 2360 |  |  |  |  |  |  | use Carp; | 
| 2361 |  |  |  |  |  |  |  | 
| 2362 |  |  |  |  |  |  |  | 
| 2363 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 2364 |  |  |  |  |  |  | # Extra method implementations | 
| 2365 |  |  |  |  |  |  |  | 
| 2366 |  |  |  |  |  |  | # ElementDecl is not part of the DOM Spec | 
| 2367 |  |  |  |  |  |  | sub new | 
| 2368 |  |  |  |  |  |  | { | 
| 2369 |  |  |  |  |  |  | my ($class, $doc, $name, $model, $hidden) = @_; | 
| 2370 |  |  |  |  |  |  |  | 
| 2371 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 2372 |  |  |  |  |  |  | "bad Element TagName [$name] in ElementDecl") | 
| 2373 |  |  |  |  |  |  | unless XML::DOM::isValidName ($name); | 
| 2374 |  |  |  |  |  |  |  | 
| 2375 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 2376 |  |  |  |  |  |  |  | 
| 2377 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 2378 |  |  |  |  |  |  | $self->[_Name] = $name; | 
| 2379 |  |  |  |  |  |  | $self->[_ReadOnly] = 1; | 
| 2380 |  |  |  |  |  |  | $self->[_Model] = $model; | 
| 2381 |  |  |  |  |  |  | $self->[_Hidden] = $hidden; | 
| 2382 |  |  |  |  |  |  | $self; | 
| 2383 |  |  |  |  |  |  | } | 
| 2384 |  |  |  |  |  |  |  | 
| 2385 |  |  |  |  |  |  | sub getNodeType | 
| 2386 |  |  |  |  |  |  | { | 
| 2387 |  |  |  |  |  |  | ELEMENT_DECL_NODE; | 
| 2388 |  |  |  |  |  |  | } | 
| 2389 |  |  |  |  |  |  |  | 
| 2390 |  |  |  |  |  |  | sub getName | 
| 2391 |  |  |  |  |  |  | { | 
| 2392 |  |  |  |  |  |  | $_[0]->[_Name]; | 
| 2393 |  |  |  |  |  |  | } | 
| 2394 |  |  |  |  |  |  |  | 
| 2395 |  |  |  |  |  |  | sub getNodeName | 
| 2396 |  |  |  |  |  |  | { | 
| 2397 |  |  |  |  |  |  | $_[0]->[_Name]; | 
| 2398 |  |  |  |  |  |  | } | 
| 2399 |  |  |  |  |  |  |  | 
| 2400 |  |  |  |  |  |  | sub getModel | 
| 2401 |  |  |  |  |  |  | { | 
| 2402 |  |  |  |  |  |  | $_[0]->[_Model]; | 
| 2403 |  |  |  |  |  |  | } | 
| 2404 |  |  |  |  |  |  |  | 
| 2405 |  |  |  |  |  |  | sub setModel | 
| 2406 |  |  |  |  |  |  | { | 
| 2407 |  |  |  |  |  |  | my ($self, $model) = @_; | 
| 2408 |  |  |  |  |  |  |  | 
| 2409 |  |  |  |  |  |  | $self->[_Model] = $model; | 
| 2410 |  |  |  |  |  |  | } | 
| 2411 |  |  |  |  |  |  |  | 
| 2412 |  |  |  |  |  |  | sub print | 
| 2413 |  |  |  |  |  |  | { | 
| 2414 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 2415 |  |  |  |  |  |  |  | 
| 2416 |  |  |  |  |  |  | my $name = $self->[_Name]; | 
| 2417 |  |  |  |  |  |  | my $model = $self->[_Model]; | 
| 2418 |  |  |  |  |  |  |  | 
| 2419 |  |  |  |  |  |  | $FILE->print ("") | 
| 2420 |  |  |  |  |  |  | unless $self->[_Hidden]; | 
| 2421 |  |  |  |  |  |  | } | 
| 2422 |  |  |  |  |  |  |  | 
| 2423 |  |  |  |  |  |  | sub cloneNode | 
| 2424 |  |  |  |  |  |  | { | 
| 2425 |  |  |  |  |  |  | my $self = shift; | 
| 2426 |  |  |  |  |  |  | $self->[_Doc]->createElementDecl ($self->[_Name], $self->[_Model], | 
| 2427 |  |  |  |  |  |  | $self->[_Hidden]); | 
| 2428 |  |  |  |  |  |  | } | 
| 2429 |  |  |  |  |  |  |  | 
| 2430 |  |  |  |  |  |  | sub to_expat | 
| 2431 |  |  |  |  |  |  | { | 
| 2432 |  |  |  |  |  |  | #?? add support for Hidden?? (allover, also in _to_sax!!) | 
| 2433 |  |  |  |  |  |  |  | 
| 2434 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 2435 |  |  |  |  |  |  | $iter->Element ($self->getName, $self->getModel); | 
| 2436 |  |  |  |  |  |  | } | 
| 2437 |  |  |  |  |  |  |  | 
| 2438 |  |  |  |  |  |  | sub _to_sax | 
| 2439 |  |  |  |  |  |  | { | 
| 2440 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 2441 |  |  |  |  |  |  | $dtdh->element_decl ( { Name => $self->getName, | 
| 2442 |  |  |  |  |  |  | Model => $self->getModel } ); | 
| 2443 |  |  |  |  |  |  | } | 
| 2444 |  |  |  |  |  |  |  | 
| 2445 |  |  |  |  |  |  | ###################################################################### | 
| 2446 |  |  |  |  |  |  | package XML::DOM::Element; | 
| 2447 |  |  |  |  |  |  | ###################################################################### | 
| 2448 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 2449 |  |  |  |  |  |  |  | 
| 2450 |  |  |  |  |  |  | BEGIN | 
| 2451 |  |  |  |  |  |  | { | 
| 2452 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 2453 |  |  |  |  |  |  | XML::DOM::def_fields ("TagName", "XML::DOM::Node"); | 
| 2454 |  |  |  |  |  |  | } | 
| 2455 |  |  |  |  |  |  |  | 
| 2456 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 2457 |  |  |  |  |  |  | use XML::DOM::NamedNodeMap; | 
| 2458 |  |  |  |  |  |  | use Carp; | 
| 2459 |  |  |  |  |  |  |  | 
| 2460 |  |  |  |  |  |  | sub new | 
| 2461 |  |  |  |  |  |  | { | 
| 2462 |  |  |  |  |  |  | my ($class, $doc, $tagName) = @_; | 
| 2463 |  |  |  |  |  |  |  | 
| 2464 |  |  |  |  |  |  | if ($XML::DOM::SafeMode) | 
| 2465 |  |  |  |  |  |  | { | 
| 2466 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 2467 |  |  |  |  |  |  | "bad Element TagName [$tagName]") | 
| 2468 |  |  |  |  |  |  | unless XML::DOM::isValidName ($tagName); | 
| 2469 |  |  |  |  |  |  | } | 
| 2470 |  |  |  |  |  |  |  | 
| 2471 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 2472 |  |  |  |  |  |  |  | 
| 2473 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 2474 |  |  |  |  |  |  | $self->[_C] = new XML::DOM::NodeList; | 
| 2475 |  |  |  |  |  |  | $self->[_TagName] = $tagName; | 
| 2476 |  |  |  |  |  |  |  | 
| 2477 |  |  |  |  |  |  | # Now we're creating the NamedNodeMap only when needed (REC 2313 => 1147) | 
| 2478 |  |  |  |  |  |  | #    $self->[_A] = new XML::DOM::NamedNodeMap (Doc	=> $doc, | 
| 2479 |  |  |  |  |  |  | #					     Parent	=> $self); | 
| 2480 |  |  |  |  |  |  |  | 
| 2481 |  |  |  |  |  |  | $self; | 
| 2482 |  |  |  |  |  |  | } | 
| 2483 |  |  |  |  |  |  |  | 
| 2484 |  |  |  |  |  |  | sub getNodeType | 
| 2485 |  |  |  |  |  |  | { | 
| 2486 |  |  |  |  |  |  | ELEMENT_NODE; | 
| 2487 |  |  |  |  |  |  | } | 
| 2488 |  |  |  |  |  |  |  | 
| 2489 |  |  |  |  |  |  | sub getTagName | 
| 2490 |  |  |  |  |  |  | { | 
| 2491 |  |  |  |  |  |  | $_[0]->[_TagName]; | 
| 2492 |  |  |  |  |  |  | } | 
| 2493 |  |  |  |  |  |  |  | 
| 2494 |  |  |  |  |  |  | sub getNodeName | 
| 2495 |  |  |  |  |  |  | { | 
| 2496 |  |  |  |  |  |  | $_[0]->[_TagName]; | 
| 2497 |  |  |  |  |  |  | } | 
| 2498 |  |  |  |  |  |  |  | 
| 2499 |  |  |  |  |  |  | sub getAttributeNode | 
| 2500 |  |  |  |  |  |  | { | 
| 2501 |  |  |  |  |  |  | my ($self, $name) = @_; | 
| 2502 |  |  |  |  |  |  | return undef unless defined $self->[_A]; | 
| 2503 |  |  |  |  |  |  |  | 
| 2504 |  |  |  |  |  |  | $self->getAttributes->{$name}; | 
| 2505 |  |  |  |  |  |  | } | 
| 2506 |  |  |  |  |  |  |  | 
| 2507 |  |  |  |  |  |  | sub getAttribute | 
| 2508 |  |  |  |  |  |  | { | 
| 2509 |  |  |  |  |  |  | my ($self, $name) = @_; | 
| 2510 |  |  |  |  |  |  | my $attr = $self->getAttributeNode ($name); | 
| 2511 |  |  |  |  |  |  | (defined $attr) ? $attr->getValue : ""; | 
| 2512 |  |  |  |  |  |  | } | 
| 2513 |  |  |  |  |  |  |  | 
| 2514 |  |  |  |  |  |  | sub setAttribute | 
| 2515 |  |  |  |  |  |  | { | 
| 2516 |  |  |  |  |  |  | my ($self, $name, $val) = @_; | 
| 2517 |  |  |  |  |  |  |  | 
| 2518 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 2519 |  |  |  |  |  |  | "bad Attr Name [$name]") | 
| 2520 |  |  |  |  |  |  | unless XML::DOM::isValidName ($name); | 
| 2521 |  |  |  |  |  |  |  | 
| 2522 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, | 
| 2523 |  |  |  |  |  |  | "node is ReadOnly") | 
| 2524 |  |  |  |  |  |  | if $self->isReadOnly; | 
| 2525 |  |  |  |  |  |  |  | 
| 2526 |  |  |  |  |  |  | my $node = $self->getAttributes->{$name}; | 
| 2527 |  |  |  |  |  |  | if (defined $node) | 
| 2528 |  |  |  |  |  |  | { | 
| 2529 |  |  |  |  |  |  | $node->setValue ($val); | 
| 2530 |  |  |  |  |  |  | } | 
| 2531 |  |  |  |  |  |  | else | 
| 2532 |  |  |  |  |  |  | { | 
| 2533 |  |  |  |  |  |  | $node = $self->[_Doc]->createAttribute ($name, $val); | 
| 2534 |  |  |  |  |  |  | $self->[_A]->setNamedItem ($node); | 
| 2535 |  |  |  |  |  |  | } | 
| 2536 |  |  |  |  |  |  | } | 
| 2537 |  |  |  |  |  |  |  | 
| 2538 |  |  |  |  |  |  | sub setAttributeNode | 
| 2539 |  |  |  |  |  |  | { | 
| 2540 |  |  |  |  |  |  | my ($self, $node) = @_; | 
| 2541 |  |  |  |  |  |  | my $attr = $self->getAttributes; | 
| 2542 |  |  |  |  |  |  | my $name = $node->getNodeName; | 
| 2543 |  |  |  |  |  |  |  | 
| 2544 |  |  |  |  |  |  | # REC 1147 | 
| 2545 |  |  |  |  |  |  | if ($XML::DOM::SafeMode) | 
| 2546 |  |  |  |  |  |  | { | 
| 2547 |  |  |  |  |  |  | croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, | 
| 2548 |  |  |  |  |  |  | "nodes belong to different documents") | 
| 2549 |  |  |  |  |  |  | if $self->[_Doc] != $node->[_Doc]; | 
| 2550 |  |  |  |  |  |  |  | 
| 2551 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, | 
| 2552 |  |  |  |  |  |  | "node is ReadOnly") | 
| 2553 |  |  |  |  |  |  | if $self->isReadOnly; | 
| 2554 |  |  |  |  |  |  |  | 
| 2555 |  |  |  |  |  |  | my $attrParent = $node->[_UsedIn]; | 
| 2556 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INUSE_ATTRIBUTE_ERR, | 
| 2557 |  |  |  |  |  |  | "Attr is already used by another Element") | 
| 2558 |  |  |  |  |  |  | if (defined ($attrParent) && $attrParent != $attr); | 
| 2559 |  |  |  |  |  |  | } | 
| 2560 |  |  |  |  |  |  |  | 
| 2561 |  |  |  |  |  |  | my $other = $attr->{$name}; | 
| 2562 |  |  |  |  |  |  | $attr->removeNamedItem ($name) if defined $other; | 
| 2563 |  |  |  |  |  |  |  | 
| 2564 |  |  |  |  |  |  | $attr->setNamedItem ($node); | 
| 2565 |  |  |  |  |  |  |  | 
| 2566 |  |  |  |  |  |  | $other; | 
| 2567 |  |  |  |  |  |  | } | 
| 2568 |  |  |  |  |  |  |  | 
| 2569 |  |  |  |  |  |  | sub removeAttributeNode | 
| 2570 |  |  |  |  |  |  | { | 
| 2571 |  |  |  |  |  |  | my ($self, $node) = @_; | 
| 2572 |  |  |  |  |  |  |  | 
| 2573 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, | 
| 2574 |  |  |  |  |  |  | "node is ReadOnly") | 
| 2575 |  |  |  |  |  |  | if $self->isReadOnly; | 
| 2576 |  |  |  |  |  |  |  | 
| 2577 |  |  |  |  |  |  | my $attr = $self->[_A]; | 
| 2578 |  |  |  |  |  |  | unless (defined $attr) | 
| 2579 |  |  |  |  |  |  | { | 
| 2580 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NOT_FOUND_ERR); | 
| 2581 |  |  |  |  |  |  | return undef; | 
| 2582 |  |  |  |  |  |  | } | 
| 2583 |  |  |  |  |  |  |  | 
| 2584 |  |  |  |  |  |  | my $name = $node->getNodeName; | 
| 2585 |  |  |  |  |  |  | my $attrNode = $attr->getNamedItem ($name); | 
| 2586 |  |  |  |  |  |  |  | 
| 2587 |  |  |  |  |  |  | #?? should it croak if it's the default value? | 
| 2588 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NOT_FOUND_ERR) | 
| 2589 |  |  |  |  |  |  | unless $node == $attrNode; | 
| 2590 |  |  |  |  |  |  |  | 
| 2591 |  |  |  |  |  |  | # Not removing anything if it's the default value already | 
| 2592 |  |  |  |  |  |  | return undef unless $node->isSpecified; | 
| 2593 |  |  |  |  |  |  |  | 
| 2594 |  |  |  |  |  |  | $attr->removeNamedItem ($name); | 
| 2595 |  |  |  |  |  |  |  | 
| 2596 |  |  |  |  |  |  | # Substitute with default value if it's defined | 
| 2597 |  |  |  |  |  |  | my $default = $self->getDefaultAttrValue ($name); | 
| 2598 |  |  |  |  |  |  | if (defined $default) | 
| 2599 |  |  |  |  |  |  | { | 
| 2600 |  |  |  |  |  |  | local $XML::DOM::IgnoreReadOnly = 1; | 
| 2601 |  |  |  |  |  |  |  | 
| 2602 |  |  |  |  |  |  | $default = $default->cloneNode (1); | 
| 2603 |  |  |  |  |  |  | $attr->setNamedItem ($default); | 
| 2604 |  |  |  |  |  |  | } | 
| 2605 |  |  |  |  |  |  | $node; | 
| 2606 |  |  |  |  |  |  | } | 
| 2607 |  |  |  |  |  |  |  | 
| 2608 |  |  |  |  |  |  | sub removeAttribute | 
| 2609 |  |  |  |  |  |  | { | 
| 2610 |  |  |  |  |  |  | my ($self, $name) = @_; | 
| 2611 |  |  |  |  |  |  | my $attr = $self->[_A]; | 
| 2612 |  |  |  |  |  |  | unless (defined $attr) | 
| 2613 |  |  |  |  |  |  | { | 
| 2614 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NOT_FOUND_ERR); | 
| 2615 |  |  |  |  |  |  | return; | 
| 2616 |  |  |  |  |  |  | } | 
| 2617 |  |  |  |  |  |  |  | 
| 2618 |  |  |  |  |  |  | my $node = $attr->getNamedItem ($name); | 
| 2619 |  |  |  |  |  |  | if (defined $node) | 
| 2620 |  |  |  |  |  |  | { | 
| 2621 |  |  |  |  |  |  | #?? could use dispose() to remove circular references for gc, but what if | 
| 2622 |  |  |  |  |  |  | #?? somebody is referencing it? | 
| 2623 |  |  |  |  |  |  | $self->removeAttributeNode ($node); | 
| 2624 |  |  |  |  |  |  | } | 
| 2625 |  |  |  |  |  |  | } | 
| 2626 |  |  |  |  |  |  |  | 
| 2627 |  |  |  |  |  |  | sub cloneNode | 
| 2628 |  |  |  |  |  |  | { | 
| 2629 |  |  |  |  |  |  | my ($self, $deep) = @_; | 
| 2630 |  |  |  |  |  |  | my $node = $self->[_Doc]->createElement ($self->getTagName); | 
| 2631 |  |  |  |  |  |  |  | 
| 2632 |  |  |  |  |  |  | # Always clone the Attr nodes, even if $deep == 0 | 
| 2633 |  |  |  |  |  |  | if (defined $self->[_A]) | 
| 2634 |  |  |  |  |  |  | { | 
| 2635 |  |  |  |  |  |  | $node->[_A] = $self->[_A]->cloneNode (1);	# deep=1 | 
| 2636 |  |  |  |  |  |  | $node->[_A]->setParentNode ($node); | 
| 2637 |  |  |  |  |  |  | } | 
| 2638 |  |  |  |  |  |  |  | 
| 2639 |  |  |  |  |  |  | $node->cloneChildren ($self, $deep); | 
| 2640 |  |  |  |  |  |  | $node; | 
| 2641 |  |  |  |  |  |  | } | 
| 2642 |  |  |  |  |  |  |  | 
| 2643 |  |  |  |  |  |  | sub getAttributes | 
| 2644 |  |  |  |  |  |  | { | 
| 2645 |  |  |  |  |  |  | $_[0]->[_A] ||= XML::DOM::NamedNodeMap->new (Doc	=> $_[0]->[_Doc], | 
| 2646 |  |  |  |  |  |  | Parent	=> $_[0]); | 
| 2647 |  |  |  |  |  |  | } | 
| 2648 |  |  |  |  |  |  |  | 
| 2649 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 2650 |  |  |  |  |  |  | # Extra method implementations | 
| 2651 |  |  |  |  |  |  |  | 
| 2652 |  |  |  |  |  |  | # Added for convenience | 
| 2653 |  |  |  |  |  |  | sub setTagName | 
| 2654 |  |  |  |  |  |  | { | 
| 2655 |  |  |  |  |  |  | my ($self, $tagName) = @_; | 
| 2656 |  |  |  |  |  |  |  | 
| 2657 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, | 
| 2658 |  |  |  |  |  |  | "bad Element TagName [$tagName]") | 
| 2659 |  |  |  |  |  |  | unless XML::DOM::isValidName ($tagName); | 
| 2660 |  |  |  |  |  |  |  | 
| 2661 |  |  |  |  |  |  | $self->[_TagName] = $tagName; | 
| 2662 |  |  |  |  |  |  | } | 
| 2663 |  |  |  |  |  |  |  | 
| 2664 |  |  |  |  |  |  | sub isReadOnly | 
| 2665 |  |  |  |  |  |  | { | 
| 2666 |  |  |  |  |  |  | 0; | 
| 2667 |  |  |  |  |  |  | } | 
| 2668 |  |  |  |  |  |  |  | 
| 2669 |  |  |  |  |  |  | # Added for optimization. | 
| 2670 |  |  |  |  |  |  | sub isElementNode | 
| 2671 |  |  |  |  |  |  | { | 
| 2672 |  |  |  |  |  |  | 1; | 
| 2673 |  |  |  |  |  |  | } | 
| 2674 |  |  |  |  |  |  |  | 
| 2675 |  |  |  |  |  |  | sub rejectChild | 
| 2676 |  |  |  |  |  |  | { | 
| 2677 |  |  |  |  |  |  | my $t = $_[1]->getNodeType; | 
| 2678 |  |  |  |  |  |  |  | 
| 2679 |  |  |  |  |  |  | $t != TEXT_NODE | 
| 2680 |  |  |  |  |  |  | && $t != ENTITY_REFERENCE_NODE | 
| 2681 |  |  |  |  |  |  | && $t != PROCESSING_INSTRUCTION_NODE | 
| 2682 |  |  |  |  |  |  | && $t != COMMENT_NODE | 
| 2683 |  |  |  |  |  |  | && $t != CDATA_SECTION_NODE | 
| 2684 |  |  |  |  |  |  | && $t != ELEMENT_NODE; | 
| 2685 |  |  |  |  |  |  | } | 
| 2686 |  |  |  |  |  |  |  | 
| 2687 |  |  |  |  |  |  | sub getDefaultAttrValue | 
| 2688 |  |  |  |  |  |  | { | 
| 2689 |  |  |  |  |  |  | my ($self, $attr) = @_; | 
| 2690 |  |  |  |  |  |  | $self->[_Doc]->getDefaultAttrValue ($self->[_TagName], $attr); | 
| 2691 |  |  |  |  |  |  | } | 
| 2692 |  |  |  |  |  |  |  | 
| 2693 |  |  |  |  |  |  | sub dispose | 
| 2694 |  |  |  |  |  |  | { | 
| 2695 |  |  |  |  |  |  | my $self = shift; | 
| 2696 |  |  |  |  |  |  |  | 
| 2697 |  |  |  |  |  |  | $self->[_A]->dispose if defined $self->[_A]; | 
| 2698 |  |  |  |  |  |  | $self->SUPER::dispose; | 
| 2699 |  |  |  |  |  |  | } | 
| 2700 |  |  |  |  |  |  |  | 
| 2701 |  |  |  |  |  |  | sub setOwnerDocument | 
| 2702 |  |  |  |  |  |  | { | 
| 2703 |  |  |  |  |  |  | my ($self, $doc) = @_; | 
| 2704 |  |  |  |  |  |  | $self->SUPER::setOwnerDocument ($doc); | 
| 2705 |  |  |  |  |  |  |  | 
| 2706 |  |  |  |  |  |  | $self->[_A]->setOwnerDocument ($doc) if defined $self->[_A]; | 
| 2707 |  |  |  |  |  |  | } | 
| 2708 |  |  |  |  |  |  |  | 
| 2709 |  |  |  |  |  |  | sub print | 
| 2710 |  |  |  |  |  |  | { | 
| 2711 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 2712 |  |  |  |  |  |  |  | 
| 2713 |  |  |  |  |  |  | my $name = $self->[_TagName]; | 
| 2714 |  |  |  |  |  |  |  | 
| 2715 |  |  |  |  |  |  | $FILE->print ("<$name"); | 
| 2716 |  |  |  |  |  |  |  | 
| 2717 |  |  |  |  |  |  | if (defined $self->[_A]) | 
| 2718 |  |  |  |  |  |  | { | 
| 2719 |  |  |  |  |  |  | for my $att (@{$self->[_A]->getValues}) | 
| 2720 |  |  |  |  |  |  | { | 
| 2721 |  |  |  |  |  |  | # skip un-specified (default) Attr nodes | 
| 2722 |  |  |  |  |  |  | if ($att->isSpecified) | 
| 2723 |  |  |  |  |  |  | { | 
| 2724 |  |  |  |  |  |  | $FILE->print (" "); | 
| 2725 |  |  |  |  |  |  | $att->print ($FILE); | 
| 2726 |  |  |  |  |  |  | } | 
| 2727 |  |  |  |  |  |  | } | 
| 2728 |  |  |  |  |  |  | } | 
| 2729 |  |  |  |  |  |  |  | 
| 2730 |  |  |  |  |  |  | my @kids = @{$self->[_C]}; | 
| 2731 |  |  |  |  |  |  | if (@kids > 0) | 
| 2732 |  |  |  |  |  |  | { | 
| 2733 |  |  |  |  |  |  | $FILE->print (">"); | 
| 2734 |  |  |  |  |  |  | for my $kid (@kids) | 
| 2735 |  |  |  |  |  |  | { | 
| 2736 |  |  |  |  |  |  | $kid->print ($FILE); | 
| 2737 |  |  |  |  |  |  | } | 
| 2738 |  |  |  |  |  |  | $FILE->print ("$name>"); | 
| 2739 |  |  |  |  |  |  | } | 
| 2740 |  |  |  |  |  |  | else | 
| 2741 |  |  |  |  |  |  | { | 
| 2742 |  |  |  |  |  |  | my $style = &$XML::DOM::TagStyle ($name, $self); | 
| 2743 |  |  |  |  |  |  | if ($style == 0) | 
| 2744 |  |  |  |  |  |  | { | 
| 2745 |  |  |  |  |  |  | $FILE->print ("/>"); | 
| 2746 |  |  |  |  |  |  | } | 
| 2747 |  |  |  |  |  |  | elsif ($style == 1) | 
| 2748 |  |  |  |  |  |  | { | 
| 2749 |  |  |  |  |  |  | $FILE->print (">$name>"); | 
| 2750 |  |  |  |  |  |  | } | 
| 2751 |  |  |  |  |  |  | else | 
| 2752 |  |  |  |  |  |  | { | 
| 2753 |  |  |  |  |  |  | $FILE->print (" />"); | 
| 2754 |  |  |  |  |  |  | } | 
| 2755 |  |  |  |  |  |  | } | 
| 2756 |  |  |  |  |  |  | } | 
| 2757 |  |  |  |  |  |  |  | 
| 2758 |  |  |  |  |  |  | sub check | 
| 2759 |  |  |  |  |  |  | { | 
| 2760 |  |  |  |  |  |  | my ($self, $checker) = @_; | 
| 2761 |  |  |  |  |  |  | die "Usage: \$xml_dom_elem->check (\$checker)" unless $checker; | 
| 2762 |  |  |  |  |  |  |  | 
| 2763 |  |  |  |  |  |  | $checker->InitDomElem; | 
| 2764 |  |  |  |  |  |  | $self->to_expat ($checker); | 
| 2765 |  |  |  |  |  |  | $checker->FinalDomElem; | 
| 2766 |  |  |  |  |  |  | } | 
| 2767 |  |  |  |  |  |  |  | 
| 2768 |  |  |  |  |  |  | sub to_expat | 
| 2769 |  |  |  |  |  |  | { | 
| 2770 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 2771 |  |  |  |  |  |  |  | 
| 2772 |  |  |  |  |  |  | my $tag = $self->getTagName; | 
| 2773 |  |  |  |  |  |  | $iter->Start ($tag); | 
| 2774 |  |  |  |  |  |  |  | 
| 2775 |  |  |  |  |  |  | if (defined $self->[_A]) | 
| 2776 |  |  |  |  |  |  | { | 
| 2777 |  |  |  |  |  |  | for my $attr ($self->[_A]->getValues) | 
| 2778 |  |  |  |  |  |  | { | 
| 2779 |  |  |  |  |  |  | $iter->Attr ($tag, $attr->getName, $attr->getValue, $attr->isSpecified); | 
| 2780 |  |  |  |  |  |  | } | 
| 2781 |  |  |  |  |  |  | } | 
| 2782 |  |  |  |  |  |  |  | 
| 2783 |  |  |  |  |  |  | $iter->EndAttr; | 
| 2784 |  |  |  |  |  |  |  | 
| 2785 |  |  |  |  |  |  | for my $kid ($self->getChildNodes) | 
| 2786 |  |  |  |  |  |  | { | 
| 2787 |  |  |  |  |  |  | $kid->to_expat ($iter); | 
| 2788 |  |  |  |  |  |  | } | 
| 2789 |  |  |  |  |  |  |  | 
| 2790 |  |  |  |  |  |  | $iter->End; | 
| 2791 |  |  |  |  |  |  | } | 
| 2792 |  |  |  |  |  |  |  | 
| 2793 |  |  |  |  |  |  | sub _to_sax | 
| 2794 |  |  |  |  |  |  | { | 
| 2795 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 2796 |  |  |  |  |  |  |  | 
| 2797 |  |  |  |  |  |  | my $tag = $self->getTagName; | 
| 2798 |  |  |  |  |  |  |  | 
| 2799 |  |  |  |  |  |  | my @attr = (); | 
| 2800 |  |  |  |  |  |  | my $attrOrder; | 
| 2801 |  |  |  |  |  |  | my $attrDefaulted; | 
| 2802 |  |  |  |  |  |  |  | 
| 2803 |  |  |  |  |  |  | if (defined $self->[_A]) | 
| 2804 |  |  |  |  |  |  | { | 
| 2805 |  |  |  |  |  |  | my @spec = ();		# names of specified attributes | 
| 2806 |  |  |  |  |  |  | my @unspec = ();	# names of defaulted attributes | 
| 2807 |  |  |  |  |  |  |  | 
| 2808 |  |  |  |  |  |  | for my $attr ($self->[_A]->getValues) | 
| 2809 |  |  |  |  |  |  | { | 
| 2810 |  |  |  |  |  |  | my $attrName = $attr->getName; | 
| 2811 |  |  |  |  |  |  | push @attr, $attrName, $attr->getValue; | 
| 2812 |  |  |  |  |  |  | if ($attr->isSpecified) | 
| 2813 |  |  |  |  |  |  | { | 
| 2814 |  |  |  |  |  |  | push @spec, $attrName; | 
| 2815 |  |  |  |  |  |  | } | 
| 2816 |  |  |  |  |  |  | else | 
| 2817 |  |  |  |  |  |  | { | 
| 2818 |  |  |  |  |  |  | push @unspec, $attrName; | 
| 2819 |  |  |  |  |  |  | } | 
| 2820 |  |  |  |  |  |  | } | 
| 2821 |  |  |  |  |  |  | $attrOrder = [ @spec, @unspec ]; | 
| 2822 |  |  |  |  |  |  | $attrDefaulted = @spec; | 
| 2823 |  |  |  |  |  |  | } | 
| 2824 |  |  |  |  |  |  | $doch->start_element (defined $attrOrder ? | 
| 2825 |  |  |  |  |  |  | { Name => $tag, | 
| 2826 |  |  |  |  |  |  | Attributes => { @attr }, | 
| 2827 |  |  |  |  |  |  | AttributeOrder => $attrOrder, | 
| 2828 |  |  |  |  |  |  | Defaulted => $attrDefaulted | 
| 2829 |  |  |  |  |  |  | } : | 
| 2830 |  |  |  |  |  |  | { Name => $tag, | 
| 2831 |  |  |  |  |  |  | Attributes => { @attr } | 
| 2832 |  |  |  |  |  |  | } | 
| 2833 |  |  |  |  |  |  | ); | 
| 2834 |  |  |  |  |  |  |  | 
| 2835 |  |  |  |  |  |  | for my $kid ($self->getChildNodes) | 
| 2836 |  |  |  |  |  |  | { | 
| 2837 |  |  |  |  |  |  | $kid->_to_sax ($doch, $dtdh, $enth); | 
| 2838 |  |  |  |  |  |  | } | 
| 2839 |  |  |  |  |  |  |  | 
| 2840 |  |  |  |  |  |  | $doch->end_element ( { Name => $tag } ); | 
| 2841 |  |  |  |  |  |  | } | 
| 2842 |  |  |  |  |  |  |  | 
| 2843 |  |  |  |  |  |  | ###################################################################### | 
| 2844 |  |  |  |  |  |  | package XML::DOM::CharacterData; | 
| 2845 |  |  |  |  |  |  | ###################################################################### | 
| 2846 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 2847 |  |  |  |  |  |  |  | 
| 2848 |  |  |  |  |  |  | BEGIN | 
| 2849 |  |  |  |  |  |  | { | 
| 2850 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 2851 |  |  |  |  |  |  | XML::DOM::def_fields ("Data", "XML::DOM::Node"); | 
| 2852 |  |  |  |  |  |  | } | 
| 2853 |  |  |  |  |  |  |  | 
| 2854 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 2855 |  |  |  |  |  |  | use Carp; | 
| 2856 |  |  |  |  |  |  |  | 
| 2857 |  |  |  |  |  |  |  | 
| 2858 |  |  |  |  |  |  | # | 
| 2859 |  |  |  |  |  |  | # CharacterData nodes should never be created directly, only subclassed! | 
| 2860 |  |  |  |  |  |  | # | 
| 2861 |  |  |  |  |  |  | sub new | 
| 2862 |  |  |  |  |  |  | { | 
| 2863 |  |  |  |  |  |  | my ($class, $doc, $data) = @_; | 
| 2864 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 2865 |  |  |  |  |  |  |  | 
| 2866 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 2867 |  |  |  |  |  |  | $self->[_Data] = $data; | 
| 2868 |  |  |  |  |  |  | $self; | 
| 2869 |  |  |  |  |  |  | } | 
| 2870 |  |  |  |  |  |  |  | 
| 2871 |  |  |  |  |  |  | sub appendData | 
| 2872 |  |  |  |  |  |  | { | 
| 2873 |  |  |  |  |  |  | my ($self, $data) = @_; | 
| 2874 |  |  |  |  |  |  |  | 
| 2875 |  |  |  |  |  |  | if ($XML::DOM::SafeMode) | 
| 2876 |  |  |  |  |  |  | { | 
| 2877 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, | 
| 2878 |  |  |  |  |  |  | "node is ReadOnly") | 
| 2879 |  |  |  |  |  |  | if $self->isReadOnly; | 
| 2880 |  |  |  |  |  |  | } | 
| 2881 |  |  |  |  |  |  | $self->[_Data] .= $data; | 
| 2882 |  |  |  |  |  |  | } | 
| 2883 |  |  |  |  |  |  |  | 
| 2884 |  |  |  |  |  |  | sub deleteData | 
| 2885 |  |  |  |  |  |  | { | 
| 2886 |  |  |  |  |  |  | my ($self, $offset, $count) = @_; | 
| 2887 |  |  |  |  |  |  |  | 
| 2888 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INDEX_SIZE_ERR, | 
| 2889 |  |  |  |  |  |  | "bad offset [$offset]") | 
| 2890 |  |  |  |  |  |  | if ($offset < 0 || $offset >= length ($self->[_Data])); | 
| 2891 |  |  |  |  |  |  | #?? DOM Spec says >, but >= makes more sense! | 
| 2892 |  |  |  |  |  |  |  | 
| 2893 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INDEX_SIZE_ERR, | 
| 2894 |  |  |  |  |  |  | "negative count [$count]") | 
| 2895 |  |  |  |  |  |  | if $count < 0; | 
| 2896 |  |  |  |  |  |  |  | 
| 2897 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, | 
| 2898 |  |  |  |  |  |  | "node is ReadOnly") | 
| 2899 |  |  |  |  |  |  | if $self->isReadOnly; | 
| 2900 |  |  |  |  |  |  |  | 
| 2901 |  |  |  |  |  |  | substr ($self->[_Data], $offset, $count) = ""; | 
| 2902 |  |  |  |  |  |  | } | 
| 2903 |  |  |  |  |  |  |  | 
| 2904 |  |  |  |  |  |  | sub getData | 
| 2905 |  |  |  |  |  |  | { | 
| 2906 |  |  |  |  |  |  | $_[0]->[_Data]; | 
| 2907 |  |  |  |  |  |  | } | 
| 2908 |  |  |  |  |  |  |  | 
| 2909 |  |  |  |  |  |  | sub getLength | 
| 2910 |  |  |  |  |  |  | { | 
| 2911 |  |  |  |  |  |  | length $_[0]->[_Data]; | 
| 2912 |  |  |  |  |  |  | } | 
| 2913 |  |  |  |  |  |  |  | 
| 2914 |  |  |  |  |  |  | sub insertData | 
| 2915 |  |  |  |  |  |  | { | 
| 2916 |  |  |  |  |  |  | my ($self, $offset, $data) = @_; | 
| 2917 |  |  |  |  |  |  |  | 
| 2918 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INDEX_SIZE_ERR, | 
| 2919 |  |  |  |  |  |  | "bad offset [$offset]") | 
| 2920 |  |  |  |  |  |  | if ($offset < 0 || $offset >= length ($self->[_Data])); | 
| 2921 |  |  |  |  |  |  | #?? DOM Spec says >, but >= makes more sense! | 
| 2922 |  |  |  |  |  |  |  | 
| 2923 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, | 
| 2924 |  |  |  |  |  |  | "node is ReadOnly") | 
| 2925 |  |  |  |  |  |  | if $self->isReadOnly; | 
| 2926 |  |  |  |  |  |  |  | 
| 2927 |  |  |  |  |  |  | substr ($self->[_Data], $offset, 0) = $data; | 
| 2928 |  |  |  |  |  |  | } | 
| 2929 |  |  |  |  |  |  |  | 
| 2930 |  |  |  |  |  |  | sub replaceData | 
| 2931 |  |  |  |  |  |  | { | 
| 2932 |  |  |  |  |  |  | my ($self, $offset, $count, $data) = @_; | 
| 2933 |  |  |  |  |  |  |  | 
| 2934 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INDEX_SIZE_ERR, | 
| 2935 |  |  |  |  |  |  | "bad offset [$offset]") | 
| 2936 |  |  |  |  |  |  | if ($offset < 0 || $offset >= length ($self->[_Data])); | 
| 2937 |  |  |  |  |  |  | #?? DOM Spec says >, but >= makes more sense! | 
| 2938 |  |  |  |  |  |  |  | 
| 2939 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INDEX_SIZE_ERR, | 
| 2940 |  |  |  |  |  |  | "negative count [$count]") | 
| 2941 |  |  |  |  |  |  | if $count < 0; | 
| 2942 |  |  |  |  |  |  |  | 
| 2943 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, | 
| 2944 |  |  |  |  |  |  | "node is ReadOnly") | 
| 2945 |  |  |  |  |  |  | if $self->isReadOnly; | 
| 2946 |  |  |  |  |  |  |  | 
| 2947 |  |  |  |  |  |  | substr ($self->[_Data], $offset, $count) = $data; | 
| 2948 |  |  |  |  |  |  | } | 
| 2949 |  |  |  |  |  |  |  | 
| 2950 |  |  |  |  |  |  | sub setData | 
| 2951 |  |  |  |  |  |  | { | 
| 2952 |  |  |  |  |  |  | my ($self, $data) = @_; | 
| 2953 |  |  |  |  |  |  |  | 
| 2954 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, | 
| 2955 |  |  |  |  |  |  | "node is ReadOnly") | 
| 2956 |  |  |  |  |  |  | if $self->isReadOnly; | 
| 2957 |  |  |  |  |  |  |  | 
| 2958 |  |  |  |  |  |  | $self->[_Data] = $data; | 
| 2959 |  |  |  |  |  |  | } | 
| 2960 |  |  |  |  |  |  |  | 
| 2961 |  |  |  |  |  |  | sub substringData | 
| 2962 |  |  |  |  |  |  | { | 
| 2963 |  |  |  |  |  |  | my ($self, $offset, $count) = @_; | 
| 2964 |  |  |  |  |  |  | my $data = $self->[_Data]; | 
| 2965 |  |  |  |  |  |  |  | 
| 2966 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INDEX_SIZE_ERR, | 
| 2967 |  |  |  |  |  |  | "bad offset [$offset]") | 
| 2968 |  |  |  |  |  |  | if ($offset < 0 || $offset >= length ($data)); | 
| 2969 |  |  |  |  |  |  | #?? DOM Spec says >, but >= makes more sense! | 
| 2970 |  |  |  |  |  |  |  | 
| 2971 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INDEX_SIZE_ERR, | 
| 2972 |  |  |  |  |  |  | "negative count [$count]") | 
| 2973 |  |  |  |  |  |  | if $count < 0; | 
| 2974 |  |  |  |  |  |  |  | 
| 2975 |  |  |  |  |  |  | substr ($data, $offset, $count); | 
| 2976 |  |  |  |  |  |  | } | 
| 2977 |  |  |  |  |  |  |  | 
| 2978 |  |  |  |  |  |  | sub getNodeValue | 
| 2979 |  |  |  |  |  |  | { | 
| 2980 |  |  |  |  |  |  | $_[0]->getData; | 
| 2981 |  |  |  |  |  |  | } | 
| 2982 |  |  |  |  |  |  |  | 
| 2983 |  |  |  |  |  |  | sub setNodeValue | 
| 2984 |  |  |  |  |  |  | { | 
| 2985 |  |  |  |  |  |  | $_[0]->setData ($_[1]); | 
| 2986 |  |  |  |  |  |  | } | 
| 2987 |  |  |  |  |  |  |  | 
| 2988 |  |  |  |  |  |  | ###################################################################### | 
| 2989 |  |  |  |  |  |  | package XML::DOM::CDATASection; | 
| 2990 |  |  |  |  |  |  | ###################################################################### | 
| 2991 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 2992 |  |  |  |  |  |  |  | 
| 2993 |  |  |  |  |  |  | BEGIN | 
| 2994 |  |  |  |  |  |  | { | 
| 2995 |  |  |  |  |  |  | import XML::DOM::CharacterData qw( :DEFAULT :Fields ); | 
| 2996 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 2997 |  |  |  |  |  |  | XML::DOM::def_fields ("", "XML::DOM::CharacterData"); | 
| 2998 |  |  |  |  |  |  | } | 
| 2999 |  |  |  |  |  |  |  | 
| 3000 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 3001 |  |  |  |  |  |  |  | 
| 3002 |  |  |  |  |  |  | sub getNodeName | 
| 3003 |  |  |  |  |  |  | { | 
| 3004 |  |  |  |  |  |  | "#cdata-section"; | 
| 3005 |  |  |  |  |  |  | } | 
| 3006 |  |  |  |  |  |  |  | 
| 3007 |  |  |  |  |  |  | sub getNodeType | 
| 3008 |  |  |  |  |  |  | { | 
| 3009 |  |  |  |  |  |  | CDATA_SECTION_NODE; | 
| 3010 |  |  |  |  |  |  | } | 
| 3011 |  |  |  |  |  |  |  | 
| 3012 |  |  |  |  |  |  | sub cloneNode | 
| 3013 |  |  |  |  |  |  | { | 
| 3014 |  |  |  |  |  |  | my $self = shift; | 
| 3015 |  |  |  |  |  |  | $self->[_Doc]->createCDATASection ($self->getData); | 
| 3016 |  |  |  |  |  |  | } | 
| 3017 |  |  |  |  |  |  |  | 
| 3018 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 3019 |  |  |  |  |  |  | # Extra method implementations | 
| 3020 |  |  |  |  |  |  |  | 
| 3021 |  |  |  |  |  |  | sub isReadOnly | 
| 3022 |  |  |  |  |  |  | { | 
| 3023 |  |  |  |  |  |  | 0; | 
| 3024 |  |  |  |  |  |  | } | 
| 3025 |  |  |  |  |  |  |  | 
| 3026 |  |  |  |  |  |  | sub print | 
| 3027 |  |  |  |  |  |  | { | 
| 3028 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 3029 |  |  |  |  |  |  | $FILE->print (" | 
| 3030 |  |  |  |  |  |  | $FILE->print (XML::DOM::encodeCDATA ($self->getData)); | 
| 3031 |  |  |  |  |  |  | $FILE->print ("]]>"); | 
| 3032 |  |  |  |  |  |  | } | 
| 3033 |  |  |  |  |  |  |  | 
| 3034 |  |  |  |  |  |  | sub to_expat | 
| 3035 |  |  |  |  |  |  | { | 
| 3036 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 3037 |  |  |  |  |  |  | $iter->CData ($self->getData); | 
| 3038 |  |  |  |  |  |  | } | 
| 3039 |  |  |  |  |  |  |  | 
| 3040 |  |  |  |  |  |  | sub _to_sax | 
| 3041 |  |  |  |  |  |  | { | 
| 3042 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 3043 |  |  |  |  |  |  | $doch->start_cdata; | 
| 3044 |  |  |  |  |  |  | $doch->characters ( { Data => $self->getData } ); | 
| 3045 |  |  |  |  |  |  | $doch->end_cdata; | 
| 3046 |  |  |  |  |  |  | } | 
| 3047 |  |  |  |  |  |  |  | 
| 3048 |  |  |  |  |  |  | ###################################################################### | 
| 3049 |  |  |  |  |  |  | package XML::DOM::Comment; | 
| 3050 |  |  |  |  |  |  | ###################################################################### | 
| 3051 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 3052 |  |  |  |  |  |  |  | 
| 3053 |  |  |  |  |  |  | BEGIN | 
| 3054 |  |  |  |  |  |  | { | 
| 3055 |  |  |  |  |  |  | import XML::DOM::CharacterData qw( :DEFAULT :Fields ); | 
| 3056 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 3057 |  |  |  |  |  |  | XML::DOM::def_fields ("", "XML::DOM::CharacterData"); | 
| 3058 |  |  |  |  |  |  | } | 
| 3059 |  |  |  |  |  |  |  | 
| 3060 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 3061 |  |  |  |  |  |  | use Carp; | 
| 3062 |  |  |  |  |  |  |  | 
| 3063 |  |  |  |  |  |  | #?? setData - could check comment for double minus | 
| 3064 |  |  |  |  |  |  |  | 
| 3065 |  |  |  |  |  |  | sub getNodeType | 
| 3066 |  |  |  |  |  |  | { | 
| 3067 |  |  |  |  |  |  | COMMENT_NODE; | 
| 3068 |  |  |  |  |  |  | } | 
| 3069 |  |  |  |  |  |  |  | 
| 3070 |  |  |  |  |  |  | sub getNodeName | 
| 3071 |  |  |  |  |  |  | { | 
| 3072 |  |  |  |  |  |  | "#comment"; | 
| 3073 |  |  |  |  |  |  | } | 
| 3074 |  |  |  |  |  |  |  | 
| 3075 |  |  |  |  |  |  | sub cloneNode | 
| 3076 |  |  |  |  |  |  | { | 
| 3077 |  |  |  |  |  |  | my $self = shift; | 
| 3078 |  |  |  |  |  |  | $self->[_Doc]->createComment ($self->getData); | 
| 3079 |  |  |  |  |  |  | } | 
| 3080 |  |  |  |  |  |  |  | 
| 3081 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 3082 |  |  |  |  |  |  | # Extra method implementations | 
| 3083 |  |  |  |  |  |  |  | 
| 3084 |  |  |  |  |  |  | sub isReadOnly | 
| 3085 |  |  |  |  |  |  | { | 
| 3086 |  |  |  |  |  |  | return 0 if $XML::DOM::IgnoreReadOnly; | 
| 3087 |  |  |  |  |  |  |  | 
| 3088 |  |  |  |  |  |  | my $pa = $_[0]->[_Parent]; | 
| 3089 |  |  |  |  |  |  | defined ($pa) ? $pa->isReadOnly : 0; | 
| 3090 |  |  |  |  |  |  | } | 
| 3091 |  |  |  |  |  |  |  | 
| 3092 |  |  |  |  |  |  | sub print | 
| 3093 |  |  |  |  |  |  | { | 
| 3094 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 3095 |  |  |  |  |  |  | my $comment = XML::DOM::encodeComment ($self->[_Data]); | 
| 3096 |  |  |  |  |  |  |  | 
| 3097 |  |  |  |  |  |  | $FILE->print (""); | 
| 3098 |  |  |  |  |  |  | } | 
| 3099 |  |  |  |  |  |  |  | 
| 3100 |  |  |  |  |  |  | sub to_expat | 
| 3101 |  |  |  |  |  |  | { | 
| 3102 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 3103 |  |  |  |  |  |  | $iter->Comment ($self->getData); | 
| 3104 |  |  |  |  |  |  | } | 
| 3105 |  |  |  |  |  |  |  | 
| 3106 |  |  |  |  |  |  | sub _to_sax | 
| 3107 |  |  |  |  |  |  | { | 
| 3108 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 3109 |  |  |  |  |  |  | $doch->comment ( { Data => $self->getData }); | 
| 3110 |  |  |  |  |  |  | } | 
| 3111 |  |  |  |  |  |  |  | 
| 3112 |  |  |  |  |  |  | ###################################################################### | 
| 3113 |  |  |  |  |  |  | package XML::DOM::Text; | 
| 3114 |  |  |  |  |  |  | ###################################################################### | 
| 3115 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 3116 |  |  |  |  |  |  |  | 
| 3117 |  |  |  |  |  |  | BEGIN | 
| 3118 |  |  |  |  |  |  | { | 
| 3119 |  |  |  |  |  |  | import XML::DOM::CharacterData qw( :DEFAULT :Fields ); | 
| 3120 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 3121 |  |  |  |  |  |  | XML::DOM::def_fields ("", "XML::DOM::CharacterData"); | 
| 3122 |  |  |  |  |  |  | } | 
| 3123 |  |  |  |  |  |  |  | 
| 3124 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 3125 |  |  |  |  |  |  | use Carp; | 
| 3126 |  |  |  |  |  |  |  | 
| 3127 |  |  |  |  |  |  | sub getNodeType | 
| 3128 |  |  |  |  |  |  | { | 
| 3129 |  |  |  |  |  |  | TEXT_NODE; | 
| 3130 |  |  |  |  |  |  | } | 
| 3131 |  |  |  |  |  |  |  | 
| 3132 |  |  |  |  |  |  | sub getNodeName | 
| 3133 |  |  |  |  |  |  | { | 
| 3134 |  |  |  |  |  |  | "#text"; | 
| 3135 |  |  |  |  |  |  | } | 
| 3136 |  |  |  |  |  |  |  | 
| 3137 |  |  |  |  |  |  | sub splitText | 
| 3138 |  |  |  |  |  |  | { | 
| 3139 |  |  |  |  |  |  | my ($self, $offset) = @_; | 
| 3140 |  |  |  |  |  |  |  | 
| 3141 |  |  |  |  |  |  | my $data = $self->getData; | 
| 3142 |  |  |  |  |  |  | croak new XML::DOM::DOMException (INDEX_SIZE_ERR, | 
| 3143 |  |  |  |  |  |  | "bad offset [$offset]") | 
| 3144 |  |  |  |  |  |  | if ($offset < 0 || $offset >= length ($data)); | 
| 3145 |  |  |  |  |  |  | #?? DOM Spec says >, but >= makes more sense! | 
| 3146 |  |  |  |  |  |  |  | 
| 3147 |  |  |  |  |  |  | croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, | 
| 3148 |  |  |  |  |  |  | "node is ReadOnly") | 
| 3149 |  |  |  |  |  |  | if $self->isReadOnly; | 
| 3150 |  |  |  |  |  |  |  | 
| 3151 |  |  |  |  |  |  | my $rest = substr ($data, $offset); | 
| 3152 |  |  |  |  |  |  |  | 
| 3153 |  |  |  |  |  |  | $self->setData (substr ($data, 0, $offset)); | 
| 3154 |  |  |  |  |  |  | my $node = $self->[_Doc]->createTextNode ($rest); | 
| 3155 |  |  |  |  |  |  |  | 
| 3156 |  |  |  |  |  |  | # insert new node after this node | 
| 3157 |  |  |  |  |  |  | $self->[_Parent]->insertBefore ($node, $self->getNextSibling); | 
| 3158 |  |  |  |  |  |  |  | 
| 3159 |  |  |  |  |  |  | $node; | 
| 3160 |  |  |  |  |  |  | } | 
| 3161 |  |  |  |  |  |  |  | 
| 3162 |  |  |  |  |  |  | sub cloneNode | 
| 3163 |  |  |  |  |  |  | { | 
| 3164 |  |  |  |  |  |  | my $self = shift; | 
| 3165 |  |  |  |  |  |  | $self->[_Doc]->createTextNode ($self->getData); | 
| 3166 |  |  |  |  |  |  | } | 
| 3167 |  |  |  |  |  |  |  | 
| 3168 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 3169 |  |  |  |  |  |  | # Extra method implementations | 
| 3170 |  |  |  |  |  |  |  | 
| 3171 |  |  |  |  |  |  | sub isReadOnly | 
| 3172 |  |  |  |  |  |  | { | 
| 3173 |  |  |  |  |  |  | 0; | 
| 3174 |  |  |  |  |  |  | } | 
| 3175 |  |  |  |  |  |  |  | 
| 3176 |  |  |  |  |  |  | sub print | 
| 3177 |  |  |  |  |  |  | { | 
| 3178 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 3179 |  |  |  |  |  |  | $FILE->print (XML::DOM::encodeText ($self->getData, '<&>"')); | 
| 3180 |  |  |  |  |  |  | } | 
| 3181 |  |  |  |  |  |  |  | 
| 3182 |  |  |  |  |  |  | sub isTextNode | 
| 3183 |  |  |  |  |  |  | { | 
| 3184 |  |  |  |  |  |  | 1; | 
| 3185 |  |  |  |  |  |  | } | 
| 3186 |  |  |  |  |  |  |  | 
| 3187 |  |  |  |  |  |  | sub to_expat | 
| 3188 |  |  |  |  |  |  | { | 
| 3189 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 3190 |  |  |  |  |  |  | $iter->Char ($self->getData); | 
| 3191 |  |  |  |  |  |  | } | 
| 3192 |  |  |  |  |  |  |  | 
| 3193 |  |  |  |  |  |  | sub _to_sax | 
| 3194 |  |  |  |  |  |  | { | 
| 3195 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 3196 |  |  |  |  |  |  | $doch->characters ( { Data => $self->getData } ); | 
| 3197 |  |  |  |  |  |  | } | 
| 3198 |  |  |  |  |  |  |  | 
| 3199 |  |  |  |  |  |  | ###################################################################### | 
| 3200 |  |  |  |  |  |  | package XML::DOM::XMLDecl; | 
| 3201 |  |  |  |  |  |  | ###################################################################### | 
| 3202 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 3203 |  |  |  |  |  |  |  | 
| 3204 |  |  |  |  |  |  | BEGIN | 
| 3205 |  |  |  |  |  |  | { | 
| 3206 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 3207 |  |  |  |  |  |  | XML::DOM::def_fields ("Version Encoding Standalone", "XML::DOM::Node"); | 
| 3208 |  |  |  |  |  |  | } | 
| 3209 |  |  |  |  |  |  |  | 
| 3210 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 3211 |  |  |  |  |  |  |  | 
| 3212 |  |  |  |  |  |  |  | 
| 3213 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 3214 |  |  |  |  |  |  | # Extra method implementations | 
| 3215 |  |  |  |  |  |  |  | 
| 3216 |  |  |  |  |  |  | # XMLDecl is not part of the DOM Spec | 
| 3217 |  |  |  |  |  |  | sub new | 
| 3218 |  |  |  |  |  |  | { | 
| 3219 |  |  |  |  |  |  | my ($class, $doc, $version, $encoding, $standalone) = @_; | 
| 3220 |  |  |  |  |  |  |  | 
| 3221 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 3222 |  |  |  |  |  |  |  | 
| 3223 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 3224 |  |  |  |  |  |  | $self->[_Version] = $version if defined $version; | 
| 3225 |  |  |  |  |  |  | $self->[_Encoding] = $encoding if defined $encoding; | 
| 3226 |  |  |  |  |  |  | $self->[_Standalone] = $standalone if defined $standalone; | 
| 3227 |  |  |  |  |  |  |  | 
| 3228 |  |  |  |  |  |  | $self; | 
| 3229 |  |  |  |  |  |  | } | 
| 3230 |  |  |  |  |  |  |  | 
| 3231 |  |  |  |  |  |  | sub setVersion | 
| 3232 |  |  |  |  |  |  | { | 
| 3233 |  |  |  |  |  |  | if (defined $_[1]) | 
| 3234 |  |  |  |  |  |  | { | 
| 3235 |  |  |  |  |  |  | $_[0]->[_Version] = $_[1]; | 
| 3236 |  |  |  |  |  |  | } | 
| 3237 |  |  |  |  |  |  | else | 
| 3238 |  |  |  |  |  |  | { | 
| 3239 |  |  |  |  |  |  | undef $_[0]->[_Version]; # was delete | 
| 3240 |  |  |  |  |  |  | } | 
| 3241 |  |  |  |  |  |  | } | 
| 3242 |  |  |  |  |  |  |  | 
| 3243 |  |  |  |  |  |  | sub getVersion | 
| 3244 |  |  |  |  |  |  | { | 
| 3245 |  |  |  |  |  |  | $_[0]->[_Version]; | 
| 3246 |  |  |  |  |  |  | } | 
| 3247 |  |  |  |  |  |  |  | 
| 3248 |  |  |  |  |  |  | sub setEncoding | 
| 3249 |  |  |  |  |  |  | { | 
| 3250 |  |  |  |  |  |  | if (defined $_[1]) | 
| 3251 |  |  |  |  |  |  | { | 
| 3252 |  |  |  |  |  |  | $_[0]->[_Encoding] = $_[1]; | 
| 3253 |  |  |  |  |  |  | } | 
| 3254 |  |  |  |  |  |  | else | 
| 3255 |  |  |  |  |  |  | { | 
| 3256 |  |  |  |  |  |  | undef $_[0]->[_Encoding]; # was delete | 
| 3257 |  |  |  |  |  |  | } | 
| 3258 |  |  |  |  |  |  | } | 
| 3259 |  |  |  |  |  |  |  | 
| 3260 |  |  |  |  |  |  | sub getEncoding | 
| 3261 |  |  |  |  |  |  | { | 
| 3262 |  |  |  |  |  |  | $_[0]->[_Encoding]; | 
| 3263 |  |  |  |  |  |  | } | 
| 3264 |  |  |  |  |  |  |  | 
| 3265 |  |  |  |  |  |  | sub setStandalone | 
| 3266 |  |  |  |  |  |  | { | 
| 3267 |  |  |  |  |  |  | if (defined $_[1]) | 
| 3268 |  |  |  |  |  |  | { | 
| 3269 |  |  |  |  |  |  | $_[0]->[_Standalone] = $_[1]; | 
| 3270 |  |  |  |  |  |  | } | 
| 3271 |  |  |  |  |  |  | else | 
| 3272 |  |  |  |  |  |  | { | 
| 3273 |  |  |  |  |  |  | undef $_[0]->[_Standalone]; # was delete | 
| 3274 |  |  |  |  |  |  | } | 
| 3275 |  |  |  |  |  |  | } | 
| 3276 |  |  |  |  |  |  |  | 
| 3277 |  |  |  |  |  |  | sub getStandalone | 
| 3278 |  |  |  |  |  |  | { | 
| 3279 |  |  |  |  |  |  | $_[0]->[_Standalone]; | 
| 3280 |  |  |  |  |  |  | } | 
| 3281 |  |  |  |  |  |  |  | 
| 3282 |  |  |  |  |  |  | sub getNodeType | 
| 3283 |  |  |  |  |  |  | { | 
| 3284 |  |  |  |  |  |  | XML_DECL_NODE; | 
| 3285 |  |  |  |  |  |  | } | 
| 3286 |  |  |  |  |  |  |  | 
| 3287 |  |  |  |  |  |  | sub cloneNode | 
| 3288 |  |  |  |  |  |  | { | 
| 3289 |  |  |  |  |  |  | my $self = shift; | 
| 3290 |  |  |  |  |  |  |  | 
| 3291 |  |  |  |  |  |  | new XML::DOM::XMLDecl ($self->[_Doc], $self->[_Version], | 
| 3292 |  |  |  |  |  |  | $self->[_Encoding], $self->[_Standalone]); | 
| 3293 |  |  |  |  |  |  | } | 
| 3294 |  |  |  |  |  |  |  | 
| 3295 |  |  |  |  |  |  | sub print | 
| 3296 |  |  |  |  |  |  | { | 
| 3297 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 3298 |  |  |  |  |  |  |  | 
| 3299 |  |  |  |  |  |  | my $version = $self->[_Version]; | 
| 3300 |  |  |  |  |  |  | my $encoding = $self->[_Encoding]; | 
| 3301 |  |  |  |  |  |  | my $standalone = $self->[_Standalone]; | 
| 3302 |  |  |  |  |  |  | $standalone = ($standalone ? "yes" : "no") if defined $standalone; | 
| 3303 |  |  |  |  |  |  |  | 
| 3304 |  |  |  |  |  |  | $FILE->print (" | 
| 3305 |  |  |  |  |  |  | $FILE->print (" version=\"$version\"")	 if defined $version; | 
| 3306 |  |  |  |  |  |  | $FILE->print (" encoding=\"$encoding\"")	 if defined $encoding; | 
| 3307 |  |  |  |  |  |  | $FILE->print (" standalone=\"$standalone\"") if defined $standalone; | 
| 3308 |  |  |  |  |  |  | $FILE->print ("?>"); | 
| 3309 |  |  |  |  |  |  | } | 
| 3310 |  |  |  |  |  |  |  | 
| 3311 |  |  |  |  |  |  | sub to_expat | 
| 3312 |  |  |  |  |  |  | { | 
| 3313 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 3314 |  |  |  |  |  |  | $iter->XMLDecl ($self->getVersion, $self->getEncoding, $self->getStandalone); | 
| 3315 |  |  |  |  |  |  | } | 
| 3316 |  |  |  |  |  |  |  | 
| 3317 |  |  |  |  |  |  | sub _to_sax | 
| 3318 |  |  |  |  |  |  | { | 
| 3319 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 3320 |  |  |  |  |  |  | $dtdh->xml_decl ( { Version => $self->getVersion, | 
| 3321 |  |  |  |  |  |  | Encoding => $self->getEncoding, | 
| 3322 |  |  |  |  |  |  | Standalone => $self->getStandalone } ); | 
| 3323 |  |  |  |  |  |  | } | 
| 3324 |  |  |  |  |  |  |  | 
| 3325 |  |  |  |  |  |  | ###################################################################### | 
| 3326 |  |  |  |  |  |  | package XML::DOM::DocumentFragment; | 
| 3327 |  |  |  |  |  |  | ###################################################################### | 
| 3328 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 3329 |  |  |  |  |  |  |  | 
| 3330 |  |  |  |  |  |  | BEGIN | 
| 3331 |  |  |  |  |  |  | { | 
| 3332 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 3333 |  |  |  |  |  |  | XML::DOM::def_fields ("", "XML::DOM::Node"); | 
| 3334 |  |  |  |  |  |  | } | 
| 3335 |  |  |  |  |  |  |  | 
| 3336 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 3337 |  |  |  |  |  |  |  | 
| 3338 |  |  |  |  |  |  | sub new | 
| 3339 |  |  |  |  |  |  | { | 
| 3340 |  |  |  |  |  |  | my ($class, $doc) = @_; | 
| 3341 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 3342 |  |  |  |  |  |  |  | 
| 3343 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 3344 |  |  |  |  |  |  | $self->[_C] = new XML::DOM::NodeList; | 
| 3345 |  |  |  |  |  |  | $self; | 
| 3346 |  |  |  |  |  |  | } | 
| 3347 |  |  |  |  |  |  |  | 
| 3348 |  |  |  |  |  |  | sub getNodeType | 
| 3349 |  |  |  |  |  |  | { | 
| 3350 |  |  |  |  |  |  | DOCUMENT_FRAGMENT_NODE; | 
| 3351 |  |  |  |  |  |  | } | 
| 3352 |  |  |  |  |  |  |  | 
| 3353 |  |  |  |  |  |  | sub getNodeName | 
| 3354 |  |  |  |  |  |  | { | 
| 3355 |  |  |  |  |  |  | "#document-fragment"; | 
| 3356 |  |  |  |  |  |  | } | 
| 3357 |  |  |  |  |  |  |  | 
| 3358 |  |  |  |  |  |  | sub cloneNode | 
| 3359 |  |  |  |  |  |  | { | 
| 3360 |  |  |  |  |  |  | my ($self, $deep) = @_; | 
| 3361 |  |  |  |  |  |  | my $node = $self->[_Doc]->createDocumentFragment; | 
| 3362 |  |  |  |  |  |  |  | 
| 3363 |  |  |  |  |  |  | $node->cloneChildren ($self, $deep); | 
| 3364 |  |  |  |  |  |  | $node; | 
| 3365 |  |  |  |  |  |  | } | 
| 3366 |  |  |  |  |  |  |  | 
| 3367 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 3368 |  |  |  |  |  |  | # Extra method implementations | 
| 3369 |  |  |  |  |  |  |  | 
| 3370 |  |  |  |  |  |  | sub isReadOnly | 
| 3371 |  |  |  |  |  |  | { | 
| 3372 |  |  |  |  |  |  | 0; | 
| 3373 |  |  |  |  |  |  | } | 
| 3374 |  |  |  |  |  |  |  | 
| 3375 |  |  |  |  |  |  | sub print | 
| 3376 |  |  |  |  |  |  | { | 
| 3377 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 3378 |  |  |  |  |  |  |  | 
| 3379 |  |  |  |  |  |  | for my $node (@{$self->[_C]}) | 
| 3380 |  |  |  |  |  |  | { | 
| 3381 |  |  |  |  |  |  | $node->print ($FILE); | 
| 3382 |  |  |  |  |  |  | } | 
| 3383 |  |  |  |  |  |  | } | 
| 3384 |  |  |  |  |  |  |  | 
| 3385 |  |  |  |  |  |  | sub rejectChild | 
| 3386 |  |  |  |  |  |  | { | 
| 3387 |  |  |  |  |  |  | my $t = $_[1]->getNodeType; | 
| 3388 |  |  |  |  |  |  |  | 
| 3389 |  |  |  |  |  |  | $t != TEXT_NODE | 
| 3390 |  |  |  |  |  |  | && $t != ENTITY_REFERENCE_NODE | 
| 3391 |  |  |  |  |  |  | && $t != PROCESSING_INSTRUCTION_NODE | 
| 3392 |  |  |  |  |  |  | && $t != COMMENT_NODE | 
| 3393 |  |  |  |  |  |  | && $t != CDATA_SECTION_NODE | 
| 3394 |  |  |  |  |  |  | && $t != ELEMENT_NODE; | 
| 3395 |  |  |  |  |  |  | } | 
| 3396 |  |  |  |  |  |  |  | 
| 3397 |  |  |  |  |  |  | sub isDocumentFragmentNode | 
| 3398 |  |  |  |  |  |  | { | 
| 3399 |  |  |  |  |  |  | 1; | 
| 3400 |  |  |  |  |  |  | } | 
| 3401 |  |  |  |  |  |  |  | 
| 3402 |  |  |  |  |  |  | ###################################################################### | 
| 3403 |  |  |  |  |  |  | package XML::DOM::DocumentType;		# forward declaration | 
| 3404 |  |  |  |  |  |  | ###################################################################### | 
| 3405 |  |  |  |  |  |  |  | 
| 3406 |  |  |  |  |  |  | ###################################################################### | 
| 3407 |  |  |  |  |  |  | package XML::DOM::Document; | 
| 3408 |  |  |  |  |  |  | ###################################################################### | 
| 3409 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 3410 |  |  |  |  |  |  |  | 
| 3411 |  |  |  |  |  |  | BEGIN | 
| 3412 |  |  |  |  |  |  | { | 
| 3413 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 3414 |  |  |  |  |  |  | XML::DOM::def_fields ("Doctype XmlDecl", "XML::DOM::Node"); | 
| 3415 |  |  |  |  |  |  | } | 
| 3416 |  |  |  |  |  |  |  | 
| 3417 |  |  |  |  |  |  | use Carp; | 
| 3418 |  |  |  |  |  |  | use XML::DOM::NodeList; | 
| 3419 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 3420 |  |  |  |  |  |  |  | 
| 3421 |  |  |  |  |  |  | sub new | 
| 3422 |  |  |  |  |  |  | { | 
| 3423 |  |  |  |  |  |  | my ($class) = @_; | 
| 3424 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 3425 |  |  |  |  |  |  |  | 
| 3426 |  |  |  |  |  |  | # keep Doc pointer, even though getOwnerDocument returns undef | 
| 3427 |  |  |  |  |  |  | $self->[_Doc] = $self; | 
| 3428 |  |  |  |  |  |  | $self->[_C] = new XML::DOM::NodeList; | 
| 3429 |  |  |  |  |  |  | $self; | 
| 3430 |  |  |  |  |  |  | } | 
| 3431 |  |  |  |  |  |  |  | 
| 3432 |  |  |  |  |  |  | sub getNodeType | 
| 3433 |  |  |  |  |  |  | { | 
| 3434 |  |  |  |  |  |  | DOCUMENT_NODE; | 
| 3435 |  |  |  |  |  |  | } | 
| 3436 |  |  |  |  |  |  |  | 
| 3437 |  |  |  |  |  |  | sub getNodeName | 
| 3438 |  |  |  |  |  |  | { | 
| 3439 |  |  |  |  |  |  | "#document"; | 
| 3440 |  |  |  |  |  |  | } | 
| 3441 |  |  |  |  |  |  |  | 
| 3442 |  |  |  |  |  |  | #?? not sure about keeping a fixed order of these nodes.... | 
| 3443 |  |  |  |  |  |  | sub getDoctype | 
| 3444 |  |  |  |  |  |  | { | 
| 3445 |  |  |  |  |  |  | $_[0]->[_Doctype]; | 
| 3446 |  |  |  |  |  |  | } | 
| 3447 |  |  |  |  |  |  |  | 
| 3448 |  |  |  |  |  |  | sub getDocumentElement | 
| 3449 |  |  |  |  |  |  | { | 
| 3450 |  |  |  |  |  |  | my ($self) = @_; | 
| 3451 |  |  |  |  |  |  | for my $kid (@{$self->[_C]}) | 
| 3452 |  |  |  |  |  |  | { | 
| 3453 |  |  |  |  |  |  | return $kid if $kid->isElementNode; | 
| 3454 |  |  |  |  |  |  | } | 
| 3455 |  |  |  |  |  |  | undef; | 
| 3456 |  |  |  |  |  |  | } | 
| 3457 |  |  |  |  |  |  |  | 
| 3458 |  |  |  |  |  |  | sub getOwnerDocument | 
| 3459 |  |  |  |  |  |  | { | 
| 3460 |  |  |  |  |  |  | undef; | 
| 3461 |  |  |  |  |  |  | } | 
| 3462 |  |  |  |  |  |  |  | 
| 3463 |  |  |  |  |  |  | sub getImplementation | 
| 3464 |  |  |  |  |  |  | { | 
| 3465 |  |  |  |  |  |  | $XML::DOM::DOMImplementation::Singleton; | 
| 3466 |  |  |  |  |  |  | } | 
| 3467 |  |  |  |  |  |  |  | 
| 3468 |  |  |  |  |  |  | # | 
| 3469 |  |  |  |  |  |  | # Added extra parameters ($val, $specified) that are passed straight to the | 
| 3470 |  |  |  |  |  |  | # Attr constructor | 
| 3471 |  |  |  |  |  |  | # | 
| 3472 |  |  |  |  |  |  | sub createAttribute | 
| 3473 |  |  |  |  |  |  | { | 
| 3474 |  |  |  |  |  |  | new XML::DOM::Attr (@_); | 
| 3475 |  |  |  |  |  |  | } | 
| 3476 |  |  |  |  |  |  |  | 
| 3477 |  |  |  |  |  |  | sub createCDATASection | 
| 3478 |  |  |  |  |  |  | { | 
| 3479 |  |  |  |  |  |  | new XML::DOM::CDATASection (@_); | 
| 3480 |  |  |  |  |  |  | } | 
| 3481 |  |  |  |  |  |  |  | 
| 3482 |  |  |  |  |  |  | sub createComment | 
| 3483 |  |  |  |  |  |  | { | 
| 3484 |  |  |  |  |  |  | new XML::DOM::Comment (@_); | 
| 3485 |  |  |  |  |  |  |  | 
| 3486 |  |  |  |  |  |  | } | 
| 3487 |  |  |  |  |  |  |  | 
| 3488 |  |  |  |  |  |  | sub createElement | 
| 3489 |  |  |  |  |  |  | { | 
| 3490 |  |  |  |  |  |  | new XML::DOM::Element (@_); | 
| 3491 |  |  |  |  |  |  | } | 
| 3492 |  |  |  |  |  |  |  | 
| 3493 |  |  |  |  |  |  | sub createTextNode | 
| 3494 |  |  |  |  |  |  | { | 
| 3495 |  |  |  |  |  |  | new XML::DOM::Text (@_); | 
| 3496 |  |  |  |  |  |  | } | 
| 3497 |  |  |  |  |  |  |  | 
| 3498 |  |  |  |  |  |  | sub createProcessingInstruction | 
| 3499 |  |  |  |  |  |  | { | 
| 3500 |  |  |  |  |  |  | new XML::DOM::ProcessingInstruction (@_); | 
| 3501 |  |  |  |  |  |  | } | 
| 3502 |  |  |  |  |  |  |  | 
| 3503 |  |  |  |  |  |  | sub createEntityReference | 
| 3504 |  |  |  |  |  |  | { | 
| 3505 |  |  |  |  |  |  | new XML::DOM::EntityReference (@_); | 
| 3506 |  |  |  |  |  |  | } | 
| 3507 |  |  |  |  |  |  |  | 
| 3508 |  |  |  |  |  |  | sub createDocumentFragment | 
| 3509 |  |  |  |  |  |  | { | 
| 3510 |  |  |  |  |  |  | new XML::DOM::DocumentFragment (@_); | 
| 3511 |  |  |  |  |  |  | } | 
| 3512 |  |  |  |  |  |  |  | 
| 3513 |  |  |  |  |  |  | sub createDocumentType | 
| 3514 |  |  |  |  |  |  | { | 
| 3515 |  |  |  |  |  |  | new XML::DOM::DocumentType (@_); | 
| 3516 |  |  |  |  |  |  | } | 
| 3517 |  |  |  |  |  |  |  | 
| 3518 |  |  |  |  |  |  | sub cloneNode | 
| 3519 |  |  |  |  |  |  | { | 
| 3520 |  |  |  |  |  |  | my ($self, $deep) = @_; | 
| 3521 |  |  |  |  |  |  | my $node = new XML::DOM::Document; | 
| 3522 |  |  |  |  |  |  |  | 
| 3523 |  |  |  |  |  |  | $node->cloneChildren ($self, $deep); | 
| 3524 |  |  |  |  |  |  |  | 
| 3525 |  |  |  |  |  |  | my $xmlDecl = $self->[_XmlDecl]; | 
| 3526 |  |  |  |  |  |  | $node->[_XmlDecl] = $xmlDecl->cloneNode ($deep) if defined $xmlDecl; | 
| 3527 |  |  |  |  |  |  |  | 
| 3528 |  |  |  |  |  |  | $node; | 
| 3529 |  |  |  |  |  |  | } | 
| 3530 |  |  |  |  |  |  |  | 
| 3531 |  |  |  |  |  |  | sub appendChild | 
| 3532 |  |  |  |  |  |  | { | 
| 3533 |  |  |  |  |  |  | my ($self, $node) = @_; | 
| 3534 |  |  |  |  |  |  |  | 
| 3535 |  |  |  |  |  |  | # Extra check: make sure we don't end up with more than one Element. | 
| 3536 |  |  |  |  |  |  | # Don't worry about multiple DocType nodes, because DocumentFragment | 
| 3537 |  |  |  |  |  |  | # can't contain DocType nodes. | 
| 3538 |  |  |  |  |  |  |  | 
| 3539 |  |  |  |  |  |  | my @nodes = ($node); | 
| 3540 |  |  |  |  |  |  | @nodes = @{$node->[_C]} | 
| 3541 |  |  |  |  |  |  | if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; | 
| 3542 |  |  |  |  |  |  |  | 
| 3543 |  |  |  |  |  |  | my $elem = 0; | 
| 3544 |  |  |  |  |  |  | for my $n (@nodes) | 
| 3545 |  |  |  |  |  |  | { | 
| 3546 |  |  |  |  |  |  | $elem++ if $n->isElementNode; | 
| 3547 |  |  |  |  |  |  | } | 
| 3548 |  |  |  |  |  |  |  | 
| 3549 |  |  |  |  |  |  | if ($elem > 0 && defined ($self->getDocumentElement)) | 
| 3550 |  |  |  |  |  |  | { | 
| 3551 |  |  |  |  |  |  | croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, | 
| 3552 |  |  |  |  |  |  | "document can have only one Element"); | 
| 3553 |  |  |  |  |  |  | } | 
| 3554 |  |  |  |  |  |  | $self->SUPER::appendChild ($node); | 
| 3555 |  |  |  |  |  |  | } | 
| 3556 |  |  |  |  |  |  |  | 
| 3557 |  |  |  |  |  |  | sub insertBefore | 
| 3558 |  |  |  |  |  |  | { | 
| 3559 |  |  |  |  |  |  | my ($self, $node, $refNode) = @_; | 
| 3560 |  |  |  |  |  |  |  | 
| 3561 |  |  |  |  |  |  | # Extra check: make sure sure we don't end up with more than 1 Elements. | 
| 3562 |  |  |  |  |  |  | # Don't worry about multiple DocType nodes, because DocumentFragment | 
| 3563 |  |  |  |  |  |  | # can't contain DocType nodes. | 
| 3564 |  |  |  |  |  |  |  | 
| 3565 |  |  |  |  |  |  | my @nodes = ($node); | 
| 3566 |  |  |  |  |  |  | @nodes = @{$node->[_C]} | 
| 3567 |  |  |  |  |  |  | if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; | 
| 3568 |  |  |  |  |  |  |  | 
| 3569 |  |  |  |  |  |  | my $elem = 0; | 
| 3570 |  |  |  |  |  |  | for my $n (@nodes) | 
| 3571 |  |  |  |  |  |  | { | 
| 3572 |  |  |  |  |  |  | $elem++ if $n->isElementNode; | 
| 3573 |  |  |  |  |  |  | } | 
| 3574 |  |  |  |  |  |  |  | 
| 3575 |  |  |  |  |  |  | if ($elem > 0 && defined ($self->getDocumentElement)) | 
| 3576 |  |  |  |  |  |  | { | 
| 3577 |  |  |  |  |  |  | croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, | 
| 3578 |  |  |  |  |  |  | "document can have only one Element"); | 
| 3579 |  |  |  |  |  |  | } | 
| 3580 |  |  |  |  |  |  | $self->SUPER::insertBefore ($node, $refNode); | 
| 3581 |  |  |  |  |  |  | } | 
| 3582 |  |  |  |  |  |  |  | 
| 3583 |  |  |  |  |  |  | sub replaceChild | 
| 3584 |  |  |  |  |  |  | { | 
| 3585 |  |  |  |  |  |  | my ($self, $node, $refNode) = @_; | 
| 3586 |  |  |  |  |  |  |  | 
| 3587 |  |  |  |  |  |  | # Extra check: make sure sure we don't end up with more than 1 Elements. | 
| 3588 |  |  |  |  |  |  | # Don't worry about multiple DocType nodes, because DocumentFragment | 
| 3589 |  |  |  |  |  |  | # can't contain DocType nodes. | 
| 3590 |  |  |  |  |  |  |  | 
| 3591 |  |  |  |  |  |  | my @nodes = ($node); | 
| 3592 |  |  |  |  |  |  | @nodes = @{$node->[_C]} | 
| 3593 |  |  |  |  |  |  | if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; | 
| 3594 |  |  |  |  |  |  |  | 
| 3595 |  |  |  |  |  |  | my $elem = 0; | 
| 3596 |  |  |  |  |  |  | $elem-- if $refNode->isElementNode; | 
| 3597 |  |  |  |  |  |  |  | 
| 3598 |  |  |  |  |  |  | for my $n (@nodes) | 
| 3599 |  |  |  |  |  |  | { | 
| 3600 |  |  |  |  |  |  | $elem++ if $n->isElementNode; | 
| 3601 |  |  |  |  |  |  | } | 
| 3602 |  |  |  |  |  |  |  | 
| 3603 |  |  |  |  |  |  | if ($elem > 0 && defined ($self->getDocumentElement)) | 
| 3604 |  |  |  |  |  |  | { | 
| 3605 |  |  |  |  |  |  | croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, | 
| 3606 |  |  |  |  |  |  | "document can have only one Element"); | 
| 3607 |  |  |  |  |  |  | } | 
| 3608 |  |  |  |  |  |  | $self->SUPER::replaceChild ($node, $refNode); | 
| 3609 |  |  |  |  |  |  | } | 
| 3610 |  |  |  |  |  |  |  | 
| 3611 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 3612 |  |  |  |  |  |  | # Extra method implementations | 
| 3613 |  |  |  |  |  |  |  | 
| 3614 |  |  |  |  |  |  | sub isReadOnly | 
| 3615 |  |  |  |  |  |  | { | 
| 3616 |  |  |  |  |  |  | 0; | 
| 3617 |  |  |  |  |  |  | } | 
| 3618 |  |  |  |  |  |  |  | 
| 3619 |  |  |  |  |  |  | sub print | 
| 3620 |  |  |  |  |  |  | { | 
| 3621 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 3622 |  |  |  |  |  |  |  | 
| 3623 |  |  |  |  |  |  | my $xmlDecl = $self->getXMLDecl; | 
| 3624 |  |  |  |  |  |  | if (defined $xmlDecl) | 
| 3625 |  |  |  |  |  |  | { | 
| 3626 |  |  |  |  |  |  | $xmlDecl->print ($FILE); | 
| 3627 |  |  |  |  |  |  | $FILE->print ("\x0A"); | 
| 3628 |  |  |  |  |  |  | } | 
| 3629 |  |  |  |  |  |  |  | 
| 3630 |  |  |  |  |  |  | for my $node (@{$self->[_C]}) | 
| 3631 |  |  |  |  |  |  | { | 
| 3632 |  |  |  |  |  |  | $node->print ($FILE); | 
| 3633 |  |  |  |  |  |  | $FILE->print ("\x0A"); | 
| 3634 |  |  |  |  |  |  | } | 
| 3635 |  |  |  |  |  |  | } | 
| 3636 |  |  |  |  |  |  |  | 
| 3637 |  |  |  |  |  |  | sub setDoctype | 
| 3638 |  |  |  |  |  |  | { | 
| 3639 |  |  |  |  |  |  | my ($self, $doctype) = @_; | 
| 3640 |  |  |  |  |  |  | my $oldDoctype = $self->[_Doctype]; | 
| 3641 |  |  |  |  |  |  | if (defined $oldDoctype) | 
| 3642 |  |  |  |  |  |  | { | 
| 3643 |  |  |  |  |  |  | $self->replaceChild ($doctype, $oldDoctype); | 
| 3644 |  |  |  |  |  |  | } | 
| 3645 |  |  |  |  |  |  | else | 
| 3646 |  |  |  |  |  |  | { | 
| 3647 |  |  |  |  |  |  | #?? before root element, but after XmlDecl ! | 
| 3648 |  |  |  |  |  |  | $self->appendChild ($doctype); | 
| 3649 |  |  |  |  |  |  | } | 
| 3650 |  |  |  |  |  |  | $_[0]->[_Doctype] = $_[1]; | 
| 3651 |  |  |  |  |  |  | } | 
| 3652 |  |  |  |  |  |  |  | 
| 3653 |  |  |  |  |  |  | sub removeDoctype | 
| 3654 |  |  |  |  |  |  | { | 
| 3655 |  |  |  |  |  |  | my $self = shift; | 
| 3656 |  |  |  |  |  |  | my $doctype = $self->removeChild ($self->[_Doctype]); | 
| 3657 |  |  |  |  |  |  |  | 
| 3658 |  |  |  |  |  |  | undef $self->[_Doctype]; # was delete | 
| 3659 |  |  |  |  |  |  | $doctype; | 
| 3660 |  |  |  |  |  |  | } | 
| 3661 |  |  |  |  |  |  |  | 
| 3662 |  |  |  |  |  |  | sub rejectChild | 
| 3663 |  |  |  |  |  |  | { | 
| 3664 |  |  |  |  |  |  | my $t = $_[1]->getNodeType; | 
| 3665 |  |  |  |  |  |  | $t != ELEMENT_NODE | 
| 3666 |  |  |  |  |  |  | && $t != PROCESSING_INSTRUCTION_NODE | 
| 3667 |  |  |  |  |  |  | && $t != COMMENT_NODE | 
| 3668 |  |  |  |  |  |  | && $t != DOCUMENT_TYPE_NODE; | 
| 3669 |  |  |  |  |  |  | } | 
| 3670 |  |  |  |  |  |  |  | 
| 3671 |  |  |  |  |  |  | sub expandEntity | 
| 3672 |  |  |  |  |  |  | { | 
| 3673 |  |  |  |  |  |  | my ($self, $ent, $param) = @_; | 
| 3674 |  |  |  |  |  |  | my $doctype = $self->getDoctype; | 
| 3675 |  |  |  |  |  |  |  | 
| 3676 |  |  |  |  |  |  | (defined $doctype) ? $doctype->expandEntity ($ent, $param) : undef; | 
| 3677 |  |  |  |  |  |  | } | 
| 3678 |  |  |  |  |  |  |  | 
| 3679 |  |  |  |  |  |  | sub getDefaultAttrValue | 
| 3680 |  |  |  |  |  |  | { | 
| 3681 |  |  |  |  |  |  | my ($self, $elem, $attr) = @_; | 
| 3682 |  |  |  |  |  |  |  | 
| 3683 |  |  |  |  |  |  | my $doctype = $self->getDoctype; | 
| 3684 |  |  |  |  |  |  |  | 
| 3685 |  |  |  |  |  |  | (defined $doctype) ? $doctype->getDefaultAttrValue ($elem, $attr) : undef; | 
| 3686 |  |  |  |  |  |  | } | 
| 3687 |  |  |  |  |  |  |  | 
| 3688 |  |  |  |  |  |  | sub getEntity | 
| 3689 |  |  |  |  |  |  | { | 
| 3690 |  |  |  |  |  |  | my ($self, $entity) = @_; | 
| 3691 |  |  |  |  |  |  |  | 
| 3692 |  |  |  |  |  |  | my $doctype = $self->getDoctype; | 
| 3693 |  |  |  |  |  |  |  | 
| 3694 |  |  |  |  |  |  | (defined $doctype) ? $doctype->getEntity ($entity) : undef; | 
| 3695 |  |  |  |  |  |  | } | 
| 3696 |  |  |  |  |  |  |  | 
| 3697 |  |  |  |  |  |  | sub dispose | 
| 3698 |  |  |  |  |  |  | { | 
| 3699 |  |  |  |  |  |  | my $self = shift; | 
| 3700 |  |  |  |  |  |  |  | 
| 3701 |  |  |  |  |  |  | $self->[_XmlDecl]->dispose if defined $self->[_XmlDecl]; | 
| 3702 |  |  |  |  |  |  | undef $self->[_XmlDecl]; # was delete | 
| 3703 |  |  |  |  |  |  | undef $self->[_Doctype]; # was delete | 
| 3704 |  |  |  |  |  |  | $self->SUPER::dispose; | 
| 3705 |  |  |  |  |  |  | } | 
| 3706 |  |  |  |  |  |  |  | 
| 3707 |  |  |  |  |  |  | sub setOwnerDocument | 
| 3708 |  |  |  |  |  |  | { | 
| 3709 |  |  |  |  |  |  | # Do nothing, you can't change the owner document! | 
| 3710 |  |  |  |  |  |  | #?? could throw exception... | 
| 3711 |  |  |  |  |  |  | } | 
| 3712 |  |  |  |  |  |  |  | 
| 3713 |  |  |  |  |  |  | sub getXMLDecl | 
| 3714 |  |  |  |  |  |  | { | 
| 3715 |  |  |  |  |  |  | $_[0]->[_XmlDecl]; | 
| 3716 |  |  |  |  |  |  | } | 
| 3717 |  |  |  |  |  |  |  | 
| 3718 |  |  |  |  |  |  | sub setXMLDecl | 
| 3719 |  |  |  |  |  |  | { | 
| 3720 |  |  |  |  |  |  | $_[0]->[_XmlDecl] = $_[1]; | 
| 3721 |  |  |  |  |  |  | } | 
| 3722 |  |  |  |  |  |  |  | 
| 3723 |  |  |  |  |  |  | sub createXMLDecl | 
| 3724 |  |  |  |  |  |  | { | 
| 3725 |  |  |  |  |  |  | new XML::DOM::XMLDecl (@_); | 
| 3726 |  |  |  |  |  |  | } | 
| 3727 |  |  |  |  |  |  |  | 
| 3728 |  |  |  |  |  |  | sub createNotation | 
| 3729 |  |  |  |  |  |  | { | 
| 3730 |  |  |  |  |  |  | new XML::DOM::Notation (@_); | 
| 3731 |  |  |  |  |  |  | } | 
| 3732 |  |  |  |  |  |  |  | 
| 3733 |  |  |  |  |  |  | sub createElementDecl | 
| 3734 |  |  |  |  |  |  | { | 
| 3735 |  |  |  |  |  |  | new XML::DOM::ElementDecl (@_); | 
| 3736 |  |  |  |  |  |  | } | 
| 3737 |  |  |  |  |  |  |  | 
| 3738 |  |  |  |  |  |  | sub createAttlistDecl | 
| 3739 |  |  |  |  |  |  | { | 
| 3740 |  |  |  |  |  |  | new XML::DOM::AttlistDecl (@_); | 
| 3741 |  |  |  |  |  |  | } | 
| 3742 |  |  |  |  |  |  |  | 
| 3743 |  |  |  |  |  |  | sub createEntity | 
| 3744 |  |  |  |  |  |  | { | 
| 3745 |  |  |  |  |  |  | new XML::DOM::Entity (@_); | 
| 3746 |  |  |  |  |  |  | } | 
| 3747 |  |  |  |  |  |  |  | 
| 3748 |  |  |  |  |  |  | sub createChecker | 
| 3749 |  |  |  |  |  |  | { | 
| 3750 |  |  |  |  |  |  | my $self = shift; | 
| 3751 |  |  |  |  |  |  | my $checker = XML::Checker->new; | 
| 3752 |  |  |  |  |  |  |  | 
| 3753 |  |  |  |  |  |  | $checker->Init; | 
| 3754 |  |  |  |  |  |  | my $doctype = $self->getDoctype; | 
| 3755 |  |  |  |  |  |  | $doctype->to_expat ($checker) if $doctype; | 
| 3756 |  |  |  |  |  |  | $checker->Final; | 
| 3757 |  |  |  |  |  |  |  | 
| 3758 |  |  |  |  |  |  | $checker; | 
| 3759 |  |  |  |  |  |  | } | 
| 3760 |  |  |  |  |  |  |  | 
| 3761 |  |  |  |  |  |  | sub check | 
| 3762 |  |  |  |  |  |  | { | 
| 3763 |  |  |  |  |  |  | my ($self, $checker) = @_; | 
| 3764 |  |  |  |  |  |  | $checker ||= XML::Checker->new; | 
| 3765 |  |  |  |  |  |  |  | 
| 3766 |  |  |  |  |  |  | $self->to_expat ($checker); | 
| 3767 |  |  |  |  |  |  | } | 
| 3768 |  |  |  |  |  |  |  | 
| 3769 |  |  |  |  |  |  | sub to_expat | 
| 3770 |  |  |  |  |  |  | { | 
| 3771 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 3772 |  |  |  |  |  |  |  | 
| 3773 |  |  |  |  |  |  | $iter->Init; | 
| 3774 |  |  |  |  |  |  |  | 
| 3775 |  |  |  |  |  |  | for my $kid ($self->getChildNodes) | 
| 3776 |  |  |  |  |  |  | { | 
| 3777 |  |  |  |  |  |  | $kid->to_expat ($iter); | 
| 3778 |  |  |  |  |  |  | } | 
| 3779 |  |  |  |  |  |  | $iter->Final; | 
| 3780 |  |  |  |  |  |  | } | 
| 3781 |  |  |  |  |  |  |  | 
| 3782 |  |  |  |  |  |  | sub check_sax | 
| 3783 |  |  |  |  |  |  | { | 
| 3784 |  |  |  |  |  |  | my ($self, $checker) = @_; | 
| 3785 |  |  |  |  |  |  | $checker ||= XML::Checker->new; | 
| 3786 |  |  |  |  |  |  |  | 
| 3787 |  |  |  |  |  |  | $self->to_sax (Handler => $checker); | 
| 3788 |  |  |  |  |  |  | } | 
| 3789 |  |  |  |  |  |  |  | 
| 3790 |  |  |  |  |  |  | sub _to_sax | 
| 3791 |  |  |  |  |  |  | { | 
| 3792 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 3793 |  |  |  |  |  |  |  | 
| 3794 |  |  |  |  |  |  | $doch->start_document; | 
| 3795 |  |  |  |  |  |  |  | 
| 3796 |  |  |  |  |  |  | for my $kid ($self->getChildNodes) | 
| 3797 |  |  |  |  |  |  | { | 
| 3798 |  |  |  |  |  |  | $kid->_to_sax ($doch, $dtdh, $enth); | 
| 3799 |  |  |  |  |  |  | } | 
| 3800 |  |  |  |  |  |  | $doch->end_document; | 
| 3801 |  |  |  |  |  |  | } | 
| 3802 |  |  |  |  |  |  |  | 
| 3803 |  |  |  |  |  |  | ###################################################################### | 
| 3804 |  |  |  |  |  |  | package XML::DOM::DocumentType; | 
| 3805 |  |  |  |  |  |  | ###################################################################### | 
| 3806 |  |  |  |  |  |  | use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; | 
| 3807 |  |  |  |  |  |  |  | 
| 3808 |  |  |  |  |  |  | BEGIN | 
| 3809 |  |  |  |  |  |  | { | 
| 3810 |  |  |  |  |  |  | import XML::DOM::Node qw( :DEFAULT :Fields ); | 
| 3811 |  |  |  |  |  |  | import XML::DOM::Document qw( :Fields ); | 
| 3812 |  |  |  |  |  |  | XML::DOM::def_fields ("Entities Notations Name SysId PubId Internal", "XML::DOM::Node"); | 
| 3813 |  |  |  |  |  |  | } | 
| 3814 |  |  |  |  |  |  |  | 
| 3815 |  |  |  |  |  |  | use XML::DOM::DOMException; | 
| 3816 |  |  |  |  |  |  | use XML::DOM::NamedNodeMap; | 
| 3817 |  |  |  |  |  |  |  | 
| 3818 |  |  |  |  |  |  | sub new | 
| 3819 |  |  |  |  |  |  | { | 
| 3820 |  |  |  |  |  |  | my $class = shift; | 
| 3821 |  |  |  |  |  |  | my $doc = shift; | 
| 3822 |  |  |  |  |  |  |  | 
| 3823 |  |  |  |  |  |  | my $self = bless [], $class; | 
| 3824 |  |  |  |  |  |  |  | 
| 3825 |  |  |  |  |  |  | $self->[_Doc] = $doc; | 
| 3826 |  |  |  |  |  |  | $self->[_ReadOnly] = 1; | 
| 3827 |  |  |  |  |  |  | $self->[_C] = new XML::DOM::NodeList; | 
| 3828 |  |  |  |  |  |  |  | 
| 3829 |  |  |  |  |  |  | $self->[_Entities] =  new XML::DOM::NamedNodeMap (Doc	=> $doc, | 
| 3830 |  |  |  |  |  |  | Parent	=> $self, | 
| 3831 |  |  |  |  |  |  | ReadOnly	=> 1); | 
| 3832 |  |  |  |  |  |  | $self->[_Notations] = new XML::DOM::NamedNodeMap (Doc	=> $doc, | 
| 3833 |  |  |  |  |  |  | Parent	=> $self, | 
| 3834 |  |  |  |  |  |  | ReadOnly	=> 1); | 
| 3835 |  |  |  |  |  |  | $self->setParams (@_); | 
| 3836 |  |  |  |  |  |  | $self; | 
| 3837 |  |  |  |  |  |  | } | 
| 3838 |  |  |  |  |  |  |  | 
| 3839 |  |  |  |  |  |  | sub getNodeType | 
| 3840 |  |  |  |  |  |  | { | 
| 3841 |  |  |  |  |  |  | DOCUMENT_TYPE_NODE; | 
| 3842 |  |  |  |  |  |  | } | 
| 3843 |  |  |  |  |  |  |  | 
| 3844 |  |  |  |  |  |  | sub getNodeName | 
| 3845 |  |  |  |  |  |  | { | 
| 3846 |  |  |  |  |  |  | $_[0]->[_Name]; | 
| 3847 |  |  |  |  |  |  | } | 
| 3848 |  |  |  |  |  |  |  | 
| 3849 |  |  |  |  |  |  | sub getName | 
| 3850 |  |  |  |  |  |  | { | 
| 3851 |  |  |  |  |  |  | $_[0]->[_Name]; | 
| 3852 |  |  |  |  |  |  | } | 
| 3853 |  |  |  |  |  |  |  | 
| 3854 |  |  |  |  |  |  | sub getEntities | 
| 3855 |  |  |  |  |  |  | { | 
| 3856 |  |  |  |  |  |  | $_[0]->[_Entities]; | 
| 3857 |  |  |  |  |  |  | } | 
| 3858 |  |  |  |  |  |  |  | 
| 3859 |  |  |  |  |  |  | sub getNotations | 
| 3860 |  |  |  |  |  |  | { | 
| 3861 |  |  |  |  |  |  | $_[0]->[_Notations]; | 
| 3862 |  |  |  |  |  |  | } | 
| 3863 |  |  |  |  |  |  |  | 
| 3864 |  |  |  |  |  |  | sub setParentNode | 
| 3865 |  |  |  |  |  |  | { | 
| 3866 |  |  |  |  |  |  | my ($self, $parent) = @_; | 
| 3867 |  |  |  |  |  |  | $self->SUPER::setParentNode ($parent); | 
| 3868 |  |  |  |  |  |  |  | 
| 3869 |  |  |  |  |  |  | $parent->[_Doctype] = $self | 
| 3870 |  |  |  |  |  |  | if $parent->getNodeType == DOCUMENT_NODE; | 
| 3871 |  |  |  |  |  |  | } | 
| 3872 |  |  |  |  |  |  |  | 
| 3873 |  |  |  |  |  |  | sub cloneNode | 
| 3874 |  |  |  |  |  |  | { | 
| 3875 |  |  |  |  |  |  | my ($self, $deep) = @_; | 
| 3876 |  |  |  |  |  |  |  | 
| 3877 |  |  |  |  |  |  | my $node = new XML::DOM::DocumentType ($self->[_Doc], $self->[_Name], | 
| 3878 |  |  |  |  |  |  | $self->[_SysId], $self->[_PubId], | 
| 3879 |  |  |  |  |  |  | $self->[_Internal]); | 
| 3880 |  |  |  |  |  |  |  | 
| 3881 |  |  |  |  |  |  | #?? does it make sense to make a shallow copy? | 
| 3882 |  |  |  |  |  |  |  | 
| 3883 |  |  |  |  |  |  | # clone the NamedNodeMaps | 
| 3884 |  |  |  |  |  |  | $node->[_Entities] = $self->[_Entities]->cloneNode ($deep); | 
| 3885 |  |  |  |  |  |  |  | 
| 3886 |  |  |  |  |  |  | $node->[_Notations] = $self->[_Notations]->cloneNode ($deep); | 
| 3887 |  |  |  |  |  |  |  | 
| 3888 |  |  |  |  |  |  | $node->cloneChildren ($self, $deep); | 
| 3889 |  |  |  |  |  |  |  | 
| 3890 |  |  |  |  |  |  | $node; | 
| 3891 |  |  |  |  |  |  | } | 
| 3892 |  |  |  |  |  |  |  | 
| 3893 |  |  |  |  |  |  | #------------------------------------------------------------ | 
| 3894 |  |  |  |  |  |  | # Extra method implementations | 
| 3895 |  |  |  |  |  |  |  | 
| 3896 |  |  |  |  |  |  | sub getSysId | 
| 3897 |  |  |  |  |  |  | { | 
| 3898 |  |  |  |  |  |  | $_[0]->[_SysId]; | 
| 3899 |  |  |  |  |  |  | } | 
| 3900 |  |  |  |  |  |  |  | 
| 3901 |  |  |  |  |  |  | sub getPubId | 
| 3902 |  |  |  |  |  |  | { | 
| 3903 |  |  |  |  |  |  | $_[0]->[_PubId]; | 
| 3904 |  |  |  |  |  |  | } | 
| 3905 |  |  |  |  |  |  |  | 
| 3906 |  |  |  |  |  |  | sub getInternal | 
| 3907 |  |  |  |  |  |  | { | 
| 3908 |  |  |  |  |  |  | $_[0]->[_Internal]; | 
| 3909 |  |  |  |  |  |  | } | 
| 3910 |  |  |  |  |  |  |  | 
| 3911 |  |  |  |  |  |  | sub setSysId | 
| 3912 |  |  |  |  |  |  | { | 
| 3913 |  |  |  |  |  |  | $_[0]->[_SysId] = $_[1]; | 
| 3914 |  |  |  |  |  |  | } | 
| 3915 |  |  |  |  |  |  |  | 
| 3916 |  |  |  |  |  |  | sub setPubId | 
| 3917 |  |  |  |  |  |  | { | 
| 3918 |  |  |  |  |  |  | $_[0]->[_PubId] = $_[1]; | 
| 3919 |  |  |  |  |  |  | } | 
| 3920 |  |  |  |  |  |  |  | 
| 3921 |  |  |  |  |  |  | sub setInternal | 
| 3922 |  |  |  |  |  |  | { | 
| 3923 |  |  |  |  |  |  | $_[0]->[_Internal] = $_[1]; | 
| 3924 |  |  |  |  |  |  | } | 
| 3925 |  |  |  |  |  |  |  | 
| 3926 |  |  |  |  |  |  | sub setName | 
| 3927 |  |  |  |  |  |  | { | 
| 3928 |  |  |  |  |  |  | $_[0]->[_Name] = $_[1]; | 
| 3929 |  |  |  |  |  |  | } | 
| 3930 |  |  |  |  |  |  |  | 
| 3931 |  |  |  |  |  |  | sub removeChildHoodMemories | 
| 3932 |  |  |  |  |  |  | { | 
| 3933 |  |  |  |  |  |  | my ($self, $dontWipeReadOnly) = @_; | 
| 3934 |  |  |  |  |  |  |  | 
| 3935 |  |  |  |  |  |  | my $parent = $self->[_Parent]; | 
| 3936 |  |  |  |  |  |  | if (defined $parent && $parent->getNodeType == DOCUMENT_NODE) | 
| 3937 |  |  |  |  |  |  | { | 
| 3938 |  |  |  |  |  |  | undef $parent->[_Doctype]; # was delete | 
| 3939 |  |  |  |  |  |  | } | 
| 3940 |  |  |  |  |  |  | $self->SUPER::removeChildHoodMemories; | 
| 3941 |  |  |  |  |  |  | } | 
| 3942 |  |  |  |  |  |  |  | 
| 3943 |  |  |  |  |  |  | sub dispose | 
| 3944 |  |  |  |  |  |  | { | 
| 3945 |  |  |  |  |  |  | my $self = shift; | 
| 3946 |  |  |  |  |  |  |  | 
| 3947 |  |  |  |  |  |  | $self->[_Entities]->dispose; | 
| 3948 |  |  |  |  |  |  | $self->[_Notations]->dispose; | 
| 3949 |  |  |  |  |  |  | $self->SUPER::dispose; | 
| 3950 |  |  |  |  |  |  | } | 
| 3951 |  |  |  |  |  |  |  | 
| 3952 |  |  |  |  |  |  | sub setOwnerDocument | 
| 3953 |  |  |  |  |  |  | { | 
| 3954 |  |  |  |  |  |  | my ($self, $doc) = @_; | 
| 3955 |  |  |  |  |  |  | $self->SUPER::setOwnerDocument ($doc); | 
| 3956 |  |  |  |  |  |  |  | 
| 3957 |  |  |  |  |  |  | $self->[_Entities]->setOwnerDocument ($doc); | 
| 3958 |  |  |  |  |  |  | $self->[_Notations]->setOwnerDocument ($doc); | 
| 3959 |  |  |  |  |  |  | } | 
| 3960 |  |  |  |  |  |  |  | 
| 3961 |  |  |  |  |  |  | sub expandEntity | 
| 3962 |  |  |  |  |  |  | { | 
| 3963 |  |  |  |  |  |  | my ($self, $ent, $param) = @_; | 
| 3964 |  |  |  |  |  |  |  | 
| 3965 |  |  |  |  |  |  | my $kid = $self->[_Entities]->getNamedItem ($ent); | 
| 3966 |  |  |  |  |  |  | return $kid->getValue | 
| 3967 |  |  |  |  |  |  | if (defined ($kid) && $param == $kid->isParameterEntity); | 
| 3968 |  |  |  |  |  |  |  | 
| 3969 |  |  |  |  |  |  | undef;	# entity not found | 
| 3970 |  |  |  |  |  |  | } | 
| 3971 |  |  |  |  |  |  |  | 
| 3972 |  |  |  |  |  |  | sub getAttlistDecl | 
| 3973 |  |  |  |  |  |  | { | 
| 3974 |  |  |  |  |  |  | my ($self, $elemName) = @_; | 
| 3975 |  |  |  |  |  |  | for my $kid (@{$_[0]->[_C]}) | 
| 3976 |  |  |  |  |  |  | { | 
| 3977 |  |  |  |  |  |  | return $kid if ($kid->getNodeType == ATTLIST_DECL_NODE && | 
| 3978 |  |  |  |  |  |  | $kid->getName eq $elemName); | 
| 3979 |  |  |  |  |  |  | } | 
| 3980 |  |  |  |  |  |  | undef;	# not found | 
| 3981 |  |  |  |  |  |  | } | 
| 3982 |  |  |  |  |  |  |  | 
| 3983 |  |  |  |  |  |  | sub getElementDecl | 
| 3984 |  |  |  |  |  |  | { | 
| 3985 |  |  |  |  |  |  | my ($self, $elemName) = @_; | 
| 3986 |  |  |  |  |  |  | for my $kid (@{$_[0]->[_C]}) | 
| 3987 |  |  |  |  |  |  | { | 
| 3988 |  |  |  |  |  |  | return $kid if ($kid->getNodeType == ELEMENT_DECL_NODE && | 
| 3989 |  |  |  |  |  |  | $kid->getName eq $elemName); | 
| 3990 |  |  |  |  |  |  | } | 
| 3991 |  |  |  |  |  |  | undef;	# not found | 
| 3992 |  |  |  |  |  |  | } | 
| 3993 |  |  |  |  |  |  |  | 
| 3994 |  |  |  |  |  |  | sub addElementDecl | 
| 3995 |  |  |  |  |  |  | { | 
| 3996 |  |  |  |  |  |  | my ($self, $name, $model, $hidden) = @_; | 
| 3997 |  |  |  |  |  |  | my $node = $self->getElementDecl ($name); | 
| 3998 |  |  |  |  |  |  |  | 
| 3999 |  |  |  |  |  |  | #?? could warn | 
| 4000 |  |  |  |  |  |  | unless (defined $node) | 
| 4001 |  |  |  |  |  |  | { | 
| 4002 |  |  |  |  |  |  | $node = $self->[_Doc]->createElementDecl ($name, $model, $hidden); | 
| 4003 |  |  |  |  |  |  | $self->appendChild ($node); | 
| 4004 |  |  |  |  |  |  | } | 
| 4005 |  |  |  |  |  |  | $node; | 
| 4006 |  |  |  |  |  |  | } | 
| 4007 |  |  |  |  |  |  |  | 
| 4008 |  |  |  |  |  |  | sub addAttlistDecl | 
| 4009 |  |  |  |  |  |  | { | 
| 4010 |  |  |  |  |  |  | my ($self, $name) = @_; | 
| 4011 |  |  |  |  |  |  | my $node = $self->getAttlistDecl ($name); | 
| 4012 |  |  |  |  |  |  |  | 
| 4013 |  |  |  |  |  |  | unless (defined $node) | 
| 4014 |  |  |  |  |  |  | { | 
| 4015 |  |  |  |  |  |  | $node = $self->[_Doc]->createAttlistDecl ($name); | 
| 4016 |  |  |  |  |  |  | $self->appendChild ($node); | 
| 4017 |  |  |  |  |  |  | } | 
| 4018 |  |  |  |  |  |  | $node; | 
| 4019 |  |  |  |  |  |  | } | 
| 4020 |  |  |  |  |  |  |  | 
| 4021 |  |  |  |  |  |  | sub addNotation | 
| 4022 |  |  |  |  |  |  | { | 
| 4023 |  |  |  |  |  |  | my $self = shift; | 
| 4024 |  |  |  |  |  |  | my $node = $self->[_Doc]->createNotation (@_); | 
| 4025 |  |  |  |  |  |  | $self->[_Notations]->setNamedItem ($node); | 
| 4026 |  |  |  |  |  |  | $node; | 
| 4027 |  |  |  |  |  |  | } | 
| 4028 |  |  |  |  |  |  |  | 
| 4029 |  |  |  |  |  |  | sub addEntity | 
| 4030 |  |  |  |  |  |  | { | 
| 4031 |  |  |  |  |  |  | my $self = shift; | 
| 4032 |  |  |  |  |  |  | my $node = $self->[_Doc]->createEntity (@_); | 
| 4033 |  |  |  |  |  |  |  | 
| 4034 |  |  |  |  |  |  | $self->[_Entities]->setNamedItem ($node); | 
| 4035 |  |  |  |  |  |  | $node; | 
| 4036 |  |  |  |  |  |  | } | 
| 4037 |  |  |  |  |  |  |  | 
| 4038 |  |  |  |  |  |  | # All AttDefs for a certain Element are merged into a single ATTLIST | 
| 4039 |  |  |  |  |  |  | sub addAttDef | 
| 4040 |  |  |  |  |  |  | { | 
| 4041 |  |  |  |  |  |  | my $self = shift; | 
| 4042 |  |  |  |  |  |  | my $elemName = shift; | 
| 4043 |  |  |  |  |  |  |  | 
| 4044 |  |  |  |  |  |  | # create the AttlistDecl if it doesn't exist yet | 
| 4045 |  |  |  |  |  |  | my $attListDecl = $self->addAttlistDecl ($elemName); | 
| 4046 |  |  |  |  |  |  | $attListDecl->addAttDef (@_); | 
| 4047 |  |  |  |  |  |  | } | 
| 4048 |  |  |  |  |  |  |  | 
| 4049 |  |  |  |  |  |  | sub getDefaultAttrValue | 
| 4050 |  |  |  |  |  |  | { | 
| 4051 |  |  |  |  |  |  | my ($self, $elem, $attr) = @_; | 
| 4052 |  |  |  |  |  |  | my $elemNode = $self->getAttlistDecl ($elem); | 
| 4053 |  |  |  |  |  |  | (defined $elemNode) ? $elemNode->getDefaultAttrValue ($attr) : undef; | 
| 4054 |  |  |  |  |  |  | } | 
| 4055 |  |  |  |  |  |  |  | 
| 4056 |  |  |  |  |  |  | sub getEntity | 
| 4057 |  |  |  |  |  |  | { | 
| 4058 |  |  |  |  |  |  | my ($self, $entity) = @_; | 
| 4059 |  |  |  |  |  |  | $self->[_Entities]->getNamedItem ($entity); | 
| 4060 |  |  |  |  |  |  | } | 
| 4061 |  |  |  |  |  |  |  | 
| 4062 |  |  |  |  |  |  | sub setParams | 
| 4063 |  |  |  |  |  |  | { | 
| 4064 |  |  |  |  |  |  | my ($self, $name, $sysid, $pubid, $internal) = @_; | 
| 4065 |  |  |  |  |  |  |  | 
| 4066 |  |  |  |  |  |  | $self->[_Name] = $name; | 
| 4067 |  |  |  |  |  |  |  | 
| 4068 |  |  |  |  |  |  | #?? not sure if we need to hold on to these... | 
| 4069 |  |  |  |  |  |  | $self->[_SysId] = $sysid if defined $sysid; | 
| 4070 |  |  |  |  |  |  | $self->[_PubId] = $pubid if defined $pubid; | 
| 4071 |  |  |  |  |  |  | $self->[_Internal] = $internal if defined $internal; | 
| 4072 |  |  |  |  |  |  |  | 
| 4073 |  |  |  |  |  |  | $self; | 
| 4074 |  |  |  |  |  |  | } | 
| 4075 |  |  |  |  |  |  |  | 
| 4076 |  |  |  |  |  |  | sub rejectChild | 
| 4077 |  |  |  |  |  |  | { | 
| 4078 |  |  |  |  |  |  | # DOM Spec says: DocumentType -- no children | 
| 4079 |  |  |  |  |  |  | not $XML::DOM::IgnoreReadOnly; | 
| 4080 |  |  |  |  |  |  | } | 
| 4081 |  |  |  |  |  |  |  | 
| 4082 |  |  |  |  |  |  | sub print | 
| 4083 |  |  |  |  |  |  | { | 
| 4084 |  |  |  |  |  |  | my ($self, $FILE) = @_; | 
| 4085 |  |  |  |  |  |  |  | 
| 4086 |  |  |  |  |  |  | my $name = $self->[_Name]; | 
| 4087 |  |  |  |  |  |  |  | 
| 4088 |  |  |  |  |  |  | my $sysId = $self->[_SysId]; | 
| 4089 |  |  |  |  |  |  | my $pubId = $self->[_PubId]; | 
| 4090 |  |  |  |  |  |  |  | 
| 4091 |  |  |  |  |  |  | $FILE->print (" | 
| 4092 |  |  |  |  |  |  | if (defined $pubId) | 
| 4093 |  |  |  |  |  |  | { | 
| 4094 |  |  |  |  |  |  | $FILE->print (" PUBLIC \"$pubId\" \"$sysId\""); | 
| 4095 |  |  |  |  |  |  | } | 
| 4096 |  |  |  |  |  |  | elsif (defined $sysId) | 
| 4097 |  |  |  |  |  |  | { | 
| 4098 |  |  |  |  |  |  | $FILE->print (" SYSTEM \"$sysId\""); | 
| 4099 |  |  |  |  |  |  | } | 
| 4100 |  |  |  |  |  |  |  | 
| 4101 |  |  |  |  |  |  | my @entities = @{$self->[_Entities]->getValues}; | 
| 4102 |  |  |  |  |  |  | my @notations = @{$self->[_Notations]->getValues}; | 
| 4103 |  |  |  |  |  |  | my @kids = @{$self->[_C]}; | 
| 4104 |  |  |  |  |  |  |  | 
| 4105 |  |  |  |  |  |  | if (@entities || @notations || @kids) | 
| 4106 |  |  |  |  |  |  | { | 
| 4107 |  |  |  |  |  |  | $FILE->print (" [\x0A"); | 
| 4108 |  |  |  |  |  |  |  | 
| 4109 |  |  |  |  |  |  | for my $kid (@entities) | 
| 4110 |  |  |  |  |  |  | { | 
| 4111 |  |  |  |  |  |  | next if $kid->[_Hidden]; | 
| 4112 |  |  |  |  |  |  |  | 
| 4113 |  |  |  |  |  |  | $FILE->print (" "); | 
| 4114 |  |  |  |  |  |  | $kid->print ($FILE); | 
| 4115 |  |  |  |  |  |  | $FILE->print ("\x0A"); | 
| 4116 |  |  |  |  |  |  | } | 
| 4117 |  |  |  |  |  |  |  | 
| 4118 |  |  |  |  |  |  | for my $kid (@notations) | 
| 4119 |  |  |  |  |  |  | { | 
| 4120 |  |  |  |  |  |  | next if $kid->[_Hidden]; | 
| 4121 |  |  |  |  |  |  |  | 
| 4122 |  |  |  |  |  |  | $FILE->print (" "); | 
| 4123 |  |  |  |  |  |  | $kid->print ($FILE); | 
| 4124 |  |  |  |  |  |  | $FILE->print ("\x0A"); | 
| 4125 |  |  |  |  |  |  | } | 
| 4126 |  |  |  |  |  |  |  | 
| 4127 |  |  |  |  |  |  | for my $kid (@kids) | 
| 4128 |  |  |  |  |  |  | { | 
| 4129 |  |  |  |  |  |  | next if $kid->[_Hidden]; | 
| 4130 |  |  |  |  |  |  |  | 
| 4131 |  |  |  |  |  |  | $FILE->print (" "); | 
| 4132 |  |  |  |  |  |  | $kid->print ($FILE); | 
| 4133 |  |  |  |  |  |  | $FILE->print ("\x0A"); | 
| 4134 |  |  |  |  |  |  | } | 
| 4135 |  |  |  |  |  |  | $FILE->print ("]"); | 
| 4136 |  |  |  |  |  |  | } | 
| 4137 |  |  |  |  |  |  | $FILE->print (">"); | 
| 4138 |  |  |  |  |  |  | } | 
| 4139 |  |  |  |  |  |  |  | 
| 4140 |  |  |  |  |  |  | sub to_expat | 
| 4141 |  |  |  |  |  |  | { | 
| 4142 |  |  |  |  |  |  | my ($self, $iter) = @_; | 
| 4143 |  |  |  |  |  |  |  | 
| 4144 |  |  |  |  |  |  | $iter->Doctype ($self->getName, $self->getSysId, $self->getPubId, $self->getInternal); | 
| 4145 |  |  |  |  |  |  |  | 
| 4146 |  |  |  |  |  |  | for my $ent ($self->getEntities->getValues) | 
| 4147 |  |  |  |  |  |  | { | 
| 4148 |  |  |  |  |  |  | next if $ent->[_Hidden]; | 
| 4149 |  |  |  |  |  |  | $ent->to_expat ($iter); | 
| 4150 |  |  |  |  |  |  | } | 
| 4151 |  |  |  |  |  |  |  | 
| 4152 |  |  |  |  |  |  | for my $nota ($self->getNotations->getValues) | 
| 4153 |  |  |  |  |  |  | { | 
| 4154 |  |  |  |  |  |  | next if $nota->[_Hidden]; | 
| 4155 |  |  |  |  |  |  | $nota->to_expat ($iter); | 
| 4156 |  |  |  |  |  |  | } | 
| 4157 |  |  |  |  |  |  |  | 
| 4158 |  |  |  |  |  |  | for my $kid ($self->getChildNodes) | 
| 4159 |  |  |  |  |  |  | { | 
| 4160 |  |  |  |  |  |  | next if $kid->[_Hidden]; | 
| 4161 |  |  |  |  |  |  | $kid->to_expat ($iter); | 
| 4162 |  |  |  |  |  |  | } | 
| 4163 |  |  |  |  |  |  | } | 
| 4164 |  |  |  |  |  |  |  | 
| 4165 |  |  |  |  |  |  | sub _to_sax | 
| 4166 |  |  |  |  |  |  | { | 
| 4167 |  |  |  |  |  |  | my ($self, $doch, $dtdh, $enth) = @_; | 
| 4168 |  |  |  |  |  |  |  | 
| 4169 |  |  |  |  |  |  | $dtdh->doctype_decl ( { Name => $self->getName, | 
| 4170 |  |  |  |  |  |  | SystemId => $self->getSysId, | 
| 4171 |  |  |  |  |  |  | PublicId => $self->getPubId, | 
| 4172 |  |  |  |  |  |  | Internal => $self->getInternal }); | 
| 4173 |  |  |  |  |  |  |  | 
| 4174 |  |  |  |  |  |  | for my $ent ($self->getEntities->getValues) | 
| 4175 |  |  |  |  |  |  | { | 
| 4176 |  |  |  |  |  |  | next if $ent->[_Hidden]; | 
| 4177 |  |  |  |  |  |  | $ent->_to_sax ($doch, $dtdh, $enth); | 
| 4178 |  |  |  |  |  |  | } | 
| 4179 |  |  |  |  |  |  |  | 
| 4180 |  |  |  |  |  |  | for my $nota ($self->getNotations->getValues) | 
| 4181 |  |  |  |  |  |  | { | 
| 4182 |  |  |  |  |  |  | next if $nota->[_Hidden]; | 
| 4183 |  |  |  |  |  |  | $nota->_to_sax ($doch, $dtdh, $enth); | 
| 4184 |  |  |  |  |  |  | } | 
| 4185 |  |  |  |  |  |  |  | 
| 4186 |  |  |  |  |  |  | for my $kid ($self->getChildNodes) | 
| 4187 |  |  |  |  |  |  | { | 
| 4188 |  |  |  |  |  |  | next if $kid->[_Hidden]; | 
| 4189 |  |  |  |  |  |  | $kid->_to_sax ($doch, $dtdh, $enth); | 
| 4190 |  |  |  |  |  |  | } | 
| 4191 |  |  |  |  |  |  | } | 
| 4192 |  |  |  |  |  |  |  | 
| 4193 |  |  |  |  |  |  | ###################################################################### | 
| 4194 |  |  |  |  |  |  | package XML::DOM::Parser; | 
| 4195 |  |  |  |  |  |  | ###################################################################### | 
| 4196 |  |  |  |  |  |  | use vars qw ( @ISA ); | 
| 4197 |  |  |  |  |  |  | @ISA = qw( XML::Parser ); | 
| 4198 |  |  |  |  |  |  |  | 
| 4199 |  |  |  |  |  |  | sub new | 
| 4200 |  |  |  |  |  |  | { | 
| 4201 |  |  |  |  |  |  | my ($class, %args) = @_; | 
| 4202 |  |  |  |  |  |  |  | 
| 4203 |  |  |  |  |  |  | $args{Style} = 'XML::Parser::Dom'; | 
| 4204 |  |  |  |  |  |  | $class->SUPER::new (%args); | 
| 4205 |  |  |  |  |  |  | } | 
| 4206 |  |  |  |  |  |  |  | 
| 4207 |  |  |  |  |  |  | # This method needed to be overriden so we can restore some global | 
| 4208 |  |  |  |  |  |  | # variables when an exception is thrown | 
| 4209 |  |  |  |  |  |  | sub parse | 
| 4210 |  |  |  |  |  |  | { | 
| 4211 |  |  |  |  |  |  | my $self = shift; | 
| 4212 |  |  |  |  |  |  |  | 
| 4213 |  |  |  |  |  |  | local $XML::Parser::Dom::_DP_doc; | 
| 4214 |  |  |  |  |  |  | local $XML::Parser::Dom::_DP_elem; | 
| 4215 |  |  |  |  |  |  | local $XML::Parser::Dom::_DP_doctype; | 
| 4216 |  |  |  |  |  |  | local $XML::Parser::Dom::_DP_in_prolog; | 
| 4217 |  |  |  |  |  |  | local $XML::Parser::Dom::_DP_end_doc; | 
| 4218 |  |  |  |  |  |  | local $XML::Parser::Dom::_DP_saw_doctype; | 
| 4219 |  |  |  |  |  |  | local $XML::Parser::Dom::_DP_in_CDATA; | 
| 4220 |  |  |  |  |  |  | local $XML::Parser::Dom::_DP_keep_CDATA; | 
| 4221 |  |  |  |  |  |  | local $XML::Parser::Dom::_DP_last_text; | 
| 4222 |  |  |  |  |  |  |  | 
| 4223 |  |  |  |  |  |  |  | 
| 4224 |  |  |  |  |  |  | # Temporarily disable checks that Expat already does (for performance) | 
| 4225 |  |  |  |  |  |  | local $XML::DOM::SafeMode = 0; | 
| 4226 |  |  |  |  |  |  | # Temporarily disable ReadOnly checks | 
| 4227 |  |  |  |  |  |  | local $XML::DOM::IgnoreReadOnly = 1; | 
| 4228 |  |  |  |  |  |  |  | 
| 4229 |  |  |  |  |  |  | my $ret; | 
| 4230 |  |  |  |  |  |  | eval { | 
| 4231 |  |  |  |  |  |  | $ret = $self->SUPER::parse (@_); | 
| 4232 |  |  |  |  |  |  | }; | 
| 4233 |  |  |  |  |  |  | my $err = $@; | 
| 4234 |  |  |  |  |  |  |  | 
| 4235 |  |  |  |  |  |  | if ($err) | 
| 4236 |  |  |  |  |  |  | { | 
| 4237 |  |  |  |  |  |  | my $doc = $XML::Parser::Dom::_DP_doc; | 
| 4238 |  |  |  |  |  |  | if ($doc) | 
| 4239 |  |  |  |  |  |  | { | 
| 4240 |  |  |  |  |  |  | $doc->dispose; | 
| 4241 |  |  |  |  |  |  | } | 
| 4242 |  |  |  |  |  |  | die $err; | 
| 4243 |  |  |  |  |  |  | } | 
| 4244 |  |  |  |  |  |  |  | 
| 4245 |  |  |  |  |  |  | $ret; | 
| 4246 |  |  |  |  |  |  | } | 
| 4247 |  |  |  |  |  |  |  | 
| 4248 |  |  |  |  |  |  | my $LWP_USER_AGENT; | 
| 4249 |  |  |  |  |  |  | sub set_LWP_UserAgent | 
| 4250 |  |  |  |  |  |  | { | 
| 4251 |  |  |  |  |  |  | $LWP_USER_AGENT = shift; | 
| 4252 |  |  |  |  |  |  | } | 
| 4253 |  |  |  |  |  |  |  | 
| 4254 |  |  |  |  |  |  | sub parsefile | 
| 4255 |  |  |  |  |  |  | { | 
| 4256 |  |  |  |  |  |  | my $self = shift; | 
| 4257 |  |  |  |  |  |  | my $url = shift; | 
| 4258 |  |  |  |  |  |  |  | 
| 4259 |  |  |  |  |  |  | # Any other URL schemes? | 
| 4260 |  |  |  |  |  |  | if ($url =~ /^(https?|ftp|wais|gopher|file):/) | 
| 4261 |  |  |  |  |  |  | { | 
| 4262 |  |  |  |  |  |  | # Read the file from the web with LWP. | 
| 4263 |  |  |  |  |  |  | # | 
| 4264 |  |  |  |  |  |  | # Note that we read in the entire file, which may not be ideal | 
| 4265 |  |  |  |  |  |  | # for large files. LWP::UserAgent also provides a callback style | 
| 4266 |  |  |  |  |  |  | # request, which we could convert to a stream with a fork()... | 
| 4267 |  |  |  |  |  |  |  | 
| 4268 |  |  |  |  |  |  | my $result; | 
| 4269 |  |  |  |  |  |  | eval | 
| 4270 |  |  |  |  |  |  | { | 
| 4271 |  |  |  |  |  |  | use LWP::UserAgent; | 
| 4272 |  |  |  |  |  |  |  | 
| 4273 |  |  |  |  |  |  | my $ua = $self->{LWP_UserAgent}; | 
| 4274 |  |  |  |  |  |  | unless (defined $ua) | 
| 4275 |  |  |  |  |  |  | { | 
| 4276 |  |  |  |  |  |  | unless (defined $LWP_USER_AGENT) | 
| 4277 |  |  |  |  |  |  | { | 
| 4278 |  |  |  |  |  |  | $LWP_USER_AGENT = LWP::UserAgent->new; | 
| 4279 |  |  |  |  |  |  |  | 
| 4280 |  |  |  |  |  |  | # Load proxy settings from environment variables, i.e.: | 
| 4281 |  |  |  |  |  |  | # http_proxy, ftp_proxy, no_proxy etc. (see LWP::UserAgent(3)) | 
| 4282 |  |  |  |  |  |  | # You need these to go thru firewalls. | 
| 4283 |  |  |  |  |  |  | $LWP_USER_AGENT->env_proxy; | 
| 4284 |  |  |  |  |  |  | } | 
| 4285 |  |  |  |  |  |  | $ua = $LWP_USER_AGENT; | 
| 4286 |  |  |  |  |  |  | } | 
| 4287 |  |  |  |  |  |  | my $req = new HTTP::Request 'GET', $url; | 
| 4288 |  |  |  |  |  |  | my $response = $ua->request ($req); | 
| 4289 |  |  |  |  |  |  |  | 
| 4290 |  |  |  |  |  |  | # Parse the result of the HTTP request | 
| 4291 |  |  |  |  |  |  | $result = $self->parse ($response->content, @_); | 
| 4292 |  |  |  |  |  |  | }; | 
| 4293 |  |  |  |  |  |  | if ($@) | 
| 4294 |  |  |  |  |  |  | { | 
| 4295 |  |  |  |  |  |  | die "Couldn't parsefile [$url] with LWP: $@"; | 
| 4296 |  |  |  |  |  |  | } | 
| 4297 |  |  |  |  |  |  | return $result; | 
| 4298 |  |  |  |  |  |  | } | 
| 4299 |  |  |  |  |  |  | else | 
| 4300 |  |  |  |  |  |  | { | 
| 4301 |  |  |  |  |  |  | return $self->SUPER::parsefile ($url, @_); | 
| 4302 |  |  |  |  |  |  | } | 
| 4303 |  |  |  |  |  |  | } | 
| 4304 |  |  |  |  |  |  |  | 
| 4305 |  |  |  |  |  |  | ###################################################################### | 
| 4306 |  |  |  |  |  |  | package XML::Parser::Dom; | 
| 4307 |  |  |  |  |  |  | ###################################################################### | 
| 4308 |  |  |  |  |  |  |  | 
| 4309 |  |  |  |  |  |  | BEGIN | 
| 4310 |  |  |  |  |  |  | { | 
| 4311 |  |  |  |  |  |  | import XML::DOM::Node qw( :Fields ); | 
| 4312 |  |  |  |  |  |  | import XML::DOM::CharacterData qw( :Fields ); | 
| 4313 |  |  |  |  |  |  | } | 
| 4314 |  |  |  |  |  |  |  | 
| 4315 |  |  |  |  |  |  | use vars qw( $_DP_doc | 
| 4316 |  |  |  |  |  |  | $_DP_elem | 
| 4317 |  |  |  |  |  |  | $_DP_doctype | 
| 4318 |  |  |  |  |  |  | $_DP_in_prolog | 
| 4319 |  |  |  |  |  |  | $_DP_end_doc | 
| 4320 |  |  |  |  |  |  | $_DP_saw_doctype | 
| 4321 |  |  |  |  |  |  | $_DP_in_CDATA | 
| 4322 |  |  |  |  |  |  | $_DP_keep_CDATA | 
| 4323 |  |  |  |  |  |  | $_DP_last_text | 
| 4324 |  |  |  |  |  |  | $_DP_level | 
| 4325 |  |  |  |  |  |  | $_DP_expand_pent | 
| 4326 |  |  |  |  |  |  | ); | 
| 4327 |  |  |  |  |  |  |  | 
| 4328 |  |  |  |  |  |  | # This adds a new Style to the XML::Parser class. | 
| 4329 |  |  |  |  |  |  | # From now on you can say: $parser = new XML::Parser ('Style' => 'Dom' ); | 
| 4330 |  |  |  |  |  |  | # but that is *NOT* how a regular user should use it! | 
| 4331 |  |  |  |  |  |  | $XML::Parser::Built_In_Styles{Dom} = 1; | 
| 4332 |  |  |  |  |  |  |  | 
| 4333 |  |  |  |  |  |  | sub Init | 
| 4334 |  |  |  |  |  |  | { | 
| 4335 |  |  |  |  |  |  | $_DP_elem = $_DP_doc = new XML::DOM::Document(); | 
| 4336 |  |  |  |  |  |  | $_DP_doctype = new XML::DOM::DocumentType ($_DP_doc); | 
| 4337 |  |  |  |  |  |  | $_DP_doc->setDoctype ($_DP_doctype); | 
| 4338 |  |  |  |  |  |  | $_DP_keep_CDATA = $_[0]->{KeepCDATA}; | 
| 4339 |  |  |  |  |  |  |  | 
| 4340 |  |  |  |  |  |  | # Prepare for document prolog | 
| 4341 |  |  |  |  |  |  | $_DP_in_prolog = 1; | 
| 4342 |  |  |  |  |  |  |  | 
| 4343 |  |  |  |  |  |  | # We haven't passed the root element yet | 
| 4344 |  |  |  |  |  |  | $_DP_end_doc = 0; | 
| 4345 |  |  |  |  |  |  |  | 
| 4346 |  |  |  |  |  |  | # Expand parameter entities in the DTD by default | 
| 4347 |  |  |  |  |  |  |  | 
| 4348 |  |  |  |  |  |  | $_DP_expand_pent = defined $_[0]->{ExpandParamEnt} ? | 
| 4349 |  |  |  |  |  |  | $_[0]->{ExpandParamEnt} : 1; | 
| 4350 |  |  |  |  |  |  | if ($_DP_expand_pent) | 
| 4351 |  |  |  |  |  |  | { | 
| 4352 |  |  |  |  |  |  | $_[0]->{DOM_Entity} = {}; | 
| 4353 |  |  |  |  |  |  | } | 
| 4354 |  |  |  |  |  |  |  | 
| 4355 |  |  |  |  |  |  | $_DP_level = 0; | 
| 4356 |  |  |  |  |  |  |  | 
| 4357 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4358 |  |  |  |  |  |  | } | 
| 4359 |  |  |  |  |  |  |  | 
| 4360 |  |  |  |  |  |  | sub Final | 
| 4361 |  |  |  |  |  |  | { | 
| 4362 |  |  |  |  |  |  | unless ($_DP_saw_doctype) | 
| 4363 |  |  |  |  |  |  | { | 
| 4364 |  |  |  |  |  |  | my $doctype = $_DP_doc->removeDoctype; | 
| 4365 |  |  |  |  |  |  | $doctype->dispose; | 
| 4366 |  |  |  |  |  |  | } | 
| 4367 |  |  |  |  |  |  | $_DP_doc; | 
| 4368 |  |  |  |  |  |  | } | 
| 4369 |  |  |  |  |  |  |  | 
| 4370 |  |  |  |  |  |  | sub Char | 
| 4371 |  |  |  |  |  |  | { | 
| 4372 |  |  |  |  |  |  | my $str = $_[1]; | 
| 4373 |  |  |  |  |  |  |  | 
| 4374 |  |  |  |  |  |  | if ($_DP_in_CDATA && $_DP_keep_CDATA) | 
| 4375 |  |  |  |  |  |  | { | 
| 4376 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4377 |  |  |  |  |  |  | # Merge text with previous node if possible | 
| 4378 |  |  |  |  |  |  | $_DP_elem->addCDATA ($str); | 
| 4379 |  |  |  |  |  |  | } | 
| 4380 |  |  |  |  |  |  | else | 
| 4381 |  |  |  |  |  |  | { | 
| 4382 |  |  |  |  |  |  | # Merge text with previous node if possible | 
| 4383 |  |  |  |  |  |  | # Used to be:	$expat->{DOM_Element}->addText ($str); | 
| 4384 |  |  |  |  |  |  | if ($_DP_last_text) | 
| 4385 |  |  |  |  |  |  | { | 
| 4386 |  |  |  |  |  |  | $_DP_last_text->[_Data] .= $str; | 
| 4387 |  |  |  |  |  |  | } | 
| 4388 |  |  |  |  |  |  | else | 
| 4389 |  |  |  |  |  |  | { | 
| 4390 |  |  |  |  |  |  | $_DP_last_text = $_DP_doc->createTextNode ($str); | 
| 4391 |  |  |  |  |  |  | $_DP_last_text->[_Parent] = $_DP_elem; | 
| 4392 |  |  |  |  |  |  | push @{$_DP_elem->[_C]}, $_DP_last_text; | 
| 4393 |  |  |  |  |  |  | } | 
| 4394 |  |  |  |  |  |  | } | 
| 4395 |  |  |  |  |  |  | } | 
| 4396 |  |  |  |  |  |  |  | 
| 4397 |  |  |  |  |  |  | sub Start | 
| 4398 |  |  |  |  |  |  | { | 
| 4399 |  |  |  |  |  |  | my ($expat, $elem, @attr) = @_; | 
| 4400 |  |  |  |  |  |  | my $parent = $_DP_elem; | 
| 4401 |  |  |  |  |  |  | my $doc = $_DP_doc; | 
| 4402 |  |  |  |  |  |  |  | 
| 4403 |  |  |  |  |  |  | if ($parent == $doc) | 
| 4404 |  |  |  |  |  |  | { | 
| 4405 |  |  |  |  |  |  | # End of document prolog, i.e. start of first Element | 
| 4406 |  |  |  |  |  |  | $_DP_in_prolog = 0; | 
| 4407 |  |  |  |  |  |  | } | 
| 4408 |  |  |  |  |  |  |  | 
| 4409 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4410 |  |  |  |  |  |  | my $node = $doc->createElement ($elem); | 
| 4411 |  |  |  |  |  |  | $_DP_elem = $node; | 
| 4412 |  |  |  |  |  |  | $parent->appendChild ($node); | 
| 4413 |  |  |  |  |  |  |  | 
| 4414 |  |  |  |  |  |  | my $n = @attr; | 
| 4415 |  |  |  |  |  |  | return unless $n; | 
| 4416 |  |  |  |  |  |  |  | 
| 4417 |  |  |  |  |  |  | # Add attributes | 
| 4418 |  |  |  |  |  |  | my $first_default = $expat->specified_attr; | 
| 4419 |  |  |  |  |  |  | my $i = 0; | 
| 4420 |  |  |  |  |  |  | while ($i < $n) | 
| 4421 |  |  |  |  |  |  | { | 
| 4422 |  |  |  |  |  |  | my $specified = $i < $first_default; | 
| 4423 |  |  |  |  |  |  | my $name = $attr[$i++]; | 
| 4424 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4425 |  |  |  |  |  |  | my $attr = $doc->createAttribute ($name, $attr[$i++], $specified); | 
| 4426 |  |  |  |  |  |  | $node->setAttributeNode ($attr); | 
| 4427 |  |  |  |  |  |  | } | 
| 4428 |  |  |  |  |  |  | } | 
| 4429 |  |  |  |  |  |  |  | 
| 4430 |  |  |  |  |  |  | sub End | 
| 4431 |  |  |  |  |  |  | { | 
| 4432 |  |  |  |  |  |  | $_DP_elem = $_DP_elem->[_Parent]; | 
| 4433 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4434 |  |  |  |  |  |  |  | 
| 4435 |  |  |  |  |  |  | # Check for end of root element | 
| 4436 |  |  |  |  |  |  | $_DP_end_doc = 1 if ($_DP_elem == $_DP_doc); | 
| 4437 |  |  |  |  |  |  | } | 
| 4438 |  |  |  |  |  |  |  | 
| 4439 |  |  |  |  |  |  | # Called at end of file, i.e. whitespace following last closing tag | 
| 4440 |  |  |  |  |  |  | # Also for Entity references | 
| 4441 |  |  |  |  |  |  | # May also be called at other times... | 
| 4442 |  |  |  |  |  |  | sub Default | 
| 4443 |  |  |  |  |  |  | { | 
| 4444 |  |  |  |  |  |  | my ($expat, $str) = @_; | 
| 4445 |  |  |  |  |  |  |  | 
| 4446 |  |  |  |  |  |  | #    shift; deb ("Default", @_); | 
| 4447 |  |  |  |  |  |  |  | 
| 4448 |  |  |  |  |  |  | if ($_DP_in_prolog)	# still processing Document prolog... | 
| 4449 |  |  |  |  |  |  | { | 
| 4450 |  |  |  |  |  |  | #?? could try to store this text later | 
| 4451 |  |  |  |  |  |  | #?? I've only seen whitespace here so far | 
| 4452 |  |  |  |  |  |  | } | 
| 4453 |  |  |  |  |  |  | elsif (!$_DP_end_doc)	# ignore whitespace at end of Document | 
| 4454 |  |  |  |  |  |  | { | 
| 4455 |  |  |  |  |  |  | #	if ($expat->{NoExpand}) | 
| 4456 |  |  |  |  |  |  | #	{ | 
| 4457 |  |  |  |  |  |  | # Got a TextDecl () from an external entity here once | 
| 4458 |  |  |  |  |  |  |  | 
| 4459 |  |  |  |  |  |  | # create non-parameter entity reference, correct? | 
| 4460 |  |  |  |  |  |  | return unless $str =~ s!^&!!; | 
| 4461 |  |  |  |  |  |  | return unless $str =~ s!;$!!; | 
| 4462 |  |  |  |  |  |  | $_DP_elem->appendChild ( | 
| 4463 |  |  |  |  |  |  | $_DP_doc->createEntityReference ($str,0,$expat->{NoExpand})); | 
| 4464 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4465 |  |  |  |  |  |  | #	} | 
| 4466 |  |  |  |  |  |  | #	else | 
| 4467 |  |  |  |  |  |  | #	{ | 
| 4468 |  |  |  |  |  |  | #	    $expat->{DOM_Element}->addText ($str); | 
| 4469 |  |  |  |  |  |  | #	} | 
| 4470 |  |  |  |  |  |  | } | 
| 4471 |  |  |  |  |  |  | } | 
| 4472 |  |  |  |  |  |  |  | 
| 4473 |  |  |  |  |  |  | # XML::Parser 2.19 added support for CdataStart and CdataEnd handlers | 
| 4474 |  |  |  |  |  |  | # If they are not defined, the Default handler is called instead | 
| 4475 |  |  |  |  |  |  | # with the text " | 
| 4476 |  |  |  |  |  |  | sub CdataStart | 
| 4477 |  |  |  |  |  |  | { | 
| 4478 |  |  |  |  |  |  | $_DP_in_CDATA = 1; | 
| 4479 |  |  |  |  |  |  | } | 
| 4480 |  |  |  |  |  |  |  | 
| 4481 |  |  |  |  |  |  | sub CdataEnd | 
| 4482 |  |  |  |  |  |  | { | 
| 4483 |  |  |  |  |  |  | $_DP_in_CDATA = 0; | 
| 4484 |  |  |  |  |  |  | } | 
| 4485 |  |  |  |  |  |  |  | 
| 4486 |  |  |  |  |  |  | my $START_MARKER = "__DOM__START__ENTITY__"; | 
| 4487 |  |  |  |  |  |  | my $END_MARKER = "__DOM__END__ENTITY__"; | 
| 4488 |  |  |  |  |  |  |  | 
| 4489 |  |  |  |  |  |  | sub Comment | 
| 4490 |  |  |  |  |  |  | { | 
| 4491 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4492 |  |  |  |  |  |  |  | 
| 4493 |  |  |  |  |  |  | # These comments were inserted by ExternEnt handler | 
| 4494 |  |  |  |  |  |  | if ($_[1] =~ /(?:($START_MARKER)|($END_MARKER))/) | 
| 4495 |  |  |  |  |  |  | { | 
| 4496 |  |  |  |  |  |  | if ($1)	 # START | 
| 4497 |  |  |  |  |  |  | { | 
| 4498 |  |  |  |  |  |  | $_DP_level++; | 
| 4499 |  |  |  |  |  |  | } | 
| 4500 |  |  |  |  |  |  | else | 
| 4501 |  |  |  |  |  |  | { | 
| 4502 |  |  |  |  |  |  | $_DP_level--; | 
| 4503 |  |  |  |  |  |  | } | 
| 4504 |  |  |  |  |  |  | } | 
| 4505 |  |  |  |  |  |  | else | 
| 4506 |  |  |  |  |  |  | { | 
| 4507 |  |  |  |  |  |  | my $comment = $_DP_doc->createComment ($_[1]); | 
| 4508 |  |  |  |  |  |  | $_DP_elem->appendChild ($comment); | 
| 4509 |  |  |  |  |  |  | } | 
| 4510 |  |  |  |  |  |  | } | 
| 4511 |  |  |  |  |  |  |  | 
| 4512 |  |  |  |  |  |  | sub deb | 
| 4513 |  |  |  |  |  |  | { | 
| 4514 |  |  |  |  |  |  | #    return; | 
| 4515 |  |  |  |  |  |  |  | 
| 4516 |  |  |  |  |  |  | my $name = shift; | 
| 4517 |  |  |  |  |  |  | print "$name (" . join(",", map {defined($_)?$_ : "(undef)"} @_) . ")\n"; | 
| 4518 |  |  |  |  |  |  | } | 
| 4519 |  |  |  |  |  |  |  | 
| 4520 |  |  |  |  |  |  | sub Doctype | 
| 4521 |  |  |  |  |  |  | { | 
| 4522 |  |  |  |  |  |  | my $expat = shift; | 
| 4523 |  |  |  |  |  |  | #    deb ("Doctype", @_); | 
| 4524 |  |  |  |  |  |  |  | 
| 4525 |  |  |  |  |  |  | $_DP_doctype->setParams (@_); | 
| 4526 |  |  |  |  |  |  | $_DP_saw_doctype = 1; | 
| 4527 |  |  |  |  |  |  | } | 
| 4528 |  |  |  |  |  |  |  | 
| 4529 |  |  |  |  |  |  | sub Attlist | 
| 4530 |  |  |  |  |  |  | { | 
| 4531 |  |  |  |  |  |  | my $expat = shift; | 
| 4532 |  |  |  |  |  |  | #    deb ("Attlist", @_); | 
| 4533 |  |  |  |  |  |  |  | 
| 4534 |  |  |  |  |  |  | $_[5] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0; | 
| 4535 |  |  |  |  |  |  | $_DP_doctype->addAttDef (@_); | 
| 4536 |  |  |  |  |  |  | } | 
| 4537 |  |  |  |  |  |  |  | 
| 4538 |  |  |  |  |  |  | sub XMLDecl | 
| 4539 |  |  |  |  |  |  | { | 
| 4540 |  |  |  |  |  |  | my $expat = shift; | 
| 4541 |  |  |  |  |  |  | #    deb ("XMLDecl", @_); | 
| 4542 |  |  |  |  |  |  |  | 
| 4543 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4544 |  |  |  |  |  |  | $_DP_doc->setXMLDecl (new XML::DOM::XMLDecl ($_DP_doc, @_)); | 
| 4545 |  |  |  |  |  |  | } | 
| 4546 |  |  |  |  |  |  |  | 
| 4547 |  |  |  |  |  |  | sub Entity | 
| 4548 |  |  |  |  |  |  | { | 
| 4549 |  |  |  |  |  |  | my $expat = shift; | 
| 4550 |  |  |  |  |  |  | #    deb ("Entity", @_); | 
| 4551 |  |  |  |  |  |  |  | 
| 4552 |  |  |  |  |  |  | # check to see if Parameter Entity | 
| 4553 |  |  |  |  |  |  | if ($_[5]) | 
| 4554 |  |  |  |  |  |  | { | 
| 4555 |  |  |  |  |  |  |  | 
| 4556 |  |  |  |  |  |  | if (defined $_[2])	# was sysid specified? | 
| 4557 |  |  |  |  |  |  | { | 
| 4558 |  |  |  |  |  |  | # Store the Entity mapping for use in ExternEnt | 
| 4559 |  |  |  |  |  |  | if (exists $expat->{DOM_Entity}->{$_[2]}) | 
| 4560 |  |  |  |  |  |  | { | 
| 4561 |  |  |  |  |  |  | # If this ever happens, the name of entity may be the wrong one | 
| 4562 |  |  |  |  |  |  | # when writing out the Document. | 
| 4563 |  |  |  |  |  |  | XML::DOM::warning ("Entity $_[2] is known as %$_[0] and %" . | 
| 4564 |  |  |  |  |  |  | $expat->{DOM_Entity}->{$_[2]}); | 
| 4565 |  |  |  |  |  |  | } | 
| 4566 |  |  |  |  |  |  | else | 
| 4567 |  |  |  |  |  |  | { | 
| 4568 |  |  |  |  |  |  | $expat->{DOM_Entity}->{$_[2]} = $_[0]; | 
| 4569 |  |  |  |  |  |  | } | 
| 4570 |  |  |  |  |  |  | #?? remove this block when XML::Parser has better support | 
| 4571 |  |  |  |  |  |  | } | 
| 4572 |  |  |  |  |  |  | } | 
| 4573 |  |  |  |  |  |  |  | 
| 4574 |  |  |  |  |  |  | # no value on things with sysId | 
| 4575 |  |  |  |  |  |  | if (defined $_[2] && defined $_[1]) | 
| 4576 |  |  |  |  |  |  | { | 
| 4577 |  |  |  |  |  |  | # print STDERR "XML::DOM Warning $_[0] had both value($_[1]) And SYSId ($_[2]), removing value.\n"; | 
| 4578 |  |  |  |  |  |  | $_[1] = undef; | 
| 4579 |  |  |  |  |  |  | } | 
| 4580 |  |  |  |  |  |  |  | 
| 4581 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4582 |  |  |  |  |  |  |  | 
| 4583 |  |  |  |  |  |  | $_[6] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0; | 
| 4584 |  |  |  |  |  |  | $_DP_doctype->addEntity (@_); | 
| 4585 |  |  |  |  |  |  | } | 
| 4586 |  |  |  |  |  |  |  | 
| 4587 |  |  |  |  |  |  | # | 
| 4588 |  |  |  |  |  |  | # Unparsed is called when it encounters e.g: | 
| 4589 |  |  |  |  |  |  | # | 
| 4590 |  |  |  |  |  |  | # | 
| 4591 |  |  |  |  |  |  | # | 
| 4592 |  |  |  |  |  |  | sub Unparsed | 
| 4593 |  |  |  |  |  |  | { | 
| 4594 |  |  |  |  |  |  | Entity (@_);	# same as regular ENTITY, as far as DOM is concerned | 
| 4595 |  |  |  |  |  |  | } | 
| 4596 |  |  |  |  |  |  |  | 
| 4597 |  |  |  |  |  |  | sub Element | 
| 4598 |  |  |  |  |  |  | { | 
| 4599 |  |  |  |  |  |  | shift; | 
| 4600 |  |  |  |  |  |  | #    deb ("Element", @_); | 
| 4601 |  |  |  |  |  |  |  | 
| 4602 |  |  |  |  |  |  | # put in to convert XML::Parser::ContentModel object to string | 
| 4603 |  |  |  |  |  |  | # ($_[1] used to be a string in XML::Parser 2.27 and | 
| 4604 |  |  |  |  |  |  | # dom_attr.t fails if we don't stringify here) | 
| 4605 |  |  |  |  |  |  | $_[1] = "$_[1]"; | 
| 4606 |  |  |  |  |  |  |  | 
| 4607 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4608 |  |  |  |  |  |  | push @_, "Hidden" unless $_DP_expand_pent || $_DP_level == 0; | 
| 4609 |  |  |  |  |  |  | $_DP_doctype->addElementDecl (@_); | 
| 4610 |  |  |  |  |  |  | } | 
| 4611 |  |  |  |  |  |  |  | 
| 4612 |  |  |  |  |  |  | sub Notation | 
| 4613 |  |  |  |  |  |  | { | 
| 4614 |  |  |  |  |  |  | shift; | 
| 4615 |  |  |  |  |  |  | #    deb ("Notation", @_); | 
| 4616 |  |  |  |  |  |  |  | 
| 4617 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4618 |  |  |  |  |  |  | $_[4] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0; | 
| 4619 |  |  |  |  |  |  | $_DP_doctype->addNotation (@_); | 
| 4620 |  |  |  |  |  |  | } | 
| 4621 |  |  |  |  |  |  |  | 
| 4622 |  |  |  |  |  |  | sub Proc | 
| 4623 |  |  |  |  |  |  | { | 
| 4624 |  |  |  |  |  |  | shift; | 
| 4625 |  |  |  |  |  |  | #    deb ("Proc", @_); | 
| 4626 |  |  |  |  |  |  |  | 
| 4627 |  |  |  |  |  |  | undef $_DP_last_text; | 
| 4628 |  |  |  |  |  |  | push @_, "Hidden" unless $_DP_expand_pent || $_DP_level == 0; | 
| 4629 |  |  |  |  |  |  | $_DP_elem->appendChild ($_DP_doc->createProcessingInstruction (@_)); | 
| 4630 |  |  |  |  |  |  | } | 
| 4631 |  |  |  |  |  |  |  | 
| 4632 |  |  |  |  |  |  | # | 
| 4633 |  |  |  |  |  |  | # ExternEnt is called when an external entity, such as: | 
| 4634 |  |  |  |  |  |  | # | 
| 4635 |  |  |  |  |  |  | # | 
| 4636 |  |  |  |  |  |  | #	                        "http://server/descr.txt"> | 
| 4637 |  |  |  |  |  |  | # | 
| 4638 |  |  |  |  |  |  | # is referenced in the document, e.g. with: &externalEntity; | 
| 4639 |  |  |  |  |  |  | # If ExternEnt is not specified, the entity reference is passed to the Default | 
| 4640 |  |  |  |  |  |  | # handler as e.g. "&externalEntity;", where an EntityReference object is added. | 
| 4641 |  |  |  |  |  |  | # | 
| 4642 |  |  |  |  |  |  | # Also for %externalEntity; references in the DTD itself. | 
| 4643 |  |  |  |  |  |  | # | 
| 4644 |  |  |  |  |  |  | # It can also be called when XML::Parser parses the DOCTYPE header | 
| 4645 |  |  |  |  |  |  | # (just before calling the DocType handler), when it contains a | 
| 4646 |  |  |  |  |  |  | # reference like "docbook.dtd" below: | 
| 4647 |  |  |  |  |  |  | # | 
| 4648 |  |  |  |  |  |  | # | 
| 4649 |  |  |  |  |  |  | #	"docbook.dtd" [ | 
| 4650 |  |  |  |  |  |  | #     ... rest of DTD ... | 
| 4651 |  |  |  |  |  |  | # | 
| 4652 |  |  |  |  |  |  | sub ExternEnt | 
| 4653 |  |  |  |  |  |  | { | 
| 4654 |  |  |  |  |  |  | my ($expat, $base, $sysid, $pubid) = @_; | 
| 4655 |  |  |  |  |  |  | #    deb ("ExternEnt", @_); | 
| 4656 |  |  |  |  |  |  |  | 
| 4657 |  |  |  |  |  |  | # ?? (tjmather) i think there is a problem here | 
| 4658 |  |  |  |  |  |  | # with XML::Parser > 2.27 since file_ext_ent_handler | 
| 4659 |  |  |  |  |  |  | # now returns a IO::File object instead of a content string | 
| 4660 |  |  |  |  |  |  |  | 
| 4661 |  |  |  |  |  |  | # Invoke XML::Parser's default ExternEnt handler | 
| 4662 |  |  |  |  |  |  | my $content; | 
| 4663 |  |  |  |  |  |  | if ($XML::Parser::have_LWP) | 
| 4664 |  |  |  |  |  |  | { | 
| 4665 |  |  |  |  |  |  | $content = XML::Parser::lwp_ext_ent_handler (@_); | 
| 4666 |  |  |  |  |  |  | } | 
| 4667 |  |  |  |  |  |  | else | 
| 4668 |  |  |  |  |  |  | { | 
| 4669 |  |  |  |  |  |  | $content = XML::Parser::file_ext_ent_handler (@_); | 
| 4670 |  |  |  |  |  |  | } | 
| 4671 |  |  |  |  |  |  |  | 
| 4672 |  |  |  |  |  |  | if ($_DP_expand_pent) | 
| 4673 |  |  |  |  |  |  | { | 
| 4674 |  |  |  |  |  |  | return $content; | 
| 4675 |  |  |  |  |  |  | } | 
| 4676 |  |  |  |  |  |  | else | 
| 4677 |  |  |  |  |  |  | { | 
| 4678 |  |  |  |  |  |  | my $entname = $expat->{DOM_Entity}->{$sysid}; | 
| 4679 |  |  |  |  |  |  | if (defined $entname) | 
| 4680 |  |  |  |  |  |  | { | 
| 4681 |  |  |  |  |  |  | $_DP_doctype->appendChild ($_DP_doc->createEntityReference ($entname, 1, $expat->{NoExpand})); | 
| 4682 |  |  |  |  |  |  | # Wrap the contents in special comments, so we know when we reach the | 
| 4683 |  |  |  |  |  |  | # end of parsing the entity. This way we can omit the contents from | 
| 4684 |  |  |  |  |  |  | # the DTD, when ExpandParamEnt is set to 0. | 
| 4685 |  |  |  |  |  |  |  | 
| 4686 |  |  |  |  |  |  | return "" . | 
| 4687 |  |  |  |  |  |  | $content . ""; | 
| 4688 |  |  |  |  |  |  | } | 
| 4689 |  |  |  |  |  |  | else | 
| 4690 |  |  |  |  |  |  | { | 
| 4691 |  |  |  |  |  |  | # We either read the entity ref'd by the system id in the | 
| 4692 |  |  |  |  |  |  | #  header, or the entity was undefined. | 
| 4693 |  |  |  |  |  |  | # In either case, don't bother with maintaining the entity | 
| 4694 |  |  |  |  |  |  | # reference, just expand the contents. | 
| 4695 |  |  |  |  |  |  | return "" . | 
| 4696 |  |  |  |  |  |  | $content . ""; | 
| 4697 |  |  |  |  |  |  | } | 
| 4698 |  |  |  |  |  |  | } | 
| 4699 |  |  |  |  |  |  | } | 
| 4700 |  |  |  |  |  |  |  | 
| 4701 |  |  |  |  |  |  | 1; # module return code | 
| 4702 |  |  |  |  |  |  |  | 
| 4703 |  |  |  |  |  |  | __END__ |