|
0
|
1 =head1 LICENSE
|
|
|
2
|
|
|
3 Copyright (c) 1999-2012 The European Bioinformatics Institute and
|
|
|
4 Genome Research Limited. All rights reserved.
|
|
|
5
|
|
|
6 This software is distributed under a modified Apache license.
|
|
|
7 For license details, please see
|
|
|
8
|
|
|
9 http://www.ensembl.org/info/about/code_licence.html
|
|
|
10
|
|
|
11 =head1 CONTACT
|
|
|
12
|
|
|
13 Please email comments or questions to the public Ensembl
|
|
|
14 developers list at <dev@ensembl.org>.
|
|
|
15
|
|
|
16 Questions may also be sent to the Ensembl help desk at
|
|
|
17 <helpdesk@ensembl.org>.
|
|
|
18
|
|
|
19 =cut
|
|
|
20
|
|
|
21 =head1 NAME
|
|
|
22
|
|
|
23 Bio::EnsEMBL::Utils::Exception - Utility functions for error handling
|
|
|
24
|
|
|
25 =head1 SYNOPSIS
|
|
|
26
|
|
|
27 use Bio::EnsEMBL::Utils::Exception
|
|
|
28 qw(throw warning deprecate verbose try catch);
|
|
|
29
|
|
|
30 or to get all methods just
|
|
|
31
|
|
|
32 use Bio::EnsEMBL::Utils::Exception;
|
|
|
33
|
|
|
34 eval { throw("this is an exception with a stack trace") };
|
|
|
35 if ($@) {
|
|
|
36 print "Caught exception:\n$@";
|
|
|
37 }
|
|
|
38
|
|
|
39 # Or you can us the try/catch confortable syntax instead to deal with
|
|
|
40 # throw or die. Don't forget the ";" after the catch block. With
|
|
|
41 # this syntax, the original $@ is in $_ in the catch subroutine.
|
|
|
42
|
|
|
43 try {
|
|
|
44 throw("this is an exception with a stack trace");
|
|
|
45 }
|
|
|
46 catch { print "Caught exception:\n$_" };
|
|
|
47
|
|
|
48 # silence warnings
|
|
|
49 verbose('OFF');
|
|
|
50
|
|
|
51 warning('this is a silent warning');
|
|
|
52
|
|
|
53 #show deprecated and warning messages but not info
|
|
|
54 verbose('DEPRECATE');
|
|
|
55
|
|
|
56 warning('this is a warning');
|
|
|
57
|
|
|
58 # show all messages
|
|
|
59 verbose('ALL');
|
|
|
60
|
|
|
61 info('this is an informational message');
|
|
|
62
|
|
|
63 sub my_sub { deprecate('use other_sub() instead') }
|
|
|
64
|
|
|
65 verbose('EXCEPTION');
|
|
|
66 info( 'This is a high priority info message.', 1000 );
|
|
|
67
|
|
|
68 =head1 DESCRIPTION
|
|
|
69
|
|
|
70 This is derived from the Bio::Root module in BioPerl. Some formatting
|
|
|
71 has been changed and the deprecate function has been added. Most
|
|
|
72 notably the object methods are now static class methods that can be
|
|
|
73 called without inheriting from Bio::Root or Bio::EnsEMBL::Root. This is
|
|
|
74 especially useful for throwing exceptions with stack traces outside of a
|
|
|
75 blessed context.
|
|
|
76
|
|
|
77 The originaly implementations of these methods were by Steve Chervitz
|
|
|
78 and refactored by Ewan Birney.
|
|
|
79
|
|
|
80 It is recommended that these functions be used instead of inheriting
|
|
|
81 unnecessarily from the Bio::EnsEMBL::Root or Bio::Root object. The
|
|
|
82 functions exported by this package provide a set of useful error
|
|
|
83 handling methods.
|
|
|
84
|
|
|
85 =head1 METHODS
|
|
|
86
|
|
|
87 =cut
|
|
|
88
|
|
|
89 package Bio::EnsEMBL::Utils::Exception;
|
|
|
90
|
|
|
91 use strict;
|
|
|
92 use warnings;
|
|
|
93
|
|
|
94 use Bio::EnsEMBL::ApiVersion;
|
|
|
95
|
|
|
96 use Exporter;
|
|
|
97
|
|
|
98 use vars qw(@ISA @EXPORT);
|
|
|
99
|
|
|
100 @ISA = qw(Exporter);
|
|
|
101 @EXPORT = qw(throw warning stack_trace_dump
|
|
|
102 stack_trace verbose deprecate info try catch);
|
|
|
103
|
|
|
104 my $VERBOSITY = 3000;
|
|
|
105 my $DEFAULT_INFO = 4000;
|
|
|
106 my $DEFAULT_DEPRECATE = 3000;
|
|
|
107 my $DEFAULT_WARNING = 2000;
|
|
|
108 my $DEFAULT_EXCEPTION = 1000;
|
|
|
109
|
|
|
110
|
|
|
111 =head2 throw
|
|
|
112
|
|
|
113 Arg [1] : string $msg
|
|
|
114 Arg [2] : (optional) int $level
|
|
|
115 override the default level of exception throwing
|
|
|
116 Example : use Bio::EnsEMBL::Utils::Exception qw(throw);
|
|
|
117 throw('We have a problem');
|
|
|
118 Description: Throws an exception which if not caught by an eval will
|
|
|
119 provide a stack trace to STDERR and die. If the verbosity level
|
|
|
120 is lower than the level of the throw, then no error message is
|
|
|
121 displayed but the program will still die (unless the exception
|
|
|
122 is caught).
|
|
|
123 Returntype : none
|
|
|
124 Exceptions : thrown every time
|
|
|
125 Caller : generally on error
|
|
|
126
|
|
|
127 =cut
|
|
|
128
|
|
|
129 sub throw {
|
|
|
130 my $string = shift;
|
|
|
131
|
|
|
132 # For backwards compatibility with Bio::EnsEMBL::Root::throw: Allow
|
|
|
133 # to be called as an object method as well as class method. Root
|
|
|
134 # function now deprecated so call will have the string instead.
|
|
|
135
|
|
|
136 $string = shift if ( ref($string) ); # Skip object if one provided.
|
|
|
137 $string = shift if ( $string eq "Bio::EnsEMBL::Utils::Exception" );
|
|
|
138
|
|
|
139 my $level = shift;
|
|
|
140 $level = $DEFAULT_EXCEPTION if ( !defined($level) );
|
|
|
141
|
|
|
142 if ( $VERBOSITY < $level ) {
|
|
|
143 die("\n"); # still die, but silently
|
|
|
144 }
|
|
|
145
|
|
|
146 my $std = stack_trace_dump(3);
|
|
|
147
|
|
|
148 my $out = sprintf(
|
|
|
149 "\n" .
|
|
|
150 "-------------------- EXCEPTION --------------------\n" .
|
|
|
151 "MSG: %s\n" .
|
|
|
152 "%s" .
|
|
|
153 "Date (localtime) = %s\n" .
|
|
|
154 "Ensembl API version = %s\n" .
|
|
|
155 "---------------------------------------------------\n",
|
|
|
156 $string, $std, scalar( localtime() ), software_version() );
|
|
|
157
|
|
|
158 die($out);
|
|
|
159 } ## end sub throw
|
|
|
160
|
|
|
161
|
|
|
162
|
|
|
163 =head2 warning
|
|
|
164
|
|
|
165 Arg [1] : string warning(message);
|
|
|
166 Arg [2] : (optional) int level
|
|
|
167 Override the default level of this warning changning the level
|
|
|
168 of verbosity at which it is displayed.
|
|
|
169 Example : use Bio::EnsEMBL::Utils::Exception qw(warning)
|
|
|
170 warning('This is a warning');
|
|
|
171 Description: If the verbosity level is higher or equal to the level of this
|
|
|
172 warning then a warning message is printed to STDERR. If the
|
|
|
173 verbosity lower then nothing is done. Under the default
|
|
|
174 levels of warning and verbosity warnings will be displayed.
|
|
|
175 Returntype : none
|
|
|
176 Exceptions : warning every time
|
|
|
177 Caller : general
|
|
|
178
|
|
|
179 =cut
|
|
|
180
|
|
|
181 sub warning {
|
|
|
182 my $string = shift;
|
|
|
183
|
|
|
184 # See throw() for this:
|
|
|
185 $string = shift if ( ref($string) ); # Skip object if one provided.
|
|
|
186 $string = shift if ( $string eq "Bio::EnsEMBL::Utils::Exception" );
|
|
|
187
|
|
|
188 my $level = shift;
|
|
|
189 $level = $DEFAULT_WARNING if ( !defined($level) );
|
|
|
190
|
|
|
191 return if ( $VERBOSITY < $level );
|
|
|
192
|
|
|
193 my @caller = caller;
|
|
|
194 my $line = $caller[2] || '';
|
|
|
195
|
|
|
196 # Use only two sub-dirs for brevity when reporting the file name.
|
|
|
197 my $file;
|
|
|
198 my @path = split( /\//, $caller[1] );
|
|
|
199 $file = pop(@path);
|
|
|
200 my $i = 0;
|
|
|
201 while ( @path && $i < 2 ) {
|
|
|
202 $i++;
|
|
|
203 $file = pop(@path) . "/$file";
|
|
|
204 }
|
|
|
205
|
|
|
206 @caller = caller(1);
|
|
|
207 my $caller_line;
|
|
|
208 my $caller_file;
|
|
|
209 $i = 0;
|
|
|
210 if (@caller) {
|
|
|
211 @path = split( /\//, $caller[1] );
|
|
|
212 $caller_line = $caller[2];
|
|
|
213 $caller_file = pop(@path);
|
|
|
214 while ( @path && $i < 2 ) {
|
|
|
215 $i++;
|
|
|
216 $caller_file = pop(@path) . "/$caller_file";
|
|
|
217 }
|
|
|
218 }
|
|
|
219
|
|
|
220 my $out =
|
|
|
221 sprintf( "\n" .
|
|
|
222 "-------------------- WARNING ----------------------\n" .
|
|
|
223 "MSG: %s\n" .
|
|
|
224 "FILE: %s LINE: %d\n",
|
|
|
225 $string, $file, $line );
|
|
|
226
|
|
|
227 if ( defined($caller_file) ) {
|
|
|
228 $out .= sprintf( "CALLED BY: %s LINE: %d\n", $caller_file,
|
|
|
229 $caller_line );
|
|
|
230 }
|
|
|
231 $out .= sprintf(
|
|
|
232 "Date (localtime) = %s\n" .
|
|
|
233 "Ensembl API version = %s\n" .
|
|
|
234 "---------------------------------------------------\n",
|
|
|
235 scalar( localtime() ), software_version() );
|
|
|
236
|
|
|
237 warn($out);
|
|
|
238
|
|
|
239 } ## end sub warning
|
|
|
240
|
|
|
241
|
|
|
242
|
|
|
243 =head2 info
|
|
|
244
|
|
|
245 Arg [1] : string $string
|
|
|
246 The message to be displayed
|
|
|
247 Arg [2] : (optional) int $level
|
|
|
248 Override the default level of this message so it is displayed at
|
|
|
249 a different level of verbosity than it normally would be.
|
|
|
250 Example : use Bio::EnsEMBL::Utils::Exception qw(verbose info)
|
|
|
251 Description: This prints an info message to STDERR if verbosity is higher
|
|
|
252 than the level of the message. By default info messages are not
|
|
|
253 displayed.
|
|
|
254 Returntype : none
|
|
|
255 Exceptions : none
|
|
|
256 Caller : general
|
|
|
257
|
|
|
258 =cut
|
|
|
259
|
|
|
260 sub info {
|
|
|
261 my $string = shift;
|
|
|
262 $string = shift if($string eq "Bio::EnsEMBL::Utils::Exception");
|
|
|
263 my $level = shift;
|
|
|
264
|
|
|
265 $level = $DEFAULT_INFO if(!defined($level));
|
|
|
266
|
|
|
267 return if($VERBOSITY < $level);
|
|
|
268
|
|
|
269 print STDERR "INFO: $string\n";
|
|
|
270 }
|
|
|
271
|
|
|
272
|
|
|
273
|
|
|
274 =head2 verbose
|
|
|
275
|
|
|
276 Arg [1] : (optional) int
|
|
|
277 Example : use Bio::EnsEMBL::Utils::Exception qw(verbose warning);
|
|
|
278 #turn warnings and everything more important on (e.g. exception)
|
|
|
279 verbose('WARNING');
|
|
|
280 warning("Warning displayed");
|
|
|
281 info("This won't be displayed");
|
|
|
282 deprecate("This won't be diplayed");
|
|
|
283
|
|
|
284 #turn exception messages on
|
|
|
285 verbose('EXCEPTION');
|
|
|
286 warning("This won't do anything");
|
|
|
287 throw("Die with a message");
|
|
|
288
|
|
|
289 #turn everying off
|
|
|
290 verbose('OFF'); #same as verbose(0);
|
|
|
291 warning("This won't do anything");
|
|
|
292 throw("Die silently without a message");
|
|
|
293
|
|
|
294 #turn on all messages
|
|
|
295 verbose('ALL');
|
|
|
296 info("All messages are now displayed");
|
|
|
297
|
|
|
298 if(verbose() > 3000) {
|
|
|
299 print "Verbosity is pretty high";
|
|
|
300 }
|
|
|
301
|
|
|
302 Description: Gets/Sets verbosity level which defines which messages are
|
|
|
303 to be displayed. An integer value may be passed or one of the
|
|
|
304 following strings:
|
|
|
305 'OFF' (= 0)
|
|
|
306 'EXCEPTION' (= 1000)
|
|
|
307 'WARNING' (= 2000)
|
|
|
308 'DEPRECATE' (= 3000)
|
|
|
309 'INFO' (= 4000)
|
|
|
310 'ALL' (= 1000000)
|
|
|
311
|
|
|
312 Returntype : int
|
|
|
313 Exceptions : none
|
|
|
314 Caller : general
|
|
|
315
|
|
|
316 =cut
|
|
|
317
|
|
|
318
|
|
|
319 sub verbose {
|
|
|
320 if(@_) {
|
|
|
321 my $verbosity = shift;
|
|
|
322 $verbosity = shift if($verbosity eq "Bio::EnsEMBL::Utils::Exception");
|
|
|
323 if($verbosity =~ /\d+/) { #check if verbosity is an integer
|
|
|
324 $VERBOSITY = $verbosity;
|
|
|
325 } else {
|
|
|
326 $verbosity = uc($verbosity);
|
|
|
327 if($verbosity eq 'OFF' || $verbosity eq 'NOTHING' ||
|
|
|
328 $verbosity eq 'NONE') {
|
|
|
329 $VERBOSITY = 0;
|
|
|
330 } elsif($verbosity eq 'EXCEPTION' || $verbosity eq 'THROW') {
|
|
|
331 $VERBOSITY = $DEFAULT_EXCEPTION;
|
|
|
332 } elsif($verbosity eq 'WARNING' || $verbosity eq 'WARN') {
|
|
|
333 $VERBOSITY = $DEFAULT_WARNING;
|
|
|
334 } elsif($verbosity eq 'DEPRECATE' || $verbosity eq 'DEPRECATED') {
|
|
|
335 $VERBOSITY = $DEFAULT_DEPRECATE;
|
|
|
336 } elsif($verbosity eq 'INFO') {
|
|
|
337 $VERBOSITY = $DEFAULT_INFO;
|
|
|
338 } elsif($verbosity eq 'ON' || $verbosity eq 'ALL') {
|
|
|
339 $VERBOSITY = 1e6;
|
|
|
340 } else {
|
|
|
341 $VERBOSITY = $DEFAULT_WARNING;
|
|
|
342 warning("Unknown level of verbosity: $verbosity");
|
|
|
343 }
|
|
|
344 }
|
|
|
345 }
|
|
|
346
|
|
|
347 return $VERBOSITY;
|
|
|
348 }
|
|
|
349
|
|
|
350
|
|
|
351
|
|
|
352 =head2 stack_trace_dump
|
|
|
353
|
|
|
354 Arg [1] : (optional) int $levels
|
|
|
355 The number of levels to ignore from the top of the stack when
|
|
|
356 creating the dump. This is useful when this is called internally
|
|
|
357 from a warning or throw function when the immediate caller and
|
|
|
358 stack_trace_dump function calls are themselves uninteresting.
|
|
|
359 Example : use Bio::EnsEMBL::Utils::Exception qw(stack_trace_dump);
|
|
|
360 print STDERR stack_trace_dump();
|
|
|
361 Description: Returns a stack trace formatted as a string
|
|
|
362 Returntype : string
|
|
|
363 Exceptions : none
|
|
|
364 Caller : general, throw, warning
|
|
|
365
|
|
|
366 =cut
|
|
|
367
|
|
|
368 sub stack_trace_dump{
|
|
|
369 my @stack = stack_trace();
|
|
|
370
|
|
|
371 my $levels = 2; #default is 2 levels so stack_trace_dump call is not present
|
|
|
372 $levels = shift if(@_);
|
|
|
373 $levels = shift if($levels eq "Bio::EnsEMBL::Utils::Exception");
|
|
|
374 $levels = 1 if($levels < 1);
|
|
|
375
|
|
|
376 while($levels) {
|
|
|
377 $levels--;
|
|
|
378 shift @stack;
|
|
|
379 }
|
|
|
380
|
|
|
381 my $out;
|
|
|
382 my ($module,$function,$file,$position);
|
|
|
383
|
|
|
384
|
|
|
385 foreach my $stack ( @stack) {
|
|
|
386 ($module,$file,$position,$function) = @{$stack};
|
|
|
387 $out .= "STACK $function $file:$position\n";
|
|
|
388 }
|
|
|
389
|
|
|
390 return $out;
|
|
|
391 }
|
|
|
392
|
|
|
393
|
|
|
394
|
|
|
395 =head2 stack_trace
|
|
|
396
|
|
|
397 Arg [1] : none
|
|
|
398 Example : use Bio::EnsEMBL::Utils::Exception qw(stack_trace)
|
|
|
399 Description: Gives an array to a reference of arrays with stack trace info
|
|
|
400 each coming from the caller(stack_number) call
|
|
|
401 Returntype : array of listrefs of strings
|
|
|
402 Exceptions : none
|
|
|
403 Caller : general, stack_trace_dump()
|
|
|
404
|
|
|
405 =cut
|
|
|
406
|
|
|
407 sub stack_trace {
|
|
|
408 my $i = 0;
|
|
|
409 my @out;
|
|
|
410 my $prev;
|
|
|
411 while ( my @call = caller($i++)) {
|
|
|
412
|
|
|
413 # major annoyance that caller puts caller context as
|
|
|
414 # function name. Hence some monkeying around...
|
|
|
415 $prev->[3] = $call[3];
|
|
|
416 push(@out,$prev);
|
|
|
417 $prev = \@call;
|
|
|
418 }
|
|
|
419 $prev->[3] = 'toplevel';
|
|
|
420 push(@out,$prev);
|
|
|
421 return @out;
|
|
|
422 }
|
|
|
423
|
|
|
424
|
|
|
425 =head2 deprecate
|
|
|
426
|
|
|
427 Arg [1] : string $mesg
|
|
|
428 A message describing why a method is deprecated
|
|
|
429 Example : use Bio::EnsEMBL::Utils::Exception qw(deprecate)
|
|
|
430 sub old_sub {
|
|
|
431 deprecate('Please use new_sub() instead');
|
|
|
432 }
|
|
|
433 Description: Prints a warning to STDERR that the method which called
|
|
|
434 deprecate() is deprecated. Also prints the line number and
|
|
|
435 file from which the deprecated method was called. Deprecated
|
|
|
436 warnings only appear once for each location the method was
|
|
|
437 called from. No message is displayed if the level of verbosity
|
|
|
438 is lower than the level of the warning.
|
|
|
439 Returntype : none
|
|
|
440 Exceptions : warning every time
|
|
|
441 Caller : deprecated methods
|
|
|
442
|
|
|
443 =cut
|
|
|
444
|
|
|
445 my %DEPRECATED;
|
|
|
446
|
|
|
447 sub deprecate {
|
|
|
448 my $mesg = shift;
|
|
|
449 $mesg = shift if($mesg eq "Bio::EnsEMBL::Utils::Exception"); #skip object if one provided
|
|
|
450
|
|
|
451 my $level = shift;
|
|
|
452
|
|
|
453 $level = $DEFAULT_DEPRECATE if(!defined($level));
|
|
|
454
|
|
|
455 return if($VERBOSITY < $level);
|
|
|
456
|
|
|
457 my @caller = caller(1);
|
|
|
458 my $subname = $caller[3] ;
|
|
|
459 my $line = $caller[2];
|
|
|
460
|
|
|
461 #use only 2 subdirs for brevity when reporting the filename
|
|
|
462 my $file;
|
|
|
463 my @path = $caller[1];
|
|
|
464 $file = pop(@path);
|
|
|
465 my $i = 0;
|
|
|
466 while(@path && $i < 2) {
|
|
|
467 $i++;
|
|
|
468 $file .= pop(@path);
|
|
|
469 }
|
|
|
470
|
|
|
471 #keep track of who called this method so that the warning is only displayed
|
|
|
472 #once per deprecated call
|
|
|
473 return if $DEPRECATED{"$line:$file:$subname"};
|
|
|
474
|
|
|
475 if ( $VERBOSITY > -1 ) {
|
|
|
476 print STDERR
|
|
|
477 "\n------------------ DEPRECATED ---------------------\n"
|
|
|
478 . "Deprecated method call in file $file line $line.\n"
|
|
|
479 . "Method $subname is deprecated.\n"
|
|
|
480 . "$mesg\n"
|
|
|
481 . "Ensembl API version = "
|
|
|
482 . software_version() . "\n"
|
|
|
483 . "---------------------------------------------------\n";
|
|
|
484 }
|
|
|
485
|
|
|
486 $DEPRECATED{"$line:$file:$subname"} = 1;
|
|
|
487 }
|
|
|
488
|
|
|
489 =head2 try/catch
|
|
|
490
|
|
|
491 Arg [1] : anonymous subroutine
|
|
|
492 the block to be tried
|
|
|
493 Arg [2] : return value of the catch function
|
|
|
494 Example : use Bio::EnsEMBL::Utils::Exception qw(throw try catch)
|
|
|
495 The syntax is:
|
|
|
496 try { block1 } catch { block2 };
|
|
|
497 { block1 } is the 1st argument
|
|
|
498 catch { block2 } is the 2nd argument
|
|
|
499 e.g.
|
|
|
500 try {
|
|
|
501 throw("this is an exception with a stack trace");
|
|
|
502 } catch {
|
|
|
503 print "Caught exception:\n$_";
|
|
|
504 };
|
|
|
505 In block2, $_ is assigned the value of the first
|
|
|
506 throw or die statement executed in block 1.
|
|
|
507
|
|
|
508 Description: Replaces the classical syntax
|
|
|
509 eval { block1 };
|
|
|
510 if ($@) { block2 }
|
|
|
511 by a more confortable one.
|
|
|
512 In the try/catch syntax, the original $@ is in $_ in the catch subroutine.
|
|
|
513 This try/catch implementation is a copy and paste from
|
|
|
514 "Programming Perl" 3rd Edition, July 2000, by L.Wall, T. Christiansen
|
|
|
515 & J. Orwant. p227, and is only possible because of subroutine prototypes.
|
|
|
516 Returntype : depend on what is implemented the try or catch block
|
|
|
517 Exceptions : none
|
|
|
518 Caller : general
|
|
|
519
|
|
|
520 =cut
|
|
|
521
|
|
|
522 sub try (&$) {
|
|
|
523 my ($try, $catch) = @_;
|
|
|
524 eval { &$try };
|
|
|
525 if ($@) {
|
|
|
526 chop $@;
|
|
|
527 local $_ = $@;
|
|
|
528 &$catch;
|
|
|
529 }
|
|
|
530 }
|
|
|
531
|
|
|
532 sub catch (&) {
|
|
|
533 shift;
|
|
|
534 }
|
|
|
535
|
|
|
536 1;
|
