Net/XMPP2/Node.pm

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

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

=head1 NAME

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

=head1 SYNOPSIS

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

=head1 METHODS

=head2 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];
   bless $self, $class;
   return $self
}

=head2 name

The tag name of this node.

=cut

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

=head2 namespace

Returns the namespace URI of this node.

=cut

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

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

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

=head2 attr ($name)

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

=cut

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

=head2 add_node ($node)

Adds a sub-node to the current node.

=cut

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

=head2 nodes

Returns a list of sub nodes.

=cut

sub nodes {
   @{$_[0]->[NODES] || []};
}

=head2 add_text ($string)

Adds character data to the current node.

=cut

sub add_text {
   my ($self, $text) = @_;
   $self->[TEXT] .= $text;
}

=head2 text

Returns the text for this node.

=cut

sub text {
   $_[0]->[TEXT];
}

=head2 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
}

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

=head1 AUTHOR

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

=head1 BUGS

Please report any bugs or feature requests to
C<bug-net-xmpp2 at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-XMPP2>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::XMPP2

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-XMPP2>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-XMPP2>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-XMPP2>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-XMPP2>

=back

=head1 ACKNOWLEDGEMENTS

=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.2
Committed:	Sun Jan 28 21:52:19 2007 UTC (19 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.1:	+20 -0 lines
Log Message:	further detail work and implemented extension enabling and extensions xep-0086 along with xml stanza error generation. implemented also first parts of Net::XMPP2::IM::Connection.
#	Content
1	package Net::XMPP2::Node;
2	use warnings;
3	use strict;
4	use Net::XMPP2::Namespaces qw/xmpp_ns/;
5
6	use constant {
7	NS => 0,
8	NAME => 1,
9	ATTRS => 2,
10	TEXT => 3,
11	NODES => 4,
12	PARSER => 5,
13	};
14
15	=head1 NAME
16
17	Net::XMPP2::Node - A XML node tree helper for the parser.
18
19	=head1 SYNOPSIS
20
21	use Net::XMPP2::Node;
22	...
23
24	=head1 METHODS
25
26	=head2 new ($ns, $el, $attrs, $parser)
27
28	Creates a new Net::XMPP2::Node object with the node tag name C<$el> in the
29	namespace URI C<$ns> and the attributes C<$attrs>. The C<$parser> must be
30	the instance of C<Net::XMPP2::Parser> which generated this node.
31
32	=cut
33
34	sub new {
35	my $this = shift;
36	my $class = ref($this) \|\| $this;
37	my $self = [];
38	$self->[0] = $_[0];
39	$self->[1] = $_[1];
40	$self->[2] = $_[2];
41	$self->[5] = $_[3];
42	bless $self, $class;
43	return $self
44	}
45
46	=head2 name
47
48	The tag name of this node.
49
50	=cut
51
52	sub name {
53	$_[0]->[NAME]
54	}
55
56	=head2 namespace
57
58	Returns the namespace URI of this node.
59
60	=cut
61
62	sub namespace {
63	$_[0]->[NS]
64	}
65
66	=head2 eq ($namespace_or_alias, $name) or eq ($node)
67
68	Returns true whether the current element matches the tag name C<$name>
69	in the namespaces pointed at by C<$namespace_or_alias>.
70
71	You can either pass an alias that was defined in L<Net::XMPP2::Namespaces>
72	or pass an namespace URI in C<$namespace_or_alias>. If no alias with the name
73	C<$namespace_or_alias> was found in L<Net::XMPP2::Namespaces> it will be
74	interpreted as namespace URI.
75
76	The first argument to eq can also be another L<Net::XMPP2::Node> instance.
77
78	=cut
79
80	sub eq {
81	my ($self, $n, $name) = @_;
82	if (ref $n) {
83	return $self->[PARSER]->nseq ($n->namespace, $n->name, $self->name);
84	} else {
85	my $ns = xmpp_ns ($n);
86	return $self->[PARSER]->nseq (($ns ? $ns : $n), $name, $self->name);
87	}
88	}
89
90	=head2 eq_ns ($namespace_or_alias) or eq_ns ($node)
91
92	This method return true if the namespace of this instance of L<Net::XMPP2::Node>
93	matches the namespace described by C<$namespace_or_alias> or the
94	namespace of the C<$node> which has to be another L<Net::XMPP2::Node> instance.
95
96	See C<eq> for the meaning of C<$namespace_or_alias>.
97
98	=cut
99
100	sub eq_ns {
101	my ($self, $n) = @_;
102	if (ref $n) {
103	return ($n->namespace eq $self->namespace);
104	} else {
105	my $ns = xmpp_ns ($n);
106	$ns \|\|= $n;
107	return ($ns eq $self->namespace);
108	}
109	}
110
111	=head2 attr ($name)
112
113	Returns the contents of the C<$name> attribute.
114
115	=cut
116
117	sub attr {
118	$_[0]->[ATTRS]->{$_[1]};
119	}
120
121	=head2 add_node ($node)
122
123	Adds a sub-node to the current node.
124
125	=cut
126
127	sub add_node {
128	my ($self, $node) = @_;
129	push @{$self->[NODES]}, $node;
130	}
131
132	=head2 nodes
133
134	Returns a list of sub nodes.
135
136	=cut
137
138	sub nodes {
139	@{$_[0]->[NODES] \|\| []};
140	}
141
142	=head2 add_text ($string)
143
144	Adds character data to the current node.
145
146	=cut
147
148	sub add_text {
149	my ($self, $text) = @_;
150	$self->[TEXT] .= $text;
151	}
152
153	=head2 text
154
155	Returns the text for this node.
156
157	=cut
158
159	sub text {
160	$_[0]->[TEXT];
161	}
162
163	=head2 find_all (@path)
164
165	This method does a recursive descent through the sub-nodes and
166	fetches all nodes that match the last element of C<@path>.
167
168	The elements of C<@path> consist of a array reference to an array with
169	two elements: the namespace key known by the C<$parser> and the tagname
170	we search for.
171
172	=cut
173
174	sub find_all {
175	my ($self, @path) = @_;
176	my $cur = shift @path;
177	my @ret;
178	for my $n ($self->nodes) {
179	if ($n->eq (@$cur)) {
180	if (@path) {
181	push @ret, $n->find_all (@path);
182	} else {
183	push @ret, $n;
184	}
185	}
186	}
187	@ret
188	}
189
190	=head2 write_on ($writer)
191
192	This writes the current node out to the L<Net::XMPP2::Writer> object in C<$writer>.
193
194	=cut
195
196	sub write_on {
197	my ($self, $w) = @_;
198
199	my ($ns, $tag) = ($self->namespace, $self->name);
200	$w->addPrefix ($ns => ''); # omg, xmpp is soo broken...
201	if ($self->nodes) {
202	$w->startTag ([$ns, $tag], %{$self->[ATTRS]});
203	$_->write_on ($w) for $self->nodes;
204	$w->endTag;
205	} else {
206	$w->emptyTag ([$ns, $tag], %{$self->[ATTRS]});
207	}
208	}
209
210	=head1 AUTHOR
211
212	Robin Redeker, C<< <elmex at ta-sa.org> >>
213
214	=head1 BUGS
215
216	Please report any bugs or feature requests to
217	C<bug-net-xmpp2 at rt.cpan.org>, or through the web interface at
218	L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-XMPP2>.
219	I will be notified, and then you'll automatically be notified of progress on
220	your bug as I make changes.
221
222	=head1 SUPPORT
223
224	You can find documentation for this module with the perldoc command.
225
226	perldoc Net::XMPP2
227
228	You can also look for information at:
229
230	=over 4
231
232	=item * AnnoCPAN: Annotated CPAN documentation
233
234	L<http://annocpan.org/dist/Net-XMPP2>
235
236	=item * CPAN Ratings
237
238	L<http://cpanratings.perl.org/d/Net-XMPP2>
239
240	=item * RT: CPAN's request tracker
241
242	L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-XMPP2>
243
244	=item * Search CPAN
245
246	L<http://search.cpan.org/dist/Net-XMPP2>
247
248	=back
249
250	=head1 ACKNOWLEDGEMENTS
251
252	=head1 COPYRIGHT & LICENSE
253
254	Copyright 2007 Robin Redeker, all rights reserved.
255
256	This program is free software; you can redistribute it and/or modify it
257	under the same terms as Perl itself.
258
259	=cut
260
261	1; # End of Net::XMPP2