Archive Ensembl HomeArchive Ensembl Home
Exception.pm
Go to the documentation of this file.
00001 =head1 LICENSE
00002 
00003   Copyright (c) 1999-2012 The European Bioinformatics Institute and
00004   Genome Research Limited.  All rights reserved.
00005 
00006   This software is distributed under a modified Apache license.
00007   For license details, please see
00008 
00009     http://www.ensembl.org/info/about/code_licence.html
00010 
00011 =head1 CONTACT
00012 
00013   Please email comments or questions to the public Ensembl
00014   developers list at <dev@ensembl.org>.
00015 
00016   Questions may also be sent to the Ensembl help desk at
00017   <helpdesk@ensembl.org>.
00018 
00019 =cut
00020 
00021 =head1 NAME
00022 
00023 Bio::EnsEMBL::Utils::Exception - Utility functions for error handling
00024 
00025 =head1 SYNOPSIS
00026 
00027   use Bio::EnsEMBL::Utils::Exception
00028     qw(throw warning deprecate verbose try catch);
00029 
00030   or to get all methods just
00031 
00032   use Bio::EnsEMBL::Utils::Exception;
00033 
00034   eval { throw("this is an exception with a stack trace") };
00035   if ($@) {
00036     print "Caught exception:\n$@";
00037   }
00038 
00039   # Or you can us the try/catch confortable syntax instead to deal with
00040   # throw or die.  Don't forget the ";" after the catch block.  With
00041   # this syntax, the original $@ is in $_ in the catch subroutine.
00042 
00043   try {
00044     throw("this is an exception with a stack trace");
00045   }
00046   catch { print "Caught exception:\n$_" };
00047 
00048   # silence warnings
00049   verbose('OFF');
00050 
00051   warning('this is a silent warning');
00052 
00053   #show deprecated and warning messages but not info
00054   verbose('DEPRECATE');
00055 
00056   warning('this is a warning');
00057 
00058   # show all messages
00059   verbose('ALL');
00060 
00061   info('this is an informational message');
00062 
00063   sub my_sub { deprecate('use other_sub() instead') }
00064 
00065   verbose('EXCEPTION');
00066   info( 'This is a high priority info message.', 1000 );
00067 
00068 =head1 DESCRIPTION
00069 
00070 This is derived from the Bio::Root module in BioPerl.  Some formatting
00071 has been changed and the deprecate function has been added.  Most
00072 notably the object methods are now static class methods that can be
00073 called without inheriting from Bio::Root or Bio::EnsEMBL::Root.  This is
00074 especially useful for throwing exceptions with stack traces outside of a
00075 blessed context.
00076 
00077 The originaly implementations of these methods were by Steve Chervitz
00078 and refactored by Ewan Birney.
00079 
00080 It is recommended that these functions be used instead of inheriting
00081 unnecessarily from the Bio::EnsEMBL::Root or Bio::Root object.  The
00082 functions exported by this package provide a set of useful error
00083 handling methods.
00084 
00085 =head1 METHODS
00086 
00087 =cut
00088 
00089 package Bio::EnsEMBL::Utils::Exception;
00090 
00091 use strict;
00092 use warnings;
00093 
00094 use Bio::EnsEMBL::ApiVersion;
00095 
00096 use Exporter;
00097 
00098 use vars qw(@ISA @EXPORT);
00099 
00100 @ISA = qw(Exporter);
00101 @EXPORT = qw(throw warning stack_trace_dump 
00102              stack_trace verbose deprecate info try catch);
00103 
00104 my $VERBOSITY         = 3000;
00105 my $DEFAULT_INFO      = 4000;
00106 my $DEFAULT_DEPRECATE = 3000;
00107 my $DEFAULT_WARNING   = 2000;
00108 my $DEFAULT_EXCEPTION = 1000;
00109 
00110 
00111 =head2 throw
00112 
00113   Arg [1]    : string $msg
00114   Arg [2]    : (optional) int $level
00115                override the default level of exception throwing
00116   Example    : use Bio::EnsEMBL::Utils::Exception qw(throw);
00117                throw('We have a problem');
00118   Description: Throws an exception which if not caught by an eval will
00119                provide a stack trace to STDERR and die.  If the verbosity level
00120                is lower than the level of the throw, then no error message is
00121                displayed but the program will still die (unless the exception
00122                is caught).
00123   Returntype : none
00124   Exceptions : thrown every time
00125   Caller     : generally on error
00126 
00127 =cut
00128 
00129 sub throw {
00130   my $string = shift;
00131 
00132   #for backwards compatibility with Bio::EnsEMBL::Root::throw
00133   #allow to be called as an object method as well as class method
00134   #Root function now deprecated so call will have the string instead.
00135 
00136   $string = shift if(ref($string)); #skip object if one provided
00137   $string = shift if($string eq "Bio::EnsEMBL::Utils::Exception");
00138 
00139   my $level  = shift;
00140 
00141   $level = $DEFAULT_EXCEPTION if(!defined($level));
00142 
00143   if($VERBOSITY < $level) {
00144     die("\n"); #still die, but silently
00145   }
00146 
00147   my $std = stack_trace_dump(3);
00148 
00149   my $out =
00150     sprintf( "\n"
00151               . "-------------------- EXCEPTION --------------------\n"
00152               . "MSG: %s\n" . "%s"
00153               . "Ensembl API version = %s\n"
00154               . "---------------------------------------------------\n",
00155             $string, $std, software_version() );
00156 
00157   die $out;
00158 }
00159 
00160 
00161 
00162 =head2 warning
00163 
00164   Arg [1]    : string warning(message);
00165   Arg [2]    : (optional) int level
00166                Override the default level of this warning changning the level
00167                of verbosity at which it is displayed.
00168   Example    : use Bio::EnsEMBL::Utils::Exception qw(warning)
00169                warning('This is a warning');
00170   Description: If the verbosity level is higher or equal to the level of this 
00171                warning then a warning message is printed to STDERR.  If the 
00172                verbosity lower then nothing is done.  Under the default
00173                levels of warning and verbosity warnings will be displayed.
00174   Returntype : none
00175   Exceptions : warning every time
00176   Caller     : general
00177 
00178 =cut
00179 
00180 sub warning {
00181   my $string = shift;
00182   $string = shift if($string eq "Bio::EnsEMBL::Utils::Exception"); #skip object if one provided
00183   my $level  = shift;
00184 
00185    $level = $DEFAULT_WARNING if(!defined($level));
00186 
00187   return if ($VERBOSITY < $level);
00188 
00189   my @caller = caller;
00190   my $line = $caller[2] || '';
00191 
00192   #use only 2 subdirs for brevity when reporting the filename
00193   my $file;
00194   my @path = split(/\//, $caller[1]);
00195   $file = pop(@path);
00196   my $i = 0;
00197   while(@path && $i < 2) {
00198     $i++;
00199     $file = pop(@path) ."/$file";
00200   }
00201 
00202   @caller = caller(1);
00203   my $caller_line;
00204   my $caller_file;
00205   $i=0;
00206   if(@caller) {
00207      @path = split(/\//, $caller[1]);
00208      $caller_line = $caller[2];
00209      $caller_file = pop(@path);
00210      while(@path && $i < 2) {
00211        $i++;
00212        $caller_file = pop(@path) ."/$caller_file";
00213      }
00214   }
00215 
00216   my $out =
00217       "\n-------------------- WARNING ----------------------\n"
00218     . "MSG: $string\n"
00219     . "FILE: $file LINE: $line\n";
00220   if ($caller_file) {
00221     $out .= "CALLED BY: $caller_file  LINE: $caller_line\n";
00222   }
00223   $out .= "Ensembl API version = " . software_version() . "\n";
00224   $out .= "---------------------------------------------------\n";
00225 
00226   print STDERR $out;
00227 
00228 }
00229 
00230 
00231 
00232 =head2 info
00233 
00234   Arg [1]    : string $string
00235                The message to be displayed
00236   Arg [2]    : (optional) int $level
00237                Override the default level of this message so it is displayed at
00238                a different level of verbosity than it normally would be.
00239   Example    : use Bio::EnsEMBL::Utils::Exception qw(verbose info)
00240   Description: This prints an info message to STDERR if verbosity is higher 
00241                than the level of the message.  By default info messages are not
00242                displayed.
00243   Returntype : none
00244   Exceptions : none
00245   Caller     : general
00246 
00247 =cut
00248 
00249 sub info {
00250   my $string = shift;
00251   $string = shift if($string eq "Bio::EnsEMBL::Utils::Exception");
00252   my $level  = shift;
00253 
00254   $level = $DEFAULT_INFO if(!defined($level));
00255 
00256   return if($VERBOSITY < $level);
00257 
00258   print STDERR "INFO: $string\n";
00259 }
00260 
00261 
00262 
00263 =head2 verbose
00264 
00265   Arg [1]    : (optional) int 
00266   Example    : use Bio::EnsEMBL::Utils::Exception qw(verbose warning);
00267                #turn warnings and everything more important on (e.g. exception)
00268                verbose('WARNING'); 
00269                warning("Warning displayed");
00270                info("This won't be displayed");
00271                deprecate("This won't be diplayed"); 
00272 
00273                #turn exception messages on
00274                verbose('EXCEPTION'); 
00275                warning("This won't do anything");
00276                throw("Die with a message");
00277 
00278                #turn everying off
00279                verbose('OFF'); #same as verbose(0);               
00280                warning("This won't do anything");
00281                throw("Die silently without a message");
00282 
00283                #turn on all messages
00284                verbose('ALL');
00285                info("All messages are now displayed");
00286 
00287                if(verbose() > 3000) {
00288                  print "Verbosity is pretty high";
00289                }
00290 
00291   Description: Gets/Sets verbosity level which defines which messages are
00292                to be displayed.  An integer value may be passed or one of the
00293                following strings:
00294                'OFF'       (= 0)
00295                'EXCEPTION' (= 1000)
00296                'WARNING'   (= 2000)
00297                'DEPRECATE' (= 3000)
00298                'INFO'      (= 4000)
00299                'ALL'       (= 1000000)
00300 
00301   Returntype : int 
00302   Exceptions : none
00303   Caller     : general
00304 
00305 =cut
00306 
00307 
00308 sub verbose {
00309   if(@_) {
00310     my $verbosity = shift;
00311     $verbosity = shift if($verbosity eq "Bio::EnsEMBL::Utils::Exception");
00312     if($verbosity =~ /\d+/) { #check if verbosity is an integer
00313       $VERBOSITY = $verbosity;
00314     } else {
00315       $verbosity = uc($verbosity);
00316       if($verbosity eq 'OFF' || $verbosity eq 'NOTHING' || 
00317          $verbosity eq 'NONE') {
00318         $VERBOSITY = 0;
00319       } elsif($verbosity eq 'EXCEPTION' || $verbosity eq 'THROW') {
00320         $VERBOSITY = $DEFAULT_EXCEPTION;
00321       } elsif($verbosity eq 'WARNING' || $verbosity eq 'WARN') {
00322         $VERBOSITY = $DEFAULT_WARNING;
00323       } elsif($verbosity eq 'DEPRECATE' || $verbosity eq 'DEPRECATED') {
00324         $VERBOSITY = $DEFAULT_DEPRECATE;
00325       } elsif($verbosity eq 'INFO') {
00326         $VERBOSITY = $DEFAULT_INFO;
00327       } elsif($verbosity eq 'ON' || $verbosity eq 'ALL') {
00328         $VERBOSITY = 1e6;
00329       } else {
00330         $VERBOSITY = $DEFAULT_WARNING;
00331         warning("Unknown level of verbosity: $verbosity");
00332       }
00333     }
00334   }
00335 
00336   return $VERBOSITY;
00337 }
00338 
00339 
00340 
00341 =head2 stack_trace_dump
00342 
00343   Arg [1]    : (optional) int $levels
00344                The number of levels to ignore from the top of the stack when
00345                creating the dump. This is useful when this is called internally
00346                from a warning or throw function when the immediate caller and 
00347                stack_trace_dump function calls are themselves uninteresting.
00348   Example    : use Bio::EnsEMBL::Utils::Exception qw(stack_trace_dump);
00349                print STDERR stack_trace_dump();
00350   Description: Returns a stack trace formatted as a string
00351   Returntype : string
00352   Exceptions : none
00353   Caller     : general, throw, warning
00354 
00355 =cut
00356 
00357 sub stack_trace_dump{
00358   my @stack = stack_trace();
00359 
00360   my $levels = 2; #default is 2 levels so stack_trace_dump call is not present
00361   $levels = shift if(@_);
00362   $levels = shift if($levels eq "Bio::EnsEMBL::Utils::Exception");
00363   $levels = 1 if($levels < 1);
00364   
00365   while($levels) {
00366     $levels--;
00367     shift @stack;
00368   }
00369 
00370   my $out;
00371   my ($module,$function,$file,$position);
00372 
00373 
00374   foreach my $stack ( @stack) {
00375     ($module,$file,$position,$function) = @{$stack};
00376     $out .= "STACK $function $file:$position\n";
00377   }
00378 
00379   return $out;
00380 }
00381 
00382 
00383 
00384 =head2 stack_trace
00385 
00386   Arg [1]    : none
00387   Example    : use Bio::EnsEMBL::Utils::Exception qw(stack_trace)
00388   Description: Gives an array to a reference of arrays with stack trace info
00389                each coming from the caller(stack_number) call
00390   Returntype : array of listrefs of strings
00391   Exceptions : none
00392   Caller     : general, stack_trace_dump()
00393 
00394 =cut
00395 
00396 sub stack_trace {
00397   my $i = 0;
00398   my @out;
00399   my $prev;
00400   while ( my @call = caller($i++)) {
00401 
00402     # major annoyance that caller puts caller context as
00403     # function name. Hence some monkeying around...
00404     $prev->[3] = $call[3];
00405     push(@out,$prev);
00406     $prev = \@call;
00407   }
00408   $prev->[3] = 'toplevel';
00409   push(@out,$prev);
00410   return @out;
00411 }
00412 
00413 
00414 =head2 deprecate
00415 
00416   Arg [1]    : string $mesg
00417                A message describing why a method is deprecated
00418   Example    : use Bio::EnsEMBL::Utils::Exception qw(deprecate)
00419                sub old_sub {
00420                  deprecate('Please use new_sub() instead');
00421                }
00422   Description: Prints a warning to STDERR that the method which called 
00423                deprecate() is deprecated.  Also prints the line number and 
00424                file from which the deprecated method was called.  Deprecated
00425                warnings only appear once for each location the method was 
00426                called from.  No message is displayed if the level of verbosity
00427                is lower than the level of the warning.
00428   Returntype : none
00429   Exceptions : warning every time
00430   Caller     : deprecated methods
00431 
00432 =cut
00433 
00434 my %DEPRECATED;
00435 
00436 sub deprecate {
00437   my $mesg = shift;
00438   $mesg = shift if($mesg eq "Bio::EnsEMBL::Utils::Exception"); #skip object if one provided
00439 
00440   my $level = shift;
00441 
00442   $level = $DEFAULT_DEPRECATE if(!defined($level));
00443 
00444   return if($VERBOSITY < $level);
00445                                  
00446   my @caller = caller(1);
00447   my $subname = $caller[3] ;
00448   my $line = $caller[2];
00449 
00450   #use only 2 subdirs for brevity when reporting the filename
00451   my $file;
00452   my @path = $caller[1];
00453   $file = pop(@path);
00454   my $i = 0;
00455   while(@path && $i < 2) {
00456     $i++;
00457     $file .= pop(@path);
00458   }
00459 
00460   #keep track of who called this method so that the warning is only displayed
00461   #once per deprecated call
00462   return if $DEPRECATED{"$line:$file:$subname"};
00463 
00464   if ( $VERBOSITY > -1 ) {
00465     print STDERR
00466       "\n------------------ DEPRECATED ---------------------\n"
00467       . "Deprecated method call in file $file line $line.\n"
00468       . "Method $subname is deprecated.\n"
00469       . "$mesg\n"
00470       . "Ensembl API version = "
00471       . software_version() . "\n"
00472       . "---------------------------------------------------\n";
00473   }
00474 
00475   $DEPRECATED{"$line:$file:$subname"} = 1;
00476 }
00477 
00478 =head2 try/catch
00479 
00480   Arg [1]    : anonymous subroutine
00481                the block to be tried
00482   Arg [2]    : return value of the catch function
00483   Example    : use Bio::EnsEMBL::Utils::Exception qw(throw try catch)
00484                The syntax is:
00485                try { block1 } catch { block2 };
00486                { block1 } is the 1st argument
00487                catch { block2 } is the 2nd argument
00488                e.g.
00489                try {
00490                  throw("this is an exception with a stack trace");
00491                } catch {
00492                  print "Caught exception:\n$_";
00493                };
00494                In block2, $_ is assigned the value of the first
00495                throw or die statement executed in block 1.
00496 
00497   Description: Replaces the classical syntax
00498                eval { block1 };
00499                if ($@) { block2 }
00500                by a more confortable one.
00501                In the try/catch syntax, the original $@ is in $_ in the catch subroutine.
00502                This try/catch implementation is a copy and paste from
00503                "Programming Perl" 3rd Edition, July 2000, by L.Wall, T. Christiansen
00504                & J. Orwant. p227, and is only possible because of subroutine prototypes.
00505   Returntype : depend on what is implemented the try or catch block
00506   Exceptions : none
00507   Caller     : general
00508 
00509 =cut
00510 
00511 sub try (&$) {
00512   my ($try, $catch) = @_;
00513   eval { &$try };
00514   if ($@) {
00515     chop $@;
00516     local $_ = $@;
00517     &$catch;
00518   }
00519 }
00520 
00521 sub catch (&) {
00522   shift;
00523 }
00524 
00525 1;