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