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::Socket;
 183 use base 'OpenSRF::EX::ERROR';
 184 our $ex_msg_header = "Socket Exception";
 185
 186 =head2 OpenSRF::EX::Socket
 187
 188 Thrown when there is a network layer exception
 189
 190 =cut
 191
 192
 193
 194 # -------------------------------------------------------------------
 195 package OpenSRF::EX::Config;
 196 use base 'OpenSRF::EX::PANIC';
 197 our $ex_msg_header = "Config Exception";
 198
 199 =head2 OpenSRF::EX::Config
 200
 201 Thrown when a package requires a config option that it cannot retrieve
 202 or the config file itself cannot be loaded
 203
 204 =cut
 205
 206
 207 # -------------------------------------------------------------------
 208 package OpenSRF::EX::User;
 209 use base 'OpenSRF::EX::ERROR';
 210 our $ex_msg_header = "User Exception";
 211
 212 =head2 OpenSRF::EX::User
 213
 214 Thrown when an error occurs due to user identification information
 215
 216 =cut
 217
 218 package OpenSRF::EX::Session;
 219 use base 'OpenSRF::EX::ERROR';
 220 our $ex_msg_header = "Session Error";
 221
 222
 223 1;