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 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!" }, @_ };
   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.

=cut

sub set_stanza_cb {
   my ($self, $cb) = @_;
   $self->{stanza_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) = @_;
   $self->{parser}->parse_more ($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);
   }
}

=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.1
Committed:	Tue Jan 23 15:56:47 2007 UTC (19 years, 8 months ago) by elmex
Branch:	MAIN
Log Message:	initial checkin.
#	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			=head1 METHODS
18
19			=head2 new
20
21			This creates a new Net::XMPP2::Parser and calls C<init>.
22
23			=cut
24
25			sub new {
26			my $this = shift;
27			my $class = ref($this) \|\| $this;
28			my $self = { stanza_cb => sub { die "No stanza callback provided!" }, @_ };
29			bless $self, $class;
30			$self->init;
31			$self
32			}
33
34			=head2 set_stanza_cb ($cb)
35
36			Sets the 'XML stanza' callback.
37
38			C<$cb> must be a code reference. The first argument to
39			the callback will be this Net::XMPP2::Parser instance and
40			the second will be the stanzas root Net::XMPP2::Node as first argument.
41
42			=cut
43
44			sub set_stanza_cb {
45			my ($self, $cb) = @_;
46			$self->{stanza_cb} = $cb;
47			}
48
49			=head2 init
50
51			This methods (re)initializes the parser.
52
53			=cut
54
55			sub init {
56			my ($self) = @_;
57			$self->{parser} = XML::Parser::ExpatNB->new (
58			Namespaces => 1,
59			ProtocolEncoding => 'UTF-8'
60			);
61			$self->{parser}->setHandlers (
62			Start => sub { $self->cb_start_tag (@_) },
63			End => sub { $self->cb_end_tag (@_) },
64			Char => sub { $self->cb_char_data (@_) },
65			);
66			$self->{nso} = {};
67			$self->{nodestack} = [];
68			}
69
70			=head2 nseq ($namespace, $tagname, $cmptag)
71
72			This method checks whether the C<$cmptag> matches the C<$tagname>
73			in the C<$namespace>.
74
75			C<$cmptag> needs to come from the XML::Parser::Expat as it has
76			some magic attached that stores the namespace.
77
78			=cut
79
80			sub nseq {
81			my ($self, $ns, $name, $tag) = @_;
82
83			unless (exists $self->{nso}->{$ns}->{$name}) {
84			$self->{nso}->{$ns}->{$name} =
85			$self->{parser}->generate_ns_name ($name, $ns);
86			}
87
88			return $self->{parser}->eq_name ($self->{nso}->{$ns}->{$name}, $tag);
89			}
90
91			=head2 feed ($data)
92
93			This method feeds a chunk of unparsed data to the parser.
94
95			=cut
96
97			sub feed {
98			my ($self, $data) = @_;
99			$self->{parser}->parse_more ($data);
100			}
101
102
103			sub cb_start_tag {
104			my ($self, $p, $el, %attrs) = @_;
105			push @{$self->{nodestack}}, Net::XMPP2::Node->new ($p->namespace ($el), $el, \%attrs, $self);
106			}
107
108			sub cb_char_data {
109			my ($self, $p, $str) = @_;
110			unless (@{$self->{nodestack}}) {
111			warn "characters outside of tag: [$str]!\n";
112			return;
113			}
114			$self->{nodestack}->[-1]->add_text ($str);
115			}
116
117			sub cb_end_tag {
118			my ($self, $p, $el) = @_;
119
120			unless (@{$self->{nodestack}}) {
121			warn "end tag </$el> read without any starting tag!\n";
122			return;
123			}
124
125			if (!$p->eq_name ($self->{nodestack}->[-1]->name, $el)) {
126			warn "end tag </$el> doesn't match start tags ($self->{tags}->[-1]->[0])!\n";
127			return;
128			}
129
130			my $node = pop @{$self->{nodestack}};
131
132			# > 1 because we don't want the stream tag to save all our children...
133			if (@{$self->{nodestack}} > 1) {
134			$self->{nodestack}->[-1]->add_node ($node);
135			}
136
137			if (@{$self->{nodestack}} == 1) {
138			$self->{stanza_cb}->($self, $node);
139			}
140			}
141
142			=head1 AUTHOR
143
144			Robin Redeker, C<< <elmex at ta-sa.org> >>
145
146			=head1 BUGS
147
148			Please report any bugs or feature requests to
149			C<bug-net-xmpp2 at rt.cpan.org>, or through the web interface at
150			L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-XMPP2>.
151			I will be notified, and then you'll automatically be notified of progress on
152			your bug as I make changes.
153
154			=head1 SUPPORT
155
156			You can find documentation for this module with the perldoc command.
157
158			perldoc Net::XMPP2
159
160			You can also look for information at:
161
162			=over 4
163
164			=item * AnnoCPAN: Annotated CPAN documentation
165
166			L<http://annocpan.org/dist/Net-XMPP2>
167
168			=item * CPAN Ratings
169
170			L<http://cpanratings.perl.org/d/Net-XMPP2>
171
172			=item * RT: CPAN's request tracker
173
174			L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-XMPP2>
175
176			=item * Search CPAN
177
178			L<http://search.cpan.org/dist/Net-XMPP2>
179
180			=back
181
182			=head1 ACKNOWLEDGEMENTS
183
184			=head1 COPYRIGHT & LICENSE
185
186			Copyright 2007 Robin Redeker, all rights reserved.
187
188			This program is free software; you can redistribute it and/or modify it
189			under the same terms as Perl itself.
190
191			=cut
192
193			1; # End of Net::XMPP2