|
0
|
1 #-----------------------------------------------------------------------------
|
|
|
2 # PACKAGE : Bio::Root::Err.pm
|
|
|
3 # AUTHOR : Steve Chervitz (sac@bioperl.org)
|
|
|
4 # CREATED : 22 July 1996
|
|
|
5 # REVISION: $Id: Err.pm,v 1.15 2002/10/22 07:38:37 lapp Exp $
|
|
|
6 # STATUS : Alpha
|
|
|
7 #
|
|
|
8 # For documentation, run this module through pod2html
|
|
|
9 # (preferably from Perl v5.004 or better).
|
|
|
10 #
|
|
|
11 # Copyright (c) 1996-8 Steve Chervitz. All Rights Reserved.
|
|
|
12 # This module is free software; you can redistribute it and/or
|
|
|
13 # modify it under the same terms as Perl itself.
|
|
|
14 # Retain this notice and note any modifications made.
|
|
|
15 #-----------------------------------------------------------------------------
|
|
|
16
|
|
|
17 package Bio::Root::Err;
|
|
|
18 use strict;
|
|
|
19
|
|
|
20 use Bio::Root::Global qw(:devel $CGI);
|
|
|
21 use Bio::Root::Vector ();
|
|
|
22 use Bio::Root::Object;# qw(:std);
|
|
|
23 use Exporter ();
|
|
|
24
|
|
|
25 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
|
|
|
26 @ISA = qw( Bio::Root::Object Bio::Root::Vector Exporter );
|
|
|
27 @EXPORT = qw();
|
|
|
28 @EXPORT_OK = qw( %ERR_FIELDS @ERR_TYPES &format_stack_entry &throw &warning);
|
|
|
29 %EXPORT_TAGS = (
|
|
|
30 data => [qw(%ERR_FIELDS @ERR_TYPES)],
|
|
|
31 std => [qw(&throw &warning)]
|
|
|
32 );
|
|
|
33
|
|
|
34 use vars qw($ID $VERSION);
|
|
|
35 $ID = 'Bio::Root::Err';
|
|
|
36 $VERSION = 0.041;
|
|
|
37
|
|
|
38 %Bio::Root::Err::ERR_FIELDS = (TYPE=>1, MSG=>1, NOTE=>1, CONTEXT=>1,
|
|
|
39 TECH=>1, STACK=>1 );
|
|
|
40
|
|
|
41 @Bio::Root::Err::ERR_TYPES = qw(WARNING EXCEPTION FATAL);
|
|
|
42
|
|
|
43
|
|
|
44 ## MAIN POD DOCUMENTATION:
|
|
|
45
|
|
|
46 =head1 NAME
|
|
|
47
|
|
|
48 Bio::Root::Err - Exception class for Perl 5 objects
|
|
|
49
|
|
|
50 =head1 SYNOPSIS
|
|
|
51
|
|
|
52 =head2 Object Creation
|
|
|
53
|
|
|
54 B<Bio::Root::Object.pm> is a wrapper for Bio::Root::Err.pm objects so clients
|
|
|
55 do not have to create these objects directly. Please see
|
|
|
56 B<Bio::Root::Object::throw()> as well as L<_initialize>()
|
|
|
57 for a more complete treatment
|
|
|
58 of how to create Bio::Root::Err.pm objects.
|
|
|
59
|
|
|
60 use Bio::Root::Err;
|
|
|
61
|
|
|
62 $err = Bio::Root::Err->new(-MSG =>"Bad data: $data",
|
|
|
63 -STACK =>[\caller(0), \caller(1), ...],
|
|
|
64 );
|
|
|
65
|
|
|
66
|
|
|
67 To use the L<throw>() method directly:
|
|
|
68
|
|
|
69 use Bio::Root::Err (:std);
|
|
|
70
|
|
|
71 throw( $object_ref, 'Error message', 'additional note', 'technical note');
|
|
|
72
|
|
|
73 The C<$object_ref> argument should be a reference to a Bio::Root::Object.pm.
|
|
|
74
|
|
|
75 See also L<the USAGE section | USAGE>.
|
|
|
76
|
|
|
77 =head1 INSTALLATION
|
|
|
78
|
|
|
79 This module is included with the central Bioperl distribution:
|
|
|
80
|
|
|
81 http://bio.perl.org/Core/Latest
|
|
|
82 ftp://bio.perl.org/pub/DIST
|
|
|
83
|
|
|
84 Follow the installation instructions included in the INSTALL file.
|
|
|
85
|
|
|
86 =head1 DESCRIPTION
|
|
|
87
|
|
|
88 A Bio::Root::Err.pm object encapsulates data and methods that facilitate
|
|
|
89 working with errors and exceptional conditions that arise in Perl objects.
|
|
|
90 There are no biological semantics in this module, as one may suspect from its
|
|
|
91 location in the Bio:: hierarchy. The location of this module serves to
|
|
|
92 separate it from the namespaces of other Perl Error modules. It also makes it
|
|
|
93 convenient for use by Bio:: objects.
|
|
|
94
|
|
|
95 The motivation for having an error object is to allow
|
|
|
96 Perl 5 objects to deal with errors or exceptional conditions that
|
|
|
97 can arise during their construction or manipulation. For example:
|
|
|
98
|
|
|
99 (1) A complex object can break in many ways.
|
|
|
100 (2) Tracking errors within a set of nested objects can be difficult.
|
|
|
101 (3) The way an error is reported should be context-sensitive:
|
|
|
102 a web-user needs different information than does the
|
|
|
103 software engineer.
|
|
|
104
|
|
|
105 Bio::Root::Err.pm, along with B<Bio::Root::Object.pm>, attempt to make such
|
|
|
106 problems tractable. Please see the L<Bio::Root::Object> documentation for more
|
|
|
107 about my error handling philosophy.
|
|
|
108
|
|
|
109 A B<Bio::Root::Err.pm> object is an example of a Vector-Object: This module
|
|
|
110 inherits both from B<Bio::Root::Object.pm> and B<Bio::Root::Vector.pm>. This
|
|
|
111 permits a single Err object to exist within a linked list of Err objects OR
|
|
|
112 alone. See the L<Bio::Root::Vector> documentation for more about Vector-Objects.
|
|
|
113
|
|
|
114 B<The API for this module is not complete since the module is under development.>
|
|
|
115
|
|
|
116 =head2 Other Exception Strategies
|
|
|
117
|
|
|
118 Exception handling with Perl 5 objects is currently not as evolved as one
|
|
|
119 would like. The error handling used by B<Bio::Root::Object.pm> and Bio::Root::Err.pm
|
|
|
120 relies on Perl's built-in error/exception handling with eval/die,
|
|
|
121 which is not very object-aware. What I've attempted to do with these
|
|
|
122 modules is to make eval/die more object-savvy, as well as make Perl 5
|
|
|
123 objects more eval/die-savvy (but the current strategy is basically a hack).
|
|
|
124
|
|
|
125 It would be great if Perl could throw an object reference with die().
|
|
|
126 This would permit more intelligent and easy to write exception handlers.
|
|
|
127 For now the Err.pm object is reconstructed from the output of L<string>().
|
|
|
128
|
|
|
129 There are some other third-party Exception classes such as
|
|
|
130 Torsten Ekedahl's B<Experimental::Exception.pm> or Ken Steven's Throwable.pm or
|
|
|
131 Graham Barr's Error.pm (see L<Other Exception Modules>). These modules
|
|
|
132 attempt to introduce a traditional "try-catch-throw" exception handling mechanism
|
|
|
133 into Perl. Future version of my modules (and perhaps Perl itself) may utilize one
|
|
|
134 of these.
|
|
|
135
|
|
|
136 =head1 USAGE
|
|
|
137
|
|
|
138 A demo script that illustrates working with Bio::Root::Err objects is
|
|
|
139 examples/root_object/error.pl.
|
|
|
140
|
|
|
141
|
|
|
142 =head1 DEPENDENCIES
|
|
|
143
|
|
|
144 Bio::Root::Err.pm inherits from B<Bio::Root::Object.pm> and B<Bio::Root::Vector.pm>.
|
|
|
145
|
|
|
146
|
|
|
147 =head1 FEEDBACK
|
|
|
148
|
|
|
149 =head2 Mailing Lists
|
|
|
150
|
|
|
151 User feedback is an integral part of the evolution of this and other Bioperl modules.
|
|
|
152 Send your comments and suggestions preferably to one of the Bioperl mailing lists.
|
|
|
153 Your participation is much appreciated.
|
|
|
154
|
|
|
155 bioperl-l@bioperl.org - General discussion
|
|
|
156 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
157
|
|
|
158 =head2 Reporting Bugs
|
|
|
159
|
|
|
160 Report bugs to the Bioperl bug tracking system to help us keep track the bugs and
|
|
|
161 their resolution. Bug reports can be submitted via email or the web:
|
|
|
162
|
|
|
163 bioperl-bugs@bio.perl.org
|
|
|
164 http://bugzilla.bioperl.org/
|
|
|
165
|
|
|
166 =head1 AUTHOR Steve Chervitz
|
|
|
167
|
|
|
168 Email sac@bioperl.org
|
|
|
169
|
|
|
170 See L<the FEEDBACK section | FEEDBACK> section for where to send bug reports and comments.
|
|
|
171
|
|
|
172 =head1 VERSION
|
|
|
173
|
|
|
174 Bio::Root::Err.pm, 0.041
|
|
|
175
|
|
|
176
|
|
|
177 =head1 SEE ALSO
|
|
|
178
|
|
|
179 Bio::Root::Object.pm - Core object
|
|
|
180 Bio::Root::Vector.pm - Vector object
|
|
|
181 Bio::Root::Global.pm - Manages global variables/constants
|
|
|
182
|
|
|
183 http://bio.perl.org/Projects/modules.html - Online module documentation
|
|
|
184 http://bio.perl.org/ - Bioperl Project Homepage
|
|
|
185
|
|
|
186 =head2 Other Exception Modules
|
|
|
187
|
|
|
188 Experimental::Exception.pm - ftp://ftp.matematik.su.se/pub/teke/
|
|
|
189 Error.pm - http://www.cpan.org/authors/id/GBARR/
|
|
|
190 Throwable.pm - mailto:kstevens@globeandmail.ca
|
|
|
191
|
|
|
192 http://genome-www.stanford.edu/perlOOP/exceptions.html
|
|
|
193
|
|
|
194 =head1 ACKNOWLEDGEMENTS
|
|
|
195
|
|
|
196 This module was developed under the auspices of the Saccharomyces Genome
|
|
|
197 Database:
|
|
|
198 http://genome-www.stanford.edu/Saccharomyces
|
|
|
199
|
|
|
200 Other Bioperl developers contributed ideas including Ewan Birney, Ian Korf,
|
|
|
201 Chris Dagdigian, Georg Fuellen, and Steven Brenner.
|
|
|
202
|
|
|
203 =head1 COPYRIGHT
|
|
|
204
|
|
|
205 Copyright (c) 1996-8 Steve Chervitz. All Rights Reserved.
|
|
|
206 This module is free software; you can redistribute it and/or
|
|
|
207 modify it under the same terms as Perl itself.
|
|
|
208
|
|
|
209 =head1 TODO
|
|
|
210
|
|
|
211 =over 2
|
|
|
212
|
|
|
213 =item * Improve documentation.
|
|
|
214
|
|
|
215 =item * Experiment with other Exception modules.
|
|
|
216
|
|
|
217 =back
|
|
|
218
|
|
|
219 =cut
|
|
|
220
|
|
|
221 ## END MAIN POD DOCUMENTATION'
|
|
|
222
|
|
|
223 =head1 APPENDIX
|
|
|
224
|
|
|
225 Methods beginning with a leading underscore are considered private
|
|
|
226 and are intended for internal use by this module. They are
|
|
|
227 B<not> considered part of the public interface and are described here
|
|
|
228 for documentation purposes only.
|
|
|
229
|
|
|
230 =cut
|
|
|
231
|
|
|
232
|
|
|
233 ########################################################
|
|
|
234 # CONSTRUCTOR #
|
|
|
235 ########################################################
|
|
|
236
|
|
|
237
|
|
|
238 =head2 _initialize
|
|
|
239
|
|
|
240 Usage : n/a; automatically called by Bio::Root::Object::new()
|
|
|
241 Purpose : Initializes key Bio::Root::Err.pm data.
|
|
|
242 Returns : String (the -MAKE constructor option.)
|
|
|
243 Argument : Named parameters passed from new()
|
|
|
244 : (PARAMETER TAGS CAN BE UPPER OR LOWER CASE).
|
|
|
245 : -MSG => basic description of the exception.
|
|
|
246 : -NOTE => additional note to indicate cause of exception
|
|
|
247 : or provide information about how to fix/report it
|
|
|
248 : -TECH => addition note with technical information
|
|
|
249 : of interest to developer.
|
|
|
250 : -STACK => array reference containing caller() data
|
|
|
251 : -TYPE => string, one of @Bio::Root::Err::ERR_TYPES
|
|
|
252 : (default = exception).
|
|
|
253 : -CONTEXT => array reference
|
|
|
254 : -OBJ => Err object to be cloned.
|
|
|
255
|
|
|
256 See Also : B<Bio::Root::Object::_set_err()>
|
|
|
257
|
|
|
258 =cut
|
|
|
259
|
|
|
260 #----------------
|
|
|
261 sub _initialize {
|
|
|
262 #----------------
|
|
|
263 my( $self, @param ) = @_;
|
|
|
264
|
|
|
265 my $make = $self->Bio::Root::Object::_initialize( @param );
|
|
|
266
|
|
|
267 my( $msg, $note, $tech, $stack, $type, $context, $obj) =
|
|
|
268 $self->_rearrange([qw(MSG NOTE TECH STACK TYPE CONTEXT OBJ)], @param);
|
|
|
269
|
|
|
270 ## NOTE: Don't eval {} the construction process for Err objects.
|
|
|
271
|
|
|
272 if($make =~ /clone/i) {
|
|
|
273 $self->_set_clone($obj);
|
|
|
274 } else {
|
|
|
275 if(!$self->_build_from_string($msg, $note, $tech)) {
|
|
|
276 # print "Failed to rebuild: msg = $msg";<STDIN>;
|
|
|
277 $self->set('msg', $msg );
|
|
|
278 $self->_set_type( $type );
|
|
|
279 $self->_set_context($context);
|
|
|
280 $self->_set_list_data('note', $note );
|
|
|
281 $self->_set_list_data('tech', $tech );
|
|
|
282 $self->_set_list_data('stack', $stack );
|
|
|
283 }
|
|
|
284 $self->set_display();
|
|
|
285 }
|
|
|
286
|
|
|
287 $DEBUG and do{ print STDERR "---> Initialized Err (${\ref($self)}).\n\n";
|
|
|
288 # $self->print();
|
|
|
289 };
|
|
|
290 $make;
|
|
|
291 }
|
|
|
292
|
|
|
293 ##
|
|
|
294 ## Destructor: Not needed currently. Perhaps if and when Vector is used by delegation.
|
|
|
295 ##
|
|
|
296
|
|
|
297 #####################################################################################
|
|
|
298 ## ACCESSORS ##
|
|
|
299 #####################################################################################
|
|
|
300
|
|
|
301
|
|
|
302
|
|
|
303 =head2 _set_clone
|
|
|
304
|
|
|
305 Usage : n/a; internal method used by _initialize()
|
|
|
306 Purpose : Copy all Bio::Root::Err.pm data members into a new object reference.
|
|
|
307 Argument : object ref for object to be cloned.
|
|
|
308 Comments : Does not cloning the vector since this method is
|
|
|
309 : typically used to extract a single Err object from its vector.
|
|
|
310
|
|
|
311 =cut
|
|
|
312
|
|
|
313 #---------------
|
|
|
314 sub _set_clone {
|
|
|
315 #---------------
|
|
|
316 my($self, $obj) = @_;
|
|
|
317
|
|
|
318 ref($obj) || throw($self, "Can't clone $ID object: Not an object ref ($obj)");
|
|
|
319
|
|
|
320 $self->{'_type'} = $obj->{'_type'};
|
|
|
321 $self->{'_msg'} = $obj->{'_msg'};
|
|
|
322 $self->{'_note'} = $obj->{'_note'};
|
|
|
323 $self->{'_tech'} = $obj->{'_tech'};
|
|
|
324 $self->{'_stack'} = $obj->{'_stack'};
|
|
|
325 $self->{'_context'} = $obj->{'_context'};
|
|
|
326 # $self->clone_vector($obj);
|
|
|
327 }
|
|
|
328
|
|
|
329
|
|
|
330 =head2 _build_from_string
|
|
|
331
|
|
|
332 Usage : n/a; called by _initialize()
|
|
|
333 Purpose : Re-create an Err.pm object from a string containing Err data.
|
|
|
334 Returns : boolean, (was the Err.pm object rebuilt?)
|
|
|
335 Argument : message, note, tech passed from _initialize()
|
|
|
336 : The message is examined to see if it contains a stringified error.
|
|
|
337
|
|
|
338 See Also : L<_initialize>(), L<string>(), L<_has_err>()
|
|
|
339
|
|
|
340 =cut
|
|
|
341
|
|
|
342 #----------------------
|
|
|
343 sub _build_from_string {
|
|
|
344 #----------------------
|
|
|
345 my ($self, $msg, $note, $tech) = @_;
|
|
|
346 my @list = split "\n", $msg;
|
|
|
347 my ($mode,$line);
|
|
|
348 my $rebuilt = 0;
|
|
|
349
|
|
|
350 # print "$ID: Attempting to build from string: $msg";<STDIN>;
|
|
|
351
|
|
|
352 MEMBER:
|
|
|
353 foreach $line (@list) {
|
|
|
354 if($line =~ /^-+$/) { last MEMBER; }
|
|
|
355 if($line =~ /^-+ (\w+) -+$/) { $self->{'_type'} = $1; $rebuilt = 1; next MEMBER; }
|
|
|
356 if($line =~ /^MSG: *(\w.*)/) { my $msg = $1;
|
|
|
357 if($self->_has_err($msg)) {
|
|
|
358 die "Duplicate error.";
|
|
|
359 }
|
|
|
360 $self->{'_msg'} = $msg;
|
|
|
361 $mode = 'msg';
|
|
|
362 next MEMBER; }
|
|
|
363 if($line =~ /^CONTEXT: *(\w.*)/) { push @{$self->{'_context'}}, $1; $mode = 'context'; next MEMBER; }
|
|
|
364 if($line =~ /^NOTE: *(\w.*)/) { push @{$self->{'_note'}}, $1; $mode = 'note'; next MEMBER; }
|
|
|
365 if($line =~ /^TECH: *(\w.*)/) { push @{$self->{'_tech'}}, $1; $mode = 'tech'; next MEMBER; }
|
|
|
366 if($line =~ /^STACK:/) { $mode = 'stack'; next MEMBER; }
|
|
|
367 next MEMBER if !$mode;
|
|
|
368 SWITCH: {
|
|
|
369 local $_ = $mode;
|
|
|
370 m/msg/ && do{ $self->{'_msg'} .= "$line\n"; last SWITCH; };
|
|
|
371 m/note/ && do{ push @{$self->{'_note'}}, $line; last SWITCH; };
|
|
|
372 m/context/ && do{ push @{$self->{'_context'}}, $line; last SWITCH; };
|
|
|
373 m/tech/ && do{ push @{$self->{'_tech'}}, $line; last SWITCH; };
|
|
|
374 m/stack/ && do{ push @{$self->{'_stack'}}, $line; last SWITCH; };
|
|
|
375 next MEMBER;
|
|
|
376 }
|
|
|
377 }
|
|
|
378 if($rebuilt) {
|
|
|
379 ## Optionally add additional notes.
|
|
|
380 $self->_set_list_data('note', $note) if defined $note;
|
|
|
381 $self->_set_list_data('tech', $tech) if defined $tech;
|
|
|
382 }
|
|
|
383
|
|
|
384 $rebuilt;
|
|
|
385 }
|
|
|
386
|
|
|
387
|
|
|
388 =head2 _has_err
|
|
|
389
|
|
|
390 Usage : n/a; internal method called by _build_from_string()
|
|
|
391 Purpose : Deterimine if an Err has already been set to prevent duplicate Errs.
|
|
|
392 Returns : boolean
|
|
|
393
|
|
|
394 See Also : L<_build_from_string>()
|
|
|
395
|
|
|
396 =cut
|
|
|
397
|
|
|
398 #-------------
|
|
|
399 sub _has_err {
|
|
|
400 #-------------
|
|
|
401 my ($self, $msg) = @_;
|
|
|
402
|
|
|
403 $msg =~ s/^\s+//;
|
|
|
404 $msg =~ s/\s+$//;
|
|
|
405
|
|
|
406 my $err = $self->first;
|
|
|
407 my ($existing_msg);
|
|
|
408 do {
|
|
|
409 # print "checking err object $self\n";
|
|
|
410 $existing_msg = $err->msg;
|
|
|
411 $existing_msg =~ s/^\s+//;
|
|
|
412 $existing_msg =~ s/\s+$//;
|
|
|
413 # print " msg: $existing_msg";<STDIN>;
|
|
|
414 return 1 if $existing_msg eq $msg;
|
|
|
415
|
|
|
416 } while($err = $err->next);
|
|
|
417
|
|
|
418 0;
|
|
|
419 }
|
|
|
420
|
|
|
421
|
|
|
422 =head2 _set_type
|
|
|
423
|
|
|
424 Usage : n/a; internal method
|
|
|
425 Purpose : Sets the type of Err (warning, exception, fatal)
|
|
|
426 : Called by _initialize()
|
|
|
427 Argument : string
|
|
|
428
|
|
|
429 =cut
|
|
|
430
|
|
|
431 #----------------
|
|
|
432 sub _set_type {
|
|
|
433 #----------------
|
|
|
434 my( $self, $data ) = @_;
|
|
|
435 $data ||= 'EXCEPTION';
|
|
|
436
|
|
|
437 # printf "\n$ID: Setting type (%s) for err = %s\n", $data, $self->msg;<STDIN>;
|
|
|
438
|
|
|
439 my (@type);
|
|
|
440 if( @type = grep /$data/i, @Bio::Root::Err::ERR_TYPES ) {
|
|
|
441 $self->{'_type'} = $type[0];
|
|
|
442 } else {
|
|
|
443 $self->{'_type'} = 'EXCEPTION';
|
|
|
444 }
|
|
|
445
|
|
|
446 # print "type = $self->{'_type'} for $self";<STDIN>;
|
|
|
447 }
|
|
|
448
|
|
|
449
|
|
|
450
|
|
|
451 =head2 _set_list_data
|
|
|
452
|
|
|
453 Usage : n/a; internal method used by set().
|
|
|
454 : $err->_set_list_data( $member, $data);
|
|
|
455 Purpose : For data members which are anonymous arrays: note, tech, stack,
|
|
|
456 : adds the given data to the list.
|
|
|
457 Arguments : $member = any of qw(note tech stack)
|
|
|
458 : $data = string
|
|
|
459 Comments : Splits $data on tab. Each item
|
|
|
460 : of the split is a new entry.
|
|
|
461 : To clobber the current data (unusual situation), you must first
|
|
|
462 : call set() with no data then call again with desired data.
|
|
|
463
|
|
|
464 =cut
|
|
|
465
|
|
|
466 #-------------------
|
|
|
467 sub _set_list_data {
|
|
|
468 #-------------------
|
|
|
469 my( $self, $member, $data ) = @_;
|
|
|
470
|
|
|
471 # Sensitive to data member name changes.
|
|
|
472 $member = "_\l$member";
|
|
|
473
|
|
|
474 # $DEBUG && do {printf STDERR "\n$ID: Setting \"%s\" list data (%s)\n", $member, $data;<STDIN>; };
|
|
|
475
|
|
|
476 defined $self->{$member} and return $self->_add_list_data( $member, $data );
|
|
|
477
|
|
|
478 if( $data ) {
|
|
|
479 $self->{$member} = [];
|
|
|
480 if( $member =~ /stack/) {
|
|
|
481 foreach (@$data) {
|
|
|
482 push @{ $self->{$member}}, format_stack_entry(@$_);
|
|
|
483 }
|
|
|
484 } else {
|
|
|
485 my @entries = split "\t", $data;
|
|
|
486 foreach (@entries) {
|
|
|
487 next if /^$/;
|
|
|
488 # $DEBUG && do {print STDERR "adding $member: $_";<STDIN>;};
|
|
|
489 push @{ $self->{$member}}, $_;
|
|
|
490 }
|
|
|
491 }
|
|
|
492 } else {
|
|
|
493 $self->{$member} = undef;
|
|
|
494 }
|
|
|
495 }
|
|
|
496
|
|
|
497
|
|
|
498 =head2 _set_context
|
|
|
499
|
|
|
500 Usage : n/a; internal method used by set().
|
|
|
501 Purpose : Sets the object containment context for the exception.
|
|
|
502 : (this is the hierarchy of objects in which the
|
|
|
503 : exception occurred.)
|
|
|
504
|
|
|
505 =cut
|
|
|
506
|
|
|
507 #------------------
|
|
|
508 sub _set_context {
|
|
|
509 #------------------
|
|
|
510 my($self, $aref) = @_;
|
|
|
511
|
|
|
512 eval {
|
|
|
513 if (!ref $aref) {
|
|
|
514 # push @{$aref}, sprintf "object %s \"%s\"",ref($self->parent), $self->parent->name;
|
|
|
515 push @{$aref}, "UNKNOWN CONTEXT";
|
|
|
516 }
|
|
|
517 };
|
|
|
518 if($@) { push @{$aref}, 'undefined object'; }
|
|
|
519
|
|
|
520 if($self->type eq 'EXCEPTION') {
|
|
|
521 $aref->[0] = "Exception thrown by \l$aref->[0]";
|
|
|
522 } else {
|
|
|
523 $aref->[0] = "Error in \l$aref->[0]";
|
|
|
524 }
|
|
|
525
|
|
|
526 my $script = ($0 =~ /([\w\/\.]+)/, $1);
|
|
|
527 push @$aref, "SCRIPT: $script";
|
|
|
528
|
|
|
529 $self->{'_context'} = $aref;
|
|
|
530
|
|
|
531 # print "$ID: _set_context():\n";
|
|
|
532 # foreach(@$aref) { print " $_\n"; }
|
|
|
533 # <STDIN>;
|
|
|
534 }
|
|
|
535
|
|
|
536
|
|
|
537
|
|
|
538 =head2 set
|
|
|
539
|
|
|
540 Usage : $err->set( $member, $data );
|
|
|
541 Purpose : General accessor for setting any Err.pm data member.
|
|
|
542 Example : $err->set('note', 'this is an additional note.');
|
|
|
543 Returns : n/a
|
|
|
544 Argument : $member = string, any of qw(msg type note tech stack)
|
|
|
545 : $data = string
|
|
|
546 Throws : n/a
|
|
|
547 Comments : Note, tech, and stack items are appended to any existing
|
|
|
548 : notes, tech notes, and stack.
|
|
|
549 : There should be no need to mess with the stack.
|
|
|
550
|
|
|
551 =cut
|
|
|
552
|
|
|
553 #---------
|
|
|
554 sub set {
|
|
|
555 #---------
|
|
|
556 my( $self, $member, $data ) = @_;
|
|
|
557
|
|
|
558 local $_ = "\u$member";
|
|
|
559 SWITCH: {
|
|
|
560 /msg/i && do{ $self->{'_msg'} = (defined $data ? $data : 'Unknown error'); last SWITCH; };
|
|
|
561 /type/i && do{ $self->_set_type( $data ); last SWITCH; };
|
|
|
562 /note|tech|stack/i && do{ $self->_set_list_data( $member, $data); last SWITCH};
|
|
|
563 warn "\n*** Invalid or unspecified Err data member: $member\n\n";
|
|
|
564 }
|
|
|
565 }
|
|
|
566
|
|
|
567
|
|
|
568 =head2 msg
|
|
|
569
|
|
|
570 Usage : $message = $err->msg;
|
|
|
571 Purpose : Get the main message associated with the exception.
|
|
|
572 Returns : String
|
|
|
573 Argument : optional string to be used as a delimiter.
|
|
|
574
|
|
|
575 See Also : L<get>(), L<string>()
|
|
|
576
|
|
|
577 =cut
|
|
|
578
|
|
|
579
|
|
|
580 #-------
|
|
|
581 sub msg { my($self,$delimiter) = @_; $self->get('msg',$delimiter); }
|
|
|
582 #-------
|
|
|
583
|
|
|
584
|
|
|
585 =head2 type
|
|
|
586
|
|
|
587 Usage : $type = $err->type;
|
|
|
588 Purpose : Get the type of Err (warning, exception, fatal)
|
|
|
589 Returns : String
|
|
|
590 Argument : optional string to be used as a delimiter.
|
|
|
591
|
|
|
592 See Also : L<get>(), L<string>()
|
|
|
593
|
|
|
594 =cut
|
|
|
595
|
|
|
596 #--------
|
|
|
597 sub type { my($self,$delimiter) = @_; $self->get('type',$delimiter); }
|
|
|
598 #--------
|
|
|
599
|
|
|
600
|
|
|
601 =head2 note
|
|
|
602
|
|
|
603 Usage : $note = $err->note;
|
|
|
604 : $note = $err->note('<P>');
|
|
|
605 Purpose : Get any general note associated with the exception.
|
|
|
606 Returns : String
|
|
|
607 Argument : optional string to be used as a delimiter.
|
|
|
608
|
|
|
609 See Also : L<get>(), L<string>()
|
|
|
610
|
|
|
611 =cut
|
|
|
612
|
|
|
613 #---------
|
|
|
614 sub note { my($self,$delimiter) = @_; $self->get('note',$delimiter); }
|
|
|
615 #---------
|
|
|
616
|
|
|
617
|
|
|
618 =head2 tech
|
|
|
619
|
|
|
620 Usage : $tech = $err->tech;
|
|
|
621 : $tech = $err->tech('<P>');
|
|
|
622 Purpose : Get any technical note associate with the exception.
|
|
|
623 Returns : String
|
|
|
624 Argument : optional string to be used as a delimiter.
|
|
|
625
|
|
|
626 See Also : L<get>(), L<string>()
|
|
|
627
|
|
|
628 =cut
|
|
|
629
|
|
|
630 #------------
|
|
|
631 sub tech { my($self,$delimiter) = @_; $self->get('tech',$delimiter); }
|
|
|
632 #------------
|
|
|
633
|
|
|
634
|
|
|
635
|
|
|
636 =head2 stack
|
|
|
637
|
|
|
638 Usage : $stack = $err->stack;
|
|
|
639 : $stack = $err->stack('<P>');
|
|
|
640 Purpose : Get the call stack for the exception.
|
|
|
641 Returns : String
|
|
|
642 Argument : optional string to be used as a delimiter.
|
|
|
643
|
|
|
644 See Also : L<get>(), L<string>()
|
|
|
645
|
|
|
646 =cut
|
|
|
647
|
|
|
648 #----------
|
|
|
649 sub stack { my($self,$delimiter) = @_; $self->get('stack',$delimiter); }
|
|
|
650 #----------
|
|
|
651
|
|
|
652
|
|
|
653
|
|
|
654 =head2 context
|
|
|
655
|
|
|
656 Usage : $context = $err->context;
|
|
|
657 : $context = $err->context('<P>');
|
|
|
658 Purpose : Get the containment context of the object which generated the exception.
|
|
|
659 Returns : String
|
|
|
660 Argument : optional string to be used as a delimiter.
|
|
|
661
|
|
|
662 See Also : L<get>(), L<string>()
|
|
|
663
|
|
|
664 =cut
|
|
|
665
|
|
|
666 #------------
|
|
|
667 sub context { my($self,$delimiter) = @_; $self->get('context',$delimiter); }
|
|
|
668 #------------
|
|
|
669
|
|
|
670
|
|
|
671
|
|
|
672 =head2 get
|
|
|
673
|
|
|
674 Usage : $err->get($member, $delimiter);
|
|
|
675 Purpose : Get specific data from the Err.pm object.
|
|
|
676 Returns : String in scalar context.
|
|
|
677 : Array in list context.
|
|
|
678 Argument : $member = any of qw(msg type note tech stack context) or combination.
|
|
|
679 : $delimiter = optional string to be used as a delimiter
|
|
|
680 : between member data.
|
|
|
681
|
|
|
682 See Also : L<string>(), L<msg>(), L<note>(), L<tech>(), L<type>(), L<context>(), L<stack>()
|
|
|
683
|
|
|
684 =cut
|
|
|
685
|
|
|
686 #---------
|
|
|
687 sub get {
|
|
|
688 #---------
|
|
|
689 my( $self, $member, $delimiter ) = @_;
|
|
|
690
|
|
|
691 my $outer_delim = $delimiter || "\n";
|
|
|
692 # my $outer_delim = ($CGI ? "\n<P>" : $delimiter); ## Subtle bug here.
|
|
|
693
|
|
|
694 my (@out);
|
|
|
695 local $_ = $member;
|
|
|
696 SWITCH: {
|
|
|
697 /type/i && do{ push (@out, $self->{'_type'},$outer_delim) };
|
|
|
698 # /msg/i && do{ print "getting msg";<STDIN>; push (@out, (defined $self->{'_msg'} ? $self->{'_msg'} : ''),$outer_delim); print "msg: @out<---";<STDIN>; };
|
|
|
699 /msg/i && do{ push (@out, (defined $self->{'_msg'} ? $self->{'_msg'} : ''),$outer_delim); };
|
|
|
700 /note/i && do{ push (@out, $self->_get_list_data('note', $delimiter ),$outer_delim) };
|
|
|
701 /tech/i && do{ push (@out, $self->_get_list_data('tech', $delimiter ),$outer_delim) };
|
|
|
702 /stack/i && do{ push (@out, $self->_get_list_data('stack', $delimiter ),$outer_delim) };
|
|
|
703 /context/i && do{ push (@out, $self->_get_list_data('context', $delimiter ),$outer_delim) };
|
|
|
704
|
|
|
705 ## CAN'T USE THE FOLLOWING FORM SINCE IT FAILS WHEN $member EQUALS 'msgnote'.
|
|
|
706 # /note|tech|stack/ && do{ push @out, $self->_get_list_data( $_, $delimiter ); };
|
|
|
707
|
|
|
708 last SWITCH;
|
|
|
709 $self->warn("Invalid or undefined Err data member ($member).");
|
|
|
710 }
|
|
|
711 # $DEBUG && do{ print STDERR "OUTER DELIM = $outer_delim \nOUT: \n @out <---";<STDIN>;};
|
|
|
712 wantarray ? @out : join('',@out);
|
|
|
713 }
|
|
|
714
|
|
|
715
|
|
|
716
|
|
|
717 =head2 _get_list_data
|
|
|
718
|
|
|
719 Usage : n/a; internal method used by get()
|
|
|
720 Purpose : Gets data for members which are list refs (note, tech, stack, context)
|
|
|
721 Returns : Array
|
|
|
722 Argument : ($member, $delimiter)
|
|
|
723
|
|
|
724 See Also : L<get>()
|
|
|
725
|
|
|
726 =cut
|
|
|
727
|
|
|
728 #-------------------
|
|
|
729 sub _get_list_data {
|
|
|
730 #-------------------
|
|
|
731 my( $self, $member, $delimiter ) = @_;
|
|
|
732 $delimiter ||= "\t";
|
|
|
733 # Sensitive to data member name changes.
|
|
|
734 $member = "_\l$member";
|
|
|
735 return if !defined $self->{$member};
|
|
|
736 join( $delimiter, @{$self->{$member}} );
|
|
|
737 }
|
|
|
738
|
|
|
739
|
|
|
740
|
|
|
741 =head2 get_all
|
|
|
742
|
|
|
743 Usage : (same as get())
|
|
|
744 Purpose : Get specific data from all errors in an Err.pm object.
|
|
|
745 Returns : Array in list context.
|
|
|
746 : String in scalar context.
|
|
|
747 Argument : (same as get())
|
|
|
748
|
|
|
749 See Also : L<get>()
|
|
|
750
|
|
|
751 =cut
|
|
|
752
|
|
|
753 #------------
|
|
|
754 sub get_all {
|
|
|
755 #------------
|
|
|
756 my( $self, $member, $delimiter ) = @_;
|
|
|
757
|
|
|
758 if( $self->size() == 1) {
|
|
|
759 return $self->get( $member, $delimiter);
|
|
|
760 } else {
|
|
|
761 my $err = $self;
|
|
|
762
|
|
|
763 ### Return data from multiple errors in a list.
|
|
|
764 if(wantarray) {
|
|
|
765 my @out;
|
|
|
766 do{ push @out, $err->get( $member);
|
|
|
767 } while($err = $err->prev());
|
|
|
768 return @out;
|
|
|
769
|
|
|
770 } else {
|
|
|
771 ### Return data from multiple errors in a string with each error's data
|
|
|
772 ### bracketed by a "Error #n\n" line and two delimiters.
|
|
|
773 my $out = '';
|
|
|
774 if($err->size() == 1) {
|
|
|
775 $out = $err->get( $member, $delimiter);
|
|
|
776 } else {
|
|
|
777 do{ #$out .= "Error #${\$err->rank()}$delimiter";
|
|
|
778 $out .= $err->get( $member, $delimiter);
|
|
|
779 $out .= $delimiter.$delimiter;
|
|
|
780 } while($err = $err->prev());
|
|
|
781 }
|
|
|
782 return $out;
|
|
|
783 }
|
|
|
784 }
|
|
|
785 }
|
|
|
786
|
|
|
787 #####################################################################################
|
|
|
788 ## INSTANCE METHODS ##
|
|
|
789 #####################################################################################
|
|
|
790
|
|
|
791
|
|
|
792 =head2 _add_note
|
|
|
793
|
|
|
794 Usage : n/a; internal method called by _add_list_data()
|
|
|
795 Purpose : adds a new note.
|
|
|
796
|
|
|
797 See Also : L<_add_list_data>()
|
|
|
798
|
|
|
799 =cut
|
|
|
800
|
|
|
801 #---------------
|
|
|
802 sub _add_note {
|
|
|
803 #---------------
|
|
|
804 my( $self, $data ) = @_;
|
|
|
805
|
|
|
806 if( defined $self->{'_note'} ) {
|
|
|
807 push @{ $self->{'_note'}}, $data;
|
|
|
808 } else {
|
|
|
809 $self->_set_list_data('note', $data );
|
|
|
810 }
|
|
|
811 }
|
|
|
812
|
|
|
813 #----------------------------------------------------------------------
|
|
|
814 =head2 _add_tech()
|
|
|
815
|
|
|
816 Usage : n/a; internal method called by _add_list_data()
|
|
|
817 Purpose : adds a new technical note.
|
|
|
818
|
|
|
819 See Also : L<_add_list_data>()
|
|
|
820
|
|
|
821 =cut
|
|
|
822
|
|
|
823 #-------------
|
|
|
824 sub _add_tech {
|
|
|
825 #-------------
|
|
|
826 my( $self, $data ) = @_;
|
|
|
827
|
|
|
828 if( defined $self->{'_tech'} ) {
|
|
|
829 push @{ $self->{'_tech'}}, $data;
|
|
|
830 } else {
|
|
|
831 $self->_set_list_data('Tech', $data );
|
|
|
832 }
|
|
|
833 }
|
|
|
834
|
|
|
835
|
|
|
836 =head2 _add_list_data
|
|
|
837
|
|
|
838 Usage : n/a; called by _set_list_data()
|
|
|
839 Purpose : adds a new note or tech note.
|
|
|
840
|
|
|
841 See Also : L<_set_list_data>()
|
|
|
842
|
|
|
843 =cut
|
|
|
844
|
|
|
845 #--------------------
|
|
|
846 sub _add_list_data {
|
|
|
847 #--------------------
|
|
|
848 my( $self, $member, $data ) = @_;
|
|
|
849
|
|
|
850 local $_ = $member;
|
|
|
851 SWITCH: {
|
|
|
852 /note/i && do{ $self->_add_note( $data ); };
|
|
|
853 /tech/i && do{ $self->_add_tech( $data ); };
|
|
|
854 }
|
|
|
855 }
|
|
|
856
|
|
|
857
|
|
|
858
|
|
|
859 =head2 print
|
|
|
860
|
|
|
861 Usage : $err->print;
|
|
|
862 Purpose : Prints Err data to STDOUT or a FileHandle.
|
|
|
863 Returns : Call to print
|
|
|
864 Argument : Named parameters for string()
|
|
|
865 Comments : Uses string() to get data.
|
|
|
866
|
|
|
867 See Also : L<string>()
|
|
|
868
|
|
|
869 =cut
|
|
|
870
|
|
|
871 #-----------
|
|
|
872 sub print {
|
|
|
873 #-----------
|
|
|
874 my( $self, %param ) = @_;
|
|
|
875 # my $OUT = $self->parent->fh();
|
|
|
876 # print $OUT $self->string(%param);
|
|
|
877 print $self->string(%param);
|
|
|
878 }
|
|
|
879
|
|
|
880
|
|
|
881 =head2 string
|
|
|
882
|
|
|
883 Usage : $err->string( %named_parameters);
|
|
|
884 Purpose : Stringify the data contained in the Err.pm object.
|
|
|
885 Example : print STDERR $err->string;
|
|
|
886 Returns : String
|
|
|
887 Argument : Named parameters (optional) passed to
|
|
|
888 : Bio::Root::IOManager::set_display().
|
|
|
889
|
|
|
890 See Also : L<print>(), L<_build_from_string>(), B<Bio::Root::IOManager::set_display()>
|
|
|
891
|
|
|
892 =cut
|
|
|
893
|
|
|
894 #-----------
|
|
|
895 sub string {
|
|
|
896 #-----------
|
|
|
897 my( $self, @param ) = @_;
|
|
|
898
|
|
|
899 my %param = @param;
|
|
|
900 $self->set_display( @param );
|
|
|
901 my $show = $self->show;
|
|
|
902 my $out = $param{-BEEP} ? "\a" : '';
|
|
|
903
|
|
|
904 my $err = $param{-CURRENT} ? $self->last : $self->first;
|
|
|
905
|
|
|
906 # my $err1 = $err;
|
|
|
907 # my $errL = $self->last;
|
|
|
908 # print "\n\nERR 1: ${\$err1->msg}";
|
|
|
909 # print "\nERR L: ${\$errL->msg}";<STDIN>;
|
|
|
910
|
|
|
911 my $numerate = $err->size() >1;
|
|
|
912 my $count = 0;
|
|
|
913 my ($title);
|
|
|
914 my $hasnote = defined $self->{'_note'};
|
|
|
915 my $hastech = defined $self->{'_tech'};
|
|
|
916
|
|
|
917 while (ref $err) {
|
|
|
918 $count++;
|
|
|
919 # $out .= sprintf "\nERROR #%d:", $count;
|
|
|
920
|
|
|
921 if(not $title = $err->{'_type'}) {
|
|
|
922 $err = $err->next();
|
|
|
923 next;
|
|
|
924 }
|
|
|
925 if( $numerate) {
|
|
|
926 ## The rank data is a bit screwy at present.
|
|
|
927 $out .= sprintf "\n%s %s %s\n", '-'x 20, $title,'-'x 20;
|
|
|
928 } else {
|
|
|
929 $out .= sprintf "\n%s %s %s\n", '-'x20, $title,'-'x20;
|
|
|
930 }
|
|
|
931 $show =~ /msg|default/i and $out .= "MSG: " . $err->msg("\n");
|
|
|
932 $show =~ /note|default/i and $hasnote and $out .= "NOTE: ".$err->note("\n");
|
|
|
933 $show =~ /tech|default/i and $hastech and $out .= "TECH: ".$err->tech("\n");
|
|
|
934 $show =~ /context|default/i and $out .= "CONTEXT: ".$err->context("\n");
|
|
|
935 $show =~ /stack|default/i and $out .= "STACK: \n".$err->stack("\n");
|
|
|
936 $out .= sprintf "%s%s%s\n",'-'x 20, '-'x (length($title)+2), '-'x 20;
|
|
|
937
|
|
|
938 # print "$ID: string: cumulative err:\n$out\n";<STDIN>;
|
|
|
939
|
|
|
940 $err = $err->next();
|
|
|
941 }
|
|
|
942
|
|
|
943 $out;
|
|
|
944 }
|
|
|
945
|
|
|
946
|
|
|
947
|
|
|
948 =head2 is_fatal
|
|
|
949
|
|
|
950 Usage : $err->is_fatal;
|
|
|
951 Purpose : Determine if the error is of type 'FATAL'
|
|
|
952 Returns : Boolean
|
|
|
953 Status : Experimental, Deprecated
|
|
|
954
|
|
|
955 =cut
|
|
|
956
|
|
|
957 #--------------
|
|
|
958 sub is_fatal { my $self = shift; $self->{'_type'} eq 'FATAL'; }
|
|
|
959 #--------------
|
|
|
960
|
|
|
961 #####################################################################################
|
|
|
962 ## CLASS METHODS ##
|
|
|
963 #####################################################################################
|
|
|
964
|
|
|
965
|
|
|
966 =head2 throw
|
|
|
967
|
|
|
968 Usage : throw($object, [message], [note], [technical note]);
|
|
|
969 : This method is exported.
|
|
|
970 Purpose : Class method version of Bio::Root::Object::throw().
|
|
|
971 Returns : die()s with the contents of the Err object in a string.
|
|
|
972 : If the global strictness is less than -1, die is not called and
|
|
|
973 : the error is printed to STDERR.
|
|
|
974 Argument : [0] = object throwing the error.
|
|
|
975 : [1] = optional message about the error.
|
|
|
976 : [2] = optional note about the error.
|
|
|
977 : [3] = optional technical note about the error.
|
|
|
978 Comments : The glogal verbosity level is not used. For verbosity-sensitive
|
|
|
979 : behavior, use Bio::Root::Object::throw().
|
|
|
980 Status : Experimental
|
|
|
981 : This method is an alternative to Bio::Root::Object::throw()
|
|
|
982 : and is not as well developed or documented as that method.
|
|
|
983
|
|
|
984 See Also : L<warning>(), B<Bio::Root::Object::throw()> B<Bio::Root::Global::strictness>()
|
|
|
985
|
|
|
986 =cut
|
|
|
987
|
|
|
988 #----------
|
|
|
989 sub throw {
|
|
|
990 #----------
|
|
|
991 my($obj, @param) = @_;
|
|
|
992
|
|
|
993 # print "Throwing exception for object ${\ref $self} \"${\$self->name}\"\n";
|
|
|
994 my $err = new Bio::Root::Err(
|
|
|
995 -MSG =>$param[0],
|
|
|
996 -NOTE =>$param[1],
|
|
|
997 -TECH =>$param[2],
|
|
|
998 -STACK =>scalar(Bio::Root::Object::stack_trace($obj,2)),
|
|
|
999 -CONTEXT =>Bio::Root::Object::containment($obj),
|
|
|
1000 -TYPE =>'EXCEPTION',
|
|
|
1001 # -PARENT =>$obj,
|
|
|
1002 );
|
|
|
1003
|
|
|
1004 if(strictness() < -1) {
|
|
|
1005 print STDERR $err->string(-BEEP=>1) unless verbosity() < 0;
|
|
|
1006 } else {
|
|
|
1007 die $err->string;
|
|
|
1008 }
|
|
|
1009
|
|
|
1010 0;
|
|
|
1011 }
|
|
|
1012
|
|
|
1013
|
|
|
1014 =head2 warning
|
|
|
1015
|
|
|
1016 Usage : warning($object, [message], [note], [technical note]);
|
|
|
1017 : This method is exported.
|
|
|
1018 Purpose : Class method version of Bio::Root::Object::warn().
|
|
|
1019 Returns : Prints the contents of the error to STDERR and returns false (0).
|
|
|
1020 : If the global strictness() is > 1, warn() calls are converted
|
|
|
1021 : into throw() calls.
|
|
|
1022 Argument : [0] = object producing the warning.
|
|
|
1023 : [1] = optional message about the error.
|
|
|
1024 : [2] = optional note about the error.
|
|
|
1025 : [3] = optional technical note about the error.
|
|
|
1026 :
|
|
|
1027 Comments : The glogal verbosity level is not used. For verbosity-sensitive
|
|
|
1028 : behavior, use Bio::Root::Object::warn().
|
|
|
1029 Status : Experimental
|
|
|
1030 : This method is an alternative to Bio::Root::Object::warn()
|
|
|
1031 : and is not as well developed or documented as that method.
|
|
|
1032
|
|
|
1033 See Also : L<throw>, B<Bio::Root::Object::warn()>, B<Bio::Root::Global::strictness()>
|
|
|
1034
|
|
|
1035 =cut
|
|
|
1036
|
|
|
1037 #-----------
|
|
|
1038 sub warning {
|
|
|
1039 #-----------
|
|
|
1040 my($obj, @param) = @_;
|
|
|
1041
|
|
|
1042 # print "Throwing exception for object ${\ref $self} \"${\$self->name}\"\n";
|
|
|
1043 my $err = new Bio::Root::Err(
|
|
|
1044 -MSG =>$param[0],
|
|
|
1045 -NOTE =>$param[1],
|
|
|
1046 -TECH =>$param[2],
|
|
|
1047 -STACK =>scalar(Bio::Root::Object::stack_trace($obj,2)),
|
|
|
1048 -CONTEXT =>Bio::Root::Object::containment($obj),
|
|
|
1049 -TYPE =>'WARNING',
|
|
|
1050 # -PARENT =>$obj,
|
|
|
1051 );
|
|
|
1052
|
|
|
1053 if(strictness() > 1) {
|
|
|
1054 die $err->string;
|
|
|
1055
|
|
|
1056 } else {
|
|
|
1057 print STDERR $err->string(-BEEP=>1) unless $DONT_WARN;
|
|
|
1058 }
|
|
|
1059
|
|
|
1060 0;
|
|
|
1061 }
|
|
|
1062
|
|
|
1063
|
|
|
1064 =head2 format_stack_entry
|
|
|
1065
|
|
|
1066 Usage : &format_stack_entry(<class>,<file>,<line>,<class_method>,<has_args>,<wantarray>)
|
|
|
1067 : This function is exported.
|
|
|
1068 Purpose : Creates a single stack entry given a caller() list.
|
|
|
1069 Argument : List of scalars (output of the caller() method).
|
|
|
1070 Returns : String = class_method($line)
|
|
|
1071 : e.g., Bio::Root::Object::name(1234)
|
|
|
1072
|
|
|
1073 =cut
|
|
|
1074
|
|
|
1075 #------------------------
|
|
|
1076 sub format_stack_entry {
|
|
|
1077 #------------------------
|
|
|
1078 my( $class, $file, $line, $classmethod, $hasargs, $wantarray) = @_;
|
|
|
1079
|
|
|
1080 # if($DEBUG) {
|
|
|
1081 # print STDERR "format_stack_entry data:\n";
|
|
|
1082 # foreach(@_) {print STDERR "$_\n"; } <STDIN>;
|
|
|
1083 # }
|
|
|
1084
|
|
|
1085 $classmethod ||= 'unknown class/method';
|
|
|
1086 $line ||= 'unknown line';
|
|
|
1087 return "$classmethod($line)";
|
|
|
1088 }
|
|
|
1089
|
|
|
1090 1;
|
|
|
1091 __END__
|
|
|
1092
|
|
|
1093 #####################################################################################
|
|
|
1094 # END OF CLASS #
|
|
|
1095 #####################################################################################
|
|
|
1096
|
|
|
1097 =head1 FOR DEVELOPERS ONLY
|
|
|
1098
|
|
|
1099 =head2 Data Members
|
|
|
1100
|
|
|
1101 Information about the various data members of this module is provided for those
|
|
|
1102 wishing to modify or understand the code. Two things to bear in mind:
|
|
|
1103
|
|
|
1104 =over 4
|
|
|
1105
|
|
|
1106 =item 1 Do NOT rely on these in any code outside of this module.
|
|
|
1107
|
|
|
1108 All data members are prefixed with an underscore to signify that they are private.
|
|
|
1109 Always use accessor methods. If the accessor doesn't exist or is inadequate,
|
|
|
1110 create or modify an accessor (and let me know, too!).
|
|
|
1111
|
|
|
1112 =item 2 This documentation may be incomplete and out of date.
|
|
|
1113
|
|
|
1114 It is easy for this documentation to become obsolete as this module is still evolving.
|
|
|
1115 Always double check this info and search for members not described here.
|
|
|
1116
|
|
|
1117 =back
|
|
|
1118
|
|
|
1119 An instance of Bio::Root::Err.pm is a blessed reference to a hash containing
|
|
|
1120 all or some of the following fields:
|
|
|
1121
|
|
|
1122 FIELD VALUE
|
|
|
1123 ------------------------------------------------------------------------
|
|
|
1124 _type fatal | warning | exception (one of @Bio::Root::Err::ERR_TYPES).
|
|
|
1125
|
|
|
1126 _msg Terse description: Main cause of error.
|
|
|
1127
|
|
|
1128 _note List reference. Verbose description: probable cause & troubleshooting for user.
|
|
|
1129
|
|
|
1130 _tech List reference. Technical notes of interest to programmer.
|
|
|
1131
|
|
|
1132 _stack List reference. Stack trace: list of "class::method(line number)" strings.
|
|
|
1133
|
|
|
1134
|
|
|
1135
|
|
|
1136 =cut
|
|
|
1137
|
|
|
1138 1;
|
