[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::Node; |
---|
| 24 | |
---|
| 25 | =head1 NAME |
---|
| 26 | |
---|
| 27 | XML::Stream::Node - 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 | This creates a hierarchy of Perl objects and provides various methods |
---|
| 36 | to manipulate the structure of the tree. It is much like the C library |
---|
| 37 | libxml. |
---|
| 38 | |
---|
| 39 | =head1 FORMAT |
---|
| 40 | |
---|
| 41 | The result of parsing: |
---|
| 42 | |
---|
| 43 | <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo> |
---|
| 44 | |
---|
| 45 | would be: |
---|
| 46 | |
---|
| 47 | [ tag: foo |
---|
| 48 | att: {} |
---|
| 49 | children: [ tag: head |
---|
| 50 | att: {id=>"a"} |
---|
| 51 | children: [ tag: "__xmlstream__:node:cdata" |
---|
| 52 | children: "Hello " |
---|
| 53 | ] |
---|
| 54 | [ tag: em |
---|
| 55 | children: [ tag: "__xmlstream__:node:cdata" |
---|
| 56 | children: "there" |
---|
| 57 | ] |
---|
| 58 | ] |
---|
| 59 | ] |
---|
| 60 | [ tag: bar |
---|
| 61 | children: [ tag: "__xmlstream__:node:cdata" |
---|
| 62 | children: "Howdy " |
---|
| 63 | ] |
---|
| 64 | [ tag: ref |
---|
| 65 | ] |
---|
| 66 | ] |
---|
| 67 | [ tag: "__xmlstream__:node:cdata" |
---|
| 68 | children: "do" |
---|
| 69 | ] |
---|
| 70 | ] |
---|
| 71 | |
---|
| 72 | =head1 METHODS |
---|
| 73 | |
---|
| 74 | new() - creates a new node. If you specify tag, then the root |
---|
| 75 | new(tag) tag is set. If you specify data, then cdata is added |
---|
| 76 | new(tag,cdata) to the node as well. Returns the created node. |
---|
| 77 | |
---|
| 78 | get_tag() - returns the root tag of the node. |
---|
| 79 | |
---|
| 80 | set_tag(tag) - set the root tag of the node to tag. |
---|
| 81 | |
---|
| 82 | add_child(node) - adds the specified node as a child to the current |
---|
| 83 | add_child(tag) node, or creates a new node with the specified tag |
---|
| 84 | add_child(tag,cdata) as the root node. Returns the node added. |
---|
| 85 | |
---|
| 86 | remove_child(node) - removes the child node from the current node. |
---|
| 87 | |
---|
| 88 | remove_cdata() - removes all of the cdata children from the current node. |
---|
| 89 | |
---|
| 90 | add_cdata(string) - adds the string as cdata onto the current nodes |
---|
| 91 | child list. |
---|
| 92 | |
---|
| 93 | get_cdata() - returns all of the cdata children concatenated together |
---|
| 94 | into one string. |
---|
| 95 | |
---|
| 96 | get_attrib(attrib) - returns the value of the attrib if it is valid, |
---|
| 97 | or returns undef is attrib is not a real |
---|
| 98 | attribute. |
---|
| 99 | |
---|
| 100 | put_attrib(hash) - for each key/value pair specified, create an |
---|
| 101 | attribute in the node. |
---|
| 102 | |
---|
| 103 | remove_attrib(attrib) - remove the specified attribute from the node. |
---|
| 104 | |
---|
| 105 | add_raw_xml(string,[string,...]) - directly add a string into the XML |
---|
| 106 | packet as the last child, with no |
---|
| 107 | translation. |
---|
| 108 | |
---|
| 109 | get_raw_xml() - return all of the XML in a single string, undef if there |
---|
| 110 | is no raw XML to include. |
---|
| 111 | |
---|
| 112 | remove_raw_xml() - remove all raw XML strings. |
---|
| 113 | |
---|
| 114 | children() - return all of the children of the node in a list. |
---|
| 115 | |
---|
| 116 | attrib() - returns a hash containing all of the attributes on this |
---|
| 117 | node. |
---|
| 118 | |
---|
| 119 | copy() - return a recursive copy of the node. |
---|
| 120 | |
---|
| 121 | XPath(path) - run XML::Stream::XPath on this node. |
---|
| 122 | |
---|
| 123 | XPathCheck(path) - run XML::Stream::XPath on this node and return 1 or 0 |
---|
| 124 | to see if it matches or not. |
---|
| 125 | |
---|
| 126 | GetXML() - return the node in XML string form. |
---|
| 127 | |
---|
| 128 | =head1 AUTHOR |
---|
| 129 | |
---|
| 130 | By Ryan Eatmon in June 2002 for http://jabber.org/ |
---|
| 131 | |
---|
| 132 | =head1 COPYRIGHT |
---|
| 133 | |
---|
| 134 | This module is free software; you can redistribute it and/or modify |
---|
| 135 | it under the same terms as Perl itself. |
---|
| 136 | |
---|
| 137 | =cut |
---|
| 138 | |
---|
| 139 | use vars qw( $VERSION $LOADED ); |
---|
| 140 | |
---|
| 141 | $VERSION = "1.22"; |
---|
| 142 | $LOADED = 1; |
---|
| 143 | |
---|
| 144 | sub new |
---|
| 145 | { |
---|
| 146 | my $proto = shift; |
---|
| 147 | my $class = ref($proto) || $proto; |
---|
| 148 | |
---|
| 149 | if (ref($_[0]) eq "XML::Stream::Node") |
---|
| 150 | { |
---|
| 151 | return $_[0]; |
---|
| 152 | } |
---|
| 153 | |
---|
| 154 | my $self = {}; |
---|
| 155 | bless($self, $proto); |
---|
| 156 | |
---|
| 157 | my ($tag,$data) = @_; |
---|
| 158 | |
---|
| 159 | $self->set_tag($tag) if defined($tag); |
---|
| 160 | $self->add_cdata($data) if defined($data); |
---|
| 161 | $self->remove_raw_xml(); |
---|
| 162 | |
---|
| 163 | return $self; |
---|
| 164 | } |
---|
| 165 | |
---|
| 166 | |
---|
| 167 | sub debug |
---|
| 168 | { |
---|
| 169 | my $self = shift; |
---|
| 170 | my ($indent) = @_; |
---|
| 171 | |
---|
| 172 | $indent = "" unless defined($indent); |
---|
| 173 | |
---|
| 174 | if ($self->{TAG} eq "__xmlstream__:node:cdata") |
---|
| 175 | { |
---|
| 176 | print $indent,"cdata(",join("",@{$self->{CHILDREN}}),")\n"; |
---|
| 177 | } |
---|
| 178 | else |
---|
| 179 | { |
---|
| 180 | print $indent,"packet($self):\n"; |
---|
| 181 | print $indent,"tag: <$self->{TAG}\n"; |
---|
| 182 | if (scalar(keys(%{$self->{ATTRIBS}})) > 0) |
---|
| 183 | { |
---|
| 184 | print $indent,"attribs:\n"; |
---|
| 185 | foreach my $key (sort {$a cmp $b} keys(%{$self->{ATTRIBS}})) |
---|
| 186 | { |
---|
| 187 | print $indent," $key = '$self->{ATTRIBS}->{$key}'\n"; |
---|
| 188 | } |
---|
| 189 | } |
---|
| 190 | if ($#{$self->{CHILDREN}} == -1) |
---|
| 191 | { |
---|
| 192 | print $indent," />\n"; |
---|
| 193 | } |
---|
| 194 | else |
---|
| 195 | { |
---|
| 196 | print $indent," >\n"; |
---|
| 197 | print $indent,"children:\n"; |
---|
| 198 | foreach my $child (@{$self->{CHILDREN}}) |
---|
| 199 | { |
---|
| 200 | $child->debug($indent." "); |
---|
| 201 | } |
---|
| 202 | } |
---|
| 203 | print $indent," </$self->{TAG}>\n"; |
---|
| 204 | } |
---|
| 205 | } |
---|
| 206 | |
---|
| 207 | |
---|
| 208 | sub children |
---|
| 209 | { |
---|
| 210 | my $self = shift; |
---|
| 211 | |
---|
| 212 | return () unless exists($self->{CHILDREN}); |
---|
| 213 | return @{$self->{CHILDREN}}; |
---|
| 214 | } |
---|
| 215 | |
---|
| 216 | |
---|
| 217 | sub add_child |
---|
| 218 | { |
---|
| 219 | my $self = shift; |
---|
| 220 | |
---|
| 221 | my $child = new XML::Stream::Node(@_); |
---|
| 222 | push(@{$self->{CHILDREN}},$child); |
---|
| 223 | return $child; |
---|
| 224 | } |
---|
| 225 | |
---|
| 226 | |
---|
| 227 | sub remove_child |
---|
| 228 | { |
---|
| 229 | my $self = shift; |
---|
| 230 | my $child = shift; |
---|
| 231 | |
---|
| 232 | foreach my $index (0..$#{$self->{CHILDREN}}) |
---|
| 233 | { |
---|
| 234 | if ($child == $self->{CHILDREN}->[$index]) |
---|
| 235 | { |
---|
| 236 | splice(@{$self->{CHILDREN}},$index,1); |
---|
| 237 | last; |
---|
| 238 | } |
---|
| 239 | } |
---|
| 240 | } |
---|
| 241 | |
---|
| 242 | |
---|
| 243 | sub add_cdata |
---|
| 244 | { |
---|
| 245 | my $self = shift; |
---|
| 246 | my $child = new XML::Stream::Node("__xmlstream__:node:cdata"); |
---|
| 247 | foreach my $cdata (@_) |
---|
| 248 | { |
---|
| 249 | push(@{$child->{CHILDREN}},$cdata); |
---|
| 250 | } |
---|
| 251 | push(@{$self->{CHILDREN}},$child); |
---|
| 252 | return $child; |
---|
| 253 | } |
---|
| 254 | |
---|
| 255 | |
---|
| 256 | sub get_cdata |
---|
| 257 | { |
---|
| 258 | my $self = shift; |
---|
| 259 | |
---|
| 260 | my $cdata = ""; |
---|
| 261 | foreach my $child (@{$self->{CHILDREN}}) |
---|
| 262 | { |
---|
| 263 | $cdata .= join("",$child->children()) |
---|
| 264 | if ($child->get_tag() eq "__xmlstream__:node:cdata"); |
---|
| 265 | } |
---|
| 266 | |
---|
| 267 | return $cdata; |
---|
| 268 | } |
---|
| 269 | |
---|
| 270 | |
---|
| 271 | sub remove_cdata |
---|
| 272 | { |
---|
| 273 | my $self = shift; |
---|
| 274 | |
---|
| 275 | my @remove = (); |
---|
| 276 | foreach my $index (0..$#{$self->{CHILDREN}}) |
---|
| 277 | { |
---|
| 278 | if ($self->{CHILDREN}->[$index]->get_tag() eq "__xmlstream__:node:cdata") |
---|
| 279 | { |
---|
| 280 | |
---|
| 281 | unshift(@remove,$index); |
---|
| 282 | } |
---|
| 283 | } |
---|
| 284 | foreach my $index (@remove) |
---|
| 285 | { |
---|
| 286 | splice(@{$self->{CHILDREN}},$index,1); |
---|
| 287 | } |
---|
| 288 | } |
---|
| 289 | |
---|
| 290 | |
---|
| 291 | sub attrib |
---|
| 292 | { |
---|
| 293 | my $self = shift; |
---|
| 294 | return () unless exists($self->{ATTRIBS}); |
---|
| 295 | return %{$self->{ATTRIBS}}; |
---|
| 296 | } |
---|
| 297 | |
---|
| 298 | |
---|
| 299 | sub get_attrib |
---|
| 300 | { |
---|
| 301 | my $self = shift; |
---|
| 302 | my ($key) = @_; |
---|
| 303 | |
---|
| 304 | return unless exists($self->{ATTRIBS}->{$key}); |
---|
| 305 | return $self->{ATTRIBS}->{$key}; |
---|
| 306 | } |
---|
| 307 | |
---|
| 308 | |
---|
| 309 | sub put_attrib |
---|
| 310 | { |
---|
| 311 | my $self = shift; |
---|
| 312 | my (%att) = @_; |
---|
| 313 | |
---|
| 314 | foreach my $key (keys(%att)) |
---|
| 315 | { |
---|
| 316 | $self->{ATTRIBS}->{$key} = $att{$key}; |
---|
| 317 | } |
---|
| 318 | } |
---|
| 319 | |
---|
| 320 | |
---|
| 321 | sub remove_attrib |
---|
| 322 | { |
---|
| 323 | my $self = shift; |
---|
| 324 | my ($key) = @_; |
---|
| 325 | |
---|
| 326 | return unless exists($self->{ATTRIBS}->{$key}); |
---|
| 327 | delete($self->{ATTRIBS}->{$key}); |
---|
| 328 | } |
---|
| 329 | |
---|
| 330 | |
---|
| 331 | sub add_raw_xml |
---|
| 332 | { |
---|
| 333 | my $self = shift; |
---|
| 334 | my (@raw) = @_; |
---|
| 335 | |
---|
| 336 | push(@{$self->{RAWXML}},@raw); |
---|
| 337 | } |
---|
| 338 | |
---|
| 339 | sub get_raw_xml |
---|
| 340 | { |
---|
| 341 | my $self = shift; |
---|
| 342 | |
---|
| 343 | return if ($#{$self->{RAWXML}} == -1); |
---|
| 344 | return join("",@{$self->{RAWXML}}); |
---|
| 345 | } |
---|
| 346 | |
---|
| 347 | |
---|
| 348 | sub remove_raw_xml |
---|
| 349 | { |
---|
| 350 | my $self = shift; |
---|
| 351 | $self->{RAWXML} = []; |
---|
| 352 | } |
---|
| 353 | |
---|
| 354 | |
---|
| 355 | sub get_tag |
---|
| 356 | { |
---|
| 357 | my $self = shift; |
---|
| 358 | |
---|
| 359 | return $self->{TAG}; |
---|
| 360 | } |
---|
| 361 | |
---|
| 362 | |
---|
| 363 | sub set_tag |
---|
| 364 | { |
---|
| 365 | my $self = shift; |
---|
| 366 | my ($tag) = @_; |
---|
| 367 | |
---|
| 368 | $self->{TAG} = $tag; |
---|
| 369 | } |
---|
| 370 | |
---|
| 371 | |
---|
| 372 | sub XPath |
---|
| 373 | { |
---|
| 374 | my $self = shift; |
---|
| 375 | my @results = &XML::Stream::XPath($self,@_); |
---|
| 376 | return unless ($#results > -1); |
---|
| 377 | return $results[0] unless wantarray; |
---|
| 378 | return @results; |
---|
| 379 | } |
---|
| 380 | |
---|
| 381 | |
---|
| 382 | sub XPathCheck |
---|
| 383 | { |
---|
| 384 | my $self = shift; |
---|
| 385 | return &XML::Stream::XPathCheck($self,@_); |
---|
| 386 | } |
---|
| 387 | |
---|
| 388 | |
---|
| 389 | sub GetXML |
---|
| 390 | { |
---|
| 391 | my $self = shift; |
---|
| 392 | |
---|
| 393 | return &BuildXML($self,@_); |
---|
| 394 | } |
---|
| 395 | |
---|
| 396 | |
---|
| 397 | sub copy |
---|
| 398 | { |
---|
| 399 | my $self = shift; |
---|
| 400 | |
---|
| 401 | my $new_node = new XML::Stream::Node(); |
---|
| 402 | $new_node->set_tag($self->get_tag()); |
---|
| 403 | $new_node->put_attrib($self->attrib()); |
---|
| 404 | |
---|
| 405 | foreach my $child ($self->children()) |
---|
| 406 | { |
---|
| 407 | if ($child->get_tag() eq "__xmlstream__:node:cdata") |
---|
| 408 | { |
---|
| 409 | $new_node->add_cdata($self->get_cdata()); |
---|
| 410 | } |
---|
| 411 | else |
---|
| 412 | { |
---|
| 413 | $new_node->add_child($child->copy()); |
---|
| 414 | } |
---|
| 415 | } |
---|
| 416 | |
---|
| 417 | return $new_node; |
---|
| 418 | } |
---|
| 419 | |
---|
| 420 | |
---|
| 421 | |
---|
| 422 | |
---|
| 423 | |
---|
| 424 | ############################################################################## |
---|
| 425 | # |
---|
| 426 | # _handle_element - handles the main tag elements sent from the server. |
---|
| 427 | # On an open tag it creates a new XML::Parser::Node so |
---|
| 428 | # that _handle_cdata and _handle_element can add data |
---|
| 429 | # and tags to it later. |
---|
| 430 | # |
---|
| 431 | ############################################################################## |
---|
| 432 | sub _handle_element |
---|
| 433 | { |
---|
| 434 | my $self; |
---|
| 435 | $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 436 | $self = shift unless (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 437 | my ($sax, $tag, %att) = @_; |
---|
| 438 | my $sid = $sax->getSID(); |
---|
| 439 | |
---|
| 440 | $self->debug(2,"Node: _handle_element: sid($sid) sax($sax) tag($tag) att(",%att,")"); |
---|
| 441 | |
---|
| 442 | my $node = new XML::Stream::Node($tag); |
---|
| 443 | $node->put_attrib(%att); |
---|
| 444 | |
---|
| 445 | $self->debug(2,"Node: _handle_element: check(",$#{$self->{SIDS}->{$sid}->{node}},")"); |
---|
| 446 | |
---|
| 447 | if ($#{$self->{SIDS}->{$sid}->{node}} >= 0) |
---|
| 448 | { |
---|
| 449 | $self->{SIDS}->{$sid}->{node}->[$#{$self->{SIDS}->{$sid}->{node}}]-> |
---|
| 450 | add_child($node); |
---|
| 451 | } |
---|
| 452 | |
---|
| 453 | push(@{$self->{SIDS}->{$sid}->{node}},$node); |
---|
| 454 | } |
---|
| 455 | |
---|
| 456 | |
---|
| 457 | ############################################################################## |
---|
| 458 | # |
---|
| 459 | # _handle_cdata - handles the CDATA that is encountered. Also, in the |
---|
| 460 | # spirit of XML::Parser::Node it combines any sequential |
---|
| 461 | # CDATA into one tag. |
---|
| 462 | # |
---|
| 463 | ############################################################################## |
---|
| 464 | sub _handle_cdata |
---|
| 465 | { |
---|
| 466 | my $self; |
---|
| 467 | $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 468 | $self = shift unless (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 469 | my ($sax, $cdata) = @_; |
---|
| 470 | my $sid = $sax->getSID(); |
---|
| 471 | |
---|
| 472 | $self->debug(2,"Node: _handle_cdata: sid($sid) sax($sax) cdata($cdata)"); |
---|
| 473 | |
---|
| 474 | return if ($#{$self->{SIDS}->{$sid}->{node}} == -1); |
---|
| 475 | |
---|
| 476 | $self->debug(2,"Node: _handle_cdata: sax($sax) cdata($cdata)"); |
---|
| 477 | |
---|
| 478 | $self->{SIDS}->{$sid}->{node}->[$#{$self->{SIDS}->{$sid}->{node}}]-> |
---|
| 479 | add_cdata($cdata); |
---|
| 480 | } |
---|
| 481 | |
---|
| 482 | |
---|
| 483 | ############################################################################## |
---|
| 484 | # |
---|
| 485 | # _handle_close - when we see a close tag we need to pop the last element |
---|
| 486 | # from the list and push it onto the end of the previous |
---|
| 487 | # element. This is how we build our hierarchy. |
---|
| 488 | # |
---|
| 489 | ############################################################################## |
---|
| 490 | sub _handle_close |
---|
| 491 | { |
---|
| 492 | my $self; |
---|
| 493 | $self = $_[0] if (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 494 | $self = shift unless (ref($_[0]) eq "XML::Stream::Parser"); |
---|
| 495 | my ($sax, $tag) = @_; |
---|
| 496 | my $sid = $sax->getSID(); |
---|
| 497 | |
---|
| 498 | $self->debug(2,"Node: _handle_close: sid($sid) sax($sax) tag($tag)"); |
---|
| 499 | |
---|
| 500 | $self->debug(2,"Node: _handle_close: check(",$#{$self->{SIDS}->{$sid}->{node}},")"); |
---|
| 501 | |
---|
| 502 | if ($#{$self->{SIDS}->{$sid}->{node}} == -1) |
---|
| 503 | { |
---|
| 504 | $self->debug(2,"Node: _handle_close: rootTag($self->{SIDS}->{$sid}->{rootTag}) tag($tag)"); |
---|
| 505 | if ($self->{SIDS}->{$sid}->{rootTag} ne $tag) |
---|
| 506 | { |
---|
| 507 | $self->{SIDS}->{$sid}->{streamerror} = "Root tag mis-match: <$self->{SIDS}->{$sid}->{rootTag}> ... </$tag>\n"; |
---|
| 508 | } |
---|
| 509 | return; |
---|
| 510 | } |
---|
| 511 | |
---|
| 512 | my $CLOSED = pop @{$self->{SIDS}->{$sid}->{node}}; |
---|
| 513 | |
---|
| 514 | $self->debug(2,"Node: _handle_close: check2(",$#{$self->{SIDS}->{$sid}->{node}},")"); |
---|
| 515 | |
---|
| 516 | if($#{$self->{SIDS}->{$sid}->{node}} == -1) |
---|
| 517 | { |
---|
| 518 | push @{$self->{SIDS}->{$sid}->{node}}, $CLOSED; |
---|
| 519 | |
---|
| 520 | if (ref($self) ne "XML::Stream::Parser") |
---|
| 521 | { |
---|
| 522 | my $stream_prefix = $self->StreamPrefix($sid); |
---|
| 523 | |
---|
| 524 | if(defined($self->{SIDS}->{$sid}->{node}->[0]) && |
---|
| 525 | ($self->{SIDS}->{$sid}->{node}->[0]->get_tag() =~ /^${stream_prefix}\:/)) |
---|
| 526 | { |
---|
| 527 | my $node = $self->{SIDS}->{$sid}->{node}->[0]; |
---|
| 528 | $self->{SIDS}->{$sid}->{node} = []; |
---|
| 529 | $self->ProcessStreamPacket($sid,$node); |
---|
| 530 | } |
---|
| 531 | else |
---|
| 532 | { |
---|
| 533 | my $node = $self->{SIDS}->{$sid}->{node}->[0]; |
---|
| 534 | $self->{SIDS}->{$sid}->{node} = []; |
---|
| 535 | |
---|
| 536 | my @special = |
---|
| 537 | &XML::Stream::XPath( |
---|
| 538 | $node, |
---|
| 539 | '[@xmlns="'.&XML::Stream::ConstXMLNS("xmpp-sasl").'" or @xmlns="'.&XML::Stream::ConstXMLNS("xmpp-tls").'"]' |
---|
| 540 | ); |
---|
| 541 | if ($#special > -1) |
---|
| 542 | { |
---|
| 543 | my $xmlns = $node->get_attrib("xmlns"); |
---|
| 544 | |
---|
| 545 | $self->ProcessSASLPacket($sid,$node) |
---|
| 546 | if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-sasl")); |
---|
| 547 | $self->ProcessTLSPacket($sid,$node) |
---|
| 548 | if ($xmlns eq &XML::Stream::ConstXMLNS("xmpp-tls")); |
---|
| 549 | } |
---|
| 550 | else |
---|
| 551 | { |
---|
| 552 | &{$self->{CB}->{node}}($sid,$node); |
---|
| 553 | } |
---|
| 554 | } |
---|
| 555 | } |
---|
| 556 | } |
---|
| 557 | } |
---|
| 558 | |
---|
| 559 | |
---|
| 560 | ############################################################################## |
---|
| 561 | # |
---|
| 562 | # SetXMLData - takes a host of arguments and sets a portion of the specified |
---|
| 563 | # XML::Parser::Node object with that data. The function works |
---|
| 564 | # in two modes "single" or "multiple". "single" denotes that |
---|
| 565 | # the function should locate the current tag that matches this |
---|
| 566 | # data and overwrite it's contents with data passed in. |
---|
| 567 | # "multiple" denotes that a new tag should be created even if |
---|
| 568 | # others exist. |
---|
| 569 | # |
---|
| 570 | # type - single or multiple |
---|
| 571 | # XMLTree - pointer to XML::Stream Node object |
---|
| 572 | # tag - name of tag to create/modify (if blank assumes |
---|
| 573 | # working with top level tag) |
---|
| 574 | # data - CDATA to set for tag |
---|
| 575 | # attribs - attributes to ADD to tag |
---|
| 576 | # |
---|
| 577 | ############################################################################## |
---|
| 578 | sub SetXMLData |
---|
| 579 | { |
---|
| 580 | my ($type,$XMLTree,$tag,$data,$attribs) = @_; |
---|
| 581 | |
---|
| 582 | if ($tag ne "") |
---|
| 583 | { |
---|
| 584 | if ($type eq "single") |
---|
| 585 | { |
---|
| 586 | foreach my $child ($XMLTree->children()) |
---|
| 587 | { |
---|
| 588 | if ($$XMLTree[1]->[$child] eq $tag) |
---|
| 589 | { |
---|
| 590 | $XMLTree->remove_child($child); |
---|
| 591 | |
---|
| 592 | my $newChild = $XMLTree->add_child($tag); |
---|
| 593 | $newChild->put_attrib(%{$attribs}); |
---|
| 594 | $newChild->add_cdata($data) if ($data ne ""); |
---|
| 595 | return; |
---|
| 596 | } |
---|
| 597 | } |
---|
| 598 | } |
---|
| 599 | my $newChild = $XMLTree->add_child($tag); |
---|
| 600 | $newChild->put_attrib(%{$attribs}); |
---|
| 601 | $newChild->add_cdata($data) if ($data ne ""); |
---|
| 602 | } |
---|
| 603 | else |
---|
| 604 | { |
---|
| 605 | $XMLTree->put_attrib(%{$attribs}); |
---|
| 606 | $XMLTree->add_cdata($data) if ($data ne ""); |
---|
| 607 | } |
---|
| 608 | } |
---|
| 609 | |
---|
| 610 | |
---|
| 611 | ############################################################################## |
---|
| 612 | # |
---|
| 613 | # GetXMLData - takes a host of arguments and returns various data structures |
---|
| 614 | # that match them. |
---|
| 615 | # |
---|
| 616 | # type - "existence" - returns 1 or 0 if the tag exists in the |
---|
| 617 | # top level. |
---|
| 618 | # "value" - returns either the CDATA of the tag, or the |
---|
| 619 | # value of the attribute depending on which is |
---|
| 620 | # sought. This ignores any mark ups to the data |
---|
| 621 | # and just returns the raw CDATA. |
---|
| 622 | # "value array" - returns an array of strings representing |
---|
| 623 | # all of the CDATA in the specified tag. |
---|
| 624 | # This ignores any mark ups to the data |
---|
| 625 | # and just returns the raw CDATA. |
---|
| 626 | # "tree" - returns an XML::Parser::Node object with the |
---|
| 627 | # specified tag as the root tag. |
---|
| 628 | # "tree array" - returns an array of XML::Parser::Node |
---|
| 629 | # objects each with the specified tag as |
---|
| 630 | # the root tag. |
---|
| 631 | # "child array" - returns a list of all children nodes |
---|
| 632 | # not including CDATA nodes. |
---|
| 633 | # "attribs" - returns a hash with the attributes, and |
---|
| 634 | # their values, for the things that match |
---|
| 635 | # the parameters |
---|
| 636 | # "count" - returns the number of things that match |
---|
| 637 | # the arguments |
---|
| 638 | # "tag" - returns the root tag of this tree |
---|
| 639 | # XMLTree - pointer to XML::Parser::Node object |
---|
| 640 | # tag - tag to pull data from. If blank then the top level |
---|
| 641 | # tag is accessed. |
---|
| 642 | # attrib - attribute value to retrieve. Ignored for types |
---|
| 643 | # "value array", "tree", "tree array". If paired |
---|
| 644 | # with value can be used to filter tags based on |
---|
| 645 | # attributes and values. |
---|
| 646 | # value - only valid if an attribute is supplied. Used to |
---|
| 647 | # filter for tags that only contain this attribute. |
---|
| 648 | # Useful to search through multiple tags that all |
---|
| 649 | # reference different name spaces. |
---|
| 650 | # |
---|
| 651 | ############################################################################## |
---|
| 652 | sub GetXMLData |
---|
| 653 | { |
---|
| 654 | my ($type,$XMLTree,$tag,$attrib,$value) = @_; |
---|
| 655 | |
---|
| 656 | $tag = "" if !defined($tag); |
---|
| 657 | $attrib = "" if !defined($attrib); |
---|
| 658 | $value = "" if !defined($value); |
---|
| 659 | |
---|
| 660 | my $skipthis = 0; |
---|
| 661 | |
---|
| 662 | #------------------------------------------------------------------------- |
---|
| 663 | # Check if a child tag in the root tag is being requested. |
---|
| 664 | #------------------------------------------------------------------------- |
---|
| 665 | if ($tag ne "") |
---|
| 666 | { |
---|
| 667 | my $count = 0; |
---|
| 668 | my @array; |
---|
| 669 | foreach my $child ($XMLTree->children()) |
---|
| 670 | { |
---|
| 671 | if (($child->get_tag() eq $tag) || ($tag eq "*")) |
---|
| 672 | { |
---|
| 673 | #------------------------------------------------------------- |
---|
| 674 | # Filter out tags that do not contain the attribute and value. |
---|
| 675 | #------------------------------------------------------------- |
---|
| 676 | next if (($value ne "") && ($attrib ne "") && $child->get_attrib($attrib) && ($XMLTree->get_attrib($attrib) ne $value)); |
---|
| 677 | next if (($attrib ne "") && !$child->get_attrib($attrib)); |
---|
| 678 | |
---|
| 679 | #------------------------------------------------------------- |
---|
| 680 | # Check for existence |
---|
| 681 | #------------------------------------------------------------- |
---|
| 682 | if ($type eq "existence") |
---|
| 683 | { |
---|
| 684 | return 1; |
---|
| 685 | } |
---|
| 686 | #------------------------------------------------------------- |
---|
| 687 | # Return the raw CDATA value without mark ups, or the value of |
---|
| 688 | # the requested attribute. |
---|
| 689 | #------------------------------------------------------------- |
---|
| 690 | if ($type eq "value") |
---|
| 691 | { |
---|
| 692 | if ($attrib eq "") |
---|
| 693 | { |
---|
| 694 | my $str = $child->get_cdata(); |
---|
| 695 | return $str; |
---|
| 696 | } |
---|
| 697 | return $XMLTree->get_attrib($attrib) |
---|
| 698 | if defined($XMLTree->get_attrib($attrib)); |
---|
| 699 | } |
---|
| 700 | #------------------------------------------------------------- |
---|
| 701 | # Return an array of values that represent the raw CDATA without |
---|
| 702 | # mark up tags for the requested tags. |
---|
| 703 | #------------------------------------------------------------- |
---|
| 704 | if ($type eq "value array") |
---|
| 705 | { |
---|
| 706 | if ($attrib eq "") |
---|
| 707 | { |
---|
| 708 | my $str = $child->get_cdata(); |
---|
| 709 | push(@array,$str); |
---|
| 710 | } |
---|
| 711 | else |
---|
| 712 | { |
---|
| 713 | push(@array, $XMLTree->get_attrib($attrib)) |
---|
| 714 | if defined($XMLTree->get_attrib($attrib)); |
---|
| 715 | } |
---|
| 716 | } |
---|
| 717 | #------------------------------------------------------------- |
---|
| 718 | # Return a pointer to a new XML::Parser::Tree object that has |
---|
| 719 | # the requested tag as the root tag. |
---|
| 720 | #------------------------------------------------------------- |
---|
| 721 | if ($type eq "tree") |
---|
| 722 | { |
---|
| 723 | return $child; |
---|
| 724 | } |
---|
| 725 | #------------------------------------------------------------- |
---|
| 726 | # Return an array of pointers to XML::Parser::Tree objects |
---|
| 727 | # that have the requested tag as the root tags. |
---|
| 728 | #------------------------------------------------------------- |
---|
| 729 | if ($type eq "tree array") |
---|
| 730 | { |
---|
| 731 | push(@array,$child); |
---|
| 732 | } |
---|
| 733 | #------------------------------------------------------------- |
---|
| 734 | # Return an array of pointers to XML::Parser::Tree objects |
---|
| 735 | # that have the requested tag as the root tags. |
---|
| 736 | #------------------------------------------------------------- |
---|
| 737 | if ($type eq "child array") |
---|
| 738 | { |
---|
| 739 | push(@array,$child) if ($child->get_tag() ne "__xmlstream__:node:cdata"); |
---|
| 740 | } |
---|
| 741 | #------------------------------------------------------------- |
---|
| 742 | # Return a count of the number of tags that match |
---|
| 743 | #------------------------------------------------------------- |
---|
| 744 | if ($type eq "count") |
---|
| 745 | { |
---|
| 746 | $count++; |
---|
| 747 | } |
---|
| 748 | #------------------------------------------------------------- |
---|
| 749 | # Return the attribute hash that matches this tag |
---|
| 750 | #------------------------------------------------------------- |
---|
| 751 | if ($type eq "attribs") |
---|
| 752 | { |
---|
| 753 | return $XMLTree->attrib(); |
---|
| 754 | } |
---|
| 755 | } |
---|
| 756 | } |
---|
| 757 | #--------------------------------------------------------------------- |
---|
| 758 | # If we are returning arrays then return array. |
---|
| 759 | #--------------------------------------------------------------------- |
---|
| 760 | if (($type eq "tree array") || ($type eq "value array") || |
---|
| 761 | ($type eq "child array")) |
---|
| 762 | { |
---|
| 763 | return @array; |
---|
| 764 | } |
---|
| 765 | |
---|
| 766 | #--------------------------------------------------------------------- |
---|
| 767 | # If we are returning then count, then do so |
---|
| 768 | #--------------------------------------------------------------------- |
---|
| 769 | if ($type eq "count") |
---|
| 770 | { |
---|
| 771 | return $count; |
---|
| 772 | } |
---|
| 773 | } |
---|
| 774 | else |
---|
| 775 | { |
---|
| 776 | #--------------------------------------------------------------------- |
---|
| 777 | # This is the root tag, so handle things a level up. |
---|
| 778 | #--------------------------------------------------------------------- |
---|
| 779 | |
---|
| 780 | #--------------------------------------------------------------------- |
---|
| 781 | # Return the raw CDATA value without mark ups, or the value of the |
---|
| 782 | # requested attribute. |
---|
| 783 | #--------------------------------------------------------------------- |
---|
| 784 | if ($type eq "value") |
---|
| 785 | { |
---|
| 786 | if ($attrib eq "") |
---|
| 787 | { |
---|
| 788 | my $str = $XMLTree->get_cdata(); |
---|
| 789 | return $str; |
---|
| 790 | } |
---|
| 791 | return $XMLTree->get_attrib($attrib) |
---|
| 792 | if $XMLTree->get_attrib($attrib); |
---|
| 793 | } |
---|
| 794 | #--------------------------------------------------------------------- |
---|
| 795 | # Return a pointer to a new XML::Parser::Tree object that has the |
---|
| 796 | # requested tag as the root tag. |
---|
| 797 | #--------------------------------------------------------------------- |
---|
| 798 | if ($type eq "tree") |
---|
| 799 | { |
---|
| 800 | return $XMLTree; |
---|
| 801 | } |
---|
| 802 | |
---|
| 803 | #--------------------------------------------------------------------- |
---|
| 804 | # Return the 1 if the specified attribute exists in the root tag. |
---|
| 805 | #--------------------------------------------------------------------- |
---|
| 806 | if ($type eq "existence") |
---|
| 807 | { |
---|
| 808 | if ($attrib ne "") |
---|
| 809 | { |
---|
| 810 | return ($XMLTree->get_attrib($attrib) eq $value) if ($value ne ""); |
---|
| 811 | return defined($XMLTree->get_attrib($attrib)); |
---|
| 812 | } |
---|
| 813 | return 0; |
---|
| 814 | } |
---|
| 815 | |
---|
| 816 | #--------------------------------------------------------------------- |
---|
| 817 | # Return the attribute hash that matches this tag |
---|
| 818 | #--------------------------------------------------------------------- |
---|
| 819 | if ($type eq "attribs") |
---|
| 820 | { |
---|
| 821 | return $XMLTree->attrib(); |
---|
| 822 | } |
---|
| 823 | #--------------------------------------------------------------------- |
---|
| 824 | # Return the tag of this node |
---|
| 825 | #--------------------------------------------------------------------- |
---|
| 826 | if ($type eq "tag") |
---|
| 827 | { |
---|
| 828 | return $XMLTree->get_tag(); |
---|
| 829 | } |
---|
| 830 | } |
---|
| 831 | #------------------------------------------------------------------------- |
---|
| 832 | # Return 0 if this was a request for existence, or "" if a request for |
---|
| 833 | # a "value", or [] for "tree", "value array", and "tree array". |
---|
| 834 | #------------------------------------------------------------------------- |
---|
| 835 | return 0 if ($type eq "existence"); |
---|
| 836 | return "" if ($type eq "value"); |
---|
| 837 | return []; |
---|
| 838 | } |
---|
| 839 | |
---|
| 840 | |
---|
| 841 | ############################################################################## |
---|
| 842 | # |
---|
| 843 | # BuildXML - takes an XML::Parser::Tree object and builds the XML string |
---|
| 844 | # that it represents. |
---|
| 845 | # |
---|
| 846 | ############################################################################## |
---|
| 847 | sub BuildXML |
---|
| 848 | { |
---|
| 849 | my ($node,$rawXML) = @_; |
---|
| 850 | |
---|
| 851 | my $str = "<".$node->get_tag(); |
---|
| 852 | |
---|
| 853 | my %attrib = $node->attrib(); |
---|
| 854 | |
---|
| 855 | foreach my $att (sort {$a cmp $b} keys(%attrib)) |
---|
| 856 | { |
---|
| 857 | $str .= " ".$att."='".&XML::Stream::EscapeXML($attrib{$att})."'"; |
---|
| 858 | } |
---|
| 859 | |
---|
| 860 | my @children = $node->children(); |
---|
| 861 | if (($#children > -1) || |
---|
| 862 | (defined($rawXML) && ($rawXML ne "")) || |
---|
| 863 | (defined($node->get_raw_xml()) && ($node->get_raw_xml() ne "")) |
---|
| 864 | ) |
---|
| 865 | { |
---|
| 866 | $str .= ">"; |
---|
| 867 | foreach my $child (@children) |
---|
| 868 | { |
---|
| 869 | if ($child->get_tag() eq "__xmlstream__:node:cdata") |
---|
| 870 | { |
---|
| 871 | $str .= &XML::Stream::EscapeXML(join("",$child->children())); |
---|
| 872 | } |
---|
| 873 | else |
---|
| 874 | { |
---|
| 875 | $str .= &XML::Stream::Node::BuildXML($child); |
---|
| 876 | } |
---|
| 877 | } |
---|
| 878 | $str .= $node->get_raw_xml() |
---|
| 879 | if (defined($node->get_raw_xml()) && |
---|
| 880 | ($node->get_raw_xml() ne "") |
---|
| 881 | ); |
---|
| 882 | $str .= $rawXML if (defined($rawXML) && ($rawXML ne "")); |
---|
| 883 | $str .= "</".$node->get_tag().">"; |
---|
| 884 | } |
---|
| 885 | else |
---|
| 886 | { |
---|
| 887 | $str .= "/>"; |
---|
| 888 | } |
---|
| 889 | |
---|
| 890 | return $str; |
---|
| 891 | } |
---|
| 892 | |
---|
| 893 | |
---|
| 894 | ############################################################################## |
---|
| 895 | # |
---|
| 896 | # XML2Config - takes an XML data tree and turns it into a hash of hashes. |
---|
| 897 | # This only works for certain kinds of XML trees like this: |
---|
| 898 | # |
---|
| 899 | # <foo> |
---|
| 900 | # <bar>1</bar> |
---|
| 901 | # <x> |
---|
| 902 | # <y>foo</y> |
---|
| 903 | # </x> |
---|
| 904 | # <z>5</z> |
---|
| 905 | # </foo> |
---|
| 906 | # |
---|
| 907 | # The resulting hash would be: |
---|
| 908 | # |
---|
| 909 | # $hash{bar} = 1; |
---|
| 910 | # $hash{x}->{y} = "foo"; |
---|
| 911 | # $hash{z} = 5; |
---|
| 912 | # |
---|
| 913 | # Good for config files. |
---|
| 914 | # |
---|
| 915 | ############################################################################## |
---|
| 916 | sub XML2Config |
---|
| 917 | { |
---|
| 918 | my ($XMLTree) = @_; |
---|
| 919 | |
---|
| 920 | my %hash; |
---|
| 921 | foreach my $tree (&XML::Stream::GetXMLData("tree array",$XMLTree,"*")) |
---|
| 922 | { |
---|
| 923 | if ($tree->get_tag() eq "__xmlstream__:node:cdata") |
---|
| 924 | { |
---|
| 925 | my $str = join("",$tree->children()); |
---|
| 926 | return $str unless ($str =~ /^\s*$/); |
---|
| 927 | } |
---|
| 928 | else |
---|
| 929 | { |
---|
| 930 | if (&XML::Stream::GetXMLData("count",$XMLTree,$tree->get_tag()) > 1) |
---|
| 931 | { |
---|
| 932 | push(@{$hash{$tree->get_tag()}},&XML::Stream::XML2Config($tree)); |
---|
| 933 | } |
---|
| 934 | else |
---|
| 935 | { |
---|
| 936 | $hash{$tree->get_tag()} = &XML::Stream::XML2Config($tree); |
---|
| 937 | } |
---|
| 938 | } |
---|
| 939 | } |
---|
| 940 | return \%hash; |
---|
| 941 | } |
---|
| 942 | |
---|
| 943 | |
---|
| 944 | 1; |
---|