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::Stanza;
our @ISA = qw/Net::XMPP2::Error/;

=head1 SUBCLASS

Net::XMPP2::Error::Stanza - Stanza errors

=cut

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

   unless (defined $node) {
      $self->{error_cond} = 'client-timeout';
      $self->{error_type} = 'cancel';
      return;
   }

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

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

   $self->{error_type} = $err->attr ('type');
   $self->{error_code} = $err->attr ('code');

   if (my ($txt) = $err->find_all ([qw/stanzas text/])) {
      $self->{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->{error_cond}      = $er;
         $self->{error_cond_node} = $el;
         last;
      }
   }
}

=head2 METHODS

=head3 xml_node ()

Returns the L<Net::XMPP2::Node> object for this Stanza error.
This method returns undef if the Stanza timeouted.

In the case of a timeout the C<condition> method returns C<client-timeout>,
C<type> returns 'cancel' and C<code> undef.

=cut

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

=head3 

=head3 type ()

This method returns one of:

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

=cut

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

=head3 code ()

This method returns the error code if one was found.

=cut

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

=head3 condition ()

Returns the error condition string if one was found when receiving the Stanza 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]->{error_cond} }

=head3 condition_node ()

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

=cut

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

=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 "stanza error: %s/%s (type %s): %s",
      $self->code || '',
      $self->condition || '',
      $self->type,
      $self->text
}

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

=head1 SUBCLASS

Net::XMPP2::Error::Presence - Message errors

(Subclass of L<Net::XMPP2::Error::Stanza>)

=cut

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

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

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

=head1 SUBCLASS

Net::XMPP2::Error::Message - Message errors

(Subclass of L<Net::XMPP2::Error::Stanza>)

=cut

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

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

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

=head1 SUBCLASS

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

(Subclass of L<Net::XMPP2::Error::Stanza>)

=cut

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

   unless (defined $node) {
      $self->{error_cond} = 'client-timeout';
      $self->{error_type} = 'cancel';
      return;
   }

   $self->SUPER::init;
}

=head3 condition ()

Same as L<Net::XMPP2::Error::Stanza> except that
in case of a IQ timeout it returns:

   'client-timeout'

=cut

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/streams 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/)
   {
      if (my (@n) = $node->find_all ([streams => $er])) {
         $error = $n[0]->name;
         last;
      }
   }

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

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

=head2 METHODS

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

=head2 METHODS

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

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

=head1 SUBCLASS

Net::XMPP2::Error::Register - In band registration error

=cut

=head2 METHODS

=head3 register_state ()

Returns the state of registration, one of:

   form-request
   form-submitted

=cut

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

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

   sprintf "ibb registration error (in %s): %s",
      $self->register_state,
      $self->SUPER::string
}

