File Coverage

Bio/Root/Exception.pm
Criterion Covered Total %
statement 53 55 96.3
branch 16 20 80.0
condition 10 18 55.5
subroutine 5 5 100.0
pod 3 3 100.0
total 87 101 86.1


line stmt bran cond sub pod time code
1             package Bio::Root::Exception;
2 276     276   1228 use strict;
  276         423  
  276         182304  
3              
4             =head1 SYNOPSIS
5              
6             =head2 Throwing exceptions using L:
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:
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:
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
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
75             * C
76             * C
77             * C
78             * C
79             * C
80             * C
81             * C
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 module available from CPAN. Despite this dependency, the
116             L module does not explicitly C.
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 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 directory of the Bioperl distribution for
131             working demo code.
132              
133             L for information about throwing
134             L-based exceptions.
135              
136             L (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
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 143     143 1 1483 my ($class, @args) = @_;
198 143         163 my ($value, %params);
199 143 100 100     457 if( @args % 2 == 0 && $args[0] =~ /^-/) {
200 11         24 %params = @args;
201 11         18 $value = $params{'-value'};
202             }
203             else {
204 132         328 $params{-text} = $args[0];
205 132         170 $value = $args[1];
206             }
207              
208 143 100       268 if( defined $value ) {
209 10 50 66     44 $value = "The number zero (0)" if $value =~ /^\d+$/ && $value == 0;
210 10 100       24 $value = "An empty string (\"\")" if $value eq "";
211             }
212             else {
213 133   33     511 $value ||= $DEFAULT_VALUE;
214             }
215 143         354 $params{-value} = $value;
216              
217 143         592 my $self = $class->SUPER::new( %params );
218 143         74469 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 120     120 1 153 my $self = shift;
234 120         390 my $msg = $self->text;
235 120         511 my $stack = '';
236 120 50       274 if( $Error::Debug ) {
237 120         223 $stack = $self->_reformat_stacktrace();
238             }
239 120 100       337 my $value_string = $self->value ne $DEFAULT_VALUE ? "VALUE: ".$self->value."\n" : "";
240 120         652 my $class = ref($self);
241              
242 120         190 my $title = "------------- EXCEPTION: $class -------------";
243 120         247 my $footer = "\n" . '-' x CORE::length($title);
244 120         371 my $out = "\n$title\n"
245             . "MSG: $msg\n". $value_string. $stack. $footer . "\n";
246 120         551 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 120     120   132 my $self = shift;
266 120         220 my $msg = $self->text;
267 120         508 my $stack = $self->stacktrace();
268 120         2031 $stack =~ s/\Q$msg//;
269 120         619 my @stack = split( /\n/, $stack);
270 120         157 my @new_stack = ();
271 120         136 my ($method, $file, $linenum, $prev_file, $prev_linenum);
272 120         135 my $stack_count = 0;
273 120         344 foreach my $i( 0..$#stack ) {
274             # print "STACK-ORIG: $stack[$i]\n";
275 697 100 66     3055 if( ($stack[$i] =~ /^\s*([^(]+)\s*\(.*\) called at (\S+) line (\d+)/) ||
276             ($stack[$i] =~ /^\s*(require 0) called at (\S+) line (\d+)/)) {
277 547         1007 ($method, $file, $linenum) = ($1, $2, $3);
278 547         435 $stack_count++;
279             }
280             else{
281 150         189 next;
282             }
283 547 100       746 if( $stack_count == 1 ) {
284 120         244 push @new_stack, "STACK: $method";
285 120         176 ($prev_file, $prev_linenum) = ($file, $linenum);
286 120         117 next;
287             }
288              
289 427 50       625 if( $method =~ /__ANON__/ ) {
290 0         0 $method = "try{} block";
291             }
292 427 50 33     1601 if( ($method =~ /^require/ and $file =~ /Error\.pm/ ) ||
      33        
293             ($method =~ /^Error::subs::try/ ) ) {
294 0         0 last;
295             }
296 427         782 push @new_stack, "STACK: $method $prev_file:$prev_linenum";
297 427         481 ($prev_file, $prev_linenum) = ($file, $linenum);
298             }
299 120         234 push @new_stack, "STACK: $prev_file:$prev_linenum";
300              
301 120         518 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
315              
316             =cut
317              
318             sub stringify {
319 120     120 1 10606 my ($self, @args) = @_;
320 120         316 return $self->pretty_format( @args );
321             }
322              
323             =head1 Subclasses of Bio::Root::Exception
324              
325             =head2 L
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
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
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
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
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
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
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;