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