Mercurial > repos > mahtabm > ensembl

comparison variant_effect_predictor/Bio/Root/Object.pm @ 0:1f6dce3d34e0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author mahtabm
date Thu, 11 Apr 2013 02:01:53 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:1f6dce3d34e0
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