ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/Net-XMPP2/lib/Net/XMPP2/Error.pm
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...

File Contents

# Content
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 package Net::XMPP2::Error::Stream;
188 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 sub name { $_[0]->{error_name} }
274
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 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 =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