Net/XMPP2/Parser.pm

package Net::XMPP2::Parser;
use warnings;
use strict;
# OMFG!!!111 THANK YOU FOR THIS MODULE TO HANDLE THE XMPP INSANITY:
use Net::XMPP2::Node;
use XML::Parser::Expat;

=head1 NAME

Net::XMPP2::Parser - Parser for XML streams (helper for Net::XMPP2)

=head1 SYNOPSIS

   use Net::XMPP2::Parser;
   ...

=head1 DESCRIPTION

This is a XMPP XML parser helper class, which helps me to cope with the XMPP XML.

See also L<Net::XMPP2::Writer> for a discussion of the issues with XML in XMPP.

=head1 METHODS

=over 4

=item B<new>

This creates a new Net::XMPP2::Parser and calls C<init>.

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = {
      stanza_cb => sub { die "No stanza callback provided!" },
      error_cb  => sub { warn "No error callback provided: $_[0]: $_[1]!" },
      stream_cb => sub { },
      @_
   };
   bless $self, $class;
   $self->init;
   $self
}

=item B<set_stanza_cb ($cb)>

Sets the 'XML stanza' callback.

C<$cb> must be a code reference. The first argument to
the callback will be this Net::XMPP2::Parser instance and
the second will be the stanzas root Net::XMPP2::Node as first argument.

If the second argument is undefined the end of the stream has been found.

=cut

sub set_stanza_cb {
   my ($self, $cb) = @_;
   $self->{stanza_cb} = $cb;
}

=item B<set_error_cb ($cb)>

This sets the error callback that will be called when
the parser encounters an syntax error. The first argument
is the exception and the second is the data which caused the error.

=cut

sub set_error_cb {
   my ($self, $cb) = @_;
   $self->{error_cb} = $cb;
}

=item B<set_stream_cb ($cb)>

This method sets the stream tag callback. It is called
when the <stream> tag from the server has been encountered.
The first argument to the callback is the L<Net::XMPP2::Node>
of the opening stream tag.

=cut

sub set_stream_cb {
   my ($self, $cb) = @_;
   $self->{stream_cb} = $cb;
}

=item B<init>

This methods (re)initializes the parser.

=cut

sub init {
   my ($self) = @_;
   $self->{parser} = XML::Parser::ExpatNB->new (
      Namespaces => 1,
      ProtocolEncoding => 'UTF-8'
   );
   $self->{parser}->setHandlers (
      Start => sub { $self->cb_start_tag (@_) },
      End   => sub { $self->cb_end_tag   (@_) },
      Char  => sub { $self->cb_char_data (@_) },
   );
   $self->{nso} = {};
   $self->{nodestack} = [];
}

=item B<nseq ($namespace, $tagname, $cmptag)>

This method checks whether the C<$cmptag> matches the C<$tagname>
in the C<$namespace>.

C<$cmptag> needs to come from the XML::Parser::Expat as it has
some magic attached that stores the namespace.

=cut

sub nseq {
   my ($self, $ns, $name, $tag) = @_;

   unless (exists $self->{nso}->{$ns}->{$name}) {
      $self->{nso}->{$ns}->{$name} =
         $self->{parser}->generate_ns_name ($name, $ns);
   }

   return $self->{parser}->eq_name ($self->{nso}->{$ns}->{$name}, $tag);
}

=item B<feed ($data)>

This method feeds a chunk of unparsed data to the parser.

=cut

sub feed {
   my ($self, $data) = @_;
   eval {
      $self->{parser}->parse_more ($data);
   };
   if ($@) {
      $self->{error_cb}->($@, $data, 'xml');
   }
}

#=item B<stream_id>
#
#This method retrieves the streams ID attribute.
#
#=cut
#
#sub stream_id {
#   my ($self) = @_;
#   return undef unless $self->{nodestack}->[0];
#   $self->{nodestack}->[0]->attr ('id')
#}

sub cb_start_tag {
   my ($self, $p, $el, %attrs) = @_;
   my $node = Net::XMPP2::Node->new ($p->namespace ($el), $el, \%attrs, $self);
   $node->append_raw ($p->original_string);
   if (not @{$self->{nodestack}}) {
      $self->{stream_cb}->($node);
   }
   push @{$self->{nodestack}}, $node;
}

sub cb_char_data {
   my ($self, $p, $str) = @_;
   unless (@{$self->{nodestack}}) {
      warn "characters outside of tag: [$str]!\n";
      return;
   }
   my $node = $self->{nodestack}->[-1];
   $node->add_text ($str);
   $node->append_raw ($p->original_string);
}

