File Coverage

blib/lib/Net/XMPP/Stanza.pm
Criterion Covered Total %
statement 338 437 77.3
branch 146 228 64.0
condition 48 108 44.4
subroutine 34 41 82.9
pod 0 13 0.0
total 566 827 68.4


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             # Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
19             #
20             ##############################################################################
21              
22             package Net::XMPP::Stanza;
23              
24             =head1 NAME
25              
26             Net::XMPP::Stanza - XMPP Stanza Module
27              
28             =head1 SYNOPSIS
29              
30             Net::XMPP::Stanza is a private package that serves as a basis for all
31             XMPP stanzas generated by L.
32              
33             =head1 DESCRIPTION
34              
35             This module is not meant to be used directly. You should be using
36             either L, L, L, or
37             another package that inherits from Net::XMPP::Stanza.
38              
39             That said, this is where all of the namespaced methods are documented.
40              
41             The current supported namespaces are:
42              
43             =cut
44              
45             # NS_BEGIN
46              
47             =pod
48              
49             jabber:iq:auth
50             jabber:iq:privacy
51             jabber:iq:register
52             jabber:iq:roster
53             urn:ietf:params:xml:ns:xmpp-bind
54             urn:ietf:params:xml:ns:xmpp-session
55              
56             =cut
57              
58             # NS_END
59              
60             =pod
61              
62             For more information on what these namespaces are for, visit
63             L and browse the Jabber Programmers Guide.
64              
65             The following tables can be read as follows:
66              
67             ny:private:ns
68              
69             Name Type Get Set Remove Defined Add
70             ========================== ======= === === ====== ======= ===
71             Foo scalar X X X X
72             Bar child X
73             Bars child X
74             Test master X X
75              
76             Withing the my:private:ns namespace, there exists the functions:
77              
78             GetFoo(), SetFoo(), RemoveFoo(), DefinedFoo()
79              
80             AddBar()
81              
82             GetBars(), DefinedBars()
83              
84             GetTest(), SetMaster()
85              
86             Hopefully it should be obvious how this all works. If not feel free to
87             contact me and I'll work on adding more documentation.
88              
89             =cut
90              
91             # DOC_BEGIN
92             =head1 jabber:iq:auth
93              
94             Name Type Get Set Remove Defined Add
95             ========================== ========= === === ====== ======= ===
96             Digest scalar X X X X
97             Hash scalar X X X X
98             Password scalar X X X X
99             Resource scalar X X X X
100             Sequence scalar X X X X
101             Token scalar X X X X
102             Username scalar X X X X
103             Auth master X X
104              
105             =head1 jabber:iq:privacy
106              
107             Name Type Get Set Remove Defined Add
108             ========================== ========= === === ====== ======= ===
109             Active scalar X X X X
110             Default scalar X X X X
111             List child X
112             Lists child X X X
113             Privacy master X X
114              
115             =head1 jabber:iq:privacy - item objects
116              
117             Name Type Get Set Remove Defined Add
118             ========================== ========= === === ====== ======= ===
119             Action scalar X X X X
120             IQ flag X X X X
121             Message flag X X X X
122             Order scalar X X X X
123             PresenceIn flag X X X X
124             PresenceOut flag X X X X
125             Type scalar X X X X
126             Value scalar X X X X
127             Item master X X
128              
129             =head1 jabber:iq:privacy - list objects
130              
131             Name Type Get Set Remove Defined Add
132             ========================== ========= === === ====== ======= ===
133             Name scalar X X X X
134             Item child X
135             Items child X X X
136             List master X X
137              
138             =head1 jabber:iq:register
139              
140             Name Type Get Set Remove Defined Add
141             ========================== ========= === === ====== ======= ===
142             Address scalar X X X X
143             City scalar X X X X
144             Date scalar X X X X
145             Email scalar X X X X
146             First scalar X X X X
147             Instructions scalar X X X X
148             Key scalar X X X X
149             Last scalar X X X X
150             Misc scalar X X X X
151             Name scalar X X X X
152             Nick scalar X X X X
153             Password scalar X X X X
154             Phone scalar X X X X
155             Registered flag X X X X
156             Remove flag X X X X
157             State scalar X X X X
158             Text scalar X X X X
159             URL scalar X X X X
160             Username scalar X X X X
161             Zip scalar X X X X
162             Register master X X
163              
164             =head1 jabber:iq:roster
165              
166             Name Type Get Set Remove Defined Add
167             ========================== ========= === === ====== ======= ===
168             Item child X
169             Items child X
170             Roster master X X
171              
172             =head1 jabber:iq:roster - item objects
173              
174             Name Type Get Set Remove Defined Add
175             ========================== ========= === === ====== ======= ===
176             Ask scalar X X X X
177             Group array X X X X
178             JID jid X X X X
179             Name scalar X X X X
180             Subscription scalar X X X X
181             Item master X X
182              
183             =head1 urn:ietf:params:xml:ns:xmpp-bind
184              
185             Name Type Get Set Remove Defined Add
186             ========================== ========= === === ====== ======= ===
187             JID jid X X X X
188             Resource scalar X X X X
189             Bind master X X
190              
191             =head1 urn:ietf:params:xml:ns:xmpp-session
192              
193             Name Type Get Set Remove Defined Add
194             ========================== ========= === === ====== ======= ===
195             Session master X X
196              
197              
198             =cut
199              
200             # DOC_END
201              
202             =head1 AUTHOR
203              
204             Originally authored by Ryan Eatmon.
205              
206             Previously maintained by Eric Hacker.
207              
208             Currently maintained by Darian Anthony Patrick.
209              
210             =head1 COPYRIGHT
211              
212             This module is free software, you can redistribute it and/or modify it
213             under the LGPL 2.1.
214              
215             =cut
216              
217 15     15   194 use 5.008;
  15         33  
  15         540  
218 15     15   57 use strict;
  15         21  
  15         360  
219 15     15   65 use warnings;
  15         17  
  15         307  
220              
221 15     15   54 use Carp;
  15         18  
  15         854  
222 15     15   71 use XML::Stream qw( Node );
  15         20  
  15         97  
223 15     15   3826 use Net::XMPP::JID;
  15         16  
  15         224  
224 15     15   49 use Net::XMPP::Debug;
  15         15  
  15         210  
