Bio/Root/Exception.pm

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