sub cb_end_tag {
   my ($self, $p, $el) = @_;

   unless (@{$self->{nodestack}}) {
      warn "end tag </$el> read without any starting tag!\n";
      return;
   }

   if (!$p->eq_name ($self->{nodestack}->[-1]->name, $el)) {
      warn "end tag </$el> doesn't match start tags ($self->{tags}->[-1]->[0])!\n";
      return;
   }

   my $node = pop @{$self->{nodestack}};
   $node->append_raw ($p->original_string);

   # > 1 because we don't want the stream tag to save all our children...
   if (@{$self->{nodestack}} > 1) {
      $self->{nodestack}->[-1]->add_node ($node);
   }

   eval {
      if (@{$self->{nodestack}} == 1) {
         $self->{stanza_cb}->($self, $node);
      } elsif (@{$self->{nodestack}} == 0) {
         $self->{stanza_cb}->($self, undef);
      }
   };
   if ($@) {
      $self->{error_cb}->($@, undef, 'exception');
   }
}

=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:	Fri Jul 20 20:41:48 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.8:	+36 -2 lines
Log Message:	lots of changes. added as_string to Net::XMPP2::Node to restore the original xml document part of a stanza or subtree. also implemented the jabber component protocol.
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::Parser;
2			use warnings;
3			use strict;
4			# OMFG!!!111 THANK YOU FOR THIS MODULE TO HANDLE THE XMPP INSANITY:
5			use Net::XMPP2::Node;
6			use XML::Parser::Expat;
7
8			=head1 NAME
9
10	elmex	1.7	Net::XMPP2::Parser - Parser for XML streams (helper for Net::XMPP2)
11	elmex	1.1
12			=head1 SYNOPSIS
13
14			use Net::XMPP2::Parser;
15			...
16
17	elmex	1.2	=head1 DESCRIPTION
18
19			This is a XMPP XML parser helper class, which helps me to cope with the XMPP XML.
20
21			See also L<Net::XMPP2::Writer> for a discussion of the issues with XML in XMPP.
22
23	elmex	1.1	=head1 METHODS
24
25	elmex	1.6	=over 4
26
27			=item B<new>
28	elmex	1.1
29			This creates a new Net::XMPP2::Parser and calls C<init>.
30
31			=cut
32
33			sub new {
34			my $this = shift;
35			my $class = ref($this) \|\| $this;
36	elmex	1.5	my $self = {
37			stanza_cb => sub { die "No stanza callback provided!" },
38			error_cb => sub { warn "No error callback provided: $_[0]: $_[1]!" },
39	elmex	1.9	stream_cb => sub { },
40	elmex	1.5	@_
41			};
42	elmex	1.1	bless $self, $class;
43			$self->init;
44			$self
45			}
46
47	elmex	1.6	=item B<set_stanza_cb ($cb)>
48	elmex	1.1
49			Sets the 'XML stanza' callback.
50
51			C<$cb> must be a code reference. The first argument to
52			the callback will be this Net::XMPP2::Parser instance and
53			the second will be the stanzas root Net::XMPP2::Node as first argument.
54
55	elmex	1.5	If the second argument is undefined the end of the stream has been found.
56
57	elmex	1.1	=cut
58
59			sub set_stanza_cb {
60			my ($self, $cb) = @_;
61			$self->{stanza_cb} = $cb;
62			}
63
64	elmex	1.6	=item B<set_error_cb ($cb)>
65	elmex	1.5
66			This sets the error callback that will be called when
67			the parser encounters an syntax error. The first argument
68			is the exception and the second is the data which caused the error.
69
70			=cut
71
72			sub set_error_cb {
73			my ($self, $cb) = @_;
74			$self->{error_cb} = $cb;
75			}
76
77	elmex	1.9	=item B<set_stream_cb ($cb)>
78
79			This method sets the stream tag callback. It is called
80			when the <stream> tag from the server has been encountered.
81			The first argument to the callback is the L<Net::XMPP2::Node>
82			of the opening stream tag.
83
84			=cut
85
86			sub set_stream_cb {
87			my ($self, $cb) = @_;
88			$self->{stream_cb} = $cb;
89			}
90
91	elmex	1.6	=item B<init>
92	elmex	1.1
93			This methods (re)initializes the parser.
94
95			=cut
96
97			sub init {
98			my ($self) = @_;
99			$self->{parser} = XML::Parser::ExpatNB->new (
100			Namespaces => 1,
101			ProtocolEncoding => 'UTF-8'
102			);
103			$self->{parser}->setHandlers (
104			Start => sub { $self->cb_start_tag (@_) },
105			End => sub { $self->cb_end_tag (@_) },
106			Char => sub { $self->cb_char_data (@_) },
107			);
108			$self->{nso} = {};
109			$self->{nodestack} = [];
110			}
111
112	elmex	1.6	=item B<nseq ($namespace, $tagname, $cmptag)>
113	elmex	1.1
114			This method checks whether the C<$cmptag> matches the C<$tagname>
115			in the C<$namespace>.
116
117			C<$cmptag> needs to come from the XML::Parser::Expat as it has
118			some magic attached that stores the namespace.
119
120			=cut
121
122			sub nseq {
123			my ($self, $ns, $name, $tag) = @_;
124
125			unless (exists $self->{nso}->{$ns}->{$name}) {
126			$self->{nso}->{$ns}->{$name} =
127			$self->{parser}->generate_ns_name ($name, $ns);
128			}
129
130			return $self->{parser}->eq_name ($self->{nso}->{$ns}->{$name}, $tag);
131			}
132
133	elmex	1.6	=item B<feed ($data)>
134	elmex	1.1
135			This method feeds a chunk of unparsed data to the parser.
136
137			=cut
138
139			sub feed {
140			my ($self, $data) = @_;
141	elmex	1.5	eval {
142			$self->{parser}->parse_more ($data);
143			};
144			if ($@) {
145	elmex	1.8	$self->{error_cb}->($@, $data, 'xml');
146	elmex	1.5	}
147	elmex	1.1	}
148
149	elmex	1.9	#=item B<stream_id>
150			#
151			#This method retrieves the streams ID attribute.
152			#
153			#=cut
154			#
155			#sub stream_id {
156			# my ($self) = @_;
157			# return undef unless $self->{nodestack}->[0];
158			# $self->{nodestack}->[0]->attr ('id')
159			#}
160	elmex	1.1
161			sub cb_start_tag {
162			my ($self, $p, $el, %attrs) = @_;
163	elmex	1.9	my $node = Net::XMPP2::Node->new ($p->namespace ($el), $el, \%attrs, $self);
164			$node->append_raw ($p->original_string);
165			if (not @{$self->{nodestack}}) {
166			$self->{stream_cb}->($node);
167			}
168			push @{$self->{nodestack}}, $node;
169	elmex	1.1	}
170
171			sub cb_char_data {
172			my ($self, $p, $str) = @_;
173			unless (@{$self->{nodestack}}) {
174			warn "characters outside of tag: [$str]!\n";
175			return;
176			}
177	elmex	1.9	my $node = $self->{nodestack}->[-1];
178			$node->add_text ($str);
179			$node->append_raw ($p->original_string);
180	elmex	1.1	}
181
182			sub cb_end_tag {
183			my ($self, $p, $el) = @_;
184
185			unless (@{$self->{nodestack}}) {
186			warn "end tag </$el> read without any starting tag!\n";
187			return;
188			}
189
190			if (!$p->eq_name ($self->{nodestack}->[-1]->name, $el)) {
191			warn "end tag </$el> doesn't match start tags ($self->{tags}->[-1]->[0])!\n";
192			return;
193			}
194
195			my $node = pop @{$self->{nodestack}};
196	elmex	1.9	$node->append_raw ($p->original_string);
197	elmex	1.1
198			# > 1 because we don't want the stream tag to save all our children...
199			if (@{$self->{nodestack}} > 1) {
200			$self->{nodestack}->[-1]->add_node ($node);
201			}
202
203	elmex	1.8	eval {
204			if (@{$self->{nodestack}} == 1) {
205			$self->{stanza_cb}->($self, $node);
206			} elsif (@{$self->{nodestack}} == 0) {
207			$self->{stanza_cb}->($self, undef);
208			}
209			};
210			if ($@) {
211			$self->{error_cb}->($@, undef, 'exception');
212	elmex	1.1	}
213			}
214
215	elmex	1.6	=back
216
217	elmex	1.1	=head1 AUTHOR
218
219	elmex	1.6	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
220	elmex	1.1
221			=head1 COPYRIGHT & LICENSE
222
223			Copyright 2007 Robin Redeker, all rights reserved.
224
225			This program is free software; you can redistribute it and/or modify it
226			under the same terms as Perl itself.
227
228			=cut
229
230			1; # End of Net::XMPP2