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) = @_;
   $w->raw ($self->as_string);
}


=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,
   });
}

=back

=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.9
Committed:	Thu Jul 26 19:45:46 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.8:	+2 -1 lines
Log Message:	fixing up for release of 0.04
#	Content
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	RAW => 6
13	};
14
15	use constant {
16	NNODE => 0,
17	NTEXT => 1,
18	NRAW => 2,
19	};
20
21	=head1 NAME
22
23	Net::XMPP2::Node - XML node tree helper for the parser.
24
25	=head1 SYNOPSIS
26
27	use Net::XMPP2::Node;
28	...
29
30	=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	=head1 METHODS
43
44	=over 4
45
46	=item B<new ($ns, $el, $attrs, $parser)>
47
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	$self->[6] = '';
63	bless $self, $class;
64	return $self
65	}
66
67	=item B<name>
68
69	The tag name of this node.
70
71	=cut
72
73	sub name {
74	$_[0]->[NAME]
75	}
76
77	=item B<namespace>
78
79	Returns the namespace URI of this node.
80
81	=cut
82
83	sub namespace {
84	$_[0]->[NS]
85	}
86
87	=item B<eq ($namespace_or_alias, $name) or eq ($node)>
88
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	=item B<eq_ns ($namespace_or_alias) or eq_ns ($node)>
112
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	=item B<attr ($name)>
133
134	Returns the contents of the C<$name> attribute.
135
136	=cut
137
138	sub attr {
139	$_[0]->[ATTRS]->{$_[1]};
140	}
141
142	=item B<add_node ($node)>
143
144	Adds a sub-node to the current node.
145
146	=cut
147
148	sub add_node {
149	my ($self, $node) = @_;
150	push @{$self->[NODES]}, [NNODE, $node];
151	}
152
153	=item B<nodes>
154
155	Returns a list of sub nodes.
156
157	=cut
158
159	sub nodes {
160	map { $_->[1] }
161	grep { $_->[0] == NNODE }
162	@{$_[0]->[NODES] \|\| []};
163	}
164
165	=item B<add_text ($string)>
166
167	Adds character data to the current node.
168
169	=cut
170
171	sub add_text {
172	my ($self, $text) = @_;
173	push @{$self->[NODES]}, [NTEXT, $text];
174	}
175
176	=item B<text>
177
178	Returns the text for this node.
179
180	=cut
181
182	sub text {
183	join '', map $_->[1], grep { $_->[0] == NTEXT } @{$_[0]->[NODES] \|\| []}
184	}
185
186	=item B<find_all (@path)>
187
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	=item B<write_on ($writer)>
214
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	$w->raw ($self->as_string);
222	}
223
224
225	=item B<as_string ()>
226
227	This method returns the original character representation of this XML element
228	(and it's children nodes). Please note that the string is a unicode string,
229	meaning: to get octets use:
230
231	my $octets = encode ('UTF-8', $node->as_string);
232
233	Now you can roll stunts like this:
234
235	my $libxml = XML::LibXML->new;
236	my $doc = $libxml->parse_string (encode ('UTF-8', $node->as_string ()));
237
238	(You can use your favorite XML parser :)
239
240	=cut
241
242	sub as_string {
243	my ($self) = @_;
244	join '',
245	map { $_->[0] == NRAW ? $_->[1] : $_->[1]->as_string }
246	grep { $_->[0] != NTEXT }
247	@{$self->[NODES] \|\| []};
248	}
249
250	=item B<append_raw ($string)>
251
252	This method is called by the parser to store original strings of this element.
253
254	=cut
255
256	sub append_raw {
257	my ($self, $str) = @_;
258	push @{$self->[NODES]}, [NRAW, $str];
259	}
260
261	=item B<to_sax_events ($handler)>
262
263	This method takes anything that can receive SAX events.
264	See also L<XML::GDOME::SAX::Builder> or L<XML::Handler::BuildDOM>
265	or L<XML::LibXML::SAX::Builder>.
266
267	With this you can convert this node to any DOM level 2 structure you want:
268
269	my $builder = XML::LibXML::SAX::Builder->new;
270	$node->to_sax_events ($builder);
271	my $dom = $builder->result;
272	print "Canonized: " . $dom->toStringC14N . "\n";
273
274	=cut
275
276	sub to_sax_events {
277	my ($self, $handler) = @_;
278	my $doc = { Parent => undef };
279	$handler->start_document ($doc);
280	$self->_to_sax_events ($handler);
281	$handler->end_document ($doc);
282	}
283
284	sub _to_sax_events {
285	my ($self, $handler) = @_;
286	$handler->start_element ({
287	NamespaceURI => $self->namespace,
288	Name => $self->name,
289	Attributes => {
290	map {
291	($_ => { Name => $_, Value => $self->[ATTRS]->{$_} })
292	} keys %{$self->[ATTRS]}
293	}
294	});
295	for (@{$self->[NODES]}) {
296	if ($_->[0] == NTEXT) {
297	$handler->characters ($_->[1]);
298	} elsif ($_->[0] == NNODE) {
299	$_->[1]->_to_sax_events ($handler);
300	}
301	}
302	$handler->end_element ({
303	NamespaceURI => $self->namespace,
304	Name => $self->name,
305	});
306	}
307
308	=back
309
310	=head1 AUTHOR
311
312	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
313
314	=head1 COPYRIGHT & LICENSE
315
316	Copyright 2007 Robin Redeker, all rights reserved.
317
318	This program is free software; you can redistribute it and/or modify it
319	under the same terms as Perl itself.
320
321	=cut
322
323	1; # End of Net::XMPP2