~evergreen-bugs/evergreen/rel_3_11

« back to all changes in this revision

Viewing changes to OpenSRF/src/perlmods/OpenSRF/EX.pm

  • Committer: phasefx
  • Date: 2005-02-04 22:08:15 UTC
  • Revision ID: git-v1:940e152e588a9b1c1b4f18cbbecf46691cb2f58c
Initial revision


git-svn-id: svn://svn.open-ils.org/ILS/trunk@2 dcc99617-32d9-48b4-a31d-7c20da2025e4

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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;