Net/XMPP2/Node.pm

package Net::XMPP2::Node;
use strict;
use Net::XMPP2::Namespaces qw/xmpp_ns/;

use constant {
   NS     => 0,
   NAME   => 1,
   ATTRS  => 2,
   TEXT   => 3,
   NODES  => 4,
   PARSER => 5,
   RAW    => 6
};

use constant {
   NNODE   => 0,
   NTEXT   => 1,
   NRAW    => 2,
};

=head1 NAME

Net::XMPP2::Node - XML node tree helper for the parser.

=head1 SYNOPSIS

   use Net::XMPP2::Node;
   ...

=head1 DESCRIPTION

This class represens a XML node. L<Net::XMPP2> should usually not
require messing with the parse tree, but sometimes it is neccessary.

If you experience any need for messing with these and feel L<Net::XMPP2> should
rather take care of it drop me a mail, feature request or most preferably a patch!

Every L<Net::XMPP2::Node> has a namespace, attributes, text and child nodes.

You can access these with the following methods:

=head1 METHODS

=over 4

=item B<new ($ns, $el, $attrs, $parser)>

Creates a new Net::XMPP2::Node object with the node tag name C<$el> in the
namespace URI C<$ns> and the attributes C<$attrs>. The C<$parser> must be
the instance of C<Net::XMPP2::Parser> which generated this node.

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = [];
   $self->[0] = $_[0];
   $self->[1] = $_[1];
   $self->[2] = $_[2];
   $self->[5] = $_[3];
   $self->[6] = '';
   bless $self, $class;
   return $self
}

=item B<name>

The tag name of this node.

=cut

sub name {
   $_[0]->[NAME]
}

=item B<namespace>

Returns the namespace URI of this node.

=cut

sub namespace {
   $_[0]->[NS]
}

=item B<eq ($namespace_or_alias, $name) or eq ($node)>

Returns true whether the current element matches the tag name C<$name>
in the namespaces pointed at by C<$namespace_or_alias>.

You can either pass an alias that was defined in L<Net::XMPP2::Namespaces>
or pass an namespace URI in C<$namespace_or_alias>. If no alias with the name
C<$namespace_or_alias> was found in L<Net::XMPP2::Namespaces> it will be
interpreted as namespace URI.

The first argument to eq can also be another L<Net::XMPP2::Node> instance.

=cut

sub eq {
   my ($self, $n, $name) = @_;
   if (ref $n) {
      return $self->[PARSER]->nseq ($n->namespace, $n->name, $self->name);
   } else {
      my $ns = xmpp_ns ($n);
      return $self->[PARSER]->nseq (($ns ? $ns : $n), $name, $self->name);
   }
}

=item B<eq_ns ($namespace_or_alias) or eq_ns ($node)>

This method return true if the namespace of this instance of L<Net::XMPP2::Node>
matches the namespace described by C<$namespace_or_alias> or the
namespace of the C<$node> which has to be another L<Net::XMPP2::Node> instance.

See C<eq> for the meaning of C<$namespace_or_alias>.

=cut

sub eq_ns {
   my ($self, $n) = @_;
   if (ref $n) {
      return ($n->namespace eq $self->namespace);
   } else {
      my $ns = xmpp_ns ($n);
      $ns ||= $n;
      return ($ns eq $self->namespace);
   }
}

=item B<attr ($name)>

Returns the contents of the C<$name> attribute.

=cut

sub attr {
   $_[0]->[ATTRS]->{$_[1]};
}

=item B<add_node ($node)>

Adds a sub-node to the current node.

=cut

sub add_node {
   my ($self, $node) = @_;
   push @{$self->[NODES]}, [NNODE, $node];
}

=item B<nodes>

Returns a list of sub nodes.

=cut

sub nodes {
   map { $_->[1] }
      grep { $_->[0] == NNODE }
         @{$_[0]->[NODES] || []};
}

=item B<add_text ($string)>

Adds character data to the current node.

=cut

sub add_text {
   my ($self, $text) = @_;
   push @{$self->[NODES]}, [NTEXT, $text];
}

=item B<text>

Returns the text for this node.

=cut

sub text {
   join '', map $_->[1], grep { $_->[0] == NTEXT } @{$_[0]->[NODES] || []}
}

=item B<find_all (@path)>

This method does a recursive descent through the sub-nodes and
fetches all nodes that match the last element of C<@path>.

The elements of C<@path> consist of a array reference to an array with
two elements: the namespace key known by the C<$parser> and the tagname
we search for.

=cut

