1## Domain Registry Interface, Encapsulatng errors (fatal or not) as exceptions in an OO way
2##
3## Copyright (c) 2005,2007,2008,2009 Patrick Mevzek <netdri@dotandco.com>. All rights reserved.
4##
5## This file is part of Net::DRI
6##
7## Net::DRI is free software; you can redistribute it and/or modify
8## it under the terms of the GNU General Public License as published by
9## the Free Software Foundation; either version 2 of the License, or
10## (at your option) any later version.
11##
12## See the LICENSE file that comes with this distribution for more details.
13#
14#
15#
16####################################################################################################
17
18package Net::DRI::Exception;
19
20use strict;
21
22use Carp;
23
24our $VERSION=do { my @r=(q$Revision: 1.8 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); };
25
26=pod
27
28=head1 NAME
29
30Net::DRI::Exception - Class to store all exceptions inside Net::DRI
31
32=head1 SYNOPSIS
33
34 my $s=Net::DRI::Exception->new(0,'area',500,'message');
35 die($s);
36 ## OR
37 Net::DRI::Exception->die(0,'area',500,'message');
38
39 $s->is_error(); ## gives 0 or 1, first argument of new/die
40 ## (internal error that should not happen are 1, others are 0)
41
42 $s->area(); ## gives back the area (second argument of new/die)
43
44 $s->code(); ## gives back the code (third argument of new/die)
45
46 $s->msg(); ## gives back the message (fourth argument of new/die)
47
48 $s->as_string(); ## gives back a nicely formatted full backtrace
49
50=head1 SUPPORT
51
52For now, support questions should be sent to:
53
54E<lt>netdri@dotandco.comE<gt>
55
56Please also see the SUPPORT file in the distribution.
57
58=head1 SEE ALSO
59
60E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt>
61
62=head1 AUTHOR
63
64Patrick Mevzek, E<lt>netdri@dotandco.comE<gt>
65
66=head1 COPYRIGHT
67
68Copyright (c) 2005,2007,2008,2009 Patrick Mevzek <netdri@dotandco.com>. All rights reserved.
69
70This program is free software; you can redistribute it and/or modify
71it under the terms of the GNU General Public License as published by
72the Free Software Foundation; either version 2 of the License, or
73(at your option) any later version.
74
75See the LICENSE file that comes with this distribution for more details.
76
77=cut
78
79####################################################################################################
80
81sub new
82{
83 my $proto=shift;
84 my $class=ref($proto) || $proto;
85 my ($error,$area,$code,$msg)=@_;
86 my $self={ is_error => (defined($error)? $error : 1 ),
87            area     => $area || '?',
88            code     => $code || 0,
89            msg      => $msg || '',
90          };
91
92 $self->{bt}=Carp::longmess();
93
94 bless($self,$class);
95 return $self;
96}
97
98sub die { die(new(@_)); }
99
100sub is_error { return shift->{is_error}; }
101sub area     { return shift->{area};     }
102sub code     { return shift->{code};     }
103sub msg      { return shift->{msg};      }
104
105sub backtrace
106{
107 my $self=shift;
108 my $m=$self->{bt};
109 my (@bt1,@bt2);
110 foreach (split(/\n/,$m)) { if (/^\s*Net::DRI::(?:BaseClass|Exception)::/) { push @bt1,$_; } else { push @bt2,$_; } }
111 shift(@bt2) if ($bt2[0]=~m!Net/DRI/BaseClass!);
112 shift(@bt2) if ($bt2[0]=~m!Net/DRI/Exception!);
113 my ($f,$l);
114 if (@bt1)
115 {
116  ($f,$l)=(pop(@bt1)=~m/ called at (\S+) line (\d+)\s*$/);
117 } else
118 {
119  ($f,$l)=(shift(@bt2)=~m/ at (\S+) line (\d+)\s*$/);
120 }
121 my @b;
122 push @b,sprintf('EXCEPTION %d@%s from line %d of file %s:',$self->code(),$self->area(),$l,$f);
123 push @b,$self->msg();
124 return (@b,@bt2);
125}
126
127## Do not parse result of this call. If needed, use accessors above (is_error(), area(), code(), msg())
128sub as_string
129{
130 my $self=shift;
131 return join("\n",$self->backtrace())."\n";
132}
133
134sub print
135{
136 print shift->as_string();
137}
138
139####################################################################################################
140
141sub err_failed_load_module { my ($w,$m,$e)=@_; Net::DRI::Exception->die(1,$w,8,'Failed to load Perl module '.$m.' : '.(ref($e)? $e->as_string() : $e)); }
142sub err_method_not_implemented  { Net::DRI::Exception->die(1,'internal',1,'Method not implemented'.($_[0]? ': '.$_[0] : '')); }
143sub err_insufficient_parameters { Net::DRI::Exception->die(1,'internal',2,'Insufficient parameters'.($_[0]? ': '.$_[0] : '')); }
144sub err_invalid_parameters      { Net::DRI::Exception->die(1,'internal',3,'Invalid parameters'.($_[0]? ': '.$_[0] : '')); }
145
146sub usererr_insufficient_parameters { Net::DRI::Exception->die(0,'internal',2,'Insufficient parameters'.($_[0]? ': '.$_[0] : '')); }
147sub usererr_invalid_parameters      { Net::DRI::Exception->die(0,'internal',3,'Invalid parameters'.($_[0]? ': '.$_[0] : '')); }
148
149sub err_assert { Net::DRI::Exception->die(1,'internal',4,'Assert failed'.($_[0]? ': '.$_[0] : '')); }
150
151####################################################################################################
1521;
153