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 - A 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

=head2 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]!" },
      @_
   };
   bless $self, $class;
   $self->init;
   $self
}

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

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

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

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

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


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

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

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}};

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

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

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.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.5
Committed:	Tue Jun 26 08:33:07 2007 UTC (19 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.4:	+26 -2 lines
Log Message:	added xml parser error callback
#	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			Net::XMPP2::Parser - A parser for XML streams (helper for Net::XMPP2)
11
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			=head2 new
26
27			This creates a new Net::XMPP2::Parser and calls C<init>.
28
29			=cut
30
31			sub new {
32			my $this = shift;
33			my $class = ref($this) \|\| $this;
34	elmex	1.5	my $self = {
35			stanza_cb => sub { die "No stanza callback provided!" },
36			error_cb => sub { warn "No error callback provided: $_[0]: $_[1]!" },
37			@_
38			};
39	elmex	1.1	bless $self, $class;
40			$self->init;
41			$self
42			}
43
44			=head2 set_stanza_cb ($cb)
45
46			Sets the 'XML stanza' callback.
47
48			C<$cb> must be a code reference. The first argument to
49			the callback will be this Net::XMPP2::Parser instance and
50			the second will be the stanzas root Net::XMPP2::Node as first argument.
51
52	elmex	1.5	If the second argument is undefined the end of the stream has been found.
53
54	elmex	1.1	=cut
55
56			sub set_stanza_cb {
57			my ($self, $cb) = @_;
58			$self->{stanza_cb} = $cb;
59			}
60
61	elmex	1.5	=head2 set_error_cb ($cb)
62
63			This sets the error callback that will be called when
64			the parser encounters an syntax error. The first argument
65			is the exception and the second is the data which caused the error.
66
67			=cut
68
69			sub set_error_cb {
70			my ($self, $cb) = @_;
71			$self->{error_cb} = $cb;
72			}
73
74	elmex	1.1	=head2 init
75
76			This methods (re)initializes the parser.
77
78			=cut
79
80			sub init {
81			my ($self) = @_;
82			$self->{parser} = XML::Parser::ExpatNB->new (
83			Namespaces => 1,
84			ProtocolEncoding => 'UTF-8'
85			);
86			$self->{parser}->setHandlers (
87			Start => sub { $self->cb_start_tag (@_) },
88			End => sub { $self->cb_end_tag (@_) },
89			Char => sub { $self->cb_char_data (@_) },
90			);
91			$self->{nso} = {};
92			$self->{nodestack} = [];
93			}
94
95			=head2 nseq ($namespace, $tagname, $cmptag)
96
97			This method checks whether the C<$cmptag> matches the C<$tagname>
98			in the C<$namespace>.
99
100			C<$cmptag> needs to come from the XML::Parser::Expat as it has
101			some magic attached that stores the namespace.
102
103			=cut
104
105			sub nseq {
106			my ($self, $ns, $name, $tag) = @_;
107
108			unless (exists $self->{nso}->{$ns}->{$name}) {
109			$self->{nso}->{$ns}->{$name} =
110			$self->{parser}->generate_ns_name ($name, $ns);
111			}
112
113			return $self->{parser}->eq_name ($self->{nso}->{$ns}->{$name}, $tag);
114			}
115
116			=head2 feed ($data)
117
118			This method feeds a chunk of unparsed data to the parser.
119
120			=cut
121
122			sub feed {
123			my ($self, $data) = @_;
124	elmex	1.5	eval {
125			$self->{parser}->parse_more ($data);
126			};
127			if ($@) {
128			$self->{error_cb}->($@, $data);
129			}
130	elmex	1.1	}
131
132
133			sub cb_start_tag {
134			my ($self, $p, $el, %attrs) = @_;
135			push @{$self->{nodestack}}, Net::XMPP2::Node->new ($p->namespace ($el), $el, \%attrs, $self);
136			}
137
138			sub cb_char_data {
139			my ($self, $p, $str) = @_;
140			unless (@{$self->{nodestack}}) {
141			warn "characters outside of tag: [$str]!\n";
142			return;
143			}
144			$self->{nodestack}->[-1]->add_text ($str);
145			}
146
147			sub cb_end_tag {
148			my ($self, $p, $el) = @_;
149
150			unless (@{$self->{nodestack}}) {
151			warn "end tag </$el> read without any starting tag!\n";
152			return;
153			}
154
155			if (!$p->eq_name ($self->{nodestack}->[-1]->name, $el)) {
156			warn "end tag </$el> doesn't match start tags ($self->{tags}->[-1]->[0])!\n";
157			return;
158			}
159
160			my $node = pop @{$self->{nodestack}};
161
162			# > 1 because we don't want the stream tag to save all our children...
163			if (@{$self->{nodestack}} > 1) {
164			$self->{nodestack}->[-1]->add_node ($node);
165			}
166
167			if (@{$self->{nodestack}} == 1) {
168			$self->{stanza_cb}->($self, $node);
169	elmex	1.4	} elsif (@{$self->{nodestack}} == 0) {
170			$self->{stanza_cb}->($self, undef);
171	elmex	1.1	}
172			}
173
174			=head1 AUTHOR
175
176			Robin Redeker, C<< <elmex at ta-sa.org> >>
177
178			=head1 COPYRIGHT & LICENSE
179
180			Copyright 2007 Robin Redeker, all rights reserved.
181
182			This program is free software; you can redistribute it and/or modify it
183			under the same terms as Perl itself.
184
185			=cut
186
187			1; # End of Net::XMPP2