Bio/Root/Exception.pm

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