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

=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]!" },
      @_
   };
   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<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);
   }
}


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

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