sub find_all {
   my ($self, @path) = @_;
   my $cur = shift @path;
   my @ret;
   for my $n ($self->nodes) {
      if ($n->eq (@$cur)) {
         if (@path) {
            push @ret, $n->find_all (@path);
         } else {
            push @ret, $n;
         }
      }
   }
   @ret
}

=item B<write_on ($writer)>

This writes the current node out to the L<Net::XMPP2::Writer> object in C<$writer>.

=cut

sub write_on {
   my ($self, $w) = @_;

   my ($ns, $tag) = ($self->namespace, $self->name);
   $w->addPrefix ($ns => ''); # omg, xmpp is soo broken...
   if ($self->nodes) {
      $w->startTag ([$ns, $tag], %{$self->[ATTRS]});
      $_->write_on ($w) for $self->nodes;
      $w->endTag;
   } else {
      $w->emptyTag ([$ns, $tag], %{$self->[ATTRS]});
   }
}

=back

=item B<as_string ()>

This method returns the original character representation of this XML element
(and it's children nodes). Please note that the string is a unicode string,
meaning: to get octets use:

   my $octets = encode ('UTF-8', $node->as_string);

Now you can roll stunts like this:

   my $libxml = XML::LibXML->new;
   my $doc    = $libxml->parse_string (encode ('UTF-8', $node->as_string ()));

(You can use your favorite XML parser :)

=cut

sub as_string {
   my ($self) = @_;
   join '',
      map { $_->[0] == NRAW ? $_->[1] : $_->[1]->as_string }
         grep { $_->[0] != NTEXT }
            @{$self->[NODES] || []};
}

=item B<append_raw ($string)>

This method is called by the parser to store original strings of this element.

=cut

sub append_raw {
   my ($self, $str) = @_;
   push @{$self->[NODES]}, [NRAW, $str];
}

=item B<to_sax_events ($handler)>

This method takes anything that can receive SAX events.
See also L<XML::GDOME::SAX::Builder> or L<XML::Handler::BuildDOM>
or L<XML::LibXML::SAX::Builder>.

With this you can convert this node to any DOM level 2 structure you want:

   my $builder = XML::LibXML::SAX::Builder->new;
   $node->to_sax_events ($builder);
   my $dom = $builder->result;
   print "Canonized: " . $dom->toStringC14N . "\n";

=cut

sub to_sax_events {
   my ($self, $handler) = @_;
   my $doc = { Parent => undef };
   $handler->start_document ($doc);
   $self->_to_sax_events ($handler);
   $handler->end_document ($doc);
}

sub _to_sax_events {
   my ($self, $handler) = @_;
   $handler->start_element ({
      NamespaceURI => $self->namespace,
      Name         => $self->name,
      Attributes   => {
         map {
            ($_ => { Name => $_, Value => $self->[ATTRS]->{$_} })
         } keys %{$self->[ATTRS]}
      }
   });
   for (@{$self->[NODES]}) {
      if ($_->[0] == NTEXT) {
         $handler->characters ($_->[1]);
      } elsif ($_->[0] == NNODE) {
         $_->[1]->_to_sax_events ($handler);
      }
   }
   $handler->end_element ({
      NamespaceURI => $self->namespace,
      Name         => $self->name,
   });
}

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 Robin Redeker, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Net::XMPP2
Revision:	1.7
Committed:	Tue Jul 24 07:56:11 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.6:	+58 -2 lines
Log Message:	added sax event generator for Net::XMPP2::Node. now other people got the serious ability to interface nicely with Net::XMPP2 by either generating the original stanza string and parsing it or let $node->to_sax_events () generate their DOM tree.
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::Node;
2			use strict;
3			use Net::XMPP2::Namespaces qw/xmpp_ns/;
4
5			use constant {
6			NS => 0,
7			NAME => 1,
8			ATTRS => 2,
9			TEXT => 3,
10			NODES => 4,
11			PARSER => 5,
12	elmex	1.6	RAW => 6
13			};
14
15			use constant {
16			NNODE => 0,
17			NTEXT => 1,
18			NRAW => 2,
19	elmex	1.1	};
20
21			=head1 NAME
22
23	elmex	1.5	Net::XMPP2::Node - XML node tree helper for the parser.
24	elmex	1.1
25			=head1 SYNOPSIS
26
27			use Net::XMPP2::Node;
28			...
29
30	elmex	1.4	=head1 DESCRIPTION
31
32			This class represens a XML node. L<Net::XMPP2> should usually not
33			require messing with the parse tree, but sometimes it is neccessary.
34
35			If you experience any need for messing with these and feel L<Net::XMPP2> should
36			rather take care of it drop me a mail, feature request or most preferably a patch!
37
38			Every L<Net::XMPP2::Node> has a namespace, attributes, text and child nodes.
39
40			You can access these with the following methods:
41
42	elmex	1.1	=head1 METHODS
43
44	elmex	1.4	=over 4
45
46			=item B<new ($ns, $el, $attrs, $parser)>
47	elmex	1.1
48			Creates a new Net::XMPP2::Node object with the node tag name C<$el> in the
49			namespace URI C<$ns> and the attributes C<$attrs>. The C<$parser> must be
50			the instance of C<Net::XMPP2::Parser> which generated this node.
51
52			=cut
53
54			sub new {
55			my $this = shift;
56			my $class = ref($this) \|\| $this;
57			my $self = [];
58			$self->[0] = $_[0];
59			$self->[1] = $_[1];
60			$self->[2] = $_[2];
61			$self->[5] = $_[3];
62	elmex	1.6	$self->[6] = '';
63	elmex	1.1	bless $self, $class;
64			return $self
65			}
66
67	elmex	1.4	=item B<name>
68	elmex	1.1
69			The tag name of this node.
70
71			=cut
72
73			sub name {
74			$_[0]->[NAME]
75			}
76
77	elmex	1.4	=item B<namespace>
78	elmex	1.1
79			Returns the namespace URI of this node.
80
81			=cut
82
83			sub namespace {
84			$_[0]->[NS]
85			}
86
87	elmex	1.4	=item B<eq ($namespace_or_alias, $name) or eq ($node)>
88	elmex	1.1
89			Returns true whether the current element matches the tag name C<$name>
90			in the namespaces pointed at by C<$namespace_or_alias>.
91
92			You can either pass an alias that was defined in L<Net::XMPP2::Namespaces>
93			or pass an namespace URI in C<$namespace_or_alias>. If no alias with the name
94			C<$namespace_or_alias> was found in L<Net::XMPP2::Namespaces> it will be
95			interpreted as namespace URI.
96
97			The first argument to eq can also be another L<Net::XMPP2::Node> instance.
98
99			=cut
100
101			sub eq {
102			my ($self, $n, $name) = @_;
103			if (ref $n) {
104			return $self->[PARSER]->nseq ($n->namespace, $n->name, $self->name);
105			} else {
106			my $ns = xmpp_ns ($n);
107			return $self->[PARSER]->nseq (($ns ? $ns : $n), $name, $self->name);
108			}
109			}
110
111	elmex	1.4	=item B<eq_ns ($namespace_or_alias) or eq_ns ($node)>
112	elmex	1.1
113			This method return true if the namespace of this instance of L<Net::XMPP2::Node>
114			matches the namespace described by C<$namespace_or_alias> or the
115			namespace of the C<$node> which has to be another L<Net::XMPP2::Node> instance.
116
117			See C<eq> for the meaning of C<$namespace_or_alias>.
118
119			=cut
120
121			sub eq_ns {
122			my ($self, $n) = @_;
123			if (ref $n) {
124			return ($n->namespace eq $self->namespace);
125			} else {
126			my $ns = xmpp_ns ($n);
127			$ns \|\|= $n;
128			return ($ns eq $self->namespace);
129			}
130			}
131
132	elmex	1.4	=item B<attr ($name)>
133	elmex	1.1
134			Returns the contents of the C<$name> attribute.
135
136			=cut
137
138			sub attr {
139			$_[0]->[ATTRS]->{$_[1]};
140			}
141
142	elmex	1.4	=item B<add_node ($node)>
143	elmex	1.1
144			Adds a sub-node to the current node.
145
146			=cut
147
148			sub add_node {
149			my ($self, $node) = @_;
150	elmex	1.6	push @{$self->[NODES]}, [NNODE, $node];
151	elmex	1.1	}
152
153	elmex	1.4	=item B<nodes>
154	elmex	1.1
155			Returns a list of sub nodes.
156
157			=cut
158
159			sub nodes {
160	elmex	1.6	map { $_->[1] }
161			grep { $_->[0] == NNODE }
162			@{$_[0]->[NODES] \|\| []};
163	elmex	1.1	}
164
165	elmex	1.4	=item B<add_text ($string)>
166	elmex	1.1
167			Adds character data to the current node.
168
169			=cut
170
171			sub add_text {
172			my ($self, $text) = @_;
173	elmex	1.6	push @{$self->[NODES]}, [NTEXT, $text];
174	elmex	1.1	}
175
176	elmex	1.4	=item B<text>
177	elmex	1.1
178			Returns the text for this node.
179
180			=cut
181
182			sub text {
183	elmex	1.6	join '', map $_->[1], grep { $_->[0] == NTEXT } @{$_[0]->[NODES] \|\| []}
184	elmex	1.1	}
185
186	elmex	1.4	=item B<find_all (@path)>
187	elmex	1.1
188			This method does a recursive descent through the sub-nodes and
189			fetches all nodes that match the last element of C<@path>.
190
191			The elements of C<@path> consist of a array reference to an array with
192			two elements: the namespace key known by the C<$parser> and the tagname
193			we search for.
194
195			=cut
196
197			sub find_all {
198			my ($self, @path) = @_;
199			my $cur = shift @path;
200			my @ret;
201			for my $n ($self->nodes) {
202			if ($n->eq (@$cur)) {
203			if (@path) {
204			push @ret, $n->find_all (@path);
205			} else {
206			push @ret, $n;
207			}
208			}
209			}
210			@ret
211			}
212
213	elmex	1.4	=item B<write_on ($writer)>
214	elmex	1.2
215			This writes the current node out to the L<Net::XMPP2::Writer> object in C<$writer>.
216
217			=cut
218
219			sub write_on {
220			my ($self, $w) = @_;
221
222			my ($ns, $tag) = ($self->namespace, $self->name);
223			$w->addPrefix ($ns => ''); # omg, xmpp is soo broken...
224			if ($self->nodes) {
225			$w->startTag ([$ns, $tag], %{$self->[ATTRS]});
226			$_->write_on ($w) for $self->nodes;
227			$w->endTag;
228			} else {
229			$w->emptyTag ([$ns, $tag], %{$self->[ATTRS]});
230			}
231			}
232
233	elmex	1.4	=back
234
235	elmex	1.6	=item B<as_string ()>
236
237			This method returns the original character representation of this XML element
238	elmex	1.7	(and it's children nodes). Please note that the string is a unicode string,
239			meaning: to get octets use:
240
241			my $octets = encode ('UTF-8', $node->as_string);
242
243			Now you can roll stunts like this:
244
245			my $libxml = XML::LibXML->new;
246			my $doc = $libxml->parse_string (encode ('UTF-8', $node->as_string ()));
247
248			(You can use your favorite XML parser :)
249	elmex	1.6
250			=cut
251
252			sub as_string {
253			my ($self) = @_;
254			join '',
255			map { $_->[0] == NRAW ? $_->[1] : $_->[1]->as_string }
256			grep { $_->[0] != NTEXT }
257			@{$self->[NODES] \|\| []};
258			}
259
260			=item B<append_raw ($string)>
261
262			This method is called by the parser to store original strings of this element.
263
264			=cut
265
266			sub append_raw {
267			my ($self, $str) = @_;
268			push @{$self->[NODES]}, [NRAW, $str];
269			}
270
271	elmex	1.7	=item B<to_sax_events ($handler)>
272
273			This method takes anything that can receive SAX events.
274			See also L<XML::GDOME::SAX::Builder> or L<XML::Handler::BuildDOM>
275			or L<XML::LibXML::SAX::Builder>.
276
277			With this you can convert this node to any DOM level 2 structure you want:
278
279			my $builder = XML::LibXML::SAX::Builder->new;
280			$node->to_sax_events ($builder);
281			my $dom = $builder->result;
282			print "Canonized: " . $dom->toStringC14N . "\n";
283
284			=cut
285
286			sub to_sax_events {
287			my ($self, $handler) = @_;
288			my $doc = { Parent => undef };
289			$handler->start_document ($doc);
290			$self->_to_sax_events ($handler);
291			$handler->end_document ($doc);
292			}
293
294			sub _to_sax_events {
295			my ($self, $handler) = @_;
296			$handler->start_element ({
297			NamespaceURI => $self->namespace,
298			Name => $self->name,
299			Attributes => {
300			map {
301			($_ => { Name => $_, Value => $self->[ATTRS]->{$_} })
302			} keys %{$self->[ATTRS]}
303			}
304			});
305			for (@{$self->[NODES]}) {
306			if ($_->[0] == NTEXT) {
307			$handler->characters ($_->[1]);
308			} elsif ($_->[0] == NNODE) {
309			$_->[1]->_to_sax_events ($handler);
310			}
311			}
312			$handler->end_element ({
313			NamespaceURI => $self->namespace,
314			Name => $self->name,
315			});
316			}
317
318	elmex	1.1	=head1 AUTHOR
319
320	elmex	1.4	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
321	elmex	1.1
322			=head1 COPYRIGHT & LICENSE
323
324			Copyright 2007 Robin Redeker, all rights reserved.
325
326			This program is free software; you can redistribute it and/or modify it
327			under the same terms as Perl itself.
328
329			=cut
330
331			1; # End of Net::XMPP2