Bio/Root/Exception.pm

   1 package Bio::Root::Exception;
   2 use strict;
   3
   4 =head1 SYNOPSIS
   5
   6 =head2 Throwing exceptions using L<Error.pm throw|Error::throw>:
   7
   8     use Bio::Root::Exception;
   9     use Error;
  10
  11     # Set Error::Debug to include stack trace data in the error messages
  12     $Error::Debug = 1;
  13
  14     $file = shift;
  15     open my $IN, '<', $file
  16         or Bio::Root::FileOpenException->throw("Could not read file '$file': $!");
  17
  18 =head2 Throwing exceptions using L<Bioperl throw|Bio::Root::Root/throw>:
  19
  20     # Here we have an object that ISA Bio::Root::Root, so it inherits throw().
  21
  22     open my $IN, '<', $file
  23         or $object->throw(-class => 'Bio::Root::FileOpenException',
  24                           -text  => "Could not read file '$file'",
  25                           -value => $!);
  26
  27 =head2 Catching and handling exceptions using L<Error.pm try|Error/try>:
  28
  29     use Bio::Root::Exception;
  30     use Error qw(:try);
  31
  32     # Note that we need to import the 'try' tag from Error.pm
  33
  34     # Set Error::Debug to include stack trace data in the error messages
  35     $Error::Debug = 1;
  36
  37     my $file = shift;
  38     my $IN;
  39     try {
  40         open $IN, '<', $file
  41             or Bio::Root::FileOpenException->throw("Could not read file '$file': $!");
  42     }
  43     catch Bio::Root::FileOpenException with {
  44         my $err = shift;
  45         print STDERR "Using default input file: $default_file\n";
  46         open $IN, '<', $default_file or die "Could not read file '$default_file': $!";
  47     }
  48     otherwise {
  49         my $err = shift;
  50         print STDERR "An unexpected exception occurred: \n$err";
  51
  52         # By placing an the error object reference within double quotes,
  53         # you're invoking its stringify() method.
  54     }
  55    finally {
  56        # Any code that you want to execute regardless of whether or not
  57        # an exception occurred.
  58    };
  59    # the ending semicolon is essential!
  60
  61
  62 =head2 Defining a new Exception type as a subclass of Bio::Root::Exception:
  63
  64     @Bio::TestException::ISA = qw( Bio::Root::Exception );
  65
  66 =head1 DESCRIPTION
  67
  68 =head2 Exceptions defined in L<Bio::Root::Exception>
  69
  70 These are generic exceptions for typical problem situations that could arise
  71 in any module or script.
  72
  73 =for :list
  74 * C<Bio::Root::Exception()>
  75 * C<Bio::Root::NotImplemented()>
  76 * C<Bio::Root::IOException()>
  77 * C<Bio::Root::FileOpenException()>
  78 * C<Bio::Root::SystemException()>
  79 * C<Bio::Root::BadParameter()>
  80 * C<Bio::Root::OutOfRange()>
  81 * C<Bio::Root::NoSuchThing()>
  82
  83 Using defined exception classes like these is a good idea because it
  84 indicates the basic nature of what went wrong in a convenient,
  85 computable way.
  86
  87 If there is a type of exception that you want to throw
  88 that is not covered by the classes listed above, it is easy to define
  89 a new one that fits your needs. Just write a line like the following
  90 in your module or script where you want to use it (or put it somewhere
  91 that is accessible to your code):
  92
  93     @NoCanDoException::ISA = qw( Bio::Root::Exception );
  94
  95 All of the exceptions defined in this module inherit from a common
  96 base class exception, Bio::Root::Exception. This allows a user to
  97 write a handler for all Bioperl-derived exceptions as follows:
  98
  99            use Bio::Whatever;
 100            use Error qw(:try);
 101
 102            try {
 103                 # some code that depends on Bioperl
 104            }
 105            catch Bio::Root::Exception with {
 106                my $err = shift;
 107                print "A Bioperl exception occurred:\n$err\n";
 108            };
 109
 110 So if you do create your own exceptions, just be sure they inherit
 111 from Bio::Root::Exception directly, or indirectly by inheriting from a
 112 Bio::Root::Exception subclass.
 113
 114 The exceptions in Bio::Root::Exception are extensions of Graham Barr's
 115 L<Error> module available from CPAN.  Despite this dependency, the
 116 L<Bio::Root::Exception> module does not explicitly C<require Error>.
 117 This permits Bio::Root::Exception to be loaded even when
 118 Error.pm is not available.
 119
 120 =head2 Throwing exceptions within Bioperl modules
 121
 122 Error.pm is not part of the Bioperl distibution, and may not be
 123 present within  any given perl installation. So, when you want to
 124 throw an exception in a Bioperl module, the safe way to throw it
 125 is to use L<Bio::Root::Root/throw> which can use Error.pm
 126 when it's available. See documentation in Bio::Root::Root for details.
 127
 128 =head1 SEE ALSO
 129
 130 See the C<examples/exceptions> directory of the Bioperl distribution for
 131 working demo code.
 132
 133 L<Bio::Root::Root/throw> for information about throwing
 134 L<Bio::Root::Exception>-based exceptions.
 135
 136 L<Error> (available from CPAN, author: GBARR)
 137
 138 Error.pm is helping to guide the design of exception handling in Perl 6.
 139 See these RFC's:
 140
 141      http://dev.perl.org/rfc/63.pod
 142
 143      http://dev.perl.org/rfc/88.pod
 144
 145 =head1 EXCEPTIONS
 146
 147 =head1 AUTHOR Steve Chervitz
 148
 149 =cut
 150
 151 my $debug = $Error::Debug;  # Prevents the "used only once" warning.
 152 my $DEFAULT_VALUE = "__DUMMY__";  # Permits eval{} based handlers to work
 153
 154 =head2 L<Bio::Root::Exception>
 155
 156  Purpose : A generic base class for all BioPerl exceptions.
 157            By including a "catch Bio::Root::Exception" block, you
 158            should be able to trap all BioPerl exceptions.
 159  Example : throw Bio::Root::Exception("A generic exception", $!);
 160
 161 =cut
 162
 163 #---------------------------------------------------------
 164 @Bio::Root::Exception::ISA = qw( Error );
 165 #---------------------------------------------------------
 166
 167 =head1 Methods defined by Bio::Root::Exception
 168
 169 =head2 new
 170
 171  Purpose : Guarantees that -value is set properly before
 172            calling Error::new().
 173
 174  Arguments: key-value style arguments same as for Error::new()
 175
 176      You can also specify plain arguments as ($message, $value)
 177      where $value is optional.
 178
 179      -value, if defined, must be non-zero and not an empty string
 180      in order for eval{}-based exception handlers to work.
 181      These require that if($@) evaluates to true, which will not
 182      be the case if the Error has no value (Error overloads
 183      numeric operations to the Error::value() method).
 184
 185      It is OK to create Bio::Root::Exception objects without
 186      specifying -value. In this case, an invisible dummy value is used.
 187
 188      If you happen to specify a -value of zero (0), it will
 189      be replaced by the string "The number zero (0)".
 190
 191      If you happen to specify a -value of empty string (""), it will
 192      be replaced by the string "An empty string ("")".
 193
 194 =cut
 195
 196 sub new {
 197     my ($class, @args) = @_;
 198     my ($value, %params);
 199     if( @args % 2 == 0 && $args[0] =~ /^-/) {
 200         %params = @args;
 201         $value = $params{'-value'};
 202     }
 203     else {
 204         $params{-text} = $args[0];
 205         $value = $args[1];
 206     }
 207
 208     if( defined $value ) {
 209         $value = "The number zero (0)" if $value =~ /^\d+$/ && $value == 0;
 210         $value = "An empty string (\"\")" if $value eq "";
 211     }
 212     else {
 213         $value ||= $DEFAULT_VALUE;
 214     }
 215     $params{-value} = $value;
 216
 217     my $self = $class->SUPER::new( %params );
 218     return $self;
 219 }
 220
 221 =head2 pretty_format()
 222
 223  Purpose : Get a nicely formatted string containing information about the
 224            exception. Format is similar to that produced by
 225            Bio::Root::Root::throw(), with the addition of the name of
 226            the exception class in the EXCEPTION line and some other
 227            data available via the Error object.
 228  Example : print $error->pretty_format;
 229
 230 =cut
 231
 232 sub pretty_format {
 233     my $self = shift;
 234     my $msg = $self->text;
 235     my $stack = '';
 236     if( $Error::Debug ) {
 237       $stack = $self->_reformat_stacktrace();
 238     }
 239     my $value_string = $self->value ne $DEFAULT_VALUE ? "VALUE: ".$self->value."\n" : "";
 240     my $class = ref($self);
 241
 242     my $title = "------------- EXCEPTION: $class -------------";
 243     my $footer = "\n" . '-' x CORE::length($title);
 244     my $out = "\n$title\n"
 245             . "MSG: $msg\n". $value_string. $stack. $footer . "\n";
 246     return $out;
 247 }
 248
 249
 250 =head2 _reformat_stacktrace
 251
 252 Reformatting of the stack performed by  _reformat_stacktrace:
 253 for :list
 254 1. Shift the file:line data in line i to line i+1.
 255 2. change xxx::__ANON__() to "try{} block"
 256 3. skip the "require" and "Error::subs::try" stack entries (boring)
 257
 258 This means that the first line in the stack won't have any file:line data
 259 But this isn't a big issue since it's for a Bio::Root::-based method
 260 that doesn't vary from exception to exception.
 261
 262 =cut
 263
 264 sub _reformat_stacktrace {
 265     my $self = shift;
 266     my $msg = $self->text;
 267     my $stack = $self->stacktrace();
 268     $stack =~ s/\Q$msg//;
 269     my @stack = split( /\n/, $stack);
 270     my @new_stack = ();
 271     my ($method, $file, $linenum, $prev_file, $prev_linenum);
 272     my $stack_count = 0;
 273     foreach my $i( 0..$#stack ) {
 274         # print "STACK-ORIG: $stack[$i]\n";
 275         if( ($stack[$i] =~ /^\s*([^(]+)\s*\(.*\) called at (\S+) line (\d+)/) ||
 276              ($stack[$i] =~ /^\s*(require 0) called at (\S+) line (\d+)/)) {
 277             ($method, $file, $linenum) = ($1, $2, $3);
 278             $stack_count++;
 279         }
 280         else{
 281             next;
 282         }
 283         if( $stack_count == 1 ) {
 284             push @new_stack, "STACK: $method";
 285             ($prev_file, $prev_linenum) = ($file, $linenum);
 286             next;
 287         }
 288
 289         if( $method =~ /__ANON__/ ) {
 290             $method = "try{} block";
 291         }
 292         if( ($method =~ /^require/ and $file =~ /Error\.pm/ ) ||
 293             ($method =~ /^Error::subs::try/ ) )   {
 294             last;
 295         }
 296         push @new_stack, "STACK: $method $prev_file:$prev_linenum";
 297         ($prev_file, $prev_linenum) = ($file, $linenum);
 298     }
 299     push @new_stack, "STACK: $prev_file:$prev_linenum";
 300
 301     return join "\n", @new_stack;
 302 }
 303
 304 =head2 stringify()
 305
 306  Purpose : Overrides Error::stringify() to call pretty_format().
 307            This is called automatically when an exception object
 308            is placed between double quotes.
 309  Example : catch Bio::Root::Exception with {
 310               my $error = shift;
 311               print "$error";
 312            }
 313
 314 See Also: L<pretty_format()|pretty_format>
 315
 316 =cut
 317
 318 sub stringify {
 319     my ($self, @args) = @_;
 320     return $self->pretty_format( @args );
 321 }
 322
 323 =head1 Subclasses of Bio::Root::Exception
 324
 325 =head2 L<Bio::Root::NotImplemented>
 326
 327  Purpose : Indicates that a method has not been implemented.
 328  Example : throw Bio::Root::NotImplemented(
 329                -text   => "Method \"foo\" not implemented in module FooBar.",
 330                -value  => "foo" );
 331
 332 =cut
 333
 334 #---------------------------------------------------------
 335 @Bio::Root::NotImplemented::ISA = qw( Bio::Root::Exception );
 336 #---------------------------------------------------------
 337
 338 =head2 L<Bio::Root::IOException>
 339
 340  Purpose : Indicates that some input/output-related trouble has occurred.
 341  Example : throw Bio::Root::IOException(
 342                -text   => "Can't save data to file $file.",
 343                -value  => $! );
 344
 345 =cut
 346
 347 #---------------------------------------------------------
 348 @Bio::Root::IOException::ISA = qw( Bio::Root::Exception );
 349 #---------------------------------------------------------
 350
 351
 352 =head2 L<Bio::Root::FileOpenException>
 353
 354  Purpose : Indicates that a file could not be opened.
 355  Example : throw Bio::Root::FileOpenException(
 356                -text   => "Can't open file $file for reading.",
 357                -value  => $! );
 358
 359 =cut
 360
 361 #---------------------------------------------------------
 362 @Bio::Root::FileOpenException::ISA = qw( Bio::Root::IOException );
 363 #---------------------------------------------------------
 364
 365
 366 =head2 L<Bio::Root::SystemException>
 367
 368  Purpose : Indicates that a system call failed.
 369  Example : unlink($file) or throw Bio::Root::SystemException(
 370                -text   => "Can't unlink file $file.",
 371                -value  => $! );
 372
 373 =cut
 374
 375 #---------------------------------------------------------
 376 @Bio::Root::SystemException::ISA = qw( Bio::Root::Exception );
 377 #---------------------------------------------------------
 378
 379
 380 =head2 L<Bio::Root::BadParameter>
 381
 382  Purpose : Indicates that one or more parameters supplied to a method
 383            are invalid, unspecified, or conflicting.
 384  Example : throw Bio::Root::BadParameter(
 385                -text   => "Required parameter \"-foo\" was not specified",
 386                -value  => "-foo" );
 387
 388 =cut
 389
 390 #---------------------------------------------------------
 391 @Bio::Root::BadParameter::ISA = qw( Bio::Root::Exception );
 392 #---------------------------------------------------------
 393
 394
 395 =head2 L<Bio::Root::OutOfRange>
 396
 397  Purpose : Indicates that a specified (start,end) range or
 398            an index to an array is outside the permitted range.
 399  Example : throw Bio::Root::OutOfRange(
 400                -text   => "Start coordinate ($start) cannot be less than zero.",
 401                -value  => $start  );
 402
 403 =cut
 404
 405 #---------------------------------------------------------
 406 @Bio::Root::OutOfRange::ISA = qw( Bio::Root::Exception );
 407 #---------------------------------------------------------
 408
 409
 410 =head2 L<Bio::Root::NoSuchThing>
 411
 412  Purpose : Indicates that a requested thing cannot be located
 413            and therefore could possibly be bogus.
 414  Example : throw Bio::Root::NoSuchThing(
 415                -text   => "Accession M000001 could not be found.",
 416                -value  => "M000001"  );
 417
 418 =cut
 419
 420 #---------------------------------------------------------
 421 @Bio::Root::NoSuchThing::ISA = qw( Bio::Root::Exception );
 422 #---------------------------------------------------------
 423
 424 1;