[0ff8d110] | 1 | ############################################################################## |
---|
| 2 | # |
---|
| 3 | # This library is free software; you can redistribute it and/or |
---|
| 4 | # modify it under the terms of the GNU Library General Public |
---|
| 5 | # License as published by the Free Software Foundation; either |
---|
| 6 | # version 2 of the License, or (at your option) any later version. |
---|
| 7 | # |
---|
| 8 | # This library is distributed in the hope that it will be useful, |
---|
| 9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
| 10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
---|
| 11 | # Library General Public License for more details. |
---|
| 12 | # |
---|
| 13 | # You should have received a copy of the GNU Library General Public |
---|
| 14 | # License along with this library; if not, write to the |
---|
| 15 | # Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
---|
| 16 | # Boston, MA 02111-1307, USA. |
---|
| 17 | # |
---|
| 18 | # Jabber |
---|
| 19 | # Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/ |
---|
| 20 | # |
---|
| 21 | ############################################################################## |
---|
| 22 | |
---|
| 23 | package XML::Stream::Tree; |
---|
| 24 | |
---|
| 25 | =head1 NAME |
---|
| 26 | |
---|
| 27 | XML::Stream::Tree - Functions to make building and parsing the tree easier |
---|
| 28 | to work with. |
---|
| 29 | |
---|
| 30 | =head1 SYNOPSIS |
---|
| 31 | |
---|
| 32 | Just a collection of functions that do not need to be in memory if you |
---|
| 33 | choose one of the other methods of data storage. |
---|
| 34 | |
---|
| 35 | =head1 FORMAT |
---|
| 36 | |
---|
| 37 | The result of parsing: |
---|
| 38 | |
---|
| 39 | <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo> |
---|
| 40 | |
---|
| 41 | would be: |
---|
| 42 | Tag Content |
---|
| 43 | ================================================================== |
---|
| 44 | [foo, [{}, |
---|
| 45 | head, [{id => "a"}, |
---|
| 46 | 0, "Hello ", |
---|
| 47 | em, [{}, |
---|
| 48 | 0, "there" |
---|
| 49 | ] |
---|
| 50 | ], |
---|
| 51 | bar, [{}, |
---|
| 52 | 0, "Howdy", |
---|
| 53 | ref, [{}] |
---|
| 54 | ], |
---|
| 55 | 0, "do" |
---|
| 56 | ] |
---|
| 57 | ] |
---|
| 58 | |
---|
| 59 | The above was copied from the XML::Parser man page. Many thanks to |
---|
| 60 | Larry and Clark. |
---|
| 61 | |
---|
| 62 | =head1 AUTHOR |
---|
| 63 | |
---|
| 64 | By Ryan Eatmon in March 2001 for http://jabber.org/ |
---|
| 65 | |
---|
| 66 | =head1 COPYRIGHT |
---|
| 67 | |
---|
| 68 | This module is free software; you can redistribute it and/or modify |
---|
| 69 | it under the same terms as Perl itself. |
---|
| 70 | |
---|
| 71 | =cut |
---|
| 72 | |
---|
| 73 | use vars qw( $VERSION $LOADED ); |
---|
| 74 | |
---|
| 75 | $VERSION = "1.22"; |
---|
| 76 | $LOADED = 1; |
---|
| 77 | |
---|
| 78 | ############################################################################## |
---|
| 79 | # |
---|
| 80 | # _handle_element - handles the main tag elements sent from the server. |
---|
| 81 | # On an open tag it creates a new XML::Parser::Tree so |
---|
| 82 | # that _handle_cdata and _handle_element can add data |
---|
| 83 | # and tags to it later. |
---|
| 84 | # |
---|
| 85 | ############################################################################## |
---|
| 86 | sub _handle_element |
---|
| 87 | { |
---|
| 88 | my $self; |
---|
| 89 | $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 90 | $self = shift unless (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 91 | my ($sax, $tag, %att) = @_; |
---|
| 92 | my $sid = $sax->getSID(); |
---|
| 93 | |
---|
| 94 | $self->debug(2,"_handle_element: sid($sid) sax($sax) tag($tag) att(",%att,")"); |
---|
| 95 | |
---|
| 96 | my @NEW; |
---|
| 97 | if($#{$self->{SIDS}->{$sid}->{tree}} < 0) |
---|
| 98 | { |
---|
| 99 | push @{$self->{SIDS}->{$sid}->{tree}}, $tag; |
---|
| 100 | } |
---|
| 101 | else |
---|
| 102 | { |
---|
| 103 | push @{ $self->{SIDS}->{$sid}->{tree}[ $#{$self->{SIDS}->{$sid}->{tree}}]}, $tag; |
---|
| 104 | } |
---|
| 105 | push @NEW, \%att; |
---|
| 106 | push @{$self->{SIDS}->{$sid}->{tree}}, \@NEW; |
---|
| 107 | } |
---|
| 108 | |
---|
| 109 | |
---|
| 110 | ############################################################################## |
---|
| 111 | # |
---|
| 112 | # _handle_cdata - handles the CDATA that is encountered. Also, in the |
---|
| 113 | # spirit of XML::Parser::Tree it combines any sequential |
---|
| 114 | # CDATA into one tag. |
---|
| 115 | # |
---|
| 116 | ############################################################################## |
---|
| 117 | sub _handle_cdata |
---|
| 118 | { |
---|
| 119 | my $self; |
---|
| 120 | $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 121 | $self = shift unless (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 122 | my ($sax, $cdata) = @_; |
---|
| 123 | my $sid = $sax->getSID(); |
---|
| 124 | |
---|
| 125 | $self->debug(2,"_handle_cdata: sid($sid) sax($sax) cdata($cdata)"); |
---|
| 126 | |
---|
| 127 | return if ($#{$self->{SIDS}->{$sid}->{tree}} == -1); |
---|
| 128 | |
---|
| 129 | $self->debug(2,"_handle_cdata: sax($sax) cdata($cdata)"); |
---|
| 130 | |
---|
| 131 | my $pos = $#{$self->{SIDS}->{$sid}->{tree}}; |
---|
| 132 | $self->debug(2,"_handle_cdata: pos($pos)"); |
---|
| 133 | |
---|
| 134 | if ($pos > 0 && $self->{SIDS}->{$sid}->{tree}[$pos - 1] eq "0") |
---|
| 135 | { |
---|
| 136 | $self->debug(2,"_handle_cdata: append cdata"); |
---|
| 137 | $self->{SIDS}->{$sid}->{tree}[$pos - 1] .= $cdata; |
---|
| 138 | } |
---|
| 139 | else |
---|
| 140 | { |
---|
| 141 | $self->debug(2,"_handle_cdata: new cdata"); |
---|
| 142 | push @{$self->{SIDS}->{$sid}->{tree}[$#{$self->{SIDS}->{$sid}->{tree}}]}, 0; |
---|
| 143 | push @{$self->{SIDS}->{$sid}->{tree}[$#{$self->{SIDS}->{$sid}->{tree}}]}, $cdata; |
---|
| 144 | } |
---|
| 145 | } |
---|
| 146 | |
---|
| 147 | |
---|
| 148 | ############################################################################## |
---|
| 149 | # |
---|
| 150 | # _handle_close - when we see a close tag we need to pop the last element |
---|
| 151 | # from the list and push it onto the end of the previous |
---|
| 152 | # element. This is how we build our hierarchy. |
---|
| 153 | # |
---|
| 154 | ############################################################################## |
---|
| 155 | sub _handle_close |
---|
| 156 | { |
---|
| 157 | my $self; |
---|
| 158 | $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 159 | $self = shift unless (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 160 | my ($sax, $tag) = @_; |
---|
| 161 | my $sid = $sax->getSID(); |
---|
| 162 | |
---|
| 163 | $self->debug(2,"_handle_close: sid($sid) sax($sax) tag($tag)"); |
---|
| 164 | |
---|
| 165 | my $CLOSED = pop @{$self->{SIDS}->{$sid}->{tree}}; |
---|
| 166 | |
---|
| 167 | $self->debug(2,"_handle_close: check(",$#{$self->{SIDS}->{$sid}->{tree}},")"); |
---|
| 168 | |
---|
| 169 | if ($#{$self->{SIDS}->{$sid}->{tree}} == -1) |
---|
| 170 | { |
---|
| 171 | if ($self->{SIDS}->{$sid}->{rootTag} ne $tag) |
---|
| 172 | { |
---|
| 173 | $self->{SIDS}->{$sid}->{streamerror} = "Root tag mis-match: <$self->{SIDS}->{$sid}->{rootTag}> ... </$tag>\n"; |
---|
| 174 | } |
---|
| 175 | return; |
---|
| 176 | } |
---|
| 177 | |
---|
| 178 | if($#{$self->{SIDS}->{$sid}->{tree}} < 1) |
---|
| 179 | { |
---|
| 180 | |
---|
| 181 | push @{$self->{SIDS}->{$sid}->{tree}}, $CLOSED; |
---|
| 182 | |
---|
| 183 | if (ref($self) ne "XML::Stream::Parser") |
---|
| 184 | { |
---|
| 185 | my $stream_prefix = $self->StreamPrefix($sid); |
---|
| 186 | |
---|
| 187 | if(defined($self->{SIDS}->{$sid}->{tree}->[0]) && |
---|
| 188 | ($self->{SIDS}->{$sid}->{tree}->[0] =~ /^${stream_prefix}\:/)) |
---|
| 189 | { |
---|
| 190 | my @tree = @{$self->{SIDS}->{$sid}->{tree}}; |
---|
| 191 | $self->{SIDS}->{$sid}->{tree} = []; |
---|
| 192 | $self->ProcessStreamPacket($sid,\@tree); |
---|
| 193 | } |
---|
| 194 | else |
---|
| 195 | { |
---|
| 196 | my @tree = @{$self->{SIDS}->{$sid}->{tree}}; |
---|
| 197 | $self->{SIDS}->{$sid}->{tree} = []; |
---|
| 198 | |
---|
| 199 | my @special = |
---|
| 200 | &XML::Stream::XPath( |
---|
| 201 | \@tree, |
---|
| 202 | '[@xmlns="'.&XML::Stream::ConstXMLNS("xmpp-sasl").'" or @xmlns="'.&XML::Stream::ConstXMLNS("xmpp-tls").'"]' |
---|
| 203 | ); |
---|
| 204 | if ($#special > -1) |
---|
| 205 | { |
---|
| 206 | my $xmlns = &GetXMLData("value",\@tree,"","xmlns"); |
---|
| 207 | |
---|
| 208 | $self->ProcessSASLPacket($sid,\@tree) |
---|
| 209 | if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-sasl")); |
---|
| 210 | $self->ProcessTLSPacket($sid,\@tree) |
---|
| 211 | if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-tls")); |
---|
| 212 | } |
---|
| 213 | else |
---|
| 214 | { |
---|
| 215 | &{$self->{CB}->{node}}($sid,\@tree); |
---|
| 216 | } |
---|
| 217 | } |
---|
| 218 | } |
---|
| 219 | } |
---|
| 220 | else |
---|
| 221 | { |
---|
| 222 | push @{$self->{SIDS}->{$sid}->{tree}[$#{$self->{SIDS}->{$sid}->{tree}}]}, $CLOSED; |
---|
| 223 | } |
---|
| 224 | } |
---|
| 225 | |
---|
| 226 | |
---|
| 227 | ############################################################################## |
---|
| 228 | # |
---|
| 229 | # SetXMLData - takes a host of arguments and sets a portion of the specified |
---|
| 230 | # XML::Parser::Tree object with that data. The function works |
---|
| 231 | # in two modes "single" or "multiple". "single" denotes that |
---|
| 232 | # the function should locate the current tag that matches this |
---|
| 233 | # data and overwrite it's contents with data passed in. |
---|
| 234 | # "multiple" denotes that a new tag should be created even if |
---|
| 235 | # others exist. |
---|
| 236 | # |
---|
| 237 | # type - single or multiple |
---|
| 238 | # XMLTree - pointer to XML::Stream Tree object |
---|
| 239 | # tag - name of tag to create/modify (if blank assumes |
---|
| 240 | # working with top level tag) |
---|
| 241 | # data - CDATA to set for tag |
---|
| 242 | # attribs - attributes to ADD to tag |
---|
| 243 | # |
---|
| 244 | ############################################################################## |
---|
| 245 | sub SetXMLData |
---|
| 246 | { |
---|
| 247 | my ($type,$XMLTree,$tag,$data,$attribs) = @_; |
---|
| 248 | my ($key); |
---|
| 249 | |
---|
| 250 | if ($tag ne "") |
---|
| 251 | { |
---|
| 252 | if ($type eq "single") |
---|
| 253 | { |
---|
| 254 | my ($child); |
---|
| 255 | foreach $child (1..$#{$$XMLTree[1]}) |
---|
| 256 | { |
---|
| 257 | if ($$XMLTree[1]->[$child] eq $tag) |
---|
| 258 | { |
---|
| 259 | if ($data ne "") |
---|
| 260 | { |
---|
| 261 | #todo: add code to handle writing the cdata again and appending it. |
---|
| 262 | $$XMLTree[1]->[$child+1]->[1] = 0; |
---|
| 263 | $$XMLTree[1]->[$child+1]->[2] = $data; |
---|
| 264 | } |
---|
| 265 | foreach $key (keys(%{$attribs})) |
---|
| 266 | { |
---|
| 267 | $$XMLTree[1]->[$child+1]->[0]->{$key} = $$attribs{$key}; |
---|
| 268 | } |
---|
| 269 | return; |
---|
| 270 | } |
---|
| 271 | } |
---|
| 272 | } |
---|
| 273 | $$XMLTree[1]->[($#{$$XMLTree[1]}+1)] = $tag; |
---|
| 274 | $$XMLTree[1]->[($#{$$XMLTree[1]}+1)]->[0] = {}; |
---|
| 275 | foreach $key (keys(%{$attribs})) |
---|
| 276 | { |
---|
| 277 | $$XMLTree[1]->[$#{$$XMLTree[1]}]->[0]->{$key} = $$attribs{$key}; |
---|
| 278 | } |
---|
| 279 | if ($data ne "") |
---|
| 280 | { |
---|
| 281 | $$XMLTree[1]->[$#{$$XMLTree[1]}]->[1] = 0; |
---|
| 282 | $$XMLTree[1]->[$#{$$XMLTree[1]}]->[2] = $data; |
---|
| 283 | } |
---|
| 284 | } |
---|
| 285 | else |
---|
| 286 | { |
---|
| 287 | foreach $key (keys(%{$attribs})) |
---|
| 288 | { |
---|
| 289 | $$XMLTree[1]->[0]->{$key} = $$attribs{$key}; |
---|
| 290 | } |
---|
| 291 | if ($data ne "") |
---|
| 292 | { |
---|
| 293 | if (($#{$$XMLTree[1]} > 0) && |
---|
| 294 | ($$XMLTree[1]->[($#{$$XMLTree[1]}-1)] eq "0")) |
---|
| 295 | { |
---|
| 296 | $$XMLTree[1]->[$#{$$XMLTree[1]}] .= $data; |
---|
| 297 | } |
---|
| 298 | else |
---|
| 299 | { |
---|
| 300 | $$XMLTree[1]->[($#{$$XMLTree[1]}+1)] = 0; |
---|
| 301 | $$XMLTree[1]->[($#{$$XMLTree[1]}+1)] = $data; |
---|
| 302 | } |
---|
| 303 | } |
---|
| 304 | } |
---|
| 305 | } |
---|
| 306 | |
---|
| 307 | |
---|
| 308 | ############################################################################## |
---|
| 309 | # |
---|
| 310 | # GetXMLData - takes a host of arguments and returns various data structures |
---|
| 311 | # that match them. |
---|
| 312 | # |
---|
| 313 | # type - "existence" - returns 1 or 0 if the tag exists in the |
---|
| 314 | # top level. |
---|
| 315 | # "value" - returns either the CDATA of the tag, or the |
---|
| 316 | # value of the attribute depending on which is |
---|
| 317 | # sought. This ignores any mark ups to the data |
---|
| 318 | # and just returns the raw CDATA. |
---|
| 319 | # "value array" - returns an array of strings representing |
---|
| 320 | # all of the CDATA in the specified tag. |
---|
| 321 | # This ignores any mark ups to the data |
---|
| 322 | # and just returns the raw CDATA. |
---|
| 323 | # "tree" - returns an XML::Parser::Tree object with the |
---|
| 324 | # specified tag as the root tag. |
---|
| 325 | # "tree array" - returns an array of XML::Parser::Tree |
---|
| 326 | # objects each with the specified tag as |
---|
| 327 | # the root tag. |
---|
| 328 | # "child array" - returns a list of all children nodes |
---|
| 329 | # not including CDATA nodes. |
---|
| 330 | # "attribs" - returns a hash with the attributes, and |
---|
| 331 | # their values, for the things that match |
---|
| 332 | # the parameters |
---|
| 333 | # "count" - returns the number of things that match |
---|
| 334 | # the arguments |
---|
| 335 | # "tag" - returns the root tag of this tree |
---|
| 336 | # XMLTree - pointer to XML::Parser::Tree object |
---|
| 337 | # tag - tag to pull data from. If blank then the top level |
---|
| 338 | # tag is accessed. |
---|
| 339 | # attrib - attribute value to retrieve. Ignored for types |
---|
| 340 | # "value array", "tree", "tree array". If paired |
---|
| 341 | # with value can be used to filter tags based on |
---|
| 342 | # attributes and values. |
---|
| 343 | # value - only valid if an attribute is supplied. Used to |
---|
| 344 | # filter for tags that only contain this attribute. |
---|
| 345 | # Useful to search through multiple tags that all |
---|
| 346 | # reference different name spaces. |
---|
| 347 | # |
---|
| 348 | ############################################################################## |
---|
| 349 | sub GetXMLData |
---|
| 350 | { |
---|
| 351 | my ($type,$XMLTree,$tag,$attrib,$value) = @_; |
---|
| 352 | |
---|
| 353 | $tag = "" if !defined($tag); |
---|
| 354 | $attrib = "" if !defined($attrib); |
---|
| 355 | $value = "" if !defined($value); |
---|
| 356 | |
---|
| 357 | my $skipthis = 0; |
---|
| 358 | |
---|
| 359 | #--------------------------------------------------------------------------- |
---|
| 360 | # Check if a child tag in the root tag is being requested. |
---|
| 361 | #--------------------------------------------------------------------------- |
---|
| 362 | if ($tag ne "") |
---|
| 363 | { |
---|
| 364 | my $count = 0; |
---|
| 365 | my @array; |
---|
| 366 | foreach my $child (1..$#{$$XMLTree[1]}) |
---|
| 367 | { |
---|
| 368 | next if (($child/2) !~ /\./); |
---|
| 369 | if (($$XMLTree[1]->[$child] eq $tag) || ($tag eq "*")) |
---|
| 370 | { |
---|
| 371 | next if (ref($$XMLTree[1]->[$child]) eq "ARRAY"); |
---|
| 372 | |
---|
| 373 | #--------------------------------------------------------------------- |
---|
| 374 | # Filter out tags that do not contain the attribute and value. |
---|
| 375 | #--------------------------------------------------------------------- |
---|
| 376 | next if (($value ne "") && ($attrib ne "") && exists($$XMLTree[1]->[$child+1]->[0]->{$attrib}) && ($$XMLTree[1]->[$child+1]->[0]->{$attrib} ne $value)); |
---|
| 377 | next if (($attrib ne "") && ((ref($$XMLTree[1]->[$child+1]) ne "ARRAY") || !exists($$XMLTree[1]->[$child+1]->[0]->{$attrib}))); |
---|
| 378 | |
---|
| 379 | #--------------------------------------------------------------------- |
---|
| 380 | # Check for existence |
---|
| 381 | #--------------------------------------------------------------------- |
---|
| 382 | if ($type eq "existence") |
---|
| 383 | { |
---|
| 384 | return 1; |
---|
| 385 | } |
---|
| 386 | |
---|
| 387 | #--------------------------------------------------------------------- |
---|
| 388 | # Return the raw CDATA value without mark ups, or the value of the |
---|
| 389 | # requested attribute. |
---|
| 390 | #--------------------------------------------------------------------- |
---|
| 391 | if ($type eq "value") |
---|
| 392 | { |
---|
| 393 | if ($attrib eq "") |
---|
| 394 | { |
---|
| 395 | my $str = ""; |
---|
| 396 | my $next = 0; |
---|
| 397 | my $index; |
---|
| 398 | foreach $index (1..$#{$$XMLTree[1]->[$child+1]}) { |
---|
| 399 | if ($next == 1) { $next = 0; next; } |
---|
| 400 | if ($$XMLTree[1]->[$child+1]->[$index] eq "0") { |
---|
| 401 | $str .= $$XMLTree[1]->[$child+1]->[$index+1]; |
---|
| 402 | $next = 1; |
---|
| 403 | } |
---|
| 404 | } |
---|
| 405 | return $str; |
---|
| 406 | } |
---|
| 407 | return $$XMLTree[1]->[$child+1]->[0]->{$attrib} |
---|
| 408 | if (exists $$XMLTree[1]->[$child+1]->[0]->{$attrib}); |
---|
| 409 | } |
---|
| 410 | #--------------------------------------------------------------------- |
---|
| 411 | # Return an array of values that represent the raw CDATA without |
---|
| 412 | # mark up tags for the requested tags. |
---|
| 413 | #--------------------------------------------------------------------- |
---|
| 414 | if ($type eq "value array") |
---|
| 415 | { |
---|
| 416 | if ($attrib eq "") |
---|
| 417 | { |
---|
| 418 | my $str = ""; |
---|
| 419 | my $next = 0; |
---|
| 420 | my $index; |
---|
| 421 | foreach $index (1..$#{$$XMLTree[1]->[$child+1]}) |
---|
| 422 | { |
---|
| 423 | if ($next == 1) { $next = 0; next; } |
---|
| 424 | if ($$XMLTree[1]->[$child+1]->[$index] eq "0") |
---|
| 425 | { |
---|
| 426 | $str .= $$XMLTree[1]->[$child+1]->[$index+1]; |
---|
| 427 | $next = 1; |
---|
| 428 | } |
---|
| 429 | } |
---|
| 430 | push(@array,$str); |
---|
| 431 | } |
---|
| 432 | else |
---|
| 433 | { |
---|
| 434 | push(@array,$$XMLTree[1]->[$child+1]->[0]->{$attrib}) |
---|
| 435 | if (exists $$XMLTree[1]->[$child+1]->[0]->{$attrib}); |
---|
| 436 | } |
---|
| 437 | } |
---|
| 438 | #--------------------------------------------------------------------- |
---|
| 439 | # Return a pointer to a new XML::Parser::Tree object that has the |
---|
| 440 | # requested tag as the root tag. |
---|
| 441 | #--------------------------------------------------------------------- |
---|
| 442 | if ($type eq "tree") |
---|
| 443 | { |
---|
| 444 | my @tree = ( $$XMLTree[1]->[$child] , $$XMLTree[1]->[$child+1] ); |
---|
| 445 | return @tree; |
---|
| 446 | } |
---|
| 447 | #--------------------------------------------------------------------- |
---|
| 448 | # Return an array of pointers to XML::Parser::Tree objects that have |
---|
| 449 | # the requested tag as the root tags. |
---|
| 450 | #--------------------------------------------------------------------- |
---|
| 451 | if ($type eq "tree array") |
---|
| 452 | { |
---|
| 453 | my @tree = ( $$XMLTree[1]->[$child] , $$XMLTree[1]->[$child+1] ); |
---|
| 454 | push(@array,\@tree); |
---|
| 455 | } |
---|
| 456 | #--------------------------------------------------------------------- |
---|
| 457 | # Return a count of the number of tags that match |
---|
| 458 | #--------------------------------------------------------------------- |
---|
| 459 | if ($type eq "count") |
---|
| 460 | { |
---|
| 461 | if ($$XMLTree[1]->[$child] eq "0") |
---|
| 462 | { |
---|
| 463 | $skipthis = 1; |
---|
| 464 | next; |
---|
| 465 | } |
---|
| 466 | if ($skipthis == 1) |
---|
| 467 | { |
---|
| 468 | $skipthis = 0; |
---|
| 469 | next; |
---|
| 470 | } |
---|
| 471 | $count++; |
---|
| 472 | } |
---|
| 473 | #--------------------------------------------------------------------- |
---|
| 474 | # Return a count of the number of tags that match |
---|
| 475 | #--------------------------------------------------------------------- |
---|
| 476 | if ($type eq "child array") |
---|
| 477 | { |
---|
| 478 | my @tree = ( $$XMLTree[1]->[$child] , $$XMLTree[1]->[$child+1] ); |
---|
| 479 | push(@array,\@tree) if ($tree[0] ne "0"); |
---|
| 480 | } |
---|
| 481 | #--------------------------------------------------------------------- |
---|
| 482 | # Return the attribute hash that matches this tag |
---|
| 483 | #--------------------------------------------------------------------- |
---|
| 484 | if ($type eq "attribs") |
---|
| 485 | { |
---|
| 486 | return (%{$$XMLTree[1]->[$child+1]->[0]}); |
---|
| 487 | } |
---|
| 488 | } |
---|
| 489 | } |
---|
| 490 | #------------------------------------------------------------------------- |
---|
| 491 | # If we are returning arrays then return array. |
---|
| 492 | #------------------------------------------------------------------------- |
---|
| 493 | if (($type eq "tree array") || ($type eq "value array") || |
---|
| 494 | ($type eq "child array")) |
---|
| 495 | { |
---|
| 496 | return @array; |
---|
| 497 | } |
---|
| 498 | |
---|
| 499 | #------------------------------------------------------------------------- |
---|
| 500 | # If we are returning then count, then do so |
---|
| 501 | #------------------------------------------------------------------------- |
---|
| 502 | if ($type eq "count") |
---|
| 503 | { |
---|
| 504 | return $count; |
---|
| 505 | } |
---|
| 506 | } |
---|
| 507 | else |
---|
| 508 | { |
---|
| 509 | #------------------------------------------------------------------------- |
---|
| 510 | # This is the root tag, so handle things a level up. |
---|
| 511 | #------------------------------------------------------------------------- |
---|
| 512 | |
---|
| 513 | #------------------------------------------------------------------------- |
---|
| 514 | # Return the raw CDATA value without mark ups, or the value of the |
---|
| 515 | # requested attribute. |
---|
| 516 | #------------------------------------------------------------------------- |
---|
| 517 | if ($type eq "value") |
---|
| 518 | { |
---|
| 519 | if ($attrib eq "") |
---|
| 520 | { |
---|
| 521 | my $str = ""; |
---|
| 522 | my $next = 0; |
---|
| 523 | my $index; |
---|
| 524 | foreach $index (1..$#{$$XMLTree[1]}) |
---|
| 525 | { |
---|
| 526 | if ($next == 1) { $next = 0; next; } |
---|
| 527 | if ($$XMLTree[1]->[$index] eq "0") |
---|
| 528 | { |
---|
| 529 | $str .= $$XMLTree[1]->[$index+1]; |
---|
| 530 | $next = 1; |
---|
| 531 | } |
---|
| 532 | } |
---|
| 533 | return $str; |
---|
| 534 | } |
---|
| 535 | return $$XMLTree[1]->[0]->{$attrib} |
---|
| 536 | if (exists $$XMLTree[1]->[0]->{$attrib}); |
---|
| 537 | } |
---|
| 538 | #------------------------------------------------------------------------- |
---|
| 539 | # Return a pointer to a new XML::Parser::Tree object that has the |
---|
| 540 | # requested tag as the root tag. |
---|
| 541 | #------------------------------------------------------------------------- |
---|
| 542 | if ($type eq "tree") |
---|
| 543 | { |
---|
| 544 | my @tree = @{$$XMLTree}; |
---|
| 545 | return @tree; |
---|
| 546 | } |
---|
| 547 | |
---|
| 548 | #------------------------------------------------------------------------- |
---|
| 549 | # Return the 1 if the specified attribute exists in the root tag. |
---|
| 550 | #------------------------------------------------------------------------- |
---|
| 551 | if ($type eq "existence") |
---|
| 552 | { |
---|
| 553 | return 1 if (($attrib ne "") && (exists($$XMLTree[1]->[0]->{$attrib}))); |
---|
| 554 | } |
---|
| 555 | |
---|
| 556 | #------------------------------------------------------------------------- |
---|
| 557 | # Return the attribute hash that matches this tag |
---|
| 558 | #------------------------------------------------------------------------- |
---|
| 559 | if ($type eq "attribs") |
---|
| 560 | { |
---|
| 561 | return %{$$XMLTree[1]->[0]}; |
---|
| 562 | } |
---|
| 563 | #------------------------------------------------------------------------- |
---|
| 564 | # Return the tag of this node |
---|
| 565 | #------------------------------------------------------------------------- |
---|
| 566 | if ($type eq "tag") |
---|
| 567 | { |
---|
| 568 | return $$XMLTree[0]; |
---|
| 569 | } |
---|
| 570 | } |
---|
| 571 | #--------------------------------------------------------------------------- |
---|
| 572 | # Return 0 if this was a request for existence, or "" if a request for |
---|
| 573 | # a "value", or [] for "tree", "value array", and "tree array". |
---|
| 574 | #--------------------------------------------------------------------------- |
---|
| 575 | return 0 if ($type eq "existence"); |
---|
| 576 | return "" if ($type eq "value"); |
---|
| 577 | return []; |
---|
| 578 | } |
---|
| 579 | |
---|
| 580 | |
---|
| 581 | ############################################################################## |
---|
| 582 | # |
---|
| 583 | # BuildXML - takes an XML::Parser::Tree object and builds the XML string |
---|
| 584 | # that it represents. |
---|
| 585 | # |
---|
| 586 | ############################################################################## |
---|
| 587 | sub BuildXML |
---|
| 588 | { |
---|
| 589 | my ($parseTree,$rawXML) = @_; |
---|
| 590 | |
---|
| 591 | return "" if $#{$parseTree} == -1; |
---|
| 592 | |
---|
| 593 | my $str = ""; |
---|
| 594 | if (ref($parseTree->[0]) eq "") |
---|
| 595 | { |
---|
| 596 | if ($parseTree->[0] eq "0") |
---|
| 597 | { |
---|
| 598 | return &XML::Stream::EscapeXML($parseTree->[1]); |
---|
| 599 | } |
---|
| 600 | |
---|
| 601 | $str = "<".$parseTree->[0]; |
---|
| 602 | foreach my $att (sort {$a cmp $b} keys(%{$parseTree->[1]->[0]})) |
---|
| 603 | { |
---|
| 604 | $str .= " ".$att."='".&XML::Stream::EscapeXML($parseTree->[1]->[0]->{$att})."'"; |
---|
| 605 | } |
---|
| 606 | |
---|
| 607 | if (($#{$parseTree->[1]} > 0) || (defined($rawXML) && ($rawXML ne ""))) |
---|
| 608 | { |
---|
| 609 | $str .= ">"; |
---|
| 610 | |
---|
| 611 | my $index = 1; |
---|
| 612 | while($index <= $#{$parseTree->[1]}) |
---|
| 613 | { |
---|
| 614 | my @newTree = ( $parseTree->[1]->[$index], $parseTree->[1]->[$index+1] ); |
---|
| 615 | $str .= &XML::Stream::Tree::BuildXML(\@newTree); |
---|
| 616 | $index += 2; |
---|
| 617 | } |
---|
| 618 | |
---|
| 619 | $str .= $rawXML if defined($rawXML); |
---|
| 620 | $str .= "</".$parseTree->[0].">"; |
---|
| 621 | } |
---|
| 622 | else |
---|
| 623 | { |
---|
| 624 | $str .= "/>"; |
---|
| 625 | } |
---|
| 626 | |
---|
| 627 | } |
---|
| 628 | |
---|
| 629 | return $str; |
---|
| 630 | } |
---|
| 631 | |
---|
| 632 | |
---|
| 633 | ############################################################################## |
---|
| 634 | # |
---|
| 635 | # XML2Config - takes an XML data tree and turns it into a hash of hashes. |
---|
| 636 | # This only works for certain kinds of XML trees like this: |
---|
| 637 | # |
---|
| 638 | # <foo> |
---|
| 639 | # <bar>1</bar> |
---|
| 640 | # <x> |
---|
| 641 | # <y>foo</y> |
---|
| 642 | # </x> |
---|
| 643 | # <z>5</z> |
---|
| 644 | # </foo> |
---|
| 645 | # |
---|
| 646 | # The resulting hash would be: |
---|
| 647 | # |
---|
| 648 | # $hash{bar} = 1; |
---|
| 649 | # $hash{x}->{y} = "foo"; |
---|
| 650 | # $hash{z} = 5; |
---|
| 651 | # |
---|
| 652 | # Good for config files. |
---|
| 653 | # |
---|
| 654 | ############################################################################## |
---|
| 655 | sub XML2Config |
---|
| 656 | { |
---|
| 657 | my ($XMLTree) = @_; |
---|
| 658 | |
---|
| 659 | my %hash; |
---|
| 660 | foreach my $tree (&XML::Stream::GetXMLData("tree array",$XMLTree,"*")) |
---|
| 661 | { |
---|
| 662 | if ($tree->[0] eq "0") |
---|
| 663 | { |
---|
| 664 | return $tree->[1] unless ($tree->[1] =~ /^\s*$/); |
---|
| 665 | } |
---|
| 666 | else |
---|
| 667 | { |
---|
| 668 | if (&XML::Stream::GetXMLData("count",$XMLTree,$tree->[0]) > 1) |
---|
| 669 | { |
---|
| 670 | push(@{$hash{$tree->[0]}},&XML::Stream::XML2Config($tree)); |
---|
| 671 | } |
---|
| 672 | else |
---|
| 673 | { |
---|
| 674 | $hash{$tree->[0]} = &XML::Stream::XML2Config($tree); |
---|
| 675 | } |
---|
| 676 | } |
---|
| 677 | } |
---|
| 678 | return \%hash; |
---|
| 679 | } |
---|
| 680 | |
---|
| 681 | |
---|
| 682 | 1; |
---|