=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.6
Committed:	Tue Jul 3 14:00:52 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.5:	+104 -22 lines
Log Message:	implemented stanza errors
#	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	elmex	1.6	package Net::XMPP2::Error::Stanza;
53	elmex	1.1	our @ISA = qw/Net::XMPP2::Error/;
54
55			=head1 SUBCLASS
56
57	elmex	1.6	Net::XMPP2::Error::Stanza - Stanza errors
58	elmex	1.1
59			=cut
60
61			sub init {
62			my ($self) = @_;
63			my $node = $self->xml_node;
64
65	elmex	1.4	unless (defined $node) {
66	elmex	1.6	$self->{error_cond} = 'client-timeout';
67			$self->{error_type} = 'cancel';
68	elmex	1.4	return;
69			}
70
71	elmex	1.1	my @error;
72			my ($err) = $node->find_all ([qw/client error/]);
73
74			unless ($err) {
75			warn "No error element found in error stanza!";
76	elmex	1.6	$self->{text} = "Unknown Stanza error";
77	elmex	1.1	return
78			}
79
80	elmex	1.6	$self->{error_type} = $err->attr ('type');
81			$self->{error_code} = $err->attr ('code');
82	elmex	1.1
83			if (my ($txt) = $err->find_all ([qw/stanzas text/])) {
84	elmex	1.6	$self->{error_text} = $txt->text;
85	elmex	1.1	}
86
87			for my $er (
88			qw/bad-request conflict feature-not-implemented forbidden
89			gone internal-server-error item-not-found jid-malformed
90			not-acceptable not-allowed not-authorized payment-required
91			recipient-unavailable redirect registration-required
92			remote-server-not-found remote-server-timeout resource-constraint
93			service-unavailable subscription-required undefined-condition
94			unexpected-request/)
95			{
96			if (my ($el) = $err->find_all ([stanzas => $er])) {
97	elmex	1.6	$self->{error_cond} = $er;
98			$self->{error_cond_node} = $el;
99	elmex	1.1	last;
100			}
101			}
102			}
103
104			=head2 METHODS
105
106			=head3 xml_node ()
107
108	elmex	1.6	Returns the L<Net::XMPP2::Node> object for this Stanza error.
109			This method returns undef if the Stanza timeouted.
110	elmex	1.4
111			In the case of a timeout the C<condition> method returns C<client-timeout>,
112			C<type> returns 'cancel' and C<code> undef.
113	elmex	1.1
114			=cut
115
116			sub xml_node {
117			$_[0]->{node}
118			}
119
120	elmex	1.4	=head3
121
122	elmex	1.1	=head3 type ()
123
124			This method returns one of:
125
126			'cancel', 'continue', 'modify', 'auth' and 'wait'
127
128			=cut
129
130	elmex	1.6	sub type { $_[0]->{error_type} }
131	elmex	1.1
132			=head3 code ()
133
134			This method returns the error code if one was found.
135
136			=cut
137
138	elmex	1.6	sub code { $_[0]->{error_code} }
139	elmex	1.1
140	elmex	1.4	=head3 condition ()
141	elmex	1.1
142	elmex	1.6	Returns the error condition string if one was found when receiving the Stanza error.
143	elmex	1.1	It can be undef or one of:
144
145			bad-request
146			conflict
147			feature-not-implemented
148			forbidden
149			gone
150			internal-server-error
151			item-not-found
152			jid-malformed
153			not-acceptable
154			not-allowed
155			not-authorized
156			payment-required
157			recipient-unavailable
158			redirect
159			registration-required
160			remote-server-not-found
161			remote-server-timeout
162			resource-constraint
163			service-unavailable
164			subscription-required
165			undefined-condition
166			unexpected-request
167
168	elmex	1.4
169	elmex	1.1	=cut
170
171	elmex	1.6	sub condition { $_[0]->{error_cond} }
172	elmex	1.1
173			=head3 condition_node ()
174
175	elmex	1.6	Returns the error condition node if one was found when receiving the Stanza error.
176	elmex	1.1	This is mostly for debugging purposes.
177
178			=cut
179
180	elmex	1.6	sub condition_node { $_[0]->{error_cond_node} }
181	elmex	1.1
182			=head3 text ()
183
184			The humand readable error portion. Might be undef if none was received.
185
186			=cut
187
188	elmex	1.6	sub text { $_[0]->{error_text} }
189
190			sub string {
191			my ($self) = @_;
192
193			sprintf "stanza error: %s/%s (type %s): %s",
194			$self->code \|\| '',
195			$self->condition \|\| '',
196			$self->type,
197			$self->text
198			}
199
200			package Net::XMPP2::Error::Presence;
201			our @ISA = qw/Net::XMPP2::Error::Stanza/;
202
203			=head1 SUBCLASS
204
205			Net::XMPP2::Error::Presence - Message errors
206
207			(Subclass of L<Net::XMPP2::Error::Stanza>)
208
209			=cut
210
211			sub string {
212			my ($self) = @_;
213
214			sprintf "presence error: %s/%s (type %s): %s",
215			$self->code \|\| '',
216			$self->condition \|\| '',
217			$self->type,
218			$self->text
219			}
220
221			package Net::XMPP2::Error::Message;
222			our @ISA = qw/Net::XMPP2::Error::Stanza/;
223
224			=head1 SUBCLASS
225
226			Net::XMPP2::Error::Message - Message errors
227
228			(Subclass of L<Net::XMPP2::Error::Stanza>)
229
230			=cut
231
232			sub string {
233			my ($self) = @_;
234
235			sprintf "message error: %s/%s (type %s): %s",
236			$self->code \|\| '',
237			$self->condition \|\| '',
238			$self->type,
239			$self->text
240			}
241
242			package Net::XMPP2::Error::IQ;
243			our @ISA = qw/Net::XMPP2::Error::Stanza/;
244
245			=head1 SUBCLASS
246
247			Net::XMPP2::Error::IQ - IQ errors
248
249			(Subclass of L<Net::XMPP2::Error::Stanza>)
250
251			=cut
252
253			sub init {
254			my ($self) = @_;
255			my $node = $self->xml_node;
256
257			unless (defined $node) {
258			$self->{error_cond} = 'client-timeout';
259			$self->{error_type} = 'cancel';
260			return;
261			}
262
263			$self->SUPER::init;
264			}
265
266			=head3 condition ()
267
268			Same as L<Net::XMPP2::Error::Stanza> except that
269			in case of a IQ timeout it returns:
270
271			'client-timeout'
272
273			=cut
274	elmex	1.1
275			sub string {
276			my ($self) = @_;
277
278			sprintf "iq error: %s/%s (type %s): %s",
279			$self->code \|\| '',
280			$self->condition \|\| '',
281			$self->type,
282			$self->text
283			}
284
285	elmex	1.2	package Net::XMPP2::Error::Stream;
286	elmex	1.1	our @ISA = qw/Net::XMPP2::Error/;
287
288			=head1 SUBCLASS
289
290			Net::XMPP2::Error::Stream - XML Stream errors
291
292			=cut
293
294			sub init {
295			my ($self) = @_;
296			my $node = $self->xml_node;
297
298	elmex	1.5	my @txt = $node->find_all ([qw/streams text/]);
299	elmex	1.1	my $error;
300			for my $er (
301			qw/bad-format bad-namespace-prefix conflict connection-timeout host-gone
302			host-unknown improper-addressing internal-server-error invalid-from
303			invalid-id invalid-namespace invalid-xml not-authorized policy-violation
304			remote-connection-failed resource-constraint restricted-xml
305			see-other-host system-shutdown undefined-condition unsupported-stanza-type
306			unsupported-version xml-not-well-formed/)
307			{
308	elmex	1.5	if (my (@n) = $node->find_all ([streams => $er])) {
309			$error = $n[0]->name;
310			last;
311	elmex	1.1	}
312			}
313
314			unless ($error) {
315			#d# warn "got undefined error stanza, trying to find any undefined error...";
316	elmex	1.5	for my $n ($node->nodes) {
317			if ($n->eq_ns ('streams')) {
318			$error = $n->name;
319	elmex	1.1	}
320			}
321			}
322
323			$self->{error_name} = $error;
324			$self->{error_text} = @txt ? $txt[0]->text : '';
325			}
326
327	elmex	1.3	=head2 METHODS
328
329	elmex	1.1	=head3 xml_node ()
330
331			Returns the L<Net::XMPP2::Node> object for this stream error.
332
333			=cut
334
335			sub xml_node {
336			$_[0]->{node}
337			}
338
339			=head3 name ()
340
341			Returns the name of the error. That might be undef, one of the following
342			strings or some other string that has been discovered by a heuristic
343			(because some servers send errors that are not in the RFC).
344
345			bad-format
346			bad-namespace-prefix
347			conflict
348			connection-timeout
349			host-gone
350			host-unknown
351			improper-addressing
352			internal-server-error
353			invalid-from
354			invalid-id
355			invalid-namespace
356			invalid-xml
357			not-authorized
358			policy-violation
359			remote-connection-failed
360			resource-constraint
361			restricted-xml
362			see-other-host
363			system-shutdown
364			undefined-condition
365			unsupported-stanza-type
366			unsupported-version
367			xml-not-well-formed
368
369			=cut
370
371	elmex	1.2	sub name { $_[0]->{error_name} }
372	elmex	1.1
373			=head3 text ()
374
375			The humand readable error portion. Might be undef if none was received.
376
377			=cut
378
379			sub text { $_[0]->{error_text} }
380
381			sub string {
382			my ($self) = @_;
383
384	elmex	1.5	sprintf ("stream error: %s: %s",
385	elmex	1.1	$self->name,
386	elmex	1.5	$self->text)
387	elmex	1.1	}
388
389	elmex	1.2	package Net::XMPP2::Error::SASL;
390			our @ISA = qw/Net::XMPP2::Error/;
391
392			=head1 SUBCLASS
393
394			Net::XMPP2::Error::SASL - SASL authentication error
395
396			=cut
397
398			sub init {
399			my ($self) = @_;
400			my $node = $self->xml_node;
401
402			my $error;
403			for ($node->nodes) {
404			$error = $_->name;
405			last
406			}
407
408			$self->{error_cond} = $error;
409			}
410
411	elmex	1.3	=head2 METHODS
412
413	elmex	1.2	=head3 xml_node ()
414
415			Returns the L<Net::XMPP2::Node> object for this stream error.
416
417			=cut
418
419			sub xml_node {
420			$_[0]->{node}
421			}
422
423			=head3 condition ()
424
425			Returns the error condition, which might be one of:
426
427			aborted
428			incorrect-encoding
429			invalid-authzid
430			invalid-mechanism
431			mechanism-too-weak
432			not-authorized
433			temporary-auth-failure
434
435			=cut
436
437			sub condition {
438			$_[0]->{error_cond}
439			}
440
441			sub string {
442			my ($self) = @_;
443
444			sprintf "sasl error: %s",
445			$self->condition
446			}
447
448	elmex	1.3	package Net::XMPP2::Error::Register;
449			our @ISA = qw/Net::XMPP2::Error::IQ/;
450
451			=head1 SUBCLASS
452
453			Net::XMPP2::Error::Register - In band registration error
454
455			=cut
456
457			=head2 METHODS
458
459			=head3 register_state ()
460
461			Returns the state of registration, one of:
462
463			form-request
464			form-submitted
465
466			=cut
467
468			sub register_state {
469			my ($self) = @_;
470			$self->{register_state}
471			}
472
473			sub string {
474			my ($self) = @_;
475
476			sprintf "ibb registration error (in %s): %s",
477			$self->register_state,
478			$self->SUPER::string
479			}
480
481	elmex	1.1	=head1 AUTHOR
482
483			Robin Redeker, C<< <elmex at ta-sa.org> >>
484
485			=head1 COPYRIGHT & LICENSE
486
487			Copyright 2007 Robin Redeker, all rights reserved.
488
489			This program is free software; you can redistribute it and/or modify it
490			under the same terms as Perl itself.
491
492			=cut
493
494			1; # End of Net::XMPP2