|
0
|
1 #-----------------------------------------------------------------------------
|
|
|
2 # PACKAGE : Bio::Root::Object.pm
|
|
|
3 # AUTHOR : Steve Chervitz (sac@bioperl.org)
|
|
|
4 # CREATED : 23 July 1996
|
|
|
5 # REVISION: $Id: Object.pm,v 1.23 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 # MODIFICATION NOTES: See bottom of file.
|
|
|
12 #
|
|
|
13 # Copyright (c) 1996-2000 Steve Chervitz. All Rights Reserved.
|
|
|
14 # This module is free software; you can redistribute it and/or
|
|
|
15 # modify it under the same terms as Perl itself.
|
|
|
16 # Retain this notice and note any modifications made.
|
|
|
17 #-----------------------------------------------------------------------------
|
|
|
18
|
|
|
19 package Bio::Root::Object;
|
|
|
20 use strict;
|
|
|
21
|
|
|
22 require 5.002;
|
|
|
23 use Bio::Root::Global qw(:devel $AUTHORITY $CGI);
|
|
|
24 use Bio::Root::Root;
|
|
|
25
|
|
|
26 use Exporter ();
|
|
|
27
|
|
|
28 #use AutoLoader;
|
|
|
29 #*AUTOLOAD = \&AutoLoader::AUTOLOAD;
|
|
|
30
|
|
|
31 use vars qw(@EXPORT_OK %EXPORT_TAGS);
|
|
|
32 @EXPORT_OK = qw($VERSION &find_object &stack_trace &containment &_rearrange);
|
|
|
33 %EXPORT_TAGS = ( std => [qw(&stack_trace &containment)] );
|
|
|
34
|
|
|
35 use vars qw($ID $VERSION %Objects_created $Revision @ISA);
|
|
|
36
|
|
|
37 @ISA = qw(Bio::Root::Root);
|
|
|
38
|
|
|
39
|
|
|
40 # %Objects_created can be used for tracking all objects created.
|
|
|
41 # See _initialize() for details.
|
|
|
42
|
|
|
43 $ID = 'Bio::Root::Object';
|
|
|
44 $VERSION = 0.041;
|
|
|
45 $Revision = '$Id: Object.pm,v 1.23 2002/10/22 07:38:37 lapp Exp $'; #'
|
|
|
46
|
|
|
47 ### POD Documentation:
|
|
|
48
|
|
|
49 =head1 NAME
|
|
|
50
|
|
|
51 Bio::Root::Object - A core Perl 5 object.
|
|
|
52
|
|
|
53 =head1 SYNOPSIS
|
|
|
54
|
|
|
55 Use this module as the root of your inheritance tree.
|
|
|
56
|
|
|
57 =head2 Object Creation
|
|
|
58
|
|
|
59 require Bio::Root::Object;
|
|
|
60
|
|
|
61 $dad = new Bio::Root::Object();
|
|
|
62 $son = new Bio::Root::Object(-name => 'Junior',
|
|
|
63 -parent => $dad,
|
|
|
64 -make => 'full');
|
|
|
65
|
|
|
66
|
|
|
67 See the L<new()|new> method for a complete description of parameters.
|
|
|
68 See also L<the USAGE section | USAGE>.
|
|
|
69
|
|
|
70 =head1 DESCRIPTION
|
|
|
71
|
|
|
72 B<Bio::Root::Object> attempts to encapsulate the "core" Perl5
|
|
|
73 object: What are the key data and behaviors ALL (or at least most) Perl5
|
|
|
74 objects should have?
|
|
|
75
|
|
|
76 =head2 Rationale
|
|
|
77
|
|
|
78 Use of B<Bio::Root::Object.pm> within the Bioperl framework facilitates
|
|
|
79 operational consistency across the different modules defined within
|
|
|
80 the B<Bio::> namespace. Not all objects need to derive from
|
|
|
81 B<Bio::Root::Object.pm>. However, when generating lots of different types
|
|
|
82 of potentially complex objects which should all conform to a set of
|
|
|
83 basic expectations, this module may be handy.
|
|
|
84
|
|
|
85 At the very least, this module saves you from re-writing the L<new()|new>
|
|
|
86 method for each module you develop. It also permits consistent and
|
|
|
87 robust handling of C<-tag =E<gt> value> method arguments via the
|
|
|
88 L<Bio::Root::RootI::_rearrange()|Bio::Root::RootI> method and provides a
|
|
|
89 object-oriented way handle exceptions and warnings via the L<Bio::Root::Root::throw()|Bio::Root::Root> and L<Bio::Root::Root::warn()|Bio::Root::Root> methods.
|
|
|
90
|
|
|
91 See L<the APPENDIX section | APPENDIX> for some other handy methods.
|
|
|
92
|
|
|
93 =head2 Fault-Tolerant Objects
|
|
|
94
|
|
|
95 A major motivation for this module was to promote the creation of robust,
|
|
|
96 fault-tolerant Perl5 objects. The L<Bio::Root::Root::throw()|Bio::Root::Root> method relies on Perl's built-in
|
|
|
97 C<eval{}/die> exception mechanism to generate fatal exceptions.
|
|
|
98 The data comprising an exception is managed by the B<Bio::Root::Err.pm>
|
|
|
99 module, which essentially allows the data thrown by a C<die()> event to be
|
|
|
100 wrapped into an object that can be easily examined and possibly re-thrown.
|
|
|
101
|
|
|
102 The intent here is three-fold:
|
|
|
103
|
|
|
104 =over 4
|
|
|
105
|
|
|
106 =item 1 Detailed error reporting.
|
|
|
107
|
|
|
108 Allow objects to report detailed information about the error condition
|
|
|
109 (who, what, where, why, how).
|
|
|
110
|
|
|
111 =item 2 Handle complex errors in objects.
|
|
|
112
|
|
|
113 The goal is to make it relatively painless to detect and handle the wide
|
|
|
114 variety of errors possible with a complex Perl object.
|
|
|
115 Perl's error handling mechanism is a might clunky when it comes to
|
|
|
116 handling complex errors within complex objects, but it is improving.
|
|
|
117
|
|
|
118 =item 3 Efficient & easy exception handling.
|
|
|
119
|
|
|
120 To enable robust exception handling without incurring a significant
|
|
|
121 performance penalty in the resulting code. Ideally, exception handling
|
|
|
122 code should be transparent to the cpu until and unless an exception
|
|
|
123 arises.
|
|
|
124
|
|
|
125 =back
|
|
|
126
|
|
|
127 These goals may at times be at odds and we are not claiming
|
|
|
128 to have achieved the perfect balance. Ultimately, we want self-
|
|
|
129 sufficient object-oriented systems able to deal with their own errors.
|
|
|
130 This area should improve as the module, and Perl, evolve.
|
|
|
131 One possible modification might be to utilize Graham Barr's B<Error.pm>
|
|
|
132 module or Torsten Ekedahl's B<Experimental::Exception.pm> module
|
|
|
133 (see L<Other Exception Modules>).
|
|
|
134 Technologies such as these may eventually be
|
|
|
135 incorporated into future releases of Perl. The exception handling
|
|
|
136 used by B<Bio::Root::Object.pm> can be expected to change as Perl's
|
|
|
137 exception handling mechanism evolves.
|
|
|
138
|
|
|
139 B<TERMINOLOGY NOTE:> In this discussion and elsewhere in this module,
|
|
|
140 the terms "Exception" and "Error" are used interchangeably to mean
|
|
|
141 "something unexpected occurred" either as a result of incorrect user
|
|
|
142 input or faulty internal processing.
|
|
|
143
|
|
|
144 =head1 USAGE
|
|
|
145
|
|
|
146 =head2 Basic Exception handling
|
|
|
147
|
|
|
148 Object construction is a common place for exceptions to occur. By wrapping
|
|
|
149 the construction in an C<eval{ }> block, we can prevent the exception from
|
|
|
150 crashing the script and attempt to recover gracefully:
|
|
|
151
|
|
|
152 # Package Foo.pm IS-A Bio::Root::Object.pm
|
|
|
153
|
|
|
154 $obj = eval { new Foo(@data) }; # ending semicolon required.
|
|
|
155 if($@) {
|
|
|
156 print STDERR "\nTrouble creating Foo object: $@\n";
|
|
|
157 recover_gracefully($@);
|
|
|
158 }
|
|
|
159
|
|
|
160 A common strategy when generating lots of objects is to collect
|
|
|
161 data about which objects failed to build but still permit
|
|
|
162 the successfully created ones get processed:
|
|
|
163
|
|
|
164 @errs = ();
|
|
|
165 foreach $thing ( @stuff ) {
|
|
|
166 my $obj = eval { new Foo($thing) };
|
|
|
167 if($@) {
|
|
|
168 push @err, [$thing, $@];
|
|
|
169 }
|
|
|
170 else {
|
|
|
171 process_obj($obj);
|
|
|
172 }
|
|
|
173 }
|
|
|
174
|
|
|
175 Post-mortem reporting, logging, or analysis of the problems ensues:
|
|
|
176
|
|
|
177 if(@errs) {
|
|
|
178 printf "\n%d things failed:\n", scalar(@errs);
|
|
|
179 foreach(@errs) { print "$err->[0], ";}
|
|
|
180
|
|
|
181 print "\n\nTrapped exceptions:\n";
|
|
|
182 foreach(@errs) { print "$err->[1]\n";}
|
|
|
183 }
|
|
|
184
|
|
|
185 New with B<Perl 5.005> is the ability to C<die()> with an object
|
|
|
186 reference in C<$@> instead of just a string. This feature is not yet
|
|
|
187 exploited in Bio::Root::Object.pm but may be in future versions.
|
|
|
188 Bio::Root::Err.pm objects can be reconstructed from the contents of C<$@>:
|
|
|
189
|
|
|
190 eval{ # exception-prone code here... };
|
|
|
191 if($@) {
|
|
|
192 $err = new Bio::Root::Err($@);
|
|
|
193 printf "Trouble: %s\n". $err->msg;
|
|
|
194 printf "Stack trace: %s\n". $err->stack;
|
|
|
195 }
|
|
|
196
|
|
|
197
|
|
|
198 =head2 Demo Scripts
|
|
|
199
|
|
|
200 Some demo script that illustrate working with Bio::Root::Objects
|
|
|
201 are included with the distribution in the examples/root_object directory.
|
|
|
202
|
|
|
203
|
|
|
204 =head1 STRICTNESS & VERBOSITY
|
|
|
205
|
|
|
206 There are two global variables that can be used to control sensitivity to
|
|
|
207 exceptions/warnings and the amount of reporting for all objects within a process.
|
|
|
208 These are accessed via functions B<strictness()> and B<verbosity()> exported by
|
|
|
209 Bio::Root::Global (see L<Bio::Root::Global>).
|
|
|
210
|
|
|
211 $STRICTNESS - Regulates the sensitivity of the object to exceptions and warnings.
|
|
|
212
|
|
|
213 $VERBOSITY - Regulates the amount of reporting by an object.
|
|
|
214
|
|
|
215
|
|
|
216 The L<strict()|strict> and L<verbose()|verbose> methods of B<Bio::Root::Object>
|
|
|
217 originally operated at the the object level, to permit individual
|
|
|
218 strictness and verbosity levels for different objects. This level of
|
|
|
219 control is not usually required and can often be inconvenient; one
|
|
|
220 typically wants to set these properties globally for a given
|
|
|
221 script. While this sacrifices some flexibility, it saves time and
|
|
|
222 memory when working with lots of objects. For instance, child objects
|
|
|
223 don't have to worry about checking their parents to determine their
|
|
|
224 strictness/verbosity levels. Strictness and verbosity are
|
|
|
225 globally-defined values, but different classes of objects can be
|
|
|
226 differentially sensitive to these values depending on design criteria.
|
|
|
227
|
|
|
228 Strictness and verbosity can be positive or negative. Negative
|
|
|
229 verbosity equals terseness; negative strictness equals permissiveness.
|
|
|
230 In B<Bio::Root::Object> only the Bio::Root::Root::throw() and
|
|
|
231 Bio::Root::Root::warn() methods (see L<Bio::Root::Root>) are sensitive to
|
|
|
232 these values as indicated in the tables below:
|
|
|
233
|
|
|
234 +---------+
|
|
|
235 | throw() | v e r b o s i t y
|
|
|
236 +---------+ -------------------------------------
|
|
|
237 -1 0 1
|
|
|
238 s ---------- ----------- ----------
|
|
|
239 t
|
|
|
240 r -2 -- throw() converted into warn()
|
|
|
241 i
|
|
|
242 c -1 | Exception Exception Exception
|
|
|
243 t 0 |_ printed printed printed
|
|
|
244 n 1 | without with with stack
|
|
|
245 e 2 | stack trace stack trace trace and
|
|
|
246 s | sysbeep
|
|
|
247 s
|
|
|
248
|
|
|
249
|
|
|
250 +---------+
|
|
|
251 | warn() | v e r b o s i t y
|
|
|
252 +---------+ --------------------------------------
|
|
|
253 -1 0 1
|
|
|
254 s ---------- ----------- -----------
|
|
|
255 t
|
|
|
256 r -2 | Warning Warning Warning
|
|
|
257 i -1 |_ not printed printed
|
|
|
258 c 0 | printed without with stack
|
|
|
259 t 1 | but stack trace trace and
|
|
|
260 n | attached* sysbeep
|
|
|
261 e
|
|
|
262 s 2 -- warn() converted into throw()
|
|
|
263 s
|
|
|
264
|
|
|
265 (*) Warnings will be attached to an object if the
|
|
|
266 -record_err =>1 flag is set when constructing the object
|
|
|
267 or if $object->record_err(1) is called subsequent to creation.
|
|
|
268
|
|
|
269 See the methods L<verbose()|verbose>, L<strict()|strict>, L<record_err()|record_err>,
|
|
|
270 Bio::Root::Root::throw(), and Bio::Root::Root::warn() in
|
|
|
271 L<Bio::Root::Root> for more details.
|
|
|
272
|
|
|
273
|
|
|
274 =head1 DEPENDENCIES
|
|
|
275
|
|
|
276 As the B<Bio::Root::Object> does not inherit from any modules
|
|
|
277 but wraps (i.e., provides an interface and delegates
|
|
|
278 functionality to) other modules in the Bio::Root:: hierarchy:
|
|
|
279
|
|
|
280 Module Purpose
|
|
|
281 -------------------- ------------------------------------
|
|
|
282 Bio::Root::Err.pm Exception handling
|
|
|
283 Bio::Root::IOManager.pm Input/output of object data or error data
|
|
|
284 Bio::Root::Xref.pm Arbitrary links between objects
|
|
|
285
|
|
|
286 All of these modules are loaded only when necessary.
|
|
|
287 B<Bio::Root::Err> is an object representing an exception.
|
|
|
288 B<Bio::Root::IOManager> and B<Bio::Root::Xref> are more experimental. They are
|
|
|
289 utilized via delegation, which permits them to be developed and utilized
|
|
|
290 independently of B<Bio::Root::Object>.
|
|
|
291
|
|
|
292 Since this module is at the root of potentially many different objects
|
|
|
293 in a particular application, efficiency is important. Bio::Root::Object.pm is
|
|
|
294 intended to be a lightweight, lean and mean module.
|
|
|
295
|
|
|
296
|
|
|
297 =head1 FEEDBACK
|
|
|
298
|
|
|
299 =head2 Mailing Lists
|
|
|
300
|
|
|
301 User feedback is an integral part of the evolution of this and other Bioperl modules.
|
|
|
302 Send your comments and suggestions preferably to one of the Bioperl mailing lists.
|
|
|
303 Your participation is much appreciated.
|
|
|
304
|
|
|
305 bioperl-l@bioperl.org - General discussion
|
|
|
306 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
307
|
|
|
308 =head2 Reporting Bugs
|
|
|
309
|
|
|
310 Report bugs to the Bioperl bug tracking system to help us keep track the bugs and
|
|
|
311 their resolution. Bug reports can be submitted via email or the web:
|
|
|
312
|
|
|
313 bioperl-bugs@bio.perl.org
|
|
|
314 http://bugzilla.bioperl.org/
|
|
|
315
|
|
|
316 =head1 AUTHOR
|
|
|
317
|
|
|
318 Steve Chervitz E<lt>sac@bioperl.orgE<gt>
|
|
|
319
|
|
|
320 See L<the FEEDBACK section | FEEDBACK> for where to send bug reports and comments.
|
|
|
321
|
|
|
322 =head1 VERSION
|
|
|
323
|
|
|
324 Bio::Root::Object.pm, 0.041
|
|
|
325
|
|
|
326
|
|
|
327 =head1 TODO
|
|
|
328
|
|
|
329 =over 0
|
|
|
330
|
|
|
331 =item * Experiment with other Exception classes.
|
|
|
332
|
|
|
333 Consider incorporating a more widely-used Error/Exception module
|
|
|
334 (see L<Other Exception Modules>).
|
|
|
335
|
|
|
336 =item * Think about integration with Data::Dumper.pm for persisting objects.
|
|
|
337
|
|
|
338 =back
|
|
|
339
|
|
|
340 =head1 SEE ALSO
|
|
|
341
|
|
|
342 L<Bio::Root::Err> - Error/Exception object
|
|
|
343 L<Bio::Root::IOManager> - Input/Output manager object
|
|
|
344 L<Bio::Root::Vector> - Manages dynamic lists of objects
|
|
|
345 L<Bio::Root::Xref> - Cross-reference object
|
|
|
346 L<Bio::Root::Global> - Manages global variables/constants
|
|
|
347
|
|
|
348 http://bio.perl.org/Projects/modules.html - Online module documentation
|
|
|
349 http://bio.perl.org/ - Bioperl Project Homepage
|
|
|
350
|
|
|
351 =head2 Other Exception Modules
|
|
|
352
|
|
|
353 Experimental::Exception.pm - ftp://ftp.matematik.su.se/pub/teke/
|
|
|
354 Error.pm - http://www.cpan.org/authors/id/GBARR/
|
|
|
355 Throwable.pm - mailto:kstevens@globeandmail.ca
|
|
|
356
|
|
|
357 http://genome-www.stanford.edu/perlOOP/exceptions.html
|
|
|
358
|
|
|
359 =head1 ACKNOWLEDGEMENTS
|
|
|
360
|
|
|
361 This module was developed under the auspices of the Saccharomyces Genome
|
|
|
362 Database:
|
|
|
363
|
|
|
364 http://genome-www.stanford.edu/Saccharomyces
|
|
|
365
|
|
|
366 Other Bioperl developers contributed ideas including Ewan Birney, Ian Korf,
|
|
|
367 Chris Dagdigian, Georg Fuellen, and Steven Brenner.
|
|
|
368
|
|
|
369 =head1 COPYRIGHT
|
|
|
370
|
|
|
371 Copyright (c) 1996-98 Steve Chervitz. All Rights Reserved.
|
|
|
372 This module is free software; you can redistribute it and/or
|
|
|
373 modify it under the same terms as Perl itself.
|
|
|
374
|
|
|
375 =cut
|
|
|
376
|
|
|
377
|
|
|
378 #
|
|
|
379 ##
|
|
|
380 ###
|
|
|
381 #### END of main POD documentation. '
|
|
|
382 ###
|
|
|
383 ##
|
|
|
384 #
|
|
|
385
|
|
|
386
|
|
|
387 =head1 APPENDIX
|
|
|
388
|
|
|
389 Methods beginning with a leading underscore are considered private
|
|
|
390 and are intended for internal use by this module. They are
|
|
|
391 B<not> considered part of the public interface and are described here
|
|
|
392 for documentation purposes only.
|
|
|
393
|
|
|
394 =cut
|
|
|
395
|
|
|
396 #
|
|
|
397 # This object is deprecated as the root of the inheritance tree, but some
|
|
|
398 # modules depend on it as a legacy. We issue a deprecation warning for all
|
|
|
399 # other modules.
|
|
|
400 #
|
|
|
401 my @inheriting_modules = ('Bio::Tools::Blast', 'Bio::Root::Object',
|
|
|
402 'Bio::Root::IOManager');
|
|
|
403
|
|
|
404
|
|
|
405 #######################################################
|
|
|
406 # CONSTRUCTOR/DESTRUCTOR #
|
|
|
407 #######################################################
|
|
|
408
|
|
|
409
|
|
|
410 =head2 new
|
|
|
411
|
|
|
412 Purpose : Creates a blessed object reference (hash) for the indicated class
|
|
|
413 : and calls _initialize() for the class passing it all parameters.
|
|
|
414 Usage : new CLASS_NAME [ %named_parameters];
|
|
|
415 Example : $obj = new Bio::Root::Object 'george';
|
|
|
416 : $obj = Bio::Root::Object->new(-name => 'L56163',
|
|
|
417 : -parent => $obj2 );
|
|
|
418 : $obj = Bio::Root::Object->new();
|
|
|
419 Returns : Blessed hash reference.
|
|
|
420 Argument : Named parameters: (PARAMETER TAGS CAN BE UPPER OR LOWERCASE).
|
|
|
421 : (all are optional)
|
|
|
422 : -NAME => arbitrary string to identify an object;
|
|
|
423 : should be unique within its class.
|
|
|
424 : -PARENT => blessed reference for an object that
|
|
|
425 : is responsible for the present object
|
|
|
426 : (e.g., a container).
|
|
|
427 : -MAKE => string to specify special constructor option.
|
|
|
428 : -OBJ => object reference for an object to be cloned.
|
|
|
429 : -RECORD_ERR => boolean (if true, attach all Err.pm objects generated by
|
|
|
430 : warn() or throw() calls to the present object;
|
|
|
431 : default = false).
|
|
|
432 :
|
|
|
433 : The use of STRICT and VERBOSE in constructors is no longer
|
|
|
434 : necessary since there is no object-specific strict or verbose setting.
|
|
|
435 : Use the strictness() and verbosity() functions exported by
|
|
|
436 : Bio::Root::Global.pm. These options are still provided
|
|
|
437 : in the constructor but the will affect *all* objects within a
|
|
|
438 : given process.
|
|
|
439 :
|
|
|
440 : -STRICT => integer (level of strictness: -2, -1, 0, 1, 2).
|
|
|
441 : -VERBOSE => integer (level of verbosity: -1, 0, 1)
|
|
|
442 : Verbosity can be used to control how much reporting
|
|
|
443 : an object should do generally. In this module,
|
|
|
444 : verbosity affects the behavior of throw() and warn()
|
|
|
445 : only.
|
|
|
446 :
|
|
|
447 :
|
|
|
448 Comments : This method creates blessed HASH references.
|
|
|
449 : An object is free to define its own strict, and verbose
|
|
|
450 : behavior as well as its own make (constructor) options.
|
|
|
451
|
|
|
452 See Also : L<_initialize()|_initialize>, L<name()|name>, L<parent()|parent>, L<make()|make>, L<strict()|strict>, L<verbose()|verbose>, L<record_err()|record_err>, and Bio::Root::Root::throw() and Bio::Root::Root::warn() in L<Bio::Root::Root>
|
|
|
453
|
|
|
454 =cut
|
|
|
455
|
|
|
456 #----------
|
|
|
457 sub new {
|
|
|
458 #----------
|
|
|
459 my($class, @param) = @_;
|
|
|
460 my $self = {};
|
|
|
461 bless $self, ref($class) || $class;
|
|
|
462 $DEBUG==2 && print STDERR "CREATING $self";
|
|
|
463 $self->_initialize(@param);
|
|
|
464 $self;
|
|
|
465 }
|
|
|
466
|
|
|
467
|
|
|
468 =head2 _initialize
|
|
|
469
|
|
|
470 Purpose : Initializes key Bio::Root::Object.pm data (name, parent, make, strict).
|
|
|
471 : Called by new().
|
|
|
472 Usage : n/a; automatically called by Bio::Root::Object::new()
|
|
|
473 Returns : String containing the -MAKE constructor option or 'default'
|
|
|
474 : if none defined (if a -MAKE parameter is defined, the value
|
|
|
475 : returned will be that obtained from the make() method.)
|
|
|
476 : This return value saves any subclass from having to call
|
|
|
477 : $self->make() during construction. For example, within a
|
|
|
478 : subclass _initialize() method, invoke the Bio::Root::Object::
|
|
|
479 : initialize() method as follows:
|
|
|
480 : my $make = $self->SUPER::_initialize(@param);
|
|
|
481 Argument : Named parameters passed from new()
|
|
|
482 : (PARAMETER TAGS CAN BE ALL UPPER OR ALL LOWER CASE).
|
|
|
483 Comments : This method calls name(), make(), parent(), strict(), index()
|
|
|
484 : and thus enables polymorphism on these methods. To save on method
|
|
|
485 : call overhead, these methods are called only if the data need
|
|
|
486 : to be set.
|
|
|
487 :
|
|
|
488 : The _set_clone() method is called if the -MAKE option includes
|
|
|
489 : the string 'clone' (e.g., -MAKE => 'clone').
|
|
|
490 :
|
|
|
491 : The index() method is called if the -MAKE option includes
|
|
|
492 : the string 'index'. (This is an experimental feature)
|
|
|
493 : (Example: -MAKE => 'full_index').
|
|
|
494 :
|
|
|
495 : NOTE ON USING _rearrange():
|
|
|
496 :
|
|
|
497 : _rearrange() is a handy method for working with tagged (named)
|
|
|
498 : parameters and it permits case-insensitive in tag names
|
|
|
499 : as well as handling tagged or un-tagged parameters.
|
|
|
500 : _initialize() does not currently call _rearrange() since
|
|
|
501 : there is a concern about performance when setting many objects.
|
|
|
502 : One issue is that _rearrange() could be called with many elements
|
|
|
503 : yet the caller is interested in only a few. Also, derived objects
|
|
|
504 : typically invoke _rearrange() in their constructors as well.
|
|
|
505 : This could particularly degrade performance when creating lots
|
|
|
506 : of objects with extended inheritance hierarchies and lots of tagged
|
|
|
507 : parameters which are passes along the inheritance hierarchy.
|
|
|
508 :
|
|
|
509 : One thing that may help is if _rearrange() deleted all parameters
|
|
|
510 : it extracted. This would require passing a reference to the param list
|
|
|
511 : and may add excessive dereferencing overhead.
|
|
|
512 : It also would cause problems if the same parameters are used by
|
|
|
513 : different methods or objects.
|
|
|
514
|
|
|
515 See Also : L<new()|new>, L<make()|make>, L<name()|name>, L<parent()|parent>, L<strict()|strict>, L<index()|index>, L<verbose()|verbose>
|
|
|
516
|
|
|
517 =cut
|
|
|
518
|
|
|
519 #----------------
|
|
|
520 sub _initialize {
|
|
|
521 #----------------
|
|
|
522 local($^W) = 0;
|
|
|
523 my($self, %param) = @_;
|
|
|
524
|
|
|
525 if(! grep { ref($self) =~ /$_/; } @inheriting_modules) {
|
|
|
526 $self->warn("Class " . ref($self) .
|
|
|
527 " inherits from Bio::Root::Object, which is deprecated. ".
|
|
|
528 "Try changing your inheritance to Bio::Root::Root.");
|
|
|
529 }
|
|
|
530 my($name, $parent, $make, $strict, $verbose, $obj, $record_err) = (
|
|
|
531 ($param{-NAME}||$param{'-name'}), ($param{-PARENT}||$param{'-parent'}),
|
|
|
532 ($param{-MAKE}||$param{'-make'}), ($param{-STRICT}||$param{'-strict'}),
|
|
|
533 ($param{-VERBOSE}||$param{'-verbose'}),
|
|
|
534 ($param{-OBJ}||$param{'-obj'}, $param{-RECORD_ERR}||$param{'-record_err'})
|
|
|
535 );
|
|
|
536
|
|
|
537 ## See "Comments" above regarding use of _rearrange().
|
|
|
538 # $self->_rearrange([qw(NAME PARENT MAKE STRICT VERBOSE OBJ)], %param);
|
|
|
539
|
|
|
540 $DEBUG and do{ print STDERR ">>>> Initializing $ID (${\ref($self)}) ",$name||'anon';<STDIN>};
|
|
|
541
|
|
|
542 if(defined($make) and $make =~ /clone/i) {
|
|
|
543 $self->_set_clone($obj);
|
|
|
544
|
|
|
545 } else {
|
|
|
546 $name ||= ($#_ == 1 ? $_[1] : ''); # If a single arg is given, use as name.
|
|
|
547
|
|
|
548 ## Another performance issue: calling name(), parent(), strict(), make()
|
|
|
549 ## Any speed diff with conditionals to avoid method calls?
|
|
|
550
|
|
|
551 $self->name($name) if $name;
|
|
|
552 $self->parent($parent) if $parent;
|
|
|
553 $self->{'_strict'} = $strict || undef;
|
|
|
554 $self->{'_verbose'} = $verbose || undef;
|
|
|
555 $self->{'_record_err'} = $record_err || undef;
|
|
|
556
|
|
|
557 if($make) {
|
|
|
558 $make = $self->make($make);
|
|
|
559
|
|
|
560 # Index the Object in the global object hash only if requested.
|
|
|
561 # This feature is not used much. If desired, an object can always
|
|
|
562 # call Bio::Root::Object::index() any time after construction.
|
|
|
563 $self->index() if $make =~ /index/;
|
|
|
564 }
|
|
|
565 }
|
|
|
566
|
|
|
567 $DEBUG and print STDERR "---> Initialized $ID (${\ref($self)}) ",$name,"\n";
|
|
|
568
|
|
|
569 ## Return data of potential use to subclass constructors.
|
|
|
570 # return (($make || 'default'), $strict); # maybe (?)
|
|
|
571 return $make || 'default';
|
|
|
572 }
|
|
|
573
|
|
|
574
|
|
|
575
|
|
|
576 =head2 DESTROY
|
|
|
577
|
|
|
578 Purpose : Provides indication that the object is being reclaimed
|
|
|
579 : by the GC for debugging purposes only.
|
|
|
580 Usage : n/a; automatically called by Perl when the ref count
|
|
|
581 : on the object drops to zero.
|
|
|
582 Argument : n/a
|
|
|
583 Comments : Setting the global $DEBUG to 2 will print messages upon
|
|
|
584 : object destruction.
|
|
|
585 : Subclasses should override this method to
|
|
|
586 : clean up any resources (open file handles, etc.)
|
|
|
587 : The overridden method should end with a call to
|
|
|
588 : SUPER::DESTROY;
|
|
|
589
|
|
|
590 See Also : L<destroy()|destroy>
|
|
|
591
|
|
|
592 =cut
|
|
|
593
|
|
|
594 #-----------
|
|
|
595 sub DESTROY {
|
|
|
596 #-----------
|
|
|
597 my $self=shift;
|
|
|
598
|
|
|
599 $DEBUG==2 && print STDERR "DESTROY called in $ID for ${\$self->to_string} ($self)\n";
|
|
|
600 }
|
|
|
601
|
|
|
602
|
|
|
603 =head2 destroy
|
|
|
604
|
|
|
605 Purpose : Clean up any resources allocated by the object and
|
|
|
606 : remove links to all objects connected to the present
|
|
|
607 : object with the ultimate aim of signaling the GC to
|
|
|
608 : reclaim all memory allocated for the object.
|
|
|
609 : This method breaks links to any Err, IOManager, and Xref objects
|
|
|
610 : and drops the present object as a child from any parent objects.
|
|
|
611 Usage : $object->destroy(); undef $object;
|
|
|
612 : undef-ing the object reference signals the GC to reclaim
|
|
|
613 : the object's memory.
|
|
|
614 Returns : undef
|
|
|
615 Argument : n/a
|
|
|
616 Comments : Circular reference structures are problematic for garbage
|
|
|
617 : collection schemes such as Perl's which are based on reference
|
|
|
618 : counting. If you create such structures outside of
|
|
|
619 : the parent-child relationship, be sure to properly break
|
|
|
620 : the circularity when destroying the object.
|
|
|
621 : Subclasses should override this method to call destroy()
|
|
|
622 : on any contained child objects. The overridden method
|
|
|
623 : should end with a call to SUPER::destroy().
|
|
|
624 Bugs : Bio::Root::Xref.pm objects have not been tested and
|
|
|
625 : may not be handled properly here.
|
|
|
626 : Bio::Root::Vector.pm objects are also not yet handled
|
|
|
627 : properly so beware of crunching lots of Vector objects.
|
|
|
628
|
|
|
629 =cut
|
|
|
630
|
|
|
631 #-------------'
|
|
|
632 sub destroy {
|
|
|
633 #-------------
|
|
|
634 ## Note: Cannot delete parent and xref object refs since they are not
|
|
|
635 ## owned by this object, merely associated with it.
|
|
|
636 my $self = shift;
|
|
|
637
|
|
|
638 if(ref($self->{'_parent'})) {
|
|
|
639 $self->{'_parent'}->_drop_child($self);
|
|
|
640 undef $self->{'_parent'};
|
|
|
641 }
|
|
|
642
|
|
|
643 if(ref($self->{'_io'})) {
|
|
|
644 $self->{'_io'}->destroy;
|
|
|
645 undef $self->{'_io'};
|
|
|
646 }
|
|
|
647
|
|
|
648 if(ref($self->{'_err'})) {
|
|
|
649 $self->{'_err'}->remove_all;
|
|
|
650 undef $self->{'_err'};
|
|
|
651 }
|
|
|
652
|
|
|
653 if(ref($self->{'_xref'})) {
|
|
|
654 $self->{'_xref'}->remove_all;
|
|
|
655 undef $self->{'_xref'};
|
|
|
656 }
|
|
|
657
|
|
|
658 $self->_remove_from_index if scalar %Objects_created;
|
|
|
659 }
|
|
|
660
|
|
|
661
|
|
|
662 =head2 _drop_child
|
|
|
663
|
|
|
664 Usage : $object->_drop_child(object_ref)
|
|
|
665 : Used internally by destroy().
|
|
|
666 Purpose : To remove a parent-to-child inter-object relationship.
|
|
|
667 : The aim here is to break cyclical object refs to permit Perl's
|
|
|
668 : GC to reclaim the object's memory. The expectation is that
|
|
|
669 : a child object requests of its parent that the parent drop the
|
|
|
670 : child object making the request. Parents do not drop children
|
|
|
671 : unless requested by the child in question.
|
|
|
672 Example : $self->parent->_drop_child($self);
|
|
|
673 Returns : undef
|
|
|
674 Argument : Object reference for the child object to be dropped
|
|
|
675 Throws : Exception if an object ref is not provided as an argument.
|
|
|
676 Comments : This is a simplistic version that systematically checks every
|
|
|
677 : data member, searching all top-level array, hash, and scalar
|
|
|
678 : data members.
|
|
|
679 : It does not recurse through all levels of complex data members.
|
|
|
680 : Subclasses could override this method to handle complex child
|
|
|
681 : data members for more optimal child searching. However, the
|
|
|
682 : version here is probably sufficient for most situations.
|
|
|
683 :
|
|
|
684 : _drop_child() is called by Bio::Root::Object::destroy() for
|
|
|
685 : all objects with parents.
|
|
|
686 Status : Experimental
|
|
|
687
|
|
|
688 See Also : L<destroy()|destroy>
|
|
|
689
|
|
|
690 =cut
|
|
|
691
|
|
|
692 #---------------'
|
|
|
693 sub _drop_child {
|
|
|
694 #---------------
|
|
|
695 my ($self, $child) = @_;
|
|
|
696 my ($member, $found);
|
|
|
697
|
|
|
698 $self->throw("Child not defined or not an object ($child).") unless ref $child;
|
|
|
699
|
|
|
700 local($^W = 0);
|
|
|
701 foreach $member (keys %{$self}) {
|
|
|
702 next unless ref($self->{$member});
|
|
|
703 # compare references.
|
|
|
704 if (ref($self->{$member}) eq 'ARRAY') {
|
|
|
705 my ($i);
|
|
|
706 for($i=0; $i < @{$self->{$member}}; $i++) {
|
|
|
707 if ($self->{$member}->[$i] eq $child) {
|
|
|
708 $DEBUG==2 && print STDERR "Removing array child $child\n";
|
|
|
709 undef $self->{$member}->[$i];
|
|
|
710 $found = 1; last;
|
|
|
711 }
|
|
|
712 }
|
|
|
713 } elsif(ref($self->{$member}) eq 'HASH') {
|
|
|
714 foreach(keys %{$self->{$member}}) {
|
|
|
715 if ($self->{$member}->{$_} eq $child) {
|
|
|
716 $DEBUG==2 && print STDERR "Removing hash child $child\n";
|
|
|
717 undef $self->{$member}->{$_};
|
|
|
718 $found = 1; last;
|
|
|
719 }
|
|
|
720 }
|
|
|
721 } else {
|
|
|
722 if ($self->{$member} eq $child) {
|
|
|
723 $DEBUG==2 && print STDERR "Removing child $child\n";
|
|
|
724 undef $self->{$member};
|
|
|
725 $found = 1; last;
|
|
|
726 }
|
|
|
727 }
|
|
|
728 }
|
|
|
729 # Child not found:
|
|
|
730 # It is possible that a child object has a parent but has not yet been added to
|
|
|
731 # the parent due to a failure during construction of the child. Not warning.
|
|
|
732 #$self->warn(sprintf "Child %s not found in Parent %s.", $child->to_string, $self->to_string) unless $found;
|
|
|
733
|
|
|
734 undef;
|
|
|
735 }
|
|
|
736
|
|
|
737
|
|
|
738 #################################################################
|
|
|
739 # ACCESSORS & INSTANCE METHODS
|
|
|
740 #################################################################
|
|
|
741
|
|
|
742
|
|
|
743
|
|
|
744 =head2 name
|
|
|
745
|
|
|
746 Usage : $object->name([string]);
|
|
|
747 Purpose : Set/Get an object's common name.
|
|
|
748 Example : $myName = $myObj->name;
|
|
|
749 : $myObj->name('fred');
|
|
|
750 Returns : String consisting of the object's name or
|
|
|
751 : "anonymous <CLASSNAME>" if name is not set.
|
|
|
752 : Thus, this method ALWAYS returns some string.
|
|
|
753 Argument : String to be used as the common name of the object.
|
|
|
754 : Should be unique within its class.
|
|
|
755
|
|
|
756 See also : L<has_name()|has_name>
|
|
|
757
|
|
|
758 =cut
|
|
|
759
|
|
|
760 #---------
|
|
|
761 sub name {
|
|
|
762 #---------
|
|
|
763 my $self = shift;
|
|
|
764
|
|
|
765 # $DEBUG and do{ print STDERR "\n$ID: name(@_) called.";<STDIN>; };
|
|
|
766
|
|
|
767 if (@_) { $self->{'_name'} = shift }
|
|
|
768 return defined $self->{'_name'} ? $self->{'_name'} : 'anonymous '.ref($self);
|
|
|
769 }
|
|
|
770
|
|
|
771
|
|
|
772 =head2 to_string
|
|
|
773
|
|
|
774 Usage : $object->to_string();
|
|
|
775 Purpose : Get an object as a simple string useful for debugging purposes.
|
|
|
776 Example : print $myObj->to_string; # prints: Object <PACKAGE NAME> "<OBJECT NAME>"
|
|
|
777 Returns : String consisting of the package name + object's name
|
|
|
778 : Object's name is obtained by calling the name() method.
|
|
|
779 Argument : n/a
|
|
|
780 Throws : n/a
|
|
|
781
|
|
|
782 See also : L<name()|name>
|
|
|
783
|
|
|
784 =cut
|
|
|
785
|
|
|
786 #-------------
|
|
|
787 sub to_string {
|
|
|
788 #-------------
|
|
|
789 my $self = shift;
|
|
|
790 return sprintf "Object %s \"%s\"", ref($self), $self->name;
|
|
|
791 }
|
|
|
792
|
|
|
793
|
|
|
794 =head2 parent
|
|
|
795
|
|
|
796 Usage : $object->parent([object | 'null']);
|
|
|
797 Purpose : Set/Get the current object's source object.
|
|
|
798 : An object's source object (parent) is defined as the object
|
|
|
799 : that is responsible for creating the current object (child).
|
|
|
800 : The parent object may also have a special mechanism for
|
|
|
801 : destroying the child object. This should be included
|
|
|
802 : in the parent object's DESTROY method which should end with a
|
|
|
803 : call to $self->SUPER::DESTROY.
|
|
|
804 Example : $myObj->parent($otherObject);
|
|
|
805 Returns : Object reference for the parent object or undef if none is set.
|
|
|
806 Argument : Blessed object reference (optional) or the string 'null'.
|
|
|
807 : 'null' = sets the object's _parent field to undef,
|
|
|
808 : breaking the child object's link to its parent.
|
|
|
809 Throws : Exception if argument is not an object reference or 'null'.
|
|
|
810 Comments : This method may be renamed 'parent' in the near future.
|
|
|
811 : When and if this happens, parent() will still be supported but
|
|
|
812 : will be deprecated.
|
|
|
813
|
|
|
814 See also : L<destroy()|destroy>
|
|
|
815
|
|
|
816 =cut
|
|
|
817
|
|
|
818 #------------'
|
|
|
819 sub parent {
|
|
|
820 #------------
|
|
|
821 my ($self) = shift;
|
|
|
822 if (@_) {
|
|
|
823 my $arg = shift;
|
|
|
824 if(ref $arg) {
|
|
|
825 $self->{'_parent'} = $arg;
|
|
|
826 } elsif($arg =~ /null/i) {
|
|
|
827 $self->{'_parent'} = undef;
|
|
|
828 } else {
|
|
|
829 $self->throw("Can't set parent using $arg: Not an object");
|
|
|
830 }
|
|
|
831 }
|
|
|
832 $self->{'_parent'};
|
|
|
833 }
|
|
|
834
|
|
|
835
|
|
|
836 =head2 src_obj
|
|
|
837
|
|
|
838 Usage : $object->src_obj([object | 'null']);
|
|
|
839 : THIS METHOD IS NOW DEPRECATED. USE parent() INSTEAD.
|
|
|
840 Purpose : Set/Get the current object's source object (parent).
|
|
|
841
|
|
|
842 See also : L<parent()|parent>
|
|
|
843
|
|
|
844 =cut
|
|
|
845
|
|
|
846 #------------'
|
|
|
847 sub src_obj {
|
|
|
848 #------------
|
|
|
849 my ($self) = shift;
|
|
|
850 $self->warn("DEPRECATED METHOD src_obj() CALLED. USE parent() INSTEAD.\n");
|
|
|
851 $self->parent(@_);
|
|
|
852 }
|
|
|
853
|
|
|
854
|
|
|
855 =head2 has_name
|
|
|
856
|
|
|
857 Usage : $object->has_name();
|
|
|
858 Purpose : To determine if an object has a name.
|
|
|
859 Returns : True (1) if the object's {'Name'} data member is defined.
|
|
|
860 : False otherwise.
|
|
|
861 Comments : One may argue, why not just use the name() method as a
|
|
|
862 : combination setter/getter? has_name() is necessary for
|
|
|
863 : the following reasons:
|
|
|
864 : (1) If an object's name is not defined, name() returns
|
|
|
865 : "anonymous <CLASSNAME>".
|
|
|
866 : (2) If an object's name is 0 (zero) or '' (empty string),
|
|
|
867 : conditionals that simply check name() would fail incorrectly.
|
|
|
868
|
|
|
869 See also : L<name()|name>
|
|
|
870
|
|
|
871 =cut
|
|
|
872
|
|
|
873 #--------------'
|
|
|
874 sub has_name { my $self = shift; return defined $self->{'_name'}; }
|
|
|
875 #--------------
|
|
|
876
|
|
|
877
|
|
|
878
|
|
|
879 =head2 make
|
|
|
880
|
|
|
881 Usage : $object->make([string]);
|
|
|
882 Purpose : Set/Get an object's constructor option.
|
|
|
883 : make() is intended for use during object construction
|
|
|
884 : to essentially permit alternate constructors since
|
|
|
885 : Perl doesn't have a built-in mechanism for this.
|
|
|
886 Example : $make = $object->make();
|
|
|
887 : $object->make('optionA');
|
|
|
888 Returns : String consisting of the object's make option
|
|
|
889 : or 'default' if make is not set.
|
|
|
890 : Thus, this method ALWAYS returns some string.
|
|
|
891 Argument : String to be used as an option during object construction.
|
|
|
892 Comments : A typical use of a make option is when cloning an object
|
|
|
893 : from an existing object. In this case, the new() method
|
|
|
894 : is called with -MAKE => 'clone'.
|
|
|
895
|
|
|
896 See also : L<_initialize()|_initialize>, L<clone()|clone>
|
|
|
897
|
|
|
898 =cut
|
|
|
899
|
|
|
900 #----------'
|
|
|
901 sub make {
|
|
|
902 #----------
|
|
|
903 my $self = shift;
|
|
|
904 if(@_) { $self->{'_make'} = shift; }
|
|
|
905 $self->{'_make'} || 'default';
|
|
|
906 }
|
|
|
907
|
|
|
908
|
|
|
909 =head2 err
|
|
|
910
|
|
|
911 Usage : $self->err([$data], [$delimit])
|
|
|
912 Purpose : Check for exceptions/warnings and get data about them.
|
|
|
913 : (object validation and error data retrieval)
|
|
|
914 Example : $self->err && print "has err";
|
|
|
915 : $errCount = $self->err('count');
|
|
|
916 : $errMsgs = $self->err('msg',"\t");
|
|
|
917 : @errNotes = $self->err('note');
|
|
|
918 Returns : One of the following:
|
|
|
919 : 1. If no arguments are given
|
|
|
920 : a. If the object has an error, the err data member is
|
|
|
921 : returned (this is an Bio::Root::Err.pm object),
|
|
|
922 : b. otherwise, undef is returned.
|
|
|
923 : 2. The number of Errs in the object's err data member (if $data eq 'count').
|
|
|
924 : 3. A string containing data from a specific field from an object's err member.
|
|
|
925 : -- If the object contains multiple errors, data for all errors will be
|
|
|
926 : strung together in reverse chronological order with each error's data
|
|
|
927 : preceeded by "Error #n\n" and followed by two delimiters.
|
|
|
928 : 4. A list containing data from a specific field from an object's err member.
|
|
|
929 : -- If the object contains multiple errors, data for all errors will be
|
|
|
930 : added in reverse chronological order as separate elements in the list
|
|
|
931 : with NO "Error #n\n" identifier. Individual err list data
|
|
|
932 : (note,tech,stack) will be tab-delimited.
|
|
|
933 Arguments : $data = The name of a specific Err data member (see %Bio::Root::Err::ERR_FIELDS)
|
|
|
934 : OR 'count'.
|
|
|
935 : $delimit = The delimiter separating a single Err's list data member's elements.
|
|
|
936 : Default is "\n". For multi-error objects, two of these
|
|
|
937 : delimiters separate data from different errors.
|
|
|
938 : If wantarray is true or delimiter is 'list', data from multiple
|
|
|
939 : errors will be returned as a list
|
|
|
940 :
|
|
|
941 Comments : Since Err objects are now fatal and are not attached to the object by default,
|
|
|
942 : this method is largely moot. It is a relic from the former
|
|
|
943 : error "polling" days.
|
|
|
944 : It is handy for accessing non-fatal warnings thrown by the object,
|
|
|
945 : or in situations where fatal errors are converted to warnings
|
|
|
946 : as when $self->strict is -1 or $WARN_ON_FATAL is true.
|
|
|
947 : (Note: an object now only attaches Err objects to itself when
|
|
|
948 : constructed with -RECORD_ERR =>1 or if the global $RECORD_ERR is true).
|
|
|
949 :
|
|
|
950 : This method is intended mainly to test whether or not an object
|
|
|
951 : has any Err objects associated with it and if so, obtaining the
|
|
|
952 : Err object or specific data about it.
|
|
|
953 : For obtaining ALL data about an error, use err_string().
|
|
|
954 : For more detailed manipulations with the Err data, retrieve the
|
|
|
955 : Err object and process its data as necessary.
|
|
|
956
|
|
|
957 See also : L<err_string()|err_string>, L<print_err()|print_err>, L<Bio::Root::Err::get_all|Bio::Root::Err>
|
|
|
958
|
|
|
959 =cut
|
|
|
960
|
|
|
961 #----------
|
|
|
962 sub err {
|
|
|
963 #----------
|
|
|
964 my( $self, $data, $delimit) = @_;
|
|
|
965
|
|
|
966 return undef unless defined $self->{'_err'};
|
|
|
967
|
|
|
968 $data ||= 'member';
|
|
|
969 # $delimit ||= (wantarray ? 'list' : "\n");
|
|
|
970 $delimit ||= "\n";
|
|
|
971
|
|
|
972 $data eq 'member' and return $self->{'_err'};
|
|
|
973 $data eq 'count' and return $self->{'_err'}->size();
|
|
|
974
|
|
|
975 return $self->{'_err'}->get_all($data, $delimit );
|
|
|
976 }
|
|
|
977
|
|
|
978
|
|
|
979 =head2 record_err
|
|
|
980
|
|
|
981 Usage : $object->record_err([0|1]);
|
|
|
982 Purpose : Set/Get indicator for whether an object should save
|
|
|
983 : the Bio::Root::Err.pm objects it generates via calls
|
|
|
984 : to throw() or warn().
|
|
|
985 Example : $myObj->record_err(1)
|
|
|
986 Returns : Boolean (0|1)
|
|
|
987 Argument : Boolean (0|1)
|
|
|
988 Comments : Record_err is generally useful only for examining
|
|
|
989 : warnings produced by an object, since calls to throw()
|
|
|
990 : are normally fatal (unless strictness is set to -2).
|
|
|
991 : To turn on recording of errors for all objects in a process,
|
|
|
992 : use Bio::Root::Global::record_err().
|
|
|
993 Status : Experimental
|
|
|
994
|
|
|
995 See also : L<err()|err>, and record_err() in L<Bio::Root::Err>
|
|
|
996
|
|
|
997 =cut
|
|
|
998
|
|
|
999 #---------------
|
|
|
1000 sub record_err {
|
|
|
1001 #---------------
|
|
|
1002 my $self = shift;
|
|
|
1003
|
|
|
1004 if (@_) { $self->{'_record_err'} = shift }
|
|
|
1005 return $self->{'_record_err'} || 0;
|
|
|
1006 }
|
|
|
1007
|
|
|
1008
|
|
|
1009 =head2 err_state
|
|
|
1010
|
|
|
1011 Usage : $object->err_state();
|
|
|
1012 Purpose : To assess the status of the object's Err object (if any).
|
|
|
1013 Returns : A string: 'EXCEPTION' | 'WARNING' | 'FATAL' | 'OKAY'
|
|
|
1014 : (OKAY is returned if there are no Errors)
|
|
|
1015 Status : Experimental
|
|
|
1016
|
|
|
1017 =cut
|
|
|
1018
|
|
|
1019 #-------------'
|
|
|
1020 sub err_state {
|
|
|
1021 #-------------
|
|
|
1022 my $self = shift;
|
|
|
1023 return 'OKAY' if not defined $self->{'_err'};
|
|
|
1024 $self->{'_errState'} || 'OKAY';
|
|
|
1025 }
|
|
|
1026
|
|
|
1027
|
|
|
1028 =head2 clear_err
|
|
|
1029
|
|
|
1030 Purpose : To remove any error associated with the given object.
|
|
|
1031 Usage : $myObj->clear_err;
|
|
|
1032
|
|
|
1033 See also : L<err()|err>
|
|
|
1034
|
|
|
1035 =cut
|
|
|
1036
|
|
|
1037 #-------------
|
|
|
1038 sub clear_err {
|
|
|
1039 #-------------
|
|
|
1040 my $self = shift;
|
|
|
1041 undef $self->{'_err'};
|
|
|
1042 }
|
|
|
1043
|
|
|
1044
|
|
|
1045
|
|
|
1046
|
|
|
1047
|
|
|
1048 =head2 containment
|
|
|
1049
|
|
|
1050 Usage : $aref = $object->containment();
|
|
|
1051 : Since this method can be exported, the following can be used:
|
|
|
1052 : $aref = containment($object);
|
|
|
1053 Purpose : To determine the containment hierarchy of a object.
|
|
|
1054 Returns : An array reference in which each element is a string
|
|
|
1055 : containing the class and name of
|
|
|
1056 : the object in which this object is contained.
|
|
|
1057 : Indentation increases progressively as the
|
|
|
1058 : hierarchy is traversed.
|
|
|
1059 : E.g., Object MyClass "Foo"
|
|
|
1060 : Contained in object YourClass "Bar"
|
|
|
1061 : Contained in object HisClass "Moo"
|
|
|
1062 Comments : This method will report only one object at each level
|
|
|
1063 : since an object can currently have only one source object.
|
|
|
1064 Status : Exported
|
|
|
1065
|
|
|
1066 See also : L<err()|err>
|
|
|
1067
|
|
|
1068 =cut
|
|
|
1069
|
|
|
1070 #------------------
|
|
|
1071 sub containment {
|
|
|
1072 #------------------
|
|
|
1073 my( $self) = @_;
|
|
|
1074 my(@hierarchy);
|
|
|
1075
|
|
|
1076 # print "$ID: getting err hierarchy.\n";
|
|
|
1077 push @hierarchy, $self->to_string;
|
|
|
1078 my $obj = $self;
|
|
|
1079 my $count = 0;
|
|
|
1080
|
|
|
1081 while( ref $obj->parent) {
|
|
|
1082 $obj = $obj->parent;
|
|
|
1083 push @hierarchy, sprintf "%sContained in %s", ' ' x ++$count, $obj->to_string;
|
|
|
1084 }
|
|
|
1085 return \@hierarchy;
|
|
|
1086 }
|
|
|
1087
|
|
|
1088
|
|
|
1089 =head2 set_stats
|
|
|
1090
|
|
|
1091 Usage : $object->set_stats(KEY => DATA [,KEY2 => DATA2])
|
|
|
1092 Purpose : To declare and initialize a set of statistics germain
|
|
|
1093 : to an object. Each statistic name becomes a data member
|
|
|
1094 : prefixed with an underscore (if not already) and first
|
|
|
1095 : character after the underscore is lowercased.
|
|
|
1096 Example : $object->set_stats('num_A' =>1,
|
|
|
1097 : 'Num_B' =>10 ):
|
|
|
1098 : This sets :
|
|
|
1099 : $object->{'_num_A'} = 1
|
|
|
1100 : $object->{'_num_B'} = 10;
|
|
|
1101 Returns : n/a
|
|
|
1102 Comments : This method implements a convention for naming Perl
|
|
|
1103 : object data members with a leading underscore,
|
|
|
1104 : consistent with the naming convention of private methods.
|
|
|
1105 : Data members should not be part of an object's public
|
|
|
1106 : interface. The leading underscore helps flag the members
|
|
|
1107 : as private and also prevents inadvertant clobbering.
|
|
|
1108
|
|
|
1109 =cut
|
|
|
1110
|
|
|
1111 #--------------'
|
|
|
1112 sub set_stats {
|
|
|
1113 #--------------
|
|
|
1114 my( $self, %param ) = @_;
|
|
|
1115
|
|
|
1116 my ($val);
|
|
|
1117 foreach (keys %param) {
|
|
|
1118 $val = $param{$_};;
|
|
|
1119 s/^(\w)/_\l$1/;
|
|
|
1120 $self->{$_} = $val;
|
|
|
1121 }
|
|
|
1122 }
|
|
|
1123
|
|
|
1124
|
|
|
1125 =head2 strict
|
|
|
1126
|
|
|
1127 Usage : $object->strict( [-2|-1|0|1|2] );
|
|
|
1128 : warn $message if $object->strict > 0;
|
|
|
1129 Purpose : To make the object hyper- or hyposensitive to exceptions & warnings.
|
|
|
1130 : Strict = 2 : extremely hyper-sensitive, converts warn() into throw().
|
|
|
1131 : Strict = 1 : hyper-sensitive, but calls to warn are not converted.
|
|
|
1132 : Strict = 0 : no change (throw() = fatal, warn() = non-fatal).
|
|
|
1133 : Strict = -1 : hypo-sensitive, but calls to throw are not converted.
|
|
|
1134 : Strict = -2 : extremely hypo-sensitive, converts throw() into warn()
|
|
|
1135 :
|
|
|
1136 : Two degrees of positive and negative values for strict permit
|
|
|
1137 : the following functionality:
|
|
|
1138 : 1. Setting strict to 2 or -2 leads to more dramatic strictness
|
|
|
1139 : or permissiveness, respectively. With 2, all calls to warn()
|
|
|
1140 : become calls to throw() and are therefore fatal. With -2,
|
|
|
1141 : the opposite is true and calls to throw become non-fatal.
|
|
|
1142 : A strict value of 2 is thus an object-level version of
|
|
|
1143 : Perl's "use strict" pragma.
|
|
|
1144 :
|
|
|
1145 : 2. Setting strict to 1 or -1 does not affect the behavior of
|
|
|
1146 : throw() and warn(). This allows an object to implement its
|
|
|
1147 : its own strictness policy. A strict value of 1 is thus an
|
|
|
1148 : an object-level version of Perl's -w flag.
|
|
|
1149 :
|
|
|
1150 Returns : Integer between -2 to 2.
|
|
|
1151 Comments : This method no longer accesses an object-specific strictness
|
|
|
1152 : level but rather the global $STRICTNESS variable
|
|
|
1153 : defined in Bio::Root::Global.pm and accessed via the
|
|
|
1154 : strictness() method exported by that package.
|
|
|
1155 : Thus, all objects share the same strictness which
|
|
|
1156 : is generally more convenient.
|
|
|
1157 Status : Experimental
|
|
|
1158
|
|
|
1159 See also : warn() and throw() in L<Bio::Root::Root>, L<STRICTNESS & VERBOSITY>, strictness() in L<Bio::Root::Global>
|
|
|
1160
|
|
|
1161 =cut
|
|
|
1162
|
|
|
1163 #------------
|
|
|
1164 sub strict {
|
|
|
1165 #------------
|
|
|
1166 my $self = shift;
|
|
|
1167
|
|
|
1168 # Use global strictness?
|
|
|
1169 if( $self->{'_use_global_strictness'}) {
|
|
|
1170 return &strictness(@_);
|
|
|
1171 }
|
|
|
1172 else {
|
|
|
1173 # Object-specific strictness
|
|
|
1174 if (@_) { $self->{'_strict'} = shift; }
|
|
|
1175 defined($self->{'_strict'})
|
|
|
1176 ? return $self->{'_strict'}
|
|
|
1177 : (ref $self->{'_parent'} ? $self->{'_parent'}->strict : 0);
|
|
|
1178 }
|
|
|
1179 }
|
|
|
1180
|
|
|
1181 =head2 use_global_strictness
|
|
|
1182
|
|
|
1183 Usage : $object->use_global_strictnness( [1|0] );
|
|
|
1184 Purpose : Set/Get accessor for a flag indicating whether or not
|
|
|
1185 : to use the global strictness setting or to instead use
|
|
|
1186 : object-specific strictness.
|
|
|
1187 Returns : Boolean
|
|
|
1188 Comments :
|
|
|
1189 Status : Experimental
|
|
|
1190
|
|
|
1191 See also : L<strict()|strict>, L<STRICTNESS & VERBOSITY>, strictness() in L<Bio::Root::Global>
|
|
|
1192
|
|
|
1193 =cut
|
|
|
1194
|
|
|
1195 sub use_global_strictness {
|
|
|
1196 my ($self, $value) = @_;
|
|
|
1197
|
|
|
1198 if( defined $value ) {
|
|
|
1199 $self->{'_use_global_strictness'} = $value;
|
|
|
1200 }
|
|
|
1201
|
|
|
1202 return $self->{'_use_global_strictness'};
|
|
|
1203 }
|
|
|
1204
|
|
|
1205
|
|
|
1206 =head2 clone
|
|
|
1207
|
|
|
1208 Purpose : To deeply copy an object.
|
|
|
1209 : Creates a new object reference containing an exact
|
|
|
1210 : copy of an existing object and all its data members.
|
|
|
1211 Usage : $myClone = $myObj->clone;
|
|
|
1212 Comments : This method only clones the Bio::Root::Object data members.
|
|
|
1213 : To fully clone an object that has data members beyond
|
|
|
1214 : those inherited from Bio::Root::Object, you must provide a
|
|
|
1215 : constructor in your class to copy all data of an object
|
|
|
1216 : data into the clone. For an example, see how _set_clone()
|
|
|
1217 : is called by _initialize() in this class.
|
|
|
1218 :
|
|
|
1219 : clone() will pass the named parameters {-MAKE=>'clone'}
|
|
|
1220 : and {-OBJ=>$self} to the object's constructor. The
|
|
|
1221 : constructor should then either check the -MAKE parameter
|
|
|
1222 : directly or should check the return value from
|
|
|
1223 : a call to the superclass constructor (see _initialize()
|
|
|
1224 : for an example) and then copy the required data members from OBJ
|
|
|
1225 : into the new object, bypassing the normal construction process.
|
|
|
1226 : Cloning of objects has not been extensively tested.
|
|
|
1227 : USE WITH CAUTION.
|
|
|
1228 Status : Experimental
|
|
|
1229
|
|
|
1230 See Also : L<_set_clone()|_set_clone>, L<_initialize()|_initialize>
|
|
|
1231
|
|
|
1232 =cut
|
|
|
1233
|
|
|
1234 #-------------'
|
|
|
1235 sub clone {
|
|
|
1236 #-------------
|
|
|
1237 my($self) = shift;
|
|
|
1238
|
|
|
1239 # warn sprintf "\nCloning %s \"%s\"\n\n", ref($self),$self->name;
|
|
|
1240
|
|
|
1241 my $clone = $self->new(-MAKE =>'clone',
|
|
|
1242 -OBJ =>$self);
|
|
|
1243 if($self->err()) { $clone->err($self->err); }
|
|
|
1244 $clone;
|
|
|
1245 }
|
|
|
1246
|
|
|
1247
|
|
|
1248
|
|
|
1249 =head2 _set_clone
|
|
|
1250
|
|
|
1251 Usage : n/a; internal method used by _initialize()
|
|
|
1252 : $self->_set_clone($object_to_be_cloned)
|
|
|
1253 Purpose : Deep copy all Bio::Root::Object.pm data members
|
|
|
1254 : into a new object reference.
|
|
|
1255 : (This is basically a copy constructor).
|
|
|
1256 Argument : object ref for object to be cloned.
|
|
|
1257 Throws : Exception if argument is not an object reference.
|
|
|
1258 Comments : Data members which are objects are cloned (parent, io, err).
|
|
|
1259 : Cloning of objects has not been extensively tested.
|
|
|
1260 : USE WITH CAUTION.
|
|
|
1261
|
|
|
1262 See Also : L<_initialize()|_initialize>
|
|
|
1263
|
|
|
1264 =cut
|
|
|
1265
|
|
|
1266 #----------------
|
|
|
1267 sub _set_clone {
|
|
|
1268 #----------------
|
|
|
1269 my($self, $obj) = @_;
|
|
|
1270
|
|
|
1271 ref($obj) || throw($self, "Can't clone $ID object: Not an object ref ($obj)");
|
|
|
1272
|
|
|
1273 local($^W) = 0; # suppress 'uninitialized' warnings.
|
|
|
1274
|
|
|
1275 $self->{'_name'} = $obj->{'_name'};
|
|
|
1276 $self->{'_strict'} = $obj->{'_strict'};
|
|
|
1277 $self->{'_make'} = $obj->{'_make'};
|
|
|
1278 $self->{'_verbose'} = $obj->{'_verbose'};
|
|
|
1279 $self->{'_errState'} = $obj->{'_errState'};
|
|
|
1280 ## Better to use can() with Perl 5.004.
|
|
|
1281 $self->{'_parent'} = ref($obj->{'_parent'}) and $obj->{'_parent'}->clone;
|
|
|
1282 $self->{'_io'} = ref($obj->{'_io'}) and $obj->{'_io'}->clone;
|
|
|
1283 $self->{'_err'} = ref($obj->{'_err'}) and $obj->{'_err'}->clone;
|
|
|
1284 }
|
|
|
1285
|
|
|
1286
|
|
|
1287
|
|
|
1288 =head2 verbose
|
|
|
1289
|
|
|
1290 Usage : $object->verbose([-1|0|1]);
|
|
|
1291 Purpose : Set/Get an indicator for how much ruporting an object should do.
|
|
|
1292 Argument : integer (-1, 0, or 1)
|
|
|
1293 Returns : integer (-1, 0, or 1)
|
|
|
1294 : Returns 0 if verbosity has not been defined.
|
|
|
1295 : Verbosity > 0 indicates extra reporting.
|
|
|
1296 : Verbosity < 0 indicates minimal reporting.
|
|
|
1297 : Verbosity = 0 or undefined indicates default reporting.
|
|
|
1298 Comments : This method no longer accesses an object-specific verbosity
|
|
|
1299 : level but rather the global $VERBOSITY variable
|
|
|
1300 : defined in Bio::Root::Global.pm and accessed via the
|
|
|
1301 : verbosity() method exported by that package.
|
|
|
1302 : Thus, all objects share the same verbosity which
|
|
|
1303 : is generally more convenient.
|
|
|
1304 Status : Experimental
|
|
|
1305
|
|
|
1306 See Also : L<strict()|strict>, L<STRICTNESS & VERBOSITY>, verbosity() in L<Bio::Root::Global>
|
|
|
1307
|
|
|
1308 =cut
|
|
|
1309
|
|
|
1310 #------------
|
|
|
1311 sub verbose {
|
|
|
1312 #------------
|
|
|
1313 my $self = shift;
|
|
|
1314
|
|
|
1315 # Using global verbosity
|
|
|
1316 return &verbosity(@_);
|
|
|
1317
|
|
|
1318 # Object-specific verbosity (not used unless above code is commented out)
|
|
|
1319 if(@_) { $self->{'_verbose'} = shift; }
|
|
|
1320 defined($self->{'_verbose'})
|
|
|
1321 ? return $self->{'_verbose'}
|
|
|
1322 : (ref $self->{'_parent'} ? $self->{'_parent'}->verbose : 0);
|
|
|
1323 }
|
|
|
1324
|
|
|
1325
|
|
|
1326
|
|
|
1327 =head1 I/O-RELATED METHODS (Delegated to B<Bio::Root::IOManager>)
|
|
|
1328
|
|
|
1329 =head2 _io
|
|
|
1330
|
|
|
1331 Usage : $object->_io()
|
|
|
1332 Purpose : Get the Bio::Root::IOManager.pm object for the current object.
|
|
|
1333
|
|
|
1334 See also : L<display()|display>, L<read()|read>, L<file()|file>
|
|
|
1335
|
|
|
1336 =cut
|
|
|
1337
|
|
|
1338 #-------
|
|
|
1339 sub _io { my $self = shift; return $self->{'_io'}; }
|
|
|
1340 #-------
|
|
|
1341
|
|
|
1342
|
|
|
1343
|
|
|
1344 =head2 _set_io
|
|
|
1345
|
|
|
1346 Usage : n/a; internal use only.
|
|
|
1347 Purpose : Sets a new Bio::Root::IOManager.pm object for the current object.
|
|
|
1348
|
|
|
1349 See also : L<display()|display>, L<read()|read>, L<file()|file>
|
|
|
1350
|
|
|
1351 =cut
|
|
|
1352
|
|
|
1353 #------------
|
|
|
1354 sub _set_io {
|
|
|
1355 #------------
|
|
|
1356 my $self = shift;
|
|
|
1357
|
|
|
1358 require Bio::Root::IOManager;
|
|
|
1359
|
|
|
1360 # See PR#192.
|
|
|
1361 # $self->{'_io'} = new Bio::Root::IOManager(-PARENT=>$self, @_);
|
|
|
1362 $self->{'_io'} = new Bio::Root::IOManager(-PARENT=>$self);
|
|
|
1363 }
|
|
|
1364
|
|
|
1365
|
|
|
1366
|
|
|
1367 =head2 set_display
|
|
|
1368
|
|
|
1369 Usage : $object->set_display( %named_parameters).
|
|
|
1370 : See Bio::Root::IOManager::set_display() for a description of parameters.
|
|
|
1371 Purpose : Sets the output stream for displaying data associated with an object.
|
|
|
1372 : Delegates to Bio::Root::IOManager::set_display().
|
|
|
1373 Argument : Named parameters (optional).
|
|
|
1374 : See Bio::Root::IOManager::set_display() for a
|
|
|
1375 : description of arguments.
|
|
|
1376 Status : Experimental
|
|
|
1377 Comments : Sets the IOManager.pm object if it is not set.
|
|
|
1378 : I'm not satisfied with the current display()/set_display() strategy.
|
|
|
1379
|
|
|
1380 See also : set_display() in L<Bio::Root::IOManager>
|
|
|
1381
|
|
|
1382 =cut
|
|
|
1383
|
|
|
1384 #----------------'
|
|
|
1385 sub set_display {
|
|
|
1386 #----------------
|
|
|
1387 my($self, @param) = @_;
|
|
|
1388
|
|
|
1389 $self->_set_io(@param) if !ref($self->{'_io'});
|
|
|
1390
|
|
|
1391 eval { $self->{'_io'}->set_display(@param); };
|
|
|
1392
|
|
|
1393 if($@) {
|
|
|
1394 my $er = $@;
|
|
|
1395 $self->throw(-MSG=>$er, -NOTE=>"Can't set_display for ${\$self->name}");
|
|
|
1396 }
|
|
|
1397
|
|
|
1398 return $self->{'_io'}->fh;
|
|
|
1399 }
|
|
|
1400
|
|
|
1401
|
|
|
1402 =head2 display
|
|
|
1403
|
|
|
1404 Usage : $object->display( named parameters)
|
|
|
1405 : See Bio::Root::IOManager::display() for a description of parameters.
|
|
|
1406 Purpose : Output information about an object's data.
|
|
|
1407 : Delegates this task to Bio::Root::IOManager::display()
|
|
|
1408 Argument : Named parameters for IOManager::set_display()
|
|
|
1409 Status : Experimental
|
|
|
1410 Comments : Sets the IOManager.pm object if it is not set.
|
|
|
1411 : IOManager::set_display()is then called on the new IOManager object.
|
|
|
1412 :
|
|
|
1413 : The motivation behind the display() method and IOManager.pm
|
|
|
1414 : is to allow for flexible control over output of an
|
|
|
1415 : object's data to/from filehandles, pipes, or STDIN/STDOUT,
|
|
|
1416 : and for passing file handles between objects. Currently,
|
|
|
1417 : it is used mainly for output to STDOUT.
|
|
|
1418 :
|
|
|
1419 : There is some concern whether this much functionality is
|
|
|
1420 : actually necessary, hence the "Experimental" status of this
|
|
|
1421 : method.
|
|
|
1422 :
|
|
|
1423 : -------
|
|
|
1424 : It might be worthwhile to also have a string() method
|
|
|
1425 : that will put an object's data into a string that can be
|
|
|
1426 : further processed as desired. Stringification for persistence
|
|
|
1427 : issues might be best handled by Data::Dumper.pm.
|
|
|
1428 :
|
|
|
1429 : When overriding this method, use the following syntax:
|
|
|
1430 :
|
|
|
1431 : sub display {
|
|
|
1432 : my ($self, %param) = @_;
|
|
|
1433 : $self->SUPER::display(%param);
|
|
|
1434 : my $OUT = $self->fh();
|
|
|
1435 : print $OUT "\nSome data...\n";
|
|
|
1436 : ...
|
|
|
1437 : }
|
|
|
1438 : Now $OUT holds a filhandle reference (or the string 'STDOUT')
|
|
|
1439 : which can be passed to other methods to display different
|
|
|
1440 : data for the object.
|
|
|
1441 : _set_display() is automatically called with $OUT as the sole
|
|
|
1442 : argument (after $self) by IOManager.pm::display()
|
|
|
1443 : if the -SHOW parameter is set to 'stats' or 'default'.
|
|
|
1444 :
|
|
|
1445 Bugs : Because the $OUT variable can be a FileHandle or a string,
|
|
|
1446 : it is necessary to include the line before using $OUT in
|
|
|
1447 : print statements:
|
|
|
1448 : I am considering a cleaner way of dealing with this.
|
|
|
1449 : Setting $OUT to a glob (*main::STDOUT) was unsuccessful.
|
|
|
1450 :
|
|
|
1451 : I'm not satisfied with the current display()/set_display() strategy.
|
|
|
1452
|
|
|
1453 See also : display() in L<Bio::Root::IOManager>
|
|
|
1454
|
|
|
1455 =cut
|
|
|
1456
|
|
|
1457 #-------------
|
|
|
1458 sub display {
|
|
|
1459 #-------------
|
|
|
1460 my( $self, @param ) = @_;
|
|
|
1461 $self->{'_io'} || $self->set_display(@param);
|
|
|
1462 $self->{'_io'}->display(@param);
|
|
|
1463 }
|
|
|
1464
|
|
|
1465
|
|
|
1466
|
|
|
1467
|
|
|
1468 =head2 _display_stats
|
|
|
1469
|
|
|
1470 Usage : n/a; called automatically by Bio::Root::Object::display(-SHOW=>'stats');
|
|
|
1471 Purpose : Display stereotypical data for an object.
|
|
|
1472 : Automatically called via display().
|
|
|
1473 Argument : Filehandle reference or string 'STDOUT' 'STDIN' 'STDERR'
|
|
|
1474 Status : Experimental
|
|
|
1475
|
|
|
1476 See also : L<display()|display>
|
|
|
1477
|
|
|
1478 =cut
|
|
|
1479
|
|
|
1480 #-------------------
|
|
|
1481 sub _display_stats {
|
|
|
1482 #-------------------
|
|
|
1483 my($self, $OUT) = @_;
|
|
|
1484
|
|
|
1485
|
|
|
1486 printf ( $OUT "%-15s: %s\n","NAME", $self->name());
|
|
|
1487 printf ( $OUT "%-15s: %s\n","MAKE", $self->make());
|
|
|
1488 if($self->parent) {
|
|
|
1489 printf ( $OUT "%-15s: %s\n","PARENT", $self->parent->to_string);
|
|
|
1490 }
|
|
|
1491 printf ( $OUT "%-15s: %d\n",'ERRORS', (defined $self->err('count') ? $self->err('count') : 0)); ###JES###
|
|
|
1492 printf ( $OUT "%-15s: %s\n","ERR STATE", $self->err_state());
|
|
|
1493 if($self->err()) {
|
|
|
1494 print $OUT "ERROR:\n";
|
|
|
1495 $self->print_err();
|
|
|
1496 }
|
|
|
1497 }
|
|
|
1498
|
|
|
1499
|
|
|
1500
|
|
|
1501 =head2 read
|
|
|
1502
|
|
|
1503 Usage : $object->read( named parameters)
|
|
|
1504 : See Bio::Root::IOManager::read() for a description of parameters.
|
|
|
1505 Purpose : Inputs data from an arbitrary source (file or STDIN).
|
|
|
1506 : Delegates this task to Bio::Root::IOManager::read().
|
|
|
1507 Status : Experimental
|
|
|
1508 Comments : Sets the IOManager.pm object if it is not set.
|
|
|
1509 : See the comments for the display() method for some comments
|
|
|
1510 : about IO issues for objects.
|
|
|
1511 : Note that the read() method uses a different strategy than
|
|
|
1512 : the display() method.
|
|
|
1513 : IO issues are considered experimental.
|
|
|
1514
|
|
|
1515 See also : L<display()|display>, read() in L<Bio::Root::IOManager>
|
|
|
1516
|
|
|
1517 =cut
|
|
|
1518
|
|
|
1519 #--------
|
|
|
1520 sub read {
|
|
|
1521 #--------
|
|
|
1522 my $self = shift;
|
|
|
1523
|
|
|
1524 $self->_set_io(@_) if not defined $self->{'_io'};
|
|
|
1525
|
|
|
1526 $self->{'_io'}->read(@_);
|
|
|
1527 }
|
|
|
1528
|
|
|
1529
|
|
|
1530
|
|
|
1531 =head2 fh
|
|
|
1532
|
|
|
1533 Usage : $object->fh(['name'])
|
|
|
1534 : See Bio::Root::IOManager::fh() for a complete usage description.
|
|
|
1535 Purpose : Get an object's current FileHandle object or IO stream indicator.
|
|
|
1536 : Delegates to Bio::Root::IOManager.pm.
|
|
|
1537 Status : Experimental
|
|
|
1538 Comments : Sets the IOManager.pm object if it is not set.
|
|
|
1539
|
|
|
1540 See also : fh() in L<Bio::Root::IOManager>
|
|
|
1541
|
|
|
1542 =cut
|
|
|
1543
|
|
|
1544 #--------'
|
|
|
1545 sub fh {
|
|
|
1546 #--------
|
|
|
1547 my $self = shift;
|
|
|
1548 $self->_set_io(@_) if !defined $self->{'_io'};
|
|
|
1549 $self->{'_io'}->fh(@_);
|
|
|
1550 }
|
|
|
1551
|
|
|
1552
|
|
|
1553 =head2 show
|
|
|
1554
|
|
|
1555 Usage : $object->show()
|
|
|
1556 : See Bio::Root::IOManager::show() for details.
|
|
|
1557 Purpose : Get the string used to specify what to display
|
|
|
1558 : using the display() method.
|
|
|
1559 : Delegates to Bio::Root::IOManager.pm.
|
|
|
1560 Status : Experimental
|
|
|
1561 Comments : Sets the IOManager.pm object if it is not set.
|
|
|
1562
|
|
|
1563 See also : show() in L<Bio::Root::IOManager>, set_display() in L<Bio::Root::IOManager>
|
|
|
1564
|
|
|
1565 =cut
|
|
|
1566
|
|
|
1567 #-----------
|
|
|
1568 sub show {
|
|
|
1569 #-----------
|
|
|
1570 my $self = shift;
|
|
|
1571 $self->_set_io(@_) if !defined $self->{'_io'};
|
|
|
1572 $self->{'_io'}->show;
|
|
|
1573 }
|
|
|
1574
|
|
|
1575
|
|
|
1576
|
|
|
1577 =head2 file
|
|
|
1578
|
|
|
1579 Usage : $object->file()
|
|
|
1580 : See Bio::Root::IOManager::file() for details.
|
|
|
1581 Purpose : Set/Get name of a file associated with an object.
|
|
|
1582 : Delegates to Bio::Root::IOManager.pm.
|
|
|
1583 Status : Experimental
|
|
|
1584 Comments : Sets the IOManager.pm object if it is not set.
|
|
|
1585
|
|
|
1586 See also : file() in L<Bio::Root::IOManager>
|
|
|
1587
|
|
|
1588 =cut
|
|
|
1589
|
|
|
1590 #---------
|
|
|
1591 sub file {
|
|
|
1592 #---------
|
|
|
1593 my $self = shift;
|
|
|
1594 $self->_set_io(@_) if !defined $self->{'_io'};
|
|
|
1595 $self->{'_io'}->file(@_);
|
|
|
1596 }
|
|
|
1597
|
|
|
1598
|
|
|
1599 =head2 compress_file
|
|
|
1600
|
|
|
1601 Usage : $object->compress_file([filename])
|
|
|
1602 : See Bio::Root::IOManager::compress_file() for details.
|
|
|
1603 Purpose : Compress a file associated with the current object.
|
|
|
1604 : Delegates to Bio::Root::IOManager.pm.
|
|
|
1605 Throws : Propagates exceptions thrown by Bio::Root::IOManager.pm
|
|
|
1606 Status : Experimental
|
|
|
1607 Comments : Sets the IOManager.pm object if it is not set.
|
|
|
1608
|
|
|
1609 See also : L<file()|file>, compress_file() in L<Bio::Root::IOManager>
|
|
|
1610
|
|
|
1611 =cut
|
|
|
1612
|
|
|
1613 #-------------------
|
|
|
1614 sub compress_file {
|
|
|
1615 #-------------------
|
|
|
1616 my $self = shift;
|
|
|
1617 $self->_set_io(@_) if !defined $self->{'_io'};
|
|
|
1618 $self->{'_io'}->compress_file(@_);
|
|
|
1619 }
|
|
|
1620
|
|
|
1621
|
|
|
1622
|
|
|
1623 =head2 uncompress_file
|
|
|
1624
|
|
|
1625 Usage : $object->uncompress_file([filename])
|
|
|
1626 : Delegates to Bio::Root::IOManager.pm.
|
|
|
1627 Purpose : Uncompress a file associated with the current object.
|
|
|
1628 Throws : Propagates exceptions thrown by Bio::Root::IOManager.pm
|
|
|
1629 Status : Experimental
|
|
|
1630 Comments : Sets the IOManager.pm object if it is not set.
|
|
|
1631
|
|
|
1632 See also : L<file()|file>, uncompress_file() in L<Bio::Root::IOManager>
|
|
|
1633
|
|
|
1634 =cut
|
|
|
1635
|
|
|
1636 #--------------------
|
|
|
1637 sub uncompress_file {
|
|
|
1638 #--------------------
|
|
|
1639 my $self = shift;
|
|
|
1640 $self->_set_io(@_) if !defined $self->{'_io'};
|
|
|
1641 $self->{'_io'}->uncompress_file(@_);
|
|
|
1642 }
|
|
|
1643
|
|
|
1644
|
|
|
1645 =head2 delete_file
|
|
|
1646
|
|
|
1647 Usage : $object->delete_file([filename])
|
|
|
1648 : See Bio::Root::IOManager::delete_file() for details.
|
|
|
1649 Purpose : Delete a file associated with the current object.
|
|
|
1650 : Delegates to Bio::Root::IOManager.pm.
|
|
|
1651 Throws : Propagates exceptions thrown by Bio::Root::IOManager.pm
|
|
|
1652 Status : Experimental
|
|
|
1653 Comments : Sets the IOManager.pm object if it is not set.
|
|
|
1654
|
|
|
1655 See also : L<file()|file>, delete_file() in L<Bio::Root::IOManager>
|
|
|
1656
|
|
|
1657 =cut
|
|
|
1658
|
|
|
1659 #-----------------
|
|
|
1660 sub delete_file {
|
|
|
1661 #-----------------
|
|
|
1662 my $self = shift;
|
|
|
1663 $self->_set_io(@_) if !defined $self->{'_io'};
|
|
|
1664 $self->{'_io'}->delete_file(@_);
|
|
|
1665 }
|
|
|
1666
|
|
|
1667
|
|
|
1668 =head2 file_date
|
|
|
1669
|
|
|
1670 Usage : $object->file_date( %named_parameters )
|
|
|
1671 : See Bio::Root::IOManager::file_date() for details.
|
|
|
1672 Purpose : Obtain the last modified data of a file.
|
|
|
1673 : Delegates to Bio::Root::IOManager.pm.
|
|
|
1674 Example : $object->file_date('/usr/home/me/data.txt');
|
|
|
1675 Throws : Propagates exceptions thrown by Bio::Root::IOManager.pm
|
|
|
1676 Status : Experimental
|
|
|
1677 Comments : Sets the IOManager.pm object if it is not set.
|
|
|
1678
|
|
|
1679 See also : L<file()|file>, file_date() in L<Bio::Root::IOManager>
|
|
|
1680
|
|
|
1681 =cut
|
|
|
1682
|
|
|
1683 #---------------
|
|
|
1684 sub file_date {
|
|
|
1685 #---------------
|
|
|
1686 my $self = shift;
|
|
|
1687 $self->_set_io(@_) if !defined $self->{'_io'};
|
|
|
1688 $self->{'_io'}->file_date(@_);
|
|
|
1689 }
|
|
|
1690
|
|
|
1691
|
|
|
1692
|
|
|
1693 =head1 EXPERIMENTAL METHODS
|
|
|
1694
|
|
|
1695
|
|
|
1696 =head2 xref
|
|
|
1697
|
|
|
1698 Usage : $object->xref([object | 'null']);
|
|
|
1699 Purpose : Sets/Gets an object(s) cross-referenced
|
|
|
1700 : to the current object.
|
|
|
1701 Example : $myObj->xref('null'); #remove all xrefs
|
|
|
1702 : $myObj->xref($otherObject); #add a cross referenced object
|
|
|
1703 Argument : Object reference or 'null' ('undef' also accepted).
|
|
|
1704 Returns : Object reference or undef if the object has no xref set.
|
|
|
1705 Throws : fatal error if argument is not an object reference or 'null'.
|
|
|
1706 Comments : An Xref.pm object is a vectorized wrapper for an object.
|
|
|
1707 : Thus, the number of objects cross-referenced can grow
|
|
|
1708 : and shrink at will.
|
|
|
1709 Status : Experimental
|
|
|
1710 WARNING : NOT FULLY TESTED.
|
|
|
1711
|
|
|
1712 See Also : L<Bio::Root::Xref>
|
|
|
1713
|
|
|
1714 =cut
|
|
|
1715
|
|
|
1716 #---------
|
|
|
1717 sub xref {
|
|
|
1718 #---------
|
|
|
1719 my $self = shift;
|
|
|
1720 if(@_) {
|
|
|
1721 my $arg = shift;
|
|
|
1722 if(ref $arg) {
|
|
|
1723 require Bio::Root::Xref;
|
|
|
1724
|
|
|
1725 if( !defined $self->{'_xref'}) {
|
|
|
1726 $self->{'_xref'} = new Bio::Root::Xref(-PARENT =>$self,
|
|
|
1727 -OBJ =>$arg);
|
|
|
1728 } else {
|
|
|
1729 $self->{'_xref'}->add($arg);
|
|
|
1730 }
|
|
|
1731 } elsif($arg =~ /null|undef/i) {
|
|
|
1732 undef $self->{'_xref'};
|
|
|
1733 } else {
|
|
|
1734 $self->throw("Can't set Xref using $arg: Not an object");
|
|
|
1735 }
|
|
|
1736 }
|
|
|
1737
|
|
|
1738 $self->{'_xref'};
|
|
|
1739 }
|
|
|
1740
|
|
|
1741
|
|
|
1742
|
|
|
1743 =head2 index
|
|
|
1744
|
|
|
1745 Purpose : To add an object to a package global hash of objects
|
|
|
1746 : for tracking or rapid retrieval.
|
|
|
1747 Usage : $self->index();
|
|
|
1748 Status : Experimental
|
|
|
1749 Comments : The object's name is used to index it into a hash. Objects in
|
|
|
1750 : different classes (packages) will be indexed in different hashes.
|
|
|
1751 : An object's name should thus be unique within its class.
|
|
|
1752 : To find an object, use find_object().
|
|
|
1753 : Uses the package global %Objects_created.
|
|
|
1754
|
|
|
1755 See also : L<find_object()|find_object>
|
|
|
1756
|
|
|
1757 =cut
|
|
|
1758
|
|
|
1759 #----------
|
|
|
1760 sub index {
|
|
|
1761 #----------
|
|
|
1762 my $self = shift;
|
|
|
1763 my $class = ref $self;
|
|
|
1764 my $objName = $self->{'_name'};
|
|
|
1765
|
|
|
1766 if( not defined $objName ) {
|
|
|
1767 $self->throw("Can't index $class object \"$objName\".");
|
|
|
1768 }
|
|
|
1769
|
|
|
1770 $DEBUG and do{ print STDERR "$ID: Indexing $class object \"$objName\"."; <STDIN>; };
|
|
|
1771
|
|
|
1772 $Objects_created{ $class }->{ $objName } = $self;
|
|
|
1773 }
|
|
|
1774
|
|
|
1775 #----------------------
|
|
|
1776 sub _remove_from_index {
|
|
|
1777 #----------------------
|
|
|
1778 my $self = shift;
|
|
|
1779 my $class = ref $self;
|
|
|
1780 my $objName = $self->{'_name'};
|
|
|
1781
|
|
|
1782 undef $Objects_created{$class}->{$objName} if exists $Objects_created{$class}->{$objName};
|
|
|
1783 }
|
|
|
1784
|
|
|
1785
|
|
|
1786
|
|
|
1787 =head2 find_object
|
|
|
1788
|
|
|
1789 Purpose : To obtain any object reference based on its unique name
|
|
|
1790 : within its class.
|
|
|
1791 Usage : $myObj = &find_object('fred');
|
|
|
1792 : No need to specify the class (package) name of the object.
|
|
|
1793 Comments : To use this method, the object must be previously
|
|
|
1794 : indexed by Bio::Root::Object.pm. This can be accomplished
|
|
|
1795 : by including 'index' in the -MAKE parameter during object
|
|
|
1796 : construction OR by calling the index() method on the
|
|
|
1797 : the object at any point after construction.
|
|
|
1798 : This is not an instance method.
|
|
|
1799 Status : Experimental
|
|
|
1800
|
|
|
1801 See also : L<index()|index>
|
|
|
1802
|
|
|
1803 =cut
|
|
|
1804
|
|
|
1805 #---------------
|
|
|
1806 sub find_object {
|
|
|
1807 #---------------
|
|
|
1808 my $name = shift; # Assumes name has been validated.
|
|
|
1809 my $class = undef;
|
|
|
1810 my $object = undef;
|
|
|
1811
|
|
|
1812 foreach $class ( keys %Objects_created ) {
|
|
|
1813 if( exists $Objects_created{ $class }->{ $name } ) {
|
|
|
1814 $object = $Objects_created{ $class }->{ $name };
|
|
|
1815 last;
|
|
|
1816 }
|
|
|
1817 }
|
|
|
1818 $object;
|
|
|
1819 }
|
|
|
1820
|
|
|
1821
|
|
|
1822
|
|
|
1823 =head2 has_warning
|
|
|
1824
|
|
|
1825 Purpose : Test whether or not an object has a non-fatal error (warning).
|
|
|
1826 Usage : $self->has_warning;
|
|
|
1827 Comments : This method is not usually needed. Checking err() is
|
|
|
1828 : sufficient since throw()ing an exception is a fatal event
|
|
|
1829 : and must be handled when it occurs.
|
|
|
1830 Status : Experimental
|
|
|
1831
|
|
|
1832 See also : L<err()|err>, warn() in L<Bio::Root::Root>, throw() in L<Bio::Root::Root>
|
|
|
1833
|
|
|
1834 =cut
|
|
|
1835
|
|
|
1836 #----------------
|
|
|
1837 sub has_warning {
|
|
|
1838 #----------------
|
|
|
1839 my $self = shift;
|
|
|
1840 my $errData = $self->err('type');
|
|
|
1841 return 1 if $errData =~ /WARNING/;
|
|
|
1842 0;
|
|
|
1843 }
|
|
|
1844
|
|
|
1845
|
|
|
1846
|
|
|
1847 =head2 print_err
|
|
|
1848
|
|
|
1849 Usage : print_err([-WHERE=>FileHandle_object [,-SHOW=>msg|note|tech|stack] or any combo])
|
|
|
1850 Purpose : Reports error data for any errors an object may have
|
|
|
1851 : as a string. This will only print warnings since exceptions
|
|
|
1852 : are fatal (unless a strictness of -2 is used).
|
|
|
1853 Example : $myObj->print_err;
|
|
|
1854 : $myObj->print_err(-WHERE=>$myObj->fh('err'), -SHOW=>'msgtechstack');
|
|
|
1855 Argument : SHOW parameter : specify a sub-set of the err data.
|
|
|
1856 : WHERE parameter : specify a filehandle for printing.
|
|
|
1857 Returns : n/a
|
|
|
1858 Status : Experimental
|
|
|
1859
|
|
|
1860 See also : L<err_string()|err_string>, L<strict()|strict>
|
|
|
1861
|
|
|
1862 =cut
|
|
|
1863
|
|
|
1864 #-------------
|
|
|
1865 sub print_err {
|
|
|
1866 #-------------
|
|
|
1867 my( $self, %param ) = @_;
|
|
|
1868
|
|
|
1869 # print "$ID: print_err()\n";
|
|
|
1870
|
|
|
1871 my $OUT = $self->set_display(%param);
|
|
|
1872
|
|
|
1873 # print "$ID: OUT = $OUT\n";
|
|
|
1874
|
|
|
1875 print $OUT $self->err_string( %param );
|
|
|
1876
|
|
|
1877 # print "$ID: done print_err()\n";
|
|
|
1878 }
|
|
|
1879
|
|
|
1880
|
|
|
1881
|
|
|
1882 =head2 err_string
|
|
|
1883
|
|
|
1884 Usage : err_string([-SHOW =>msg|note|tech|stack])
|
|
|
1885 : err_string([-SHOW =>'msgnote'] or other combos)
|
|
|
1886 Purpose : Reports all warnings generated by the object as a string.
|
|
|
1887 Example : $errData = $myObj->err_string;
|
|
|
1888 : print MYHANDLE $myObj->err_string();
|
|
|
1889 Argument : SHOW parameter : return a specific sub-set of the err data.
|
|
|
1890 Returns : A string containing the error data of the object.
|
|
|
1891 Comments : This method is provided as a safer and slightly easier to type
|
|
|
1892 : alternative to $self->err->string.
|
|
|
1893 Status : Experimental
|
|
|
1894
|
|
|
1895 See also : L<print_err()|print_err>, string() in L<Bio::Root::Err>
|
|
|
1896
|
|
|
1897 =cut
|
|
|
1898
|
|
|
1899 #----------------
|
|
|
1900 sub err_string {
|
|
|
1901 #----------------
|
|
|
1902 my( $self, %param ) = @_;
|
|
|
1903 my($out);
|
|
|
1904 my $errCount = $self->err('count');
|
|
|
1905
|
|
|
1906 # print "$ID: err_string(): count = $errCount\n";
|
|
|
1907
|
|
|
1908 if( $errCount) {
|
|
|
1909 $out = sprintf("\n%d error%s in %s \"%s\"\n",
|
|
|
1910 $errCount, $errCount>1?'s':'', ref($self), $self->name);
|
|
|
1911 $out .= $self->err->string( %param );
|
|
|
1912 } else {
|
|
|
1913 $out = sprintf("\nNo errors in %s \"%s\"\n", ref($self), $self->name);
|
|
|
1914 }
|
|
|
1915 $out;
|
|
|
1916 }
|
|
|
1917
|
|
|
1918
|
|
|
1919
|
|
|
1920
|
|
|
1921 #################################################################
|
|
|
1922 # DEPRECATED or HIGHLY EXPERIMENTAL METHODS
|
|
|
1923 #################################################################
|
|
|
1924
|
|
|
1925 =head1 HIGHLY EXPERIMENTAL/DEPRECATED METHODS
|
|
|
1926
|
|
|
1927 =head2 terse
|
|
|
1928
|
|
|
1929 Usage : $object->terse([0|1]);
|
|
|
1930 Purpose : Set/Get an indicator to report less than the normal amount.
|
|
|
1931 Argument : Boolean (0|1)
|
|
|
1932 Returns : Boolean (0|1)
|
|
|
1933 Comments : This method is for reducing the amount of reporting
|
|
|
1934 : an object will do.
|
|
|
1935 : terse can be set during object construction with the
|
|
|
1936 : -TERSE => 1 flag.
|
|
|
1937 : Not putting this method in IOManager.pm since that class
|
|
|
1938 : is concerned with "where" to report, not "what" or "how much".
|
|
|
1939 Status : Deprecated
|
|
|
1940 : Use verbose() with a negative value instead.
|
|
|
1941
|
|
|
1942 See also : L<verbose()|verbose>
|
|
|
1943
|
|
|
1944 =cut
|
|
|
1945
|
|
|
1946 #----------
|
|
|
1947 sub terse {
|
|
|
1948 #----------
|
|
|
1949 my $self = shift;
|
|
|
1950 if(@_) { $self->{'_verbose'} = -1 * shift; }
|
|
|
1951
|
|
|
1952 $self->warn("Deprecated method 'terse()'. Use verbose(-1) instead.");
|
|
|
1953
|
|
|
1954 my $verbosity = $self->{'_verbose'} or
|
|
|
1955 (ref $self->{'_parent'} and $self->{'_parent'}->verbose) or 0;
|
|
|
1956
|
|
|
1957 return $verbosity * -1;
|
|
|
1958 }
|
|
|
1959
|
|
|
1960
|
|
|
1961 #----------------------
|
|
|
1962 =head2 set_err_data()
|
|
|
1963 #----------------------
|
|
|
1964
|
|
|
1965 Usage : $object->set_err_data( field, data);
|
|
|
1966 Purpose : Alters data within the last error set by the object.
|
|
|
1967 : Interface to Bio::Root::Err::set().
|
|
|
1968 Returns : Calls Bio::Root::Err::set()
|
|
|
1969 Argument : field = string, name of Bio::Root::Err.pm data field to set.
|
|
|
1970 : data = string, data to set it to.
|
|
|
1971 Throws : Exception if object has no errors.
|
|
|
1972 Status : Deprecated
|
|
|
1973
|
|
|
1974 See Also : set() in L<Bio::Root::Err>
|
|
|
1975
|
|
|
1976 =cut
|
|
|
1977
|
|
|
1978 #-----------------
|
|
|
1979 sub set_err_data {
|
|
|
1980 #-----------------
|
|
|
1981 my( $self, $field, $data) = @_;
|
|
|
1982
|
|
|
1983 $self->throw("Object has no errors.") if !$self->{'_err'};
|
|
|
1984
|
|
|
1985 # print "$ID: set_err_data($field) with data = $data\n in object ${\$self->name}:\n", $self->err->last->string(-CURRENT=>1); <STDIN>;
|
|
|
1986
|
|
|
1987 $self->{'_err'}->last->set( $field, $data );
|
|
|
1988 }
|
|
|
1989
|
|
|
1990 =head2 set_read
|
|
|
1991
|
|
|
1992 Usage : see Bio::Root::IOManager::set_read()
|
|
|
1993 Purpose : Sets an input stream for importing data associated with an object.
|
|
|
1994 : Delegates to Bio::Root::IOManager::set_read().
|
|
|
1995 Status : Experimental
|
|
|
1996 WARNING! : This method has not been tested.
|
|
|
1997
|
|
|
1998 See also : set_read() in L<Bio::Root::IOManager>
|
|
|
1999
|
|
|
2000 =cut
|
|
|
2001
|
|
|
2002 #--------------
|
|
|
2003 sub set_read {
|
|
|
2004 #--------------
|
|
|
2005 my($self,%param) = @_;
|
|
|
2006
|
|
|
2007 $self->_set_io(%param) if !defined $self->{'_io'};
|
|
|
2008
|
|
|
2009 $self->{'_io'}->set_read(%param);
|
|
|
2010 }
|
|
|
2011
|
|
|
2012
|
|
|
2013
|
|
|
2014 =head2 set_log_err
|
|
|
2015
|
|
|
2016 Usage : see Bio::Root::IOManager::set_log_err()
|
|
|
2017 Purpose : Sets the output stream for logging information about
|
|
|
2018 : an object's errors.
|
|
|
2019 : Delegates to Bio::Root::IOManager::set_log_err().
|
|
|
2020 Status : Experimental
|
|
|
2021 WARNING! : This method has not been tested.
|
|
|
2022
|
|
|
2023 See also : set_log_err() in L<Bio::Root::IOManager>
|
|
|
2024
|
|
|
2025 =cut
|
|
|
2026
|
|
|
2027 #---------------'
|
|
|
2028 sub set_log_err {
|
|
|
2029 #---------------
|
|
|
2030 my($self,%param) = @_;
|
|
|
2031
|
|
|
2032 $self->_set_io(%param) if !defined $self->{'_io'};
|
|
|
2033
|
|
|
2034 $self->{'_io'}->set_log_err(%param);
|
|
|
2035 }
|
|
|
2036
|
|
|
2037
|
|
|
2038 1;
|
|
|
2039 __END__
|
|
|
2040
|
|
|
2041
|
|
|
2042 #####################################################################################
|
|
|
2043 # END OF CLASS #
|
|
|
2044 #####################################################################################
|
|
|
2045
|
|
|
2046 =head1 FOR DEVELOPERS ONLY
|
|
|
2047
|
|
|
2048 =head2 Data Members
|
|
|
2049
|
|
|
2050 Information about the various data members of this module is provided for those
|
|
|
2051 wishing to modify or understand the code. Two things to bear in mind:
|
|
|
2052
|
|
|
2053 =over 4
|
|
|
2054
|
|
|
2055 =item 1 Do NOT rely on these in any code outside of this module.
|
|
|
2056
|
|
|
2057 All data members are prefixed with an underscore to signify that they are private.
|
|
|
2058 Always use accessor methods. If the accessor doesn't exist or is inadequate,
|
|
|
2059 create or modify an accessor (and let me know, too!).
|
|
|
2060
|
|
|
2061 =item 2 This documentation may be incomplete and out of date.
|
|
|
2062
|
|
|
2063 It is easy for this documentation to become obsolete as this module is still evolving.
|
|
|
2064 Always double check this info and search for members not described here.
|
|
|
2065
|
|
|
2066 =back
|
|
|
2067
|
|
|
2068 An instance of Bio::Root::Object.pm is a blessed reference to a hash containing
|
|
|
2069 all or some of the following fields:
|
|
|
2070
|
|
|
2071 FIELD VALUE
|
|
|
2072 ------------------------------------------------------------------------
|
|
|
2073 _name Common name for an object useful for indexing.
|
|
|
2074 Should be unique within its class.
|
|
|
2075
|
|
|
2076 _parent The object which created and is responsible for this object.
|
|
|
2077 When a parent is destroyed, it takes all of its children with it.
|
|
|
2078
|
|
|
2079 _err Bio::Root::Err.pm object reference. Undefined if the object has no error
|
|
|
2080 or if the _record_err member is false (which is the default).
|
|
|
2081 If object has multiple errors, err becomes a linked
|
|
|
2082 list of Err objects and the err member always points to latest err.
|
|
|
2083 In theory, an object should care only about whether or not it HAS
|
|
|
2084 an Err not how many it has. I've tried to make the management of
|
|
|
2085 multiple errors as opaque as possible to Bio::Root::Object.
|
|
|
2086
|
|
|
2087 _errState One of @Bio::Root::Err::ERR_TYPES. Allows an object to quickly determine the
|
|
|
2088 the type of error it has (if any) without having to examine
|
|
|
2089 potentially multiple Err object(s).
|
|
|
2090
|
|
|
2091 _xref Bio::Root::Xref object (Vector) for tracking other object(s) related to the
|
|
|
2092 present object not by inheritance or composition but by some arbitrary
|
|
|
2093 criteria. This is a new, experimental feature and is not fully implemented.
|
|
|
2094
|
|
|
2095 _make Used as a switch for custom object initialization. Provides a
|
|
|
2096 mechanism for alternate constructors. This is somewhat experimental.
|
|
|
2097 It may be useful for contruction of complex objects and may be of
|
|
|
2098 use for determining how an object was constructed post facto.
|
|
|
2099
|
|
|
2100 _io Bio::Root::IOManager.pm object reference. Used primarily for handling the
|
|
|
2101 display of an object's data.
|
|
|
2102
|
|
|
2103 _strict Integer flag to set the sensitivity to exceptions/warnings
|
|
|
2104 for a given object.
|
|
|
2105
|
|
|
2106 _verbose Boolean indicator for reporting more or less than the normal amount.
|
|
|
2107
|
|
|
2108 _record_err Boolean indicator for attaching all thrown exception objects
|
|
|
2109 to the current object. Default = false (don't attach exceptions).
|
|
|
2110
|
|
|
2111 =cut
|
|
|
2112
|
|
|
2113
|
|
|
2114 MODIFICATION NOTES:
|
|
|
2115 -----------------------
|
|
|
2116 0.041, sac --- Thu Feb 4 03:50:58 1999
|
|
|
2117 * warn() utilizes the Global $CGI indicator to supress output
|
|
|
2118 when script is running as a CGI.
|
|
|
2119
|
|
|
2120 0.04, sac --- Tue Dec 1 04:32:01 1998
|
|
|
2121 * Incorporated the new globals $STRICTNESS and $VERBOSITY
|
|
|
2122 and eliminated WARN_ON_FATAL, FATAL_ON_WARN and DONT_WARN.
|
|
|
2123 * Deprecated terse() since it is better to think of terseness
|
|
|
2124 as negative verbosity.
|
|
|
2125 * Removed autoloading-related code and comments.
|
|
|
2126
|
|
|
2127 0.035, 28 Sep 1998, sac:
|
|
|
2128 * Added _drop_child() method to attempt to break cyclical refs
|
|
|
2129 between parent and child objects.
|
|
|
2130 * Added to_string() method.
|
|
|
2131 * Err objects no longer know their parents (no need).
|
|
|
2132
|
|
|
2133 0.031, 2 Sep 1998, sac:
|
|
|
2134 * Documentation changes only. Wrapped the data member docs
|
|
|
2135 at the bottom in POD comments which fixes compilation bug
|
|
|
2136 caused by commenting out __END__.
|
|
|
2137
|
|
|
2138 0.03, 16 Aug 1998, sac:
|
|
|
2139 * Calls to warn() or throw() now no longer result in Err.pm objects
|
|
|
2140 being attached to the current object. For discussion about this
|
|
|
2141 descision, see comments under err().
|
|
|
2142 * Added the -RECORD_ERR constructor option and Global::record_err()
|
|
|
2143 method to enable the attachment of Err.pm object to the current
|
|
|
2144 object.
|
|
|
2145 * Minor bug fixes with parameter handling (%param -> @param).
|
|
|
2146 * Added note about AUTOLOADing.
|
|
|
2147
|
|
|
2148 0.023, 20 Jul 1998, sac:
|
|
|
2149 * Changes in Bio::Root::IOManager::read().
|
|
|
2150 * Improved memory management (destroy(), DESTROY(), and changes
|
|
|
2151 in Bio::Root::Vector.pm).
|
|
|
2152
|
|
|
2153 0.022, 16 Jun 1998, sac:
|
|
|
2154 * Changes in Bio::Root::IOManager::read().
|
|
|
2155
|
|
|
2156 0.021, May 1998, sac:
|
|
|
2157 * Touched up _set_clone().
|
|
|
2158 * Refined documentation in this and other Bio::Root modules
|
|
|
2159 (converted to use pod2html in Perl 5.004)
|
|
|
2160
|
|
|
2161
|
