Initial revision
[OpenSRF.git] / src / perlmods / OpenSRF / EX.pm
1 package OpenSRF::EX;
2 use Error qw(:try);
3 use base qw( OpenSRF Error );
4 use OpenSRF::Utils::Logger;
5
6 my $log = "OpenSRF::Utils::Logger";
7 $Error::Debug = 1;
8
9 sub new {
10         my( $class, $message ) = @_;
11         $class = ref( $class ) || $class;
12         my $self = {};
13         $self->{'msg'} = ${$class . '::ex_msg_header'} ." \n$message";
14         return bless( $self, $class );
15 }       
16
17 sub message() { return $_[0]->{'msg'}; }
18
19 sub DESTROY{}
20
21
22 =head1 OpenSRF::EX
23
24 Top level exception.  This class logs an exception when it is thrown.  Exception subclasses
25 should subclass one of OpenSRF::EX::INFO, NOTICE, WARN, ERROR, CRITICAL, and PANIC and provide
26 a new() method that takes a message and a message() method that returns that message.
27
28 =cut
29
30 =head2 Synopsis
31
32
33         throw OpenSRF::EX::Jabber ("I Am Dying");
34
35         OpenSRF::EX::InvalidArg->throw( "Another way" );
36
37         my $je = OpenSRF::EX::Jabber->new( "I Cannot Connect" );
38         $je->throw();
39
40
41         See OpenSRF/EX.pm for example subclasses.
42
43 =cut
44
45 # Log myself and throw myself
46
47 #sub message() { shift->alert_abstract(); }
48
49 #sub new() { shift->alert_abstract(); }
50
51 sub throw() {
52
53         my $self = shift;
54
55         if( ! ref( $self ) || scalar( @_ ) ) {
56                 $self = $self->new( @_ );
57         }
58
59         if(             $self->class->isa( "OpenSRF::EX::INFO" )        ||
60                                 $self->class->isa( "OpenSRF::EX::NOTICE" ) ||
61                                 $self->class->isa( "OpenSRF::EX::WARN" ) ) {
62
63                 $log->debug( $self->stringify(), $log->DEBUG );
64         }
65
66         else{ $log->debug( $self->stringify(), $log->ERROR ); }
67         
68         $self->SUPER::throw;
69 }
70
71
72 sub stringify() {
73
74         my $self = shift;
75         my $ctime = localtime();
76         my( $package, $file, $line) = get_caller();
77         my $name = ref( $self );
78         my $msg = $self->message();
79
80         $msg =~ s/^/Mess: /mg;
81
82         return "  * ! EXCEPTION ! * \nTYPE: $name\n$msg\n".
83                 "Loc.: $line $package \nLoc.: $file \nTime: $ctime\n";
84 }
85
86
87 # --- determine the originating caller of this exception
88 sub get_caller() {
89
90         $package = caller();
91         my $x = 0;
92         while( $package->isa( "Error" ) || $package =~ /^Error::/ ) { 
93                 $package = caller( ++$x );
94         }
95         return (caller($x));
96 }
97
98
99
100
101 # -------------------------------------------------------------------
102 # -------------------------------------------------------------------
103
104 # Top level exception subclasses defining the different exception
105 # levels.
106
107 # -------------------------------------------------------------------
108
109 package OpenSRF::EX::INFO;
110 use base qw(OpenSRF::EX);
111 our $ex_msg_header = "System INFO";
112
113 # -------------------------------------------------------------------
114
115 package OpenSRF::EX::NOTICE;
116 use base qw(OpenSRF::EX);
117 our $ex_msg_header = "System NOTICE";
118
119 # -------------------------------------------------------------------
120
121 package OpenSRF::EX::WARN;
122 use base qw(OpenSRF::EX);
123 our $ex_msg_header = "System WARNING";
124
125 # -------------------------------------------------------------------
126
127 package OpenSRF::EX::ERROR;
128 use base qw(OpenSRF::EX);
129 our $ex_msg_header = "System ERROR";
130
131 # -------------------------------------------------------------------
132
133 package OpenSRF::EX::CRITICAL;
134 use base qw(OpenSRF::EX);
135 our $ex_msg_header = "System CRITICAL";
136
137 # -------------------------------------------------------------------
138
139 package OpenSRF::EX::PANIC;
140 use base qw(OpenSRF::EX);
141 our $ex_msg_header = "System PANIC";
142
143 # -------------------------------------------------------------------
144 # -------------------------------------------------------------------
145
146 # Some basic exceptions
147
148 # -------------------------------------------------------------------
149 package OpenSRF::EX::Jabber;
150 use base 'OpenSRF::EX::ERROR';
151 our $ex_msg_header = "Jabber Exception";
152
153 package OpenSRF::EX::JabberDisconnected;
154 use base 'OpenSRF::EX::ERROR';
155 our $ex_msg_header = "JabberDisconnected Exception";
156
157 =head2 OpenSRF::EX::Jabber
158
159 Thrown when there is a problem using the Jabber service
160
161 =cut
162
163 package OpenSRF::EX::Transport;
164 use base 'OpenSRF::EX::ERROR';
165 our $ex_msg_header = "Transport Exception";
166
167
168
169 # -------------------------------------------------------------------
170 package OpenSRF::EX::InvalidArg;
171 use base 'OpenSRF::EX::ERROR';
172 our $ex_msg_header = "Invalid Arg Exception";
173
174 =head2 OpenSRF::EX::InvalidArg
175
176 Thrown where an argument to a method was invalid or not provided
177
178 =cut
179
180
181 # -------------------------------------------------------------------
182 package OpenSRF::EX::NotADomainObject;
183 use base 'OpenSRF::EX::ERROR';
184 our $ex_msg_header = "Must be a Domain Object";
185
186 =head2 OpenSRF::EX::NotADomainObject
187
188 Thrown where a OpenSRF::DomainObject::oilsScalar or
189 OpenSRF::DomainObject::oilsPair was passed a value that
190 is not a perl scalar or a OpenSRF::DomainObject.
191
192 =cut
193
194
195 # -------------------------------------------------------------------
196 package OpenSRF::EX::ArrayOutOfBounds;
197 use base 'OpenSRF::EX::ERROR';
198 our $ex_msg_header = "Tied array access on a nonexistant index";
199
200 =head2 OpenSRF::EX::ArrayOutOfBounds
201
202 Thrown where a TIEd array (OpenSRF::DomainObject::oilsArray) was accessed at
203 a nonexistant index
204
205 =cut
206
207
208
209 # -------------------------------------------------------------------
210 package OpenSRF::EX::Socket;
211 use base 'OpenSRF::EX::ERROR';
212 our $ex_msg_header = "Socket Exception";
213
214 =head2 OpenSRF::EX::Socket
215
216 Thrown when there is a network layer exception
217
218 =cut
219
220
221
222 # -------------------------------------------------------------------
223 package OpenSRF::EX::Config;
224 use base 'OpenSRF::EX::PANIC';
225 our $ex_msg_header = "Config Exception";
226
227 =head2 OpenSRF::EX::Config
228
229 Thrown when a package requires a config option that it cannot retrieve
230 or the config file itself cannot be loaded
231
232 =cut
233
234
235 # -------------------------------------------------------------------
236 package OpenSRF::EX::User;
237 use base 'OpenSRF::EX::ERROR';
238 our $ex_msg_header = "User Exception";
239
240 =head2 OpenSRF::EX::User
241
242 Thrown when an error occurs due to user identification information
243
244 =cut
245
246 package OpenSRF::EX::Session;
247 use base 'OpenSRF::EX::ERROR';
248 our $ex_msg_header = "Session Error";
249
250
251 1;