Net/XMPP2/Error.pm

package Net::XMPP2::Error;
use strict;
use Net::XMPP2::Util qw/stringprep_jid prep_bare_jid/;
use Net::XMPP2::Error;

=head1 NAME

Net::XMPP2::Error - An error class hierarchy for error reporting

=head1 SYNOPSIS

   die $error->string;

=head1 DESCRIPTION

This module is a helper class for abstracting any kind
of error that occurs in Net::XMPP2.

You receive instances of these objects by various events.

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = bless { @_ }, $class;
   $self->init;
   $self
}

sub init { }

=head1 SUPER CLASS

Net::XMPP2::Error - The super class of all errors

=head2 METHODS

These methods are implemented by all subclasses.

=head3 string ()

Returns a humand readable string for this error.

=cut

sub string {
   my ($self) = @_;
   $self->{text}
}

package Net::XMPP2::Error::IQ;
our @ISA = qw/Net::XMPP2::Error/;

=head1 SUBCLASS

Net::XMPP2::Error::IQ - IQ errors

=cut

sub init {
   my ($self) = @_;
   my $node = $self->xml_node;

   my @error;
   my ($err) = $node->find_all ([qw/client error/]);

   unless ($err) {
      warn "No error element found in error stanza!";
      $self->{text} = "Unknown IQ error";
      return
   }

   $self->{iq_error_type} = $err->attr ('type');
   $self->{iq_error_code} = $err->attr ('code');

   if (my ($txt) = $err->find_all ([qw/stanzas text/])) {
      $self->{iq_error_text} = $txt->text;
   }

   for my $er (
     qw/bad-request conflict feature-not-implemented forbidden
        gone internal-server-error item-not-found jid-malformed
        not-acceptable not-allowed not-authorized payment-required
        recipient-unavailable redirect registration-required
        remote-server-not-found remote-server-timeout resource-constraint
        service-unavailable subscription-required undefined-condition
        unexpected-request/)
   {
      if (my ($el) = $err->find_all ([stanzas => $er])) {
         $self->{iq_error_cond}      = $er;
         $self->{iq_error_cond_node} = $el;
         last;
      }
   }
}

=head2 METHODS

=head3 xml_node ()

Returns the L<Net::XMPP2::Node> object for this IQ error.

=cut

sub xml_node {
   $_[0]->{node}
}

=head3 type ()

This method returns one of:

   'cancel', 'continue', 'modify', 'auth' and 'wait'

=cut

sub type { $_[0]->{iq_error_type} }

=head3 code ()

This method returns the error code if one was found.

=cut

sub code { $_[0]->{iq_error_code} }

=head3 error_condition ()

Returns the error condition string if one was found when receiving the IQ error.
It can be undef or one of:

   bad-request
   conflict
   feature-not-implemented
   forbidden
   gone
   internal-server-error
   item-not-found
   jid-malformed
   not-acceptable
   not-allowed
   not-authorized
   payment-required
   recipient-unavailable
   redirect
   registration-required
   remote-server-not-found
   remote-server-timeout
   resource-constraint
   service-unavailable
   subscription-required
   undefined-condition
   unexpected-request

=cut

sub condition { $_[0]->{iq_error_cond} }

=head3 condition_node ()

Returns the error condition node if one was found when receiving the IQ error.
This is mostly for debugging purposes.

=cut

sub condition_node { $_[0]->{iq_error_cond_node} }

=head3 text ()

The humand readable error portion. Might be undef if none was received.

=cut

sub text { $_[0]->{iq_error_text} }

sub string {
   my ($self) = @_;

   sprintf "iq error: %s/%s (type %s): %s",
      $self->code || '',
      $self->condition || '',
      $self->type,
      $self->text
}

package Net::XMPP2::Error::Stream;
our @ISA = qw/Net::XMPP2::Error/;

=head1 SUBCLASS

Net::XMPP2::Error::Stream - XML Stream errors

=cut

