t/AlignIO/AlignIO.t: fix number of tests in plan (fixup c523e6bed866)
[bioperl-live.git] / Bio / Root / Exception.pm
blob75aa0ef0766af9cfc248d7fdbbbc0dfbad221677
1 package Bio::Root::Exception;
2 use strict;
4 =head1 SYNOPSIS
6 =head2 Throwing exceptions using L<Error.pm throw|Error::throw>:
8 use Bio::Root::Exception;
9 use Error;
11 # Set Error::Debug to include stack trace data in the error messages
12 $Error::Debug = 1;
14 $file = shift;
15 open my $IN, '<', $file
16 or Bio::Root::FileOpenException->throw("Could not read file '$file': $!");
18 =head2 Throwing exceptions using L<Bioperl throw|Bio::Root::Root/throw>:
20 # Here we have an object that ISA Bio::Root::Root, so it inherits throw().
22 open my $IN, '<', $file
23 or $object->throw(-class => 'Bio::Root::FileOpenException',
24 -text => "Could not read file '$file'",
25 -value => $!);
27 =head2 Catching and handling exceptions using L<Error.pm try|Error/try>:
29 use Bio::Root::Exception;
30 use Error qw(:try);
32 # Note that we need to import the 'try' tag from Error.pm
34 # Set Error::Debug to include stack trace data in the error messages
35 $Error::Debug = 1;
37 my $file = shift;
38 my $IN;
39 try {
40 open $IN, '<', $file
41 or Bio::Root::FileOpenException->throw("Could not read file '$file': $!");
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': $!";
48 otherwise {
49 my $err = shift;
50 print STDERR "An unexpected exception occurred: \n$err";
52 # By placing an the error object reference within double quotes,
53 # you're invoking its stringify() method.
55 finally {
56 # Any code that you want to execute regardless of whether or not
57 # an exception occurred.
59 # the ending semicolon is essential!
62 =head2 Defining a new Exception type as a subclass of Bio::Root::Exception:
64 @Bio::TestException::ISA = qw( Bio::Root::Exception );
66 =head1 DESCRIPTION
68 =head2 Exceptions defined in L<Bio::Root::Exception>
70 These are generic exceptions for typical problem situations that could arise
71 in any module or script.
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()>
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.
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):
93 @NoCanDoException::ISA = qw( Bio::Root::Exception );
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:
99 use Bio::Whatever;
100 use Error qw(:try);
102 try {
103 # some code that depends on Bioperl
105 catch Bio::Root::Exception with {
106 my $err = shift;
107 print "A Bioperl exception occurred:\n$err\n";
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.
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.
120 =head2 Throwing exceptions within Bioperl modules
122 Error.pm is not part of the Bioperl distribution, 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.
128 =head1 SEE ALSO
130 See the C<examples/exceptions> directory of the Bioperl distribution for
131 working demo code.
133 L<Bio::Root::Root/throw> for information about throwing
134 L<Bio::Root::Exception>-based exceptions.
136 L<Error> (available from CPAN, author: GBARR)
138 Error.pm is helping to guide the design of exception handling in Perl 6.
139 See these RFC's:
141 http://dev.perl.org/rfc/63.pod
143 http://dev.perl.org/rfc/88.pod
145 =head1 EXCEPTIONS
147 =head1 AUTHOR Steve Chervitz
149 =cut
151 my $debug = $Error::Debug; # Prevents the "used only once" warning.
152 my $DEFAULT_VALUE = "__DUMMY__"; # Permits eval{} based handlers to work
154 =head2 L<Bio::Root::Exception>
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", $!);
161 =cut
163 #---------------------------------------------------------
164 @Bio::Root::Exception::ISA = qw( Error );
165 #---------------------------------------------------------
167 =head1 Methods defined by Bio::Root::Exception
169 =head2 new
171 Purpose : Guarantees that -value is set properly before
172 calling Error::new().
174 Arguments: key-value style arguments same as for Error::new()
176 You can also specify plain arguments as ($message, $value)
177 where $value is optional.
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).
185 It is OK to create Bio::Root::Exception objects without
186 specifying -value. In this case, an invisible dummy value is used.
188 If you happen to specify a -value of zero (0), it will
189 be replaced by the string "The number zero (0)".
191 If you happen to specify a -value of empty string (""), it will
192 be replaced by the string "An empty string ("")".
194 =cut
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'};
203 else {
204 $params{-text} = $args[0];
205 $value = $args[1];
208 if( defined $value ) {
209 $value = "The number zero (0)" if $value =~ /^\d+$/ && $value == 0;
210 $value = "An empty string (\"\")" if $value eq "";
212 else {
213 $value ||= $DEFAULT_VALUE;
215 $params{-value} = $value;
217 my $self = $class->SUPER::new( %params );
218 return $self;
221 =head2 pretty_format()
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;
230 =cut
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();
239 my $value_string = $self->value ne $DEFAULT_VALUE ? "VALUE: ".$self->value."\n" : "";
240 my $class = ref($self);
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;
250 =head2 _reformat_stacktrace
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)
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.
262 =cut
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++;
280 else{
281 next;
283 if( $stack_count == 1 ) {
284 push @new_stack, "STACK: $method";
285 ($prev_file, $prev_linenum) = ($file, $linenum);
286 next;
289 if( $method =~ /__ANON__/ ) {
290 $method = "try{} block";
292 if( ($method =~ /^require/ and $file =~ /Error\.pm/ ) ||
293 ($method =~ /^Error::subs::try/ ) ) {
294 last;
296 push @new_stack, "STACK: $method $prev_file:$prev_linenum";
297 ($prev_file, $prev_linenum) = ($file, $linenum);
299 push @new_stack, "STACK: $prev_file:$prev_linenum";
301 return join "\n", @new_stack;
304 =head2 stringify()
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";
314 See Also: L<pretty_format()|pretty_format>
316 =cut
318 sub stringify {
319 my ($self, @args) = @_;
320 return $self->pretty_format( @args );
323 =head1 Subclasses of Bio::Root::Exception
325 =head2 L<Bio::Root::NotImplemented>
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" );
332 =cut
334 #---------------------------------------------------------
335 @Bio::Root::NotImplemented::ISA = qw( Bio::Root::Exception );
336 #---------------------------------------------------------
338 =head2 L<Bio::Root::IOException>
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 => $! );
345 =cut
347 #---------------------------------------------------------
348 @Bio::Root::IOException::ISA = qw( Bio::Root::Exception );
349 #---------------------------------------------------------
352 =head2 L<Bio::Root::FileOpenException>
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 => $! );
359 =cut
361 #---------------------------------------------------------
362 @Bio::Root::FileOpenException::ISA = qw( Bio::Root::IOException );
363 #---------------------------------------------------------
366 =head2 L<Bio::Root::SystemException>
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 => $! );
373 =cut
375 #---------------------------------------------------------
376 @Bio::Root::SystemException::ISA = qw( Bio::Root::Exception );
377 #---------------------------------------------------------
380 =head2 L<Bio::Root::BadParameter>
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" );
388 =cut
390 #---------------------------------------------------------
391 @Bio::Root::BadParameter::ISA = qw( Bio::Root::Exception );
392 #---------------------------------------------------------
395 =head2 L<Bio::Root::OutOfRange>
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 );
403 =cut
405 #---------------------------------------------------------
406 @Bio::Root::OutOfRange::ISA = qw( Bio::Root::Exception );
407 #---------------------------------------------------------
410 =head2 L<Bio::Root::NoSuchThing>
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" );
418 =cut
420 #---------------------------------------------------------
421 @Bio::Root::NoSuchThing::ISA = qw( Bio::Root::Exception );
422 #---------------------------------------------------------