225 15     15   44 use Net::XMPP::Namespaces;
  15         18  
  15         248  
226 15     15   47 use vars qw( $AUTOLOAD %FUNCTIONS $DEBUG );
  15         15  
  15         56594  
227              
228             $DEBUG = Net::XMPP::Debug->new(usedefault=>1,
229             header=>"XMPP");
230              
231             # XXX need to look at evals and $@
232              
233             sub new
234             {
235 15     15 0 579 my $proto = shift;
236 15   33     68 my $class = ref($proto) || $proto;
237 15         25 my $self = { };
238              
239 15         43 bless($self, $proto);
240              
241 15         50 $self->{DEBUGHEADER} = "Stanza";
242 15         26 $self->{TAG} = "__netxmpp__:unknown:tag";
243              
244 15         31 $self->{FUNCS} = \%FUNCTIONS;
245              
246 15         42 my $result = $self->_init(@_);
247              
248 15 50       38 return $result if defined($result);
249              
250 15         33 return $self;
251             }
252              
253              
254             sub _init
255             {
256 26     26   42 my $self = shift;
257              
258 26         61 $self->{CHILDREN} = [];
259              
260 26 100       111 if ("@_" ne (""))
261             {
262 15 50       149 if ($_[0]->isa("Net::XMPP::Stanza"))
    100          
263             {
264 0         0 return $_[0];
265             }
266             elsif (ref($_[0]) eq "")
267             {
268 3         5 $self->{TAG} = shift;
269 3         26 $self->{TREE} = XML::Stream::Node->new($self->{TAG});
270             }
271             else
272             {
273 12         25 $self->{TREE} = shift;
274 12         44 $self->{TAG} = $self->{TREE}->get_tag();
275 12         77 $self->_parse_xmlns();
276 12         156 $self->_parse_tree();
277             }
278             }
279             else
280             {
281 11         75 $self->{TREE} = XML::Stream::Node->new($self->{TAG});
282             }
283              
284 26         336 return;
285             }
286              
287              
288             $FUNCTIONS{XMLNS}->{path} = '@xmlns';
289              
290             $FUNCTIONS{Child}->{type} = 'child';
291             $FUNCTIONS{Child}->{path} = '*[@xmlns]';
292             $FUNCTIONS{Child}->{child} = {};
293              
294             ##############################################################################
295             #
296             # debug - prints out the XML::Parser Tree in a readable format for debugging
297             #
298             ##############################################################################
299             sub debug
300             {
301 0     0 0 0 my $self = shift;
302              
303 0         0 print "debug ",$self,":\n";
304 0         0 &Net::XMPP::printData("debug: \$self->{CHILDREN}->",$self->{CHILDREN});
305             }
306              
307              
308             ##############################################################################
309             #+----------------------------------------------------------------------------
310             #|
311             #| Public Methods
312             #|
313             #+----------------------------------------------------------------------------
314             ##############################################################################
315              
316             ##############################################################################
317             #
318             # GetXML - Returns a string that represents the packet.
319             #
320             ##############################################################################
321             sub GetXML
322             {
323 24     24 0 5056 my $self = shift;
324 24         84 return $self->GetTree()->GetXML();
325             }
326              
327              
328             ##############################################################################
329             #
330             # GetTag - Returns the root tag of the object.
331             #
332             ##############################################################################
333             sub GetTag
334             {
335 0     0 0 0 my $self = shift;
336              
337 0         0 return $self->{TAG};
338             }
339              
340              
341             ##############################################################################
342             #
343             # GetTree - Returns an XML::Stream::Node that contains the full tree including
344             # Query, and X children.
345             #
346             ##############################################################################
347             sub GetTree
348             {
349 49     49 0 59 my $self = shift;
350 49         51 my $keepXMLNS = shift;
351 49 100       111 $keepXMLNS = 0 unless defined($keepXMLNS);
352              
353 49         147 my $node = $self->{TREE}->copy();
354              
355 49 50 33     4175 $node->remove_attrib("xmlns")
356             if (exists($self->{SKIPXMLNS}) && ($keepXMLNS == 0));
357              
358 49         52 foreach my $child (@{$self->{CHILDREN}})
  49         94  
359             {
360 10         50 my $child_tree = $child->GetTree($keepXMLNS);
361 10         24 $node->add_child($child_tree);
362             }
363              
364 49         115 my $remove_ns = 0;
365 49 100 100     101 if (defined($node->get_attrib("xmlns")) && ($keepXMLNS == 0))
366             {
367 19 100       171 $remove_ns = 1
368             if ($self->_check_skip_xmlns($node->get_attrib("xmlns")));
369             }
370              
371 49 100       280 $node->remove_attrib("xmlns") if ($remove_ns == 1);
372              
373 6         13 $node->add_raw_xml(@{$self->{RAWXML}})
  7         20  
374 49 100 100     157 if (exists($self->{RAWXML}) && ($#{$self->{RAWXML}} > -1));
375              
376 49         145 return $node;
377             }
378              
379              
380             ##############################################################################
381             #
382             # NewChild - calls AddChild to create a new Net::XMPP::Stanza object, sets the
383             # xmlns and returns a pointer to the new object.
384             #
385             ##############################################################################
386             sub NewChild
387             {
388 9     9 0 2594 my $self = shift;
389 9         15 my $xmlns = shift;
390 9         13 my $tag = shift;
391              
392 9 50       37 return unless exists($Net::XMPP::Namespaces::NS{$xmlns});
393              
394 9 50       23 if (!defined($tag))
395             {
396 9         14 $tag = "x";
397 9 50       42 $tag = $Net::XMPP::Namespaces::NS{$xmlns}->{tag}
398             if exists($Net::XMPP::Namespaces::NS{$xmlns});
399             }
400              
401 9         45 my $node = XML::Stream::Node->new($tag);
402 9         190 $node->put_attrib(xmlns=>$xmlns);
403              
404 9         109 return $self->AddChild($node);
405             }
406              
407              
408             ##############################################################################
409             #
410             # AddChild - creates a new Net::XMPP::packet object, pushes it on the child
411             # list, and returns a pointer to the new object. This is a
412             # private helper function.
413             #
414             ##############################################################################
415             sub AddChild
416             {
417 12     12 0 15 my $self = shift;
418 12         17 my $node = shift;
419 12         39 my $packet = $self->_new_packet($node);
420 12         15 push(@{$self->{CHILDREN}},$packet);
  12         30  
421 12         31 return $packet;
422             }
423              
424              
425             ##############################################################################
426             #
427             # RemoveChild - removes all xtags that have the specified namespace.
428             #
429             ##############################################################################
430             sub RemoveChild
431             {
432 1     1 0 499 my $self = shift;
433 1         2 my $xmlns = shift;
434              
435 1         3 foreach my $index (reverse(0..$#{$self->{CHILDREN}}))
  1         4  
436             {
437 1 50 33     12 splice(@{$self->{CHILDREN}},$index,1)
  1   33     6  
438             if (!defined($xmlns) ||
439             ($xmlns eq "") ||
440             ($self->{CHILDREN}->[$index]->GetXMLNS() eq $xmlns));
441             }
442             }
443              
444              
445             ##############################################################################
446             #
447             # NewFirstChild - calls AddFirstChild to create a new Net::XMPP::Stanza
448             # object, sets the xmlns and returns a pointer to the new
449             # object.
450             #
451             ##############################################################################
452             sub NewFirstChild
453             {
454 0     0 0 0 my $self = shift;
455 0         0 my $xmlns = shift;
456 0         0 my $tag = shift;
457              
458 0 0       0 return unless exists($Net::XMPP::Namespaces::NS{$xmlns});
459              
460 0 0       0 if (!defined($tag))
461             {
462 0         0 $tag = "x";
463 0 0       0 $tag = $Net::XMPP::Namespaces::NS{$xmlns}->{tag}
464             if exists($Net::XMPP::Namespaces::NS{$xmlns});
465             }
466              
467 0         0 my $node = XML::Stream::Node->new($tag);
468 0         0 $node->put_attrib(xmlns=>$xmlns);
469              
470 0         0 return $self->AddFirstChild($node);
471             }
472              
473              
474             ##############################################################################
475             #
476             # AddFirstChild - creates a new Net::XMPP::packet object, puts it on the child
477             # list in the front, and returns a pointer to the new object.
478             # This is a private helper function.
479             #
480             ##############################################################################
481             sub AddFirstChild
482             {
483 0     0 0 0 my $self = shift;
484 0         0 my $node = shift;
485 0         0 my $packet = $self->_new_packet($node);
486 0         0 unshift(@{$self->{CHILDREN}},$packet);
  0         0  
487 0         0 return $packet;
488             }
489              
490              
491             ##############################################################################
492             #
493             # RemoveFirstChild - removes all xtags that have the specified namespace.
494             #
495             ##############################################################################
496             sub RemoveFirstChild
497             {
498 0     0 0 0 my $self = shift;
499              
500 0         0 shift(@{$self->{CHILDREN}});
  0         0  
501             }
502              
503              
504             ##############################################################################
505             #
506             # InsertRawXML - puts the specified string onto the list for raw XML to be
507             # included in the packet.
508             #
509             ##############################################################################
510             sub InsertRawXML
511             {
512 5     5 0 1435 my $self = shift;
513 5         14 my(@rawxml) = @_;
514 5 100       14 if (!exists($self->{RAWXML}))
515             {
516 3         6 $self->{RAWXML} = [];
517             }
518 5         5 push(@{$self->{RAWXML}},@rawxml);
  5         12  
519             }
520              
521              
522             ##############################################################################
523             #
524             # ClearRawXML - removes all raw XML from the packet.
525             #
526             ##############################################################################
527             sub ClearRawXML
528             {
529 1     1 0 409 my $self = shift;
530 1         4 $self->{RAWXML} = [];
531             }
532              
533              
534              
535              
536             ##############################################################################
537             #+----------------------------------------------------------------------------
538             #|
539             #| AutoLoad methods
540             #|
541             #+----------------------------------------------------------------------------
542             ##############################################################################
543              
544             ##############################################################################
545             #
546             # AutoLoad - This function is a central location for handling all of the
547             # AUTOLOADS for all of the sub modules.
548             #
549             ##############################################################################
550             sub AUTOLOAD
551             {
552 591     591   135855 my $self = shift;
553 591 50       1533 return if ($AUTOLOAD =~ /::DESTROY$/);
554 591         2236 my ($package) = ($AUTOLOAD =~ /^(.*)::/);
555 591         1674 $AUTOLOAD =~ s/^.*:://;
556 591         1899 my ($call,$var) = ($AUTOLOAD =~ /^(Add|Get|Set|Remove|Defined)(.*)$/);
557 591 50       1105 $call = "" unless defined($call);
558 591 50       969 $var = "" unless defined($var);
559              
560             #$self->_debug("AUTOLOAD: self($self) AUTOLOAD($AUTOLOAD) package($package)");
561             #$self->_debug("AUTOLOAD: tag($self->{TAG}) call($call) var($var) args(",join(",",@_),")");
562              
563             #-------------------------------------------------------------------------
564             # Pick off calls for top level tags , , and
565             #-------------------------------------------------------------------------
566 591         1761 my @xmlns = $self->{TREE}->XPath('@xmlns');
567 591         135389 my $XPathArgs = $self->_xpath_AUTOLOAD($package,$call,$var,$xmlns[0]);
568 591 50       1166 return $self->_xpath($call,@{$XPathArgs},@_) if defined($XPathArgs);
  591         1209  
569              
570             #-------------------------------------------------------------------------
571             # We don't know what this function is... Hand it off to Missing Persons...
572             #-------------------------------------------------------------------------
573 0         0 $self->_missing_function($AUTOLOAD);
574             }
575              
576              
577             ##############################################################################
578             #
579             # _xpath_AUTOLOAD - This function is a helper function for the main AutoLoad
580             # function to help cut down on repeating code.
581             #
582             ##############################################################################
583             sub _xpath_AUTOLOAD
584             {
585 591     591   698 my $self = shift;
586 591         612 my $package = shift;
587 591         545 my $call = shift;
588 591         683 my $var = shift;
589 591         792 my $xmlns = shift;
590              
591 591         2244 $self->_debug("_xpath_AUTOLOAD: self($self) package($package) call($call) var($var)");
592 591 100       1338 $self->_debug("_xpath_AUTOLOAD: xmlns($xmlns)") if defined($xmlns);
593              
594             #-------------------------------------------------------------------------
595             # First thing, figure out which group of functions we are going to be
596             # working with. FUNCTIONS, or NS{$xmlns}->{xpath}...
597             #-------------------------------------------------------------------------
598 591         1082 my $funcs = $self->_xpath_funcs($package,$call,$var,$xmlns);
599 591 50       879 return unless defined($funcs);
600              
601 591         527 my @setFuncs = grep { $_ ne $var } keys(%{$funcs});
  5538         5861  
  591         1556  
602              
603             #$self->_debug("_xpath_AUTOLOAD: setFuncs(",join(",",@setFuncs),")");
604              
605              
606 591 100       1347 my $type = (exists($funcs->{$var}->{type}) ?
607             $funcs->{$var}->{type} :
608             "scalar"
609             );
610              
611 591 100       1157 my $path = (exists($funcs->{$var}->{path}) ?
612             $funcs->{$var}->{path} :
613             ""
614             );
615              
616 591 50       932 $path = "*" if ($type eq "raw");
617              
618 591         515 my $child = "";
619              
620             #-------------------------------------------------------------------------
621             # When this is a master function... change the above variables...
622             #-------------------------------------------------------------------------
623 591 100 33     2555 if(($type eq "master") ||
    100 66        
624             ((ref($type) eq "ARRAY") && ($type->[0] eq "master")))
625             {
626 13 50       33 if ($call eq "Get")
627             {
628 0         0 my @newSetFuncs;
629 0         0 foreach my $func (@setFuncs)
630             {
631 0 0       0 my $funcType = ( exists($funcs->{$func}->{type}) ?
632             $funcs->{$func}->{type} :
633             undef
634             );
635              
636 0 0 0     0 push(@newSetFuncs,$func)
      0        
      0        
      0        
      0        
      0        
637             if (!defined($funcType) || ($funcType eq "scalar") ||
638             ($funcType eq "jid") || ($funcType eq "array") ||
639             ($funcType eq "flag") || ($funcType eq "timestamp") ||
640             (ref($funcType) eq "ARRAY"));
641             }
642              
643 0         0 $child = \@newSetFuncs;
644             }
645             else
646             {
647 13         26 $child = \@setFuncs;
648             }
649             }
650             #-------------------------------------------------------------------------
651             # When this is a child based function... change the above variables...
652             #-------------------------------------------------------------------------
653             elsif (exists($funcs->{$var}->{child}))
654             {
655 33         50 $child = $funcs->{$var}->{child};
656              
657             #$self->_debug("_xpath_AUTOLOAD: child($child)");
658              
659 33 100       77 if (exists($child->{ns}))
660             {
661 4         5 my $addXMLNS = $child->{ns};
662              
663 4         7 my $addFuncs = $Net::XMPP::Namespaces::NS{$addXMLNS}->{xpath};
664 24 100       108 my @calls =
665             grep
666             {
667 4         9 exists($addFuncs->{$_}->{type}) &&
668             ($addFuncs->{$_}->{type} eq "master")
669             }
670 4         7 keys(%{$addFuncs});
671              
672 4 50       14 if ($#calls > 0)
673             {
674 0         0 print STDERR "Warning: I cannot serve two masters.\n";
675             }
676 4         9 $child->{master} = $calls[0];
677             }
678             }
679              
680             #-------------------------------------------------------------------------
681             # Return the arguments for the xpath function
682             #-------------------------------------------------------------------------
683             #$self->_debug("_xpath_AUTOLOAD: return($type,$path,$child);");
684 591         1448 return [$type,$path,$child];
685             }
686              
687              
688             ##############################################################################
689             #
690             # _xpath_funcs - Return the list of functions either from the FUNCTIONS hash
691             # or from Net::XMPP::Namespaces::NS.
692             #
693             ##############################################################################
694             sub _xpath_funcs
695             {
696 591     591   600 my $self = shift;
697 591         544 my $package = shift;
698 591         480 my $call = shift;
699 591         495 my $var = shift;
700 591         569 my $xmlns = shift;
701              
702 591         463 my $funcs;
703              
704 591         642 my $coreFuncs = $self->{FUNCS};
705             #eval "\$coreFuncs = \\%".$package."::FUNCTIONS";
706 591 50       932 $coreFuncs = {} unless defined($coreFuncs);
707              
708 591         622 my $nsFuncs = {};
709 591 100 66     1702 $nsFuncs = $Net::XMPP::Namespaces::NS{$xmlns}->{xpath}
710             if (defined($xmlns) && exists($Net::XMPP::Namespaces::NS{$xmlns}));
711              
712 591         825 foreach my $set ($coreFuncs,$nsFuncs)
713             {
714 1182 100       2331 if (exists($set->{$var}))
715             {
716 591 100       1198 my $type = (exists($set->{$var}->{type}) ?
717             $set->{$var}->{type} :
718             "scalar"
719             );
720              
721 591         994 my @calls = ('Get','Set','Defined','Remove');
722 591 100       1015 @calls = ('Get','Set') if ($type eq "master");
723 591 100       851 @calls = ('Get','Defined','Remove') if ($type eq "child");
724 591 100       1037 @calls = @{$set->{$var}->{calls}}
  4         11  
725             if exists($set->{$var}->{calls});
726              
727 591         643 foreach my $callName (@calls)
728             {
729 1234 100       1775 if ($callName eq $call)
730             {
731 591         487 $funcs = $set;
732 591         1159 last;
733             }
734             }
735             }
736             }
737              
738             #-------------------------------------------------------------------------
739             # If we didn't find any functions to return, Return failure.
740             #-------------------------------------------------------------------------
741 591 50       980 if (!defined($funcs))
742             {
743             #$self->_debug("_xpath_AUTOLOAD: no funcs found");
744 0         0 return;
745             }
746              
747 591         942 return $funcs;
748             }
749              
750              
751             ##############################################################################
752             #
753             # _xpath - given a type it calls the appropriate _xpath_* function below
754             #
755             ##############################################################################
756             sub _xpath
757             {
758 591     591   540 my $self = shift;
759 591         568 my $call = shift;
760              
761             #$self->_debug("_xpath: call($call) args(",join(",",@_),")");
762              
763 591 100       1277 if ($call eq "Get") { return $self->_xpath_get(@_) ; }
  210 100       402  
    100          
    100          
    50          
764 121         308 elsif ($call eq "Set") { return $self->_xpath_set(@_); }
765 233         461 elsif ($call eq "Defined") { return $self->_xpath_defined(@_); }
766 3         12 elsif ($call eq "Add") { return $self->_xpath_add(@_); }
767 24         68 elsif ($call eq "Remove") { return $self->_xpath_remove(@_); }
768             }
769              
770              
771             ##############################################################################
772             #
773             # _xpath_get - returns the value stored in the node
774             #
775             ##############################################################################
776             sub _xpath_get
777             {
778 210     210   197 my $self = shift;
779 210         199 my $type = shift;
780 210         195 my $xpath = shift;
781 210         174 my $childtype = shift;
782 210         227 my ($arg0) = shift;
783              
784             #$self->_debug("_xpath_get: self($self) type($type) xpath($xpath) childtype($childtype)");
785             #$self->{TREE}->debug();
786              
787 210         167 my $subType;
788 210         349 ($type,$subType) = $self->_xpath_resolve_types($type);
789              
790              
791             #-------------------------------------------------------------------------
792             # type == master
793             #-------------------------------------------------------------------------
794 210 50       384 if ($type eq "master")
795             {
796 0         0 my %fields;
797              
798 0         0 foreach my $func (sort {$a cmp $b} @{$childtype})
  0         0  
  0         0  
799             {
800 0         0 my $defined;
801 0         0 eval "\$defined = \$self->Defined$func();";
802 0 0       0 if ($defined)
803             {
804 0         0 my @values;
805 0         0 eval "\@values = \$self->Get$func();";
806              
807 0 0       0 if ($#values > 0)
808             {
809 0         0 $fields{lc($func)} = \@values;
810             }
811             else
812             {
813 0         0 $fields{lc($func)} = $values[0];
814             }
815             }
816             }
817              
818 0         0 return %fields;
819             }
820              
821             #-------------------------------------------------------------------------
822             # type == node
823             #-------------------------------------------------------------------------
824             # XXX Remove this if there are no problems
825             #if ($type eq "node")
826             #{
827             #$self->_debug("_xpath_get: node: xmlns($arg0)") if defined($arg0);
828              
829             #my @results;
830             #foreach my $child (@{$self->{CHILDREN}})
831             #{
832             #$self->_debug("_xpath_get: node: child($child)");
833             #$self->_debug("_xpath_get: node: childXML(",$child->GetXML(),")");
834              
835             #push(@results,$child)
836             # if (!defined($arg0) ||
837             # ($arg0 eq "") ||
838             # ($child->GetTree(1)->get_attrib("xmlns") eq $arg0));
839             #}
840              
841             #return $results[$childtype->{child_index}] if exists($childtype->{child_index});
842             #return @results if (wantarray);
843             #return $results[0];
844             #}
845              
846             #-------------------------------------------------------------------------
847             # The rest actually call the XPath, so call it.
848             #-------------------------------------------------------------------------
849 210         607 my @nodes = $self->{TREE}->XPath($xpath);
850              
851             #-------------------------------------------------------------------------
852             # type == scalar or timestamp
853             #-------------------------------------------------------------------------
854 210 100 66     74801 if (($type eq "scalar") || ($type eq "timestamp"))
855             {
856 133 100       289 return "" if ($#nodes == -1);
857 131         792 return $nodes[0];
858             }
859              
860             #-------------------------------------------------------------------------
861             # type == jid
862             #-------------------------------------------------------------------------
863 77 100       177 if ($type eq "jid")
864             {
865 60 50       134 return if ($#nodes == -1);
866 60 100 66     268 return $self->_new_jid($nodes[0])
867             if (defined($arg0) && ($arg0 eq "jid"));
868 36         294 return $nodes[0];
869             }
870              
871             #-------------------------------------------------------------------------
872             # type == flag
873             #-------------------------------------------------------------------------
874 17 50       83 if ($type eq "flag")
875             {
876 0         0 return $#nodes > -1;
877             }
878              
879             #-------------------------------------------------------------------------
880             # type == array
881             #-------------------------------------------------------------------------
882 17 100       39 if ($type eq "array")
883             {
884 3 100       14 return @nodes if (wantarray);
885 1         8 return $nodes[0];
886             }
887              
888             #-------------------------------------------------------------------------
889             # type == raw
890             #-------------------------------------------------------------------------
891 14 50       35 if ($type eq "raw")
892             {
893 0         0 my $rawXML = "";
894              
895 0 0       0 return join("",@{$self->{RAWXML}}) if ($#{$self->{RAWXML}} > -1);
  0         0  
  0         0  
896              
897 0         0 foreach my $node (@nodes)
898             {
899 0         0 $rawXML .= $node->GetXML();
900             }
901              
902 0         0 return $rawXML;
903             }
904              
905             #-------------------------------------------------------------------------
906             # type == child
907             #-------------------------------------------------------------------------
908 14 50 33     71 if (($type eq "child") || ($type eq "children") || ($type eq "node"))
      33        
909             {
910 14         18 my $xmlns = $arg0;
911 14 100       31 $xmlns = $childtype->{ns} if exists($childtype->{ns});
912              
913             #$self->_debug("_xpath_get: children: xmlns($xmlns)");
914              
915 14         13 my @results;
916 14         13 foreach my $child (@{$self->{CHILDREN}})
  14         33  
917             {
918 26 100 66     194 push(@results, $child)
      100        
919             if (!defined($xmlns) ||
920             ($xmlns eq "") ||
921             ($child->GetTree(1)->get_attrib("xmlns") eq $xmlns));
922             }
923              
924 14         69 foreach my $node (@nodes)
925             {
926 0 0       0 $node->put_attrib(xmlns=>$xmlns)
927             unless defined($node->get_attrib("xmlns"));
928 0         0 my $result = $self->AddChild($node);
929 0         0 $self->{TREE}->remove_child($node);
930 0 0 0     0 push(@results,$result)
      0        
931             if (!defined($xmlns) ||
932             ($xmlns eq "") ||
933             ($node->get_attrib("xmlns") eq $xmlns));
934             }
935              
936             #$self->_debug("_xpath_get: children: ",join(",",@results));
937 14 100       38 return $results[$childtype->{child_index}] if exists($childtype->{child_index});
938 13 50       76 return @results if (wantarray);
939 0         0 return $results[0];
940             }
941             }
942              
943              
944             ##############################################################################
945             #
946             # _xpath_set - makes the XML tree such that the value was set.
947             #
948             ##############################################################################
949             sub _xpath_set
950             {
951 121     121   126 my $self = shift;
952 121         118 my $type = shift;
953 121         115 my $xpath = shift;
954 121         101 my $childtype = shift;
955              
956             #$self->_debug("_xpath_set: self($self) type($type) xpath($xpath) childtype($childtype)");
957              
958 121         102 my $subType;
959 121         217 ($type,$subType) = $self->_xpath_resolve_types($type);
960              
961 121         184 my $node = $self->{TREE};
962              
963             #$self->_debug("_xpath_set: node($node)");
964              
965             #-------------------------------------------------------------------------
966             # When the type is master, the rest of the args are in hash form
967             #-------------------------------------------------------------------------
968 121 100       222 if ($type eq "master")
969             {
970             #$self->_debug("_xpath_set: master: funcs(",join(",",@{$childtype}),")");
971 13         15 my %args;
972 13         39 while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
  45         130  
973             #$self->_debug("_xpath_set: args(",%args,")");
974 13         18 foreach my $func (sort {$a cmp $b} @{$childtype})
  256         214  
  13         58  
975             {
976             #$self->_debug("_xpath_set: func($func)");
977 115 100       1140 if (exists($args{lc($func)}))
    50          
978             {
979             #$self->_debug("_xpath_set: \$self->Set$func(\$args{lc(\$func)});");
980 45         2807 eval "\$self->Set$func(\$args{lc(\$func)});";
981             }
982             elsif ($subType eq "all")
983             {
984             #$self->_debug("_xpath_set: \$self->Set$func();");
985 0         0 eval "\$self->Set$func();";
986             }
987             }
988 13         126 return;
989             }
990              
991             #-------------------------------------------------------------------------
992             # When the type is not master, there can be only one argument.
993             #-------------------------------------------------------------------------
994 108         112 my $value = shift;
995              
996 108 50       187 if ($type eq "raw")
997             {
998 0         0 $self->ClearRawXML();
999 0         0 $self->InsertRawXML($value);
1000 0         0 return;
1001             }
1002              
1003             #-------------------------------------------------------------------------
1004             # Hook to support special cases. You can register the specials with
1005             # the module and they will ba called based on match.
1006             #-------------------------------------------------------------------------
1007 108 50 33     257 if (($subType ne "") && exists($self->{CUSTOMSET}->{$subType}))
1008             {
1009             #$self->_debug("_xpath_set: custom: subType($subType)");
1010             #$self->_debug("_xpath_set: custom: value($value)") if defined($value);
1011 0         0 $value = &{$self->{CUSTOMSET}->{$subType}}($self,$value);
  0         0  
1012             }
1013              
1014 108 50       201 if ($type eq "timestamp")
1015             {
1016 0 0       0 $value = "" unless defined($value);
1017 0 0       0 if ($value eq "") {
1018 0         0 $value = &Net::XMPP::GetTimeStamp("utc","","stamp");
1019             }
1020             }
1021              
1022             #$self->_debug("_xpath_set: value($value)") unless !defined($value);
1023              
1024             #-------------------------------------------------------------------------
1025             # Now that we have resolved the value, we put it into an array so that we
1026             # can support array refs by referring to the values as an array.
1027             #-------------------------------------------------------------------------
1028 108         106 my @values;
1029 108         127 push(@values,$value);
1030 108 100       204 if ($type eq "array")
1031             {
1032 2 100       8 if (ref($value) eq "ARRAY")
1033             {
1034 1         2 @values = @{$value};
  1         3  
1035             }
1036             }
1037              
1038             #$self->_debug("_xpath_set: values(",join(",",@values),")") unless !defined($value);
1039              
1040             #-------------------------------------------------------------------------
1041             # And now, for each value...
1042             #-------------------------------------------------------------------------
1043 108         167 foreach my $val (@values)
1044             {
1045             #$self->_debug("_xpath_set: val($val)") unless !defined($val);
1046             #$self->_debug("_xpath_set: type($type)");
1047              
1048 109 50 33     267 next unless (defined($val) || ($type eq "flag"));
1049              
1050 109 50 33     250 if ((ref($val) ne "") && ($val->isa("Net::XMPP::JID")))
1051             {
1052 0         0 $val = $val->GetJID("full");
1053             }
1054              
1055 109         107 my $path = $xpath;
1056              
1057             #$self->_debug("_xpath_set: val($val)") unless !defined($val);
1058             #$self->_debug("_xpath_set: path($path)");
1059              
1060 109         110 my $childPath = "";
1061 109   66     564 while(($path !~ /^\/?\@/) && ($path !~ /^\/?text\(\)/))
1062             {
1063             #$self->_debug("_xpath_set: Multi-level!!!!");
1064 45         161 my ($child) = ($path =~ /^\/?([^\/]+)/);
1065 45         132 $path =~ s/^\/?[^\/]+//;
1066             #$self->_debug("_xpath_set: path($path)");
1067             #$self->_debug("_xpath_set: childPath($childPath)");
1068              
1069 45 50 66     152 if (($type eq "scalar") || ($type eq "jid") || ($type eq "timestamp"))
      66        
1070             {
1071 42         54 my $tmpPath = $child;
1072 42 50       84 $tmpPath = "$childPath/$child" if ($childPath ne "");
1073              
1074 42         148 my @nodes = $self->{TREE}->XPath("$tmpPath");
1075             #$self->_debug("_xpath_set: \$#nodes($#nodes)");
1076 42 100       14057 if ($#nodes == -1)
1077             {
1078 36 50       84 if ($childPath eq "")
1079             {
1080 36         111 $node = $self->{TREE}->add_child($child);
1081             }
1082             else
1083             {
1084 0         0 my $tree = $self->{TREE}->XPath("$childPath");
1085 0         0 $node = $tree->add_child($child);
1086             }
1087             }
1088             else
1089             {
1090 6         16 $node = $nodes[0];
1091             }
1092             }
1093              
1094 45 100       934 if ($type eq "array")
1095             {
1096 3         11 $node = $self->{TREE}->add_child($child);
1097             }
1098              
1099 45 50       153 if ($type eq "flag")
1100             {
1101 0         0 $node = $self->{TREE}->add_child($child);
1102 0         0 return;
1103             }
1104              
1105 45 50       84 $childPath .= "/" unless ($childPath eq "");
1106 45         296 $childPath .= $child;
1107             }
1108              
1109 109         302 my ($piece) = ($path =~ /^\/?([^\/]+)/);
1110              
1111             #$self->_debug("_xpath_set: piece($piece)");
1112              
1113 109 100       325 if ($piece =~ /^\@(.+)$/)
    50          
1114             {
1115 70         214 $node->put_attrib($1=>$val);
1116             }
1117             elsif ($piece eq "text()")
1118             {
1119 39         100 $node->remove_cdata();
1120 39         382 $node->add_cdata($val);
1121             }
1122             }
1123             }
1124              
1125              
1126             ##############################################################################
1127             #
1128             # _xpath_defined - returns true if there is data for the requested item, false
1129             # otherwise.
1130             #
1131             ##############################################################################
1132             sub _xpath_defined
1133             {
1134 233     233   230 my $self = shift;
1135 233         232 my $type = shift;
1136 233         222 my $xpath = shift;
1137 233         219 my $childtype = shift;
1138 233         215 my $ns = shift;
1139              
1140 233         1007 $self->_debug("_xpath_defined: self($self) type($type) xpath($xpath) childtype($childtype)");
1141 233 100       441 $self->_debug("_xpath_defined: ns($ns)") if defined($ns);
1142 233         644 $self->_debug("_xpath_defined: xml(",$self->{TREE}->GetXML(),")");
1143              
1144 233         263 my $subType;
1145 233         431 ($type,$subType) = $self->_xpath_resolve_types($type);
1146 233         617 $self->_debug("_xpath_defined: type($type) subType($subType) ");
1147              
1148 233 50       476 if ($type eq "raw")
1149             {
1150 0 0       0 if ($#{$self->{RAWXML}} > -1)
  0         0  
1151             {
1152 0         0 return 1;
1153             }
1154             }
1155              
1156 233         581 my @nodes = $self->{TREE}->XPath($xpath);
1157             # If the $ns is defined, then the presence of nodes does not mean
1158             # we're defined, we have to check them.
1159 233   66     97710 my $defined = ( @nodes > 0 && !defined($ns) );
1160              
1161 233         682 $self->_debug("_xpath_defined: nodes(",join(",",@nodes),")");
1162              
1163 233 50 66     1156 if (!@nodes && (($type eq "child") || ($type eq "children") || ($type eq "node")))
      66        
1164             {
1165 16 50 33     86 if ((ref($childtype) eq "HASH") && exists($childtype->{ns}))
1166             {
1167 0         0 $ns = $childtype->{ns};
1168             }
1169             }
1170              
1171 233 100       439 $self->_debug("_xpath_defined: ns(".$ns.") defined(".$defined.")") if defined($ns);
1172              
1173 233         244 foreach my $packet (@{$self->{CHILDREN}})
  233         521  
1174             {
1175 36         160 $self->_debug("_xpath_defined: packet->GetXMLNS ",$packet->GetXMLNS());
1176 36 100 100     241 if (defined($ns) && ($packet->GetXMLNS() eq $ns))
    100 100        
1177             {
1178 7         10 $defined = 1;
1179 7         10 last;
1180             }
1181             # if we have children, and that's all we're looking for, then by golly
1182             # we're done.
1183             elsif ( !defined($ns) && $type =~ /child/ )
1184             {
1185 4         7 $defined = 1;
1186 4         8 last;
1187             }
1188             }
1189 233         633 $self->_debug("_xpath_defined: defined($defined)");
1190              
1191 233         1823 return $defined;
1192             }
1193              
1194              
1195             ##############################################################################
1196             #
1197             # _xpath_add - returns the value stored in the node
1198             #
1199             ##############################################################################
1200             sub _xpath_add
1201             {
1202 3     3   4 my $self = shift;
1203 3         4 my $type = shift;
1204 3         3 my $xpath = shift;
1205 3         3 my $childtype = shift;
1206              
1207 3         5 my $xmlns = $childtype->{ns};
1208 3         4 my $master = $childtype->{master};
1209              
1210             #$self->_debug("_xpath_add: self($self) type($type) xpath($xpath) childtype($childtype)");
1211             #$self->_debug("_xpath_add: xmlns($xmlns) master($master)");
1212              
1213 3         3 my $tag = $xpath;
1214 3 50       9 if (exists($childtype->{specify_name}))
1215             {
1216 0 0 0     0 if (($#_ > -1) && (($#_/2) =~ /^\d+$/))
1217             {
1218 0         0 $tag = shift;
1219             }
1220             else
1221             {
1222 0         0 $tag = $childtype->{tag};
1223             }
1224             }
1225              
1226 3         12 my $node = XML::Stream::Node->new($tag);
1227 3         51 $node->put_attrib(xmlns=>$xmlns);
1228              
1229 3         30 my $obj = $self->AddChild($node);
1230 3 50       189 eval "\$obj->Set${master}(\@_);" if defined($master);
1231              
1232 3 50       13 $obj->_skip_xmlns() if exists($childtype->{skip_xmlns});
1233              
1234 3         13 return $obj;
1235             }
1236              
1237              
1238             ##############################################################################
1239             #
1240             # _xpath_remove - remove the specified thing from the data (I know it's vague.)
1241             #
1242             ##############################################################################
1243             sub _xpath_remove
1244             {
1245 24     24   26 my $self = shift;
1246 24         26 my $type = shift;
1247 24         52 my $xpath = shift;
1248 24         25 my $childtype = shift;
1249              
1250             #$self->_debug("_xpath_remove: self($self) type($type) xpath($xpath) childtype($childtype)");
1251              
1252 24         21 my $subType;
1253 24         41 ($type,$subType) = $self->_xpath_resolve_types($type);
1254              
1255 24         27 my $nodePath = $xpath;
1256 24         93 $nodePath =~ s/\/?\@\S+$//;
1257 24         47 $nodePath =~ s/\/text\(\)$//;
1258              
1259             #$self->_debug("_xpath_remove: xpath($xpath) nodePath($nodePath)");
1260              
1261 24         22 my @nodes;
1262 24 100       72 @nodes = $self->{TREE}->XPath($nodePath) if ($nodePath ne "");
1263              
1264             #$self->_debug("_xpath_remove: nodes($#nodes)");
1265              
1266 24 100       4291 if ($xpath =~ /\@(\S+)/)
1267             {
1268 15         30 my $attrib = $1;
1269             #$self->_debug("_xpath_remove: attrib($attrib)");
1270              
1271 15 100       34 if ($nodePath eq "")
1272             {
1273 12         43 $self->{TREE}->remove_attrib($attrib);
1274             }
1275             else
1276             {
1277 3         7 foreach my $node (@nodes)
1278             {
1279 3         14 $node->remove_attrib($attrib);
1280             }
1281             }
1282 15         203 return;
1283             }
1284              
1285 9         22 foreach my $node (@nodes)
1286             {
1287             #$self->_debug("_xpath_remove: node GetXML(".$node->GetXML().")");
1288 9         33 $self->{TREE}->remove_child($node);
1289             }
1290              
1291 9 50       186 if ($type eq "child")
1292             {
1293 0         0 my @keep;
1294 0         0 foreach my $child (@{$self->{CHILDREN}})
  0         0  
1295             {
1296             #$self->_debug("_xpath_remove: check(".$child->GetXML().")");
1297 0 0       0 next if ($child->GetXMLNS() eq $childtype->{ns});
1298             #$self->_debug("_xpath_remove: keep(".$child->GetXML().")");
1299 0         0 push(@keep,$child);
1300             }
1301 0         0 $self->{CHILDREN} = \@keep;
1302             }
1303             }
1304              
1305              
1306             ##############################################################################
1307             #
1308             # _xpath_resolve_types - Resolve the type and subType into the correct values.
1309             #
1310             ##############################################################################
1311             sub _xpath_resolve_types
1312             {
1313 588     588   531 my $self = shift;
1314 588         552 my $type = shift;
1315              
1316 588         516 my $subType = "";
1317 588 50       904 if (ref($type) eq "ARRAY")
1318             {
1319 0 0       0 if ($type->[0] eq "special")
    0          
1320             {
1321 0         0 $subType = $type->[1];
1322 0         0 $type = "scalar";
1323             }
1324             elsif ($type->[0] eq "master")
1325             {
1326 0         0 $subType = $type->[1];
1327 0         0 $type = "master";
1328             }
1329             }
1330              
1331             #$self->_debug("_xpath_resolve_types: type($type) subtype($subType)");
1332              
1333 588         1018 return ($type,$subType);
1334             }
1335              
1336              
1337             ##############################################################################
1338             #
1339             # _parse_xmlns - anything that uses the namespace method must first kow what
1340             # the xmlns of this thing is... So here's a function to do
1341             # just that.
1342             #
1343             ##############################################################################
1344             sub _parse_xmlns
1345             {
1346 12     12   19 my $self = shift;
1347              
1348 12 50       32 $self->SetXMLNS($self->{TREE}->get_attrib("xmlns"))
1349             if defined($self->{TREE}->get_attrib("xmlns"));
1350             }
1351              
1352              
1353             ##############################################################################
1354             #
1355             # _parse_tree - run through the XML::Stream::Node and pull any child nodes
1356             # out that we recognize and create objects for them.
1357             #
1358             ##############################################################################
1359             sub _parse_tree
1360             {
1361 12     12   19 my $self = shift;
1362              
1363 12         38 my @xTrees = $self->{TREE}->XPath('*[@xmlns]');
1364              
1365 12 50       4603 if ($#xTrees > -1)
1366             {
1367 0         0 foreach my $xTree (@xTrees)
1368             {
1369 0 0       0 if( exists($Net::XMPP::Namespaces::NS{$xTrees[0]->get_attrib("xmlns")}))
1370             {
1371 0         0 $self->AddChild($xTree);
1372 0         0 $self->{TREE}->remove_child($xTree);
1373             }
1374             }
1375             }
1376             }
1377              
1378              
1379              
1380              
1381             ##############################################################################
1382             #+----------------------------------------------------------------------------
1383             #|
1384             #| Private Methods
1385             #|
1386             #+----------------------------------------------------------------------------
1387             ##############################################################################
1388              
1389             sub _check_skip_xmlns
1390             {
1391 19     19   86 my $self = shift;
1392 19         19 my $xmlns = shift;
1393              
1394 19         35 foreach my $skipns (keys(%Net::XMPP::Namespaces::SKIPNS))
1395             {
1396 19 100       199 return 1 if ($xmlns =~ /^$skipns/);
1397             }
1398              
1399 10         28 return 0;
1400             }
1401              
1402              
1403             ##############################################################################
1404             #
1405             # _debug - helper function for printing debug messages using Net::XMPP::Debug
1406             #
1407             ##############################################################################
1408             sub _debug
1409             {
1410 1994     1994   26904 my $self = shift;
1411 1994         7377 return $DEBUG->Log99($self->{DEBUGHEADER},": ",@_);
1412             }
1413              
1414              
1415             ##############################################################################
1416             #
1417             # _missing_function - send an error if the function is missing.
1418             #
1419             ##############################################################################
1420             sub _missing_function
1421             {
1422 0     0   0 my ($parent,$function) = @_;
1423 0         0 croak("Undefined function $function in package ".ref($parent));
1424             }
1425              
1426              
1427             ##############################################################################
1428             #
1429             # _new_jid - create a new JID object.
1430             #
1431             ##############################################################################
1432             sub _new_jid
1433             {
1434 24     24   30 my $self = shift;
1435 24         132 return Net::XMPP::JID->new(@_);
1436             }
1437              
1438              
1439             ##############################################################################
1440             #
1441             # _new_packet - create a new Stanza object.
1442             #
1443             ##############################################################################
1444             sub _new_packet
1445             {
1446 12     12   17 my $self = shift;
1447 12         45 return Net::XMPP::Stanza->new(@_);
1448             }
1449              
1450              
1451             ##############################################################################
1452             #
1453             # _skip_xmlns - in the GetTree function, cause the xmlns attribute to be
1454             # removed for a node that has this set.
1455             #
1456             ##############################################################################
1457             sub _skip_xmlns
1458             {
1459 0     0     my $self = shift;
1460              
1461 0           $self->{SKIPXMLNS} = 1;
1462             }
1463              
1464              
1465             1;