sub init {
   my ($self) = @_;
   my $node = $self->xml_node;

   my @txt = $node->find_all ([qw/stream text/]);
   my $error;
   for my $er (
      qw/bad-format bad-namespace-prefix conflict connection-timeout host-gone
         host-unknown improper-addressing internal-server-error invalid-from
         invalid-id invalid-namespace invalid-xml not-authorized policy-violation
         remote-connection-failed resource-constraint restricted-xml
         see-other-host system-shutdown undefined-condition unsupported-stanza-type
         unsupported-version xml-not-well-formed/)
   {
      for ($node->nodes) {
         if ($node->eq (streams => $er)) {
            $error = $_->name;
            last
         }
      }
   }

   unless ($error) {
      #d# warn "got undefined error stanza, trying to find any undefined error...";
      for ($node->nodes) {
         if ($node->eq_ns ('streams')) {
            $error = $node->name;
         }
      }
   }

   $self->{error_name} = $error;
   $self->{error_text} = @txt ? $txt[0]->text : '';
}

=head3 xml_node ()

Returns the L<Net::XMPP2::Node> object for this stream error.

=cut

sub xml_node {
   $_[0]->{node}
}

=head3 name ()

Returns the name of the error. That might be undef, one of the following
strings or some other string that has been discovered by a heuristic
(because some servers send errors that are not in the RFC).

   bad-format
   bad-namespace-prefix
   conflict
   connection-timeout
   host-gone
   host-unknown
   improper-addressing
   internal-server-error
   invalid-from
   invalid-id
   invalid-namespace
   invalid-xml
   not-authorized
   policy-violation
   remote-connection-failed
   resource-constraint
   restricted-xml
   see-other-host
   system-shutdown
   undefined-condition
   unsupported-stanza-type
   unsupported-version
   xml-not-well-formed

=cut

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

=head3 text ()

The humand readable error portion. Might be undef if none was received.

=cut

sub text { $_[0]->{error_text} }

sub string {
   my ($self) = @_;

   sprintf "stream error: %s: %s",
      $self->name,
      $self->text
}

package Net::XMPP2::Error::SASL;
our @ISA = qw/Net::XMPP2::Error/;

=head1 SUBCLASS

Net::XMPP2::Error::SASL - SASL authentication error

=cut

sub init {
   my ($self) = @_;
   my $node = $self->xml_node;

   my $error;
   for ($node->nodes) {
      $error = $_->name;
      last
   }

   $self->{error_cond} = $error;
}

=head3 xml_node ()

Returns the L<Net::XMPP2::Node> object for this stream error.

=cut

sub xml_node {
   $_[0]->{node}
}

=head3 condition ()

Returns the error condition, which might be one of:

   aborted
   incorrect-encoding
   invalid-authzid
   invalid-mechanism
   mechanism-too-weak
   not-authorized
   temporary-auth-failure

=cut

sub condition {
   $_[0]->{error_cond}
}

sub string {
   my ($self) = @_;

   sprintf "sasl error: %s",
      $self->condition
}

