src/perl/lib/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'} .": $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         my $self = shift;
  74         my($package, $file, $line) = get_caller();
  75         my $name = ref($self);
  76         my $msg = $self->message();
  77
  78     my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
  79     $year += 1900; $mon += 1;
  80     my $date = sprintf(
  81         '%s-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d',
  82         $year, $mon, $mday, $hour, $min, $sec);
  83
  84     return "Exception: $name $date $package $file:$line $msg\n";
  85 }
  86
  87
  88 # --- determine the originating caller of this exception
  89 sub get_caller() {
  90
  91         my $package = caller();
  92         my $x = 0;
  93         while( $package->isa( "Error" ) || $package =~ /^Error::/ ) {
  94                 $package = caller( ++$x );
  95         }
  96         return (caller($x));
  97 }
  98
  99
 100
 101
 102 # -------------------------------------------------------------------
 103 # -------------------------------------------------------------------
 104
 105 # Top level exception subclasses defining the different exception
 106 # levels.
 107
 108 # -------------------------------------------------------------------
 109
 110 package OpenSRF::EX::INFO;
 111 use base qw(OpenSRF::EX);
 112 our $ex_msg_header = "System INFO";
 113
 114 # -------------------------------------------------------------------
 115
 116 package OpenSRF::EX::NOTICE;
 117 use base qw(OpenSRF::EX);
 118 our $ex_msg_header = "System NOTICE";
 119
 120 # -------------------------------------------------------------------
 121
 122 package OpenSRF::EX::WARN;
 123 use base qw(OpenSRF::EX);
 124 our $ex_msg_header = "System WARNING";
 125
 126 # -------------------------------------------------------------------
 127
 128 package OpenSRF::EX::ERROR;
 129 use base qw(OpenSRF::EX);
 130 our $ex_msg_header = "System ERROR";
 131
 132 # -------------------------------------------------------------------
 133
 134 package OpenSRF::EX::CRITICAL;
 135 use base qw(OpenSRF::EX);
 136 our $ex_msg_header = "System CRITICAL";
 137
 138 # -------------------------------------------------------------------
 139
 140 package OpenSRF::EX::PANIC;
 141 use base qw(OpenSRF::EX);
 142 our $ex_msg_header = "System PANIC";
 143
 144 # -------------------------------------------------------------------
 145 # -------------------------------------------------------------------
 146
 147 # Some basic exceptions
 148
 149 # -------------------------------------------------------------------
 150 package OpenSRF::EX::Jabber;
 151 use base 'OpenSRF::EX::ERROR';
 152 our $ex_msg_header = "Jabber Exception";
 153
 154 package OpenSRF::EX::JabberDisconnected;
 155 use base 'OpenSRF::EX::ERROR';
 156 our $ex_msg_header = "JabberDisconnected Exception";
 157
 158 =head2 OpenSRF::EX::Jabber
 159
 160 Thrown when there is a problem using the Jabber service
 161
 162 =cut
 163
 164 package OpenSRF::EX::Transport;
 165 use base 'OpenSRF::EX::ERROR';
 166 our $ex_msg_header = "Transport Exception";
 167
 168
 169
 170 # -------------------------------------------------------------------
 171 package OpenSRF::EX::InvalidArg;
 172 use base 'OpenSRF::EX::ERROR';
 173 our $ex_msg_header = "Invalid Arg Exception";
 174
 175 =head2 OpenSRF::EX::InvalidArg
 176
 177 Thrown where an argument to a method was invalid or not provided
 178
 179 =cut
 180
 181
 182 # -------------------------------------------------------------------
 183 package OpenSRF::EX::Socket;
 184 use base 'OpenSRF::EX::ERROR';
 185 our $ex_msg_header = "Socket Exception";
 186
 187 =head2 OpenSRF::EX::Socket
 188
 189 Thrown when there is a network layer exception
 190
 191 =cut
 192
 193
 194
 195 # -------------------------------------------------------------------
 196 package OpenSRF::EX::Config;
 197 use base 'OpenSRF::EX::PANIC';
 198 our $ex_msg_header = "Config Exception";
 199
 200 =head2 OpenSRF::EX::Config
 201
 202 Thrown when a package requires a config option that it cannot retrieve
 203 or the config file itself cannot be loaded
 204
 205 =cut
 206
 207
 208 # -------------------------------------------------------------------
 209 package OpenSRF::EX::User;
 210 use base 'OpenSRF::EX::ERROR';
 211 our $ex_msg_header = "User Exception";
 212
 213 =head2 OpenSRF::EX::User
 214
 215 Thrown when an error occurs due to user identification information
 216
 217 =cut
 218
 219 package OpenSRF::EX::Session;
 220 use base 'OpenSRF::EX::ERROR';
 221 our $ex_msg_header = "Session Error";
 222
 223
 224 1;