OpenSRF/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         warn "Throwing Exception:\n\n" . $self->stringify() . "\n\n";
  60
  61
  62         if(             $self->class->isa( "OpenSRF::EX::INFO" )        ||
  63                                 $self->class->isa( "OpenSRF::EX::NOTICE" ) ||
  64                                 $self->class->isa( "OpenSRF::EX::WARN" ) ) {
  65
  66                 $log->debug( $self->stringify(), $log->DEBUG );
  67         }
  68
  69         else{ $log->debug( $self->stringify(), $log->ERROR ); }
  70
  71         $self->SUPER::throw;
  72 }
  73
  74
  75 sub stringify() {
  76
  77         my $self = shift;
  78         my $ctime = localtime();
  79         my( $package, $file, $line) = get_caller();
  80         my $name = ref( $self );
  81         my $msg = $self->message();
  82
  83         $msg =~ s/^/Mess: /mg;
  84
  85         return "  * ! EXCEPTION ! * \nTYPE: $name\n$msg\n".
  86                 "Loc.: $line $package \nLoc.: $file \nTime: $ctime\n";
  87 }
  88
  89
  90 # --- determine the originating caller of this exception
  91 sub get_caller() {
  92
  93         $package = caller();
  94         my $x = 0;
  95         while( $package->isa( "Error" ) || $package =~ /^Error::/ ) {
  96                 $package = caller( ++$x );
  97         }
  98         return (caller($x));
  99 }
 100
 101
 102
 103
 104 # -------------------------------------------------------------------
 105 # -------------------------------------------------------------------
 106
 107 # Top level exception subclasses defining the different exception
 108 # levels.
 109
 110 # -------------------------------------------------------------------
 111
 112 package OpenSRF::EX::INFO;
 113 use base qw(OpenSRF::EX);
 114 our $ex_msg_header = "System INFO";
 115
 116 # -------------------------------------------------------------------
 117
 118 package OpenSRF::EX::NOTICE;
 119 use base qw(OpenSRF::EX);
 120 our $ex_msg_header = "System NOTICE";
 121
 122 # -------------------------------------------------------------------
 123
 124 package OpenSRF::EX::WARN;
 125 use base qw(OpenSRF::EX);
 126 our $ex_msg_header = "System WARNING";
 127
 128 # -------------------------------------------------------------------
 129
 130 package OpenSRF::EX::ERROR;
 131 use base qw(OpenSRF::EX);
 132 our $ex_msg_header = "System ERROR";
 133
 134 # -------------------------------------------------------------------
 135
 136 package OpenSRF::EX::CRITICAL;
 137 use base qw(OpenSRF::EX);
 138 our $ex_msg_header = "System CRITICAL";
 139
 140 # -------------------------------------------------------------------
 141
 142 package OpenSRF::EX::PANIC;
 143 use base qw(OpenSRF::EX);
 144 our $ex_msg_header = "System PANIC";
 145
 146 # -------------------------------------------------------------------
 147 # -------------------------------------------------------------------
 148
 149 # Some basic exceptions
 150
 151 # -------------------------------------------------------------------
 152 package OpenSRF::EX::Jabber;
 153 use base 'OpenSRF::EX::ERROR';
 154 our $ex_msg_header = "Jabber Exception";
 155
 156 package OpenSRF::EX::JabberDisconnected;
 157 use base 'OpenSRF::EX::ERROR';
 158 our $ex_msg_header = "JabberDisconnected Exception";
 159
 160 =head2 OpenSRF::EX::Jabber
 161
 162 Thrown when there is a problem using the Jabber service
 163
 164 =cut
 165
 166 package OpenSRF::EX::Transport;
 167 use base 'OpenSRF::EX::ERROR';
 168 our $ex_msg_header = "Transport Exception";
 169
 170
 171
 172 # -------------------------------------------------------------------
 173 package OpenSRF::EX::InvalidArg;
 174 use base 'OpenSRF::EX::ERROR';
 175 our $ex_msg_header = "Invalid Arg Exception";
 176
 177 =head2 OpenSRF::EX::InvalidArg
 178
 179 Thrown where an argument to a method was invalid or not provided
 180
 181 =cut
 182
 183
 184 # -------------------------------------------------------------------
 185 package OpenSRF::EX::NotADomainObject;
 186 use base 'OpenSRF::EX::ERROR';
 187 our $ex_msg_header = "Must be a Domain Object";
 188
 189 =head2 OpenSRF::EX::NotADomainObject
 190
 191 Thrown where a OpenSRF::DomainObject::oilsScalar or
 192 OpenSRF::DomainObject::oilsPair was passed a value that
 193 is not a perl scalar or a OpenSRF::DomainObject.
 194
 195 =cut
 196
 197
 198 # -------------------------------------------------------------------
 199 package OpenSRF::EX::ArrayOutOfBounds;
 200 use base 'OpenSRF::EX::ERROR';
 201 our $ex_msg_header = "Tied array access on a nonexistant index";
 202
 203 =head2 OpenSRF::EX::ArrayOutOfBounds
 204
 205 Thrown where a TIEd array (OpenSRF::DomainObject::oilsArray) was accessed at
 206 a nonexistant index
 207
 208 =cut
 209
 210
 211
 212 # -------------------------------------------------------------------
 213 package OpenSRF::EX::Socket;
 214 use base 'OpenSRF::EX::ERROR';
 215 our $ex_msg_header = "Socket Exception";
 216
 217 =head2 OpenSRF::EX::Socket
 218
 219 Thrown when there is a network layer exception
 220
 221 =cut
 222
 223
 224
 225 # -------------------------------------------------------------------
 226 package OpenSRF::EX::Config;
 227 use base 'OpenSRF::EX::PANIC';
 228 our $ex_msg_header = "Config Exception";
 229
 230 =head2 OpenSRF::EX::Config
 231
 232 Thrown when a package requires a config option that it cannot retrieve
 233 or the config file itself cannot be loaded
 234
 235 =cut
 236
 237
 238 # -------------------------------------------------------------------
 239 package OpenSRF::EX::User;
 240 use base 'OpenSRF::EX::ERROR';
 241 our $ex_msg_header = "User Exception";
 242
 243 =head2 OpenSRF::EX::User
 244
 245 Thrown when an error occurs due to user identification information
 246
 247 =cut
 248
 249 package OpenSRF::EX::Session;
 250 use base 'OpenSRF::EX::ERROR';
 251 our $ex_msg_header = "Session Error";
 252
 253
 254 1;