=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.2
Committed:	Sat Apr 21 13:51:39 2007 UTC (19 years, 5 months ago) by elmex
Branch:	MAIN
Changes since 1.1:	+59 -3 lines
Log Message:	implemented the (hopefully) last bits of important error reporting. Net::XMPP was released at the beginngin of this month - damn, i was too slow. But i've taken a look at their code. 17000 lines of code vs. my ~4500 LoC. Also their Java-API is really a mess...
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::Error;
2			use strict;
3			use Net::XMPP2::Util qw/stringprep_jid prep_bare_jid/;
4			use Net::XMPP2::Error;
5
6			=head1 NAME
7
8			Net::XMPP2::Error - An error class hierarchy for error reporting
9
10			=head1 SYNOPSIS
11
12			die $error->string;
13
14			=head1 DESCRIPTION
15
16			This module is a helper class for abstracting any kind
17			of error that occurs in Net::XMPP2.
18
19			You receive instances of these objects by various events.
20
21			=cut
22
23			sub new {
24			my $this = shift;
25			my $class = ref($this) \|\| $this;
26			my $self = bless { @_ }, $class;
27			$self->init;
28			$self
29			}
30
31			sub init { }
32
33			=head1 SUPER CLASS
34
35			Net::XMPP2::Error - The super class of all errors
36
37			=head2 METHODS
38
39			These methods are implemented by all subclasses.
40
41			=head3 string ()
42
43			Returns a humand readable string for this error.
44
45			=cut
46
47			sub string {
48			my ($self) = @_;
49			$self->{text}
50			}
51
52			package Net::XMPP2::Error::IQ;
53			our @ISA = qw/Net::XMPP2::Error/;
54
55			=head1 SUBCLASS
56
57			Net::XMPP2::Error::IQ - IQ errors
58
59			=cut
60
61			sub init {
62			my ($self) = @_;
63			my $node = $self->xml_node;
64
65			my @error;
66			my ($err) = $node->find_all ([qw/client error/]);
67
68			unless ($err) {
69			warn "No error element found in error stanza!";
70			$self->{text} = "Unknown IQ error";
71			return
72			}
73
74			$self->{iq_error_type} = $err->attr ('type');
75			$self->{iq_error_code} = $err->attr ('code');
76
77			if (my ($txt) = $err->find_all ([qw/stanzas text/])) {
78			$self->{iq_error_text} = $txt->text;
79			}
80
81			for my $er (
82			qw/bad-request conflict feature-not-implemented forbidden
83			gone internal-server-error item-not-found jid-malformed
84			not-acceptable not-allowed not-authorized payment-required
85			recipient-unavailable redirect registration-required
86			remote-server-not-found remote-server-timeout resource-constraint
87			service-unavailable subscription-required undefined-condition
88			unexpected-request/)
89			{
90			if (my ($el) = $err->find_all ([stanzas => $er])) {
91			$self->{iq_error_cond} = $er;
92			$self->{iq_error_cond_node} = $el;
93			last;
94			}
95			}
96			}
97
98			=head2 METHODS
99
100			=head3 xml_node ()
101
102			Returns the L<Net::XMPP2::Node> object for this IQ error.
103
104			=cut
105
106			sub xml_node {
107			$_[0]->{node}
108			}
109
110			=head3 type ()
111
112			This method returns one of:
113
114			'cancel', 'continue', 'modify', 'auth' and 'wait'
115
116			=cut
117
118			sub type { $_[0]->{iq_error_type} }
119
120			=head3 code ()
121
122			This method returns the error code if one was found.
123
124			=cut
125
126			sub code { $_[0]->{iq_error_code} }
127
128			=head3 error_condition ()
129
130			Returns the error condition string if one was found when receiving the IQ error.
131			It can be undef or one of:
132
133			bad-request
134			conflict
135			feature-not-implemented
136			forbidden
137			gone
138			internal-server-error
139			item-not-found
140			jid-malformed
141			not-acceptable
142			not-allowed
143			not-authorized
144			payment-required
145			recipient-unavailable
146			redirect
147			registration-required
148			remote-server-not-found
149			remote-server-timeout
150			resource-constraint
151			service-unavailable
152			subscription-required
153			undefined-condition
154			unexpected-request
155
156			=cut
157
158			sub condition { $_[0]->{iq_error_cond} }
159
160			=head3 condition_node ()
161
162			Returns the error condition node if one was found when receiving the IQ error.
163			This is mostly for debugging purposes.
164
165			=cut
166
167			sub condition_node { $_[0]->{iq_error_cond_node} }
168
169			=head3 text ()
170
171			The humand readable error portion. Might be undef if none was received.
172
173			=cut
174
175			sub text { $_[0]->{iq_error_text} }
176
177			sub string {
178			my ($self) = @_;
179
180			sprintf "iq error: %s/%s (type %s): %s",
181			$self->code \|\| '',
182			$self->condition \|\| '',
183			$self->type,
184			$self->text
185			}
186
187	elmex	1.2	package Net::XMPP2::Error::Stream;
188	elmex	1.1	our @ISA = qw/Net::XMPP2::Error/;
189
190			=head1 SUBCLASS
191
192			Net::XMPP2::Error::Stream - XML Stream errors
193
194			=cut
195
196			sub init {
197			my ($self) = @_;
198			my $node = $self->xml_node;
199
200			my @txt = $node->find_all ([qw/stream text/]);
201			my $error;
202			for my $er (
203			qw/bad-format bad-namespace-prefix conflict connection-timeout host-gone
204			host-unknown improper-addressing internal-server-error invalid-from
205			invalid-id invalid-namespace invalid-xml not-authorized policy-violation
206			remote-connection-failed resource-constraint restricted-xml
207			see-other-host system-shutdown undefined-condition unsupported-stanza-type
208			unsupported-version xml-not-well-formed/)
209			{
210			for ($node->nodes) {
211			if ($node->eq (streams => $er)) {
212			$error = $_->name;
213			last
214			}
215			}
216			}
217
218			unless ($error) {
219			#d# warn "got undefined error stanza, trying to find any undefined error...";
220			for ($node->nodes) {
221			if ($node->eq_ns ('streams')) {
222			$error = $node->name;
223			}
224			}
225			}
226
227			$self->{error_name} = $error;
228			$self->{error_text} = @txt ? $txt[0]->text : '';
229			}
230
231			=head3 xml_node ()
232
233			Returns the L<Net::XMPP2::Node> object for this stream error.
234
235			=cut
236
237			sub xml_node {
238			$_[0]->{node}
239			}
240
241			=head3 name ()
242
243			Returns the name of the error. That might be undef, one of the following
244			strings or some other string that has been discovered by a heuristic
245			(because some servers send errors that are not in the RFC).
246
247			bad-format
248			bad-namespace-prefix
249			conflict
250			connection-timeout
251			host-gone
252			host-unknown
253			improper-addressing
254			internal-server-error
255			invalid-from
256			invalid-id
257			invalid-namespace
258			invalid-xml
259			not-authorized
260			policy-violation
261			remote-connection-failed
262			resource-constraint
263			restricted-xml
264			see-other-host
265			system-shutdown
266			undefined-condition
267			unsupported-stanza-type
268			unsupported-version
269			xml-not-well-formed
270
271			=cut
272
273	elmex	1.2	sub name { $_[0]->{error_name} }
274	elmex	1.1
275			=head3 text ()
276
277			The humand readable error portion. Might be undef if none was received.
278
279			=cut
280
281			sub text { $_[0]->{error_text} }
282
283			sub string {
284			my ($self) = @_;
285
286			sprintf "stream error: %s: %s",
287			$self->name,
288			$self->text
289			}
290
291	elmex	1.2	package Net::XMPP2::Error::SASL;
292			our @ISA = qw/Net::XMPP2::Error/;
293
294			=head1 SUBCLASS
295
296			Net::XMPP2::Error::SASL - SASL authentication error
297
298			=cut
299
300			sub init {
301			my ($self) = @_;
302			my $node = $self->xml_node;
303
304			my $error;
305			for ($node->nodes) {
306			$error = $_->name;
307			last
308			}
309
310			$self->{error_cond} = $error;
311			}
312
313			=head3 xml_node ()
314
315			Returns the L<Net::XMPP2::Node> object for this stream error.
316
317			=cut
318
319			sub xml_node {
320			$_[0]->{node}
321			}
322
323			=head3 condition ()
324
325			Returns the error condition, which might be one of:
326
327			aborted
328			incorrect-encoding
329			invalid-authzid
330			invalid-mechanism
331			mechanism-too-weak
332			not-authorized
333			temporary-auth-failure
334
335			=cut
336
337			sub condition {
338			$_[0]->{error_cond}
339			}
340
341			sub string {
342			my ($self) = @_;
343
344			sprintf "sasl error: %s",
345			$self->condition
346			}
347
348	elmex	1.1	=head1 AUTHOR
349
350			Robin Redeker, C<< <elmex at ta-sa.org> >>
351
352			=head1 COPYRIGHT & LICENSE
353
354			Copyright 2007 Robin Redeker, all rights reserved.
355
356			This program is free software; you can redistribute it and/or modify it
357			under the same terms as Perl itself.
358
359			=cut
360
361			1; # End of Net::XMPP2