File Coverage

Bio/Phenotype/Phenotype.pm
Criterion Covered Total %
statement 192 195 98.4
branch 42 58 72.4
condition n/a
subroutine 44 44 100.0
pod 33 33 100.0
total 311 330 94.2


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Phenotype::Phenotype
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Christian M. Zmasek or
7             #
8             # (c) Christian M. Zmasek, czmasek-at-burnham.org, 2002.
9             # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
10             #
11             # You may distribute this module under the same terms as perl itself.
12             # Refer to the Perl Artistic License (see the license accompanying this
13             # software package, or see http://www.perl.com/language/misc/Artistic.html)
14             # for the terms under which you may use, modify, and redistribute this module.
15             #
16             # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
17             # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
18             # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
19             #
20             # You may distribute this module under the same terms as perl itself
21              
22             # POD documentation - main docs before the code
23              
24             =head1 NAME
25              
26             Bio::Phenotype::Phenotype - A class for modeling phenotypes
27              
28             =head1 SYNOPSIS
29              
30             #get Bio::Phenotype::PhenotypeI somehow
31              
32             print $phenotype->name(), "\n";
33             print $phenotype->description(), "\n";
34              
35             my @keywords = ( "achondroplasia", "dwarfism" );
36             $phenotype->add_keywords( @keywords );
37             foreach my $keyword ( $phenotype->each_keyword() ) {
38             print $keyword, "\n";
39             }
40             $phenotype->remove_keywords();
41              
42              
43             foreach my $gene_symbol ( $phenotype->each_gene_symbol() ) {
44             print $gene_symbol, "\n";
45             }
46              
47             foreach my $corr ( $phenotype->each_Correlate() ) {
48             # Do something with $corr
49             }
50              
51             foreach my $var ( $phenotype->each_Variant() ) {
52             # Do something with $var (mutation)
53             }
54              
55             foreach my $measure ( $phenotype->each_Measure() ) {
56             # Do something with $measure
57             }
58              
59              
60             =head1 DESCRIPTION
61              
62             This superclass implements common methods for classes modelling phenotypes.
63             Bio::Phenotype::OMIM::OMIMentry is an example of an instantiable phenotype
64             class (the design of this interface was partially guided by the need
65             to model OMIM entries).
66             Please note. This class provides methods to associate mutations
67             (methods "each_Variant", ...) and genotypes (methods "each_Genotype", ...)
68             with phenotypes. Yet, these aspects might need some future enhancements,
69             especially since there is no "genotype" class yet.
70              
71             =head1 FEEDBACK
72              
73             =head2 Mailing Lists
74              
75             User feedback is an integral part of the evolution of this and other
76             Bioperl modules. Send your comments and suggestions preferably to the
77             Bioperl mailing lists Your participation is much appreciated.
78              
79             bioperl-l@bioperl.org - General discussion
80             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
81              
82             =head2 Support
83              
84             Please direct usage questions or support issues to the mailing list:
85              
86             I
87              
88             rather than to the module maintainer directly. Many experienced and
89             reponsive experts will be able look at the problem and quickly
90             address it. Please include a thorough description of the problem
91             with code and data examples if at all possible.
92              
93             =head2 Reporting Bugs
94              
95             report bugs to the Bioperl bug tracking system to help us keep track
96             the bugs and their resolution. Bug reports can be submitted via the
97             web:
98              
99             https://github.com/bioperl/bioperl-live/issues
100              
101             =head1 AUTHOR
102              
103             Christian M. Zmasek
104              
105             Email: czmasek-at-burnham.org or cmzmasek@yahoo.com
106              
107             WWW: http://monochrome-effect.net/
108              
109             Address:
110              
111             Genomics Institute of the Novartis Research Foundation
112             10675 John Jay Hopkins Drive
113             San Diego, CA 92121
114              
115             =head1 APPENDIX
116              
117             The rest of the documentation details each of the object
118             methods. Internal methods are usually preceded with a _
119              
120             =cut
121              
122              
123             # Let the code begin...
124              
125              
126             package Bio::Phenotype::Phenotype;
127 3     3   523 use strict;
  3         8  
  3         97  
128              
129 3     3   506 use Bio::Species;
  3         9  
  3         90  
130 3     3   1011 use Bio::Variation::VariantI;
  3         9  
  3         117  
131 3     3   555 use Bio::Annotation::DBLink;
  3         7  
  3         1531  
132 3     3   715 use Bio::Annotation::Reference;
  3         7  
  3         84  
133 3     3   935 use Bio::Phenotype::Measure;
  3         8  
  3         140  
134 3     3   807 use Bio::Phenotype::Correlate;
  3         7  
  3         97  
135 3     3   616 use Bio::Map::CytoPosition;
  3         7  
  3         78  
136 3     3   16 use Bio::Range;
  3         4  
  3         63  
137              
138              
139 3     3   13 use base qw(Bio::Root::Root Bio::Phenotype::PhenotypeI);
  3         8  
  3         1108  
140              
141              
142              
143              
144             =head2 new
145              
146             Title : new
147             Usage : $obj = Bio::Phenotype::Phenotype->new( -name => "XY",
148             -description => "This is ..." );
149             Function: Creates a new Phenotype object.
150             Returns : A new Phenotype object.
151             Args : -name => the name
152             -description => the description of this phenotype
153             -species => ref to the the species
154             -comment => a comment
155              
156             =cut
157              
158             sub new {
159              
160 4     4 1 187 my( $class,@args ) = @_;
161              
162 4         40 my $self = $class->SUPER::new( @args );
163              
164 4         48 my ( $name,
165             $description,
166             $species,
167             $comment )
168             = $self->_rearrange( [ qw( NAME
169             DESCRIPTION
170             SPECIES
171             COMMENT ) ], @args );
172              
173 4         20 $self->init();
174              
175 4 50       11 $name && $self->name( $name );
176 4 50       16 $description && $self->description( $description );
177 4 50       13 $species && $self->species( $species );
178 4 50       11 $comment && $self->comment( $comment );
179              
180 4         13 return $self;
181              
182             } # new
183              
184              
185             =head2 init
186              
187             Title : init()
188             Usage : $obj->init();
189             Function: Initializes this OMIMentry to all "" and empty lists.
190             Returns :
191             Args :
192              
193             =cut
194              
195             sub init {
196              
197 1     1 1 4 my( $self ) = @_;
198              
199              
200 1         5 $self->name( "" );
201 1         4 $self->description( "" );
202 1         8 my $species = Bio::Species->new();
203 1         5 $species->classification( qw( sapiens Homo ) );
204 1         5 $self->species( $species );
205 1         4 $self->comment( "" );
206 1         5 $self->remove_Correlates();
207 1         4 $self->remove_References();
208 1         3 $self->remove_CytoPositions();
209 1         3 $self->remove_gene_symbols();
210 1         4 $self->remove_Genotypes();
211 1         4 $self->remove_DBLinks();
212 1         4 $self->remove_keywords();
213 1         4 $self->remove_Variants();
214 1         3 $self->remove_Measures();
215              
216             } # init
217              
218              
219             =head2 name
220              
221             Title : name
222             Usage : $obj->name( "r1" );
223             or
224             print $obj->name();
225             Function: Set/get for the name or id of this phenotype.
226             Returns : A name or id [scalar].
227             Args : A name or id [scalar] (optional).
228              
229             =cut
230              
231             sub name {
232 18     18 1 904 my ( $self, $value ) = @_;
233              
234 18 100       46 if ( defined $value ) {
235 12         30 $self->{ "_name" } = $value;
236             }
237              
238 18         57 return $self->{ "_name" };
239              
240             } # name
241              
242              
243             =head2 description
244              
245             Title : description
246             Usage : $obj->description( "This is ..." );
247             or
248             print $obj->description();
249             Function: Set/get for the description of this phenotype.
250             Returns : A description [scalar].
251             Args : A description [scalar] (optional).
252              
253             =cut
254              
255             sub description {
256 16     16 1 32 my $self = shift;
257 16 100       74 return $self->{ "_description" } = shift if(@_);
258 5         22 return $self->{ "_description" };
259             }
260              
261             =head2 species
262              
263             Title : species
264             Usage : $obj->species( $species );
265             or
266             $species = $obj->species();
267             Function: Set/get for the species of this phenotype.
268             Returns : A species [Bio::Species].
269             Args : A species [Bio::Species] (optional).
270              
271             =cut
272              
273             sub species {
274 16     16 1 583 my ( $self, $value ) = @_;
275              
276 16 100       36 if ( defined $value ) {
277 11         39 $self->_check_ref_type( $value, "Bio::Species" );
278 11         34 $self->{ "_species" } = $value;
279             }
280              
281 16         54 return $self->{ "_species" };
282              
283             } # species
284              
285             =head2 comment
286              
287             Title : comment
288             Usage : $obj->comment( "putative" );
289             or
290             print $obj->comment();
291             Function: Set/get for a comment about this phenotype.
292             Returns : A comment [scalar].
293             Args : A comment [scalar] (optional).
294              
295             =cut
296              
297             sub comment {
298 16     16 1 27 my $self = shift;
299 16 100       78 return $self->{ "_comment" } = shift if(@_);
300 5         21 return $self->{ "_comment" };
301             } # comment
302              
303              
304             =head2 each_gene_symbol
305              
306             Title : each_gene_symbol()
307             Usage : @gs = $obj->each_gene_symbol();
308             Function: Returns a list of gene symbols [scalars, most likely Strings]
309             associated with this phenotype.
310             Returns : A list of scalars.
311             Args :
312              
313             =cut
314              
315             sub each_gene_symbol {
316 24     24 1 3455 my ( $self ) = @_;
317              
318 24 100       60 return @{$self->{"_gene_symbols"}} if exists($self->{"_gene_symbols"});
  20         64  
319 4         7 return ();
320             } # each_gene_symbol
321              
322              
323             =head2 add_gene_symbols
324              
325             Title : add_gene_symbols
326             Usage : $obj->add_gene_symbols( @gs );
327             or
328             $obj->add_gene_symbols( $gs );
329             Function: Pushes one or more gene symbols [scalars, most likely Strings]
330             into the list of gene symbols.
331             Returns :
332             Args : scalar(s).
333              
334             =cut
335              
336             sub add_gene_symbols {
337 4     4 1 12 my ( $self, @values ) = @_;
338              
339 4 50       16 return unless( @values );
340              
341 4         160 push( @{ $self->{ "_gene_symbols" } }, @values );
  4         20  
342              
343             } # add_gene_symbols
344              
345              
346             =head2 remove_gene_symbols
347              
348             Usage : $obj->remove_gene_symbols();
349             Function: Deletes (and returns) the list of gene symbols [scalars,
350             most likely Strings] associated with this phenotype.
351             Returns : A list of scalars.
352             Args :
353              
354             =cut
355              
356             sub remove_gene_symbols {
357 11     11 1 20 my ( $self ) = @_;
358              
359 11         27 my @a = $self->each_gene_symbol();
360 11         24 $self->{ "_gene_symbols" } = [];
361 11         28 return @a;
362              
363             } # remove_gene_symbols
364              
365              
366              
367              
368             =head2 each_Variant
369              
370             Title : each_Variant()
371             Usage : @vs = $obj->each_Variant();
372             Function: Returns a list of Bio::Variation::VariantI implementing objects
373             associated with this phenotype.
374             This is for representing the actual mutation(s) causing this
375             phenotype.
376             {* The "variants" data member and its methods will/might need to be
377             changed/improved in one way or another, CZ 09/06/02 *}
378             Returns : A list of Bio::Variation::VariantI implementing objects.
379             Args :
380              
381             =cut
382              
383             sub each_Variant {
384 21     21 1 2305 my ( $self ) = @_;
385              
386 21 100       55 return @{ $self->{ "_variants" } } if exists($self->{ "_variants" });
  17         54  
387 4         8 return ();
388             } # each_Variant
389              
390              
391             =head2 add_Variants
392              
393             Usage : $obj->add_Variants( @vs );
394             or
395             $obj->add_Variants( $v );
396             Function: Pushes one or more Bio::Variation::VariantI implementing objects
397             into the list of Variants.
398             Returns :
399             Args : Bio::Variation::VariantI implementing object(s).
400              
401             =cut
402              
403             sub add_Variants {
404 2     2 1 6 my ( $self, @values ) = @_;
405              
406 2 50       8 return unless( @values );
407              
408 2         4 foreach my $value ( @values ) {
409 4         13 $self->_check_ref_type( $value, "Bio::Variation::VariantI" );
410             }
411              
412 2         3 push( @{ $self->{ "_variants" } }, @values );
  2         11  
413              
414             } # add_Variants
415              
416              
417             =head2 remove_Variants
418              
419             Title : remove_Variants
420             Usage : $obj->remove_Variants();
421             Function: Deletes (and returns) the list of Bio::Variation::VariantI implementing
422             objects associated with this phenotype.
423             Returns : A list of Bio::Variation::VariantI implementing objects.
424             Args :
425              
426             =cut
427              
428             sub remove_Variants {
429 11     11 1 26 my ( $self ) = @_;
430            
431 11         29 my @a = $self->each_Variant();
432 11         25 $self->{ "_variants" } = [];
433 11         23 return @a;
434              
435             } # remove_Variants
436              
437              
438              
439              
440             =head2 each_Reference
441              
442             Title : each_Reference()
443             Usage : @refs = $obj->each_Reference();
444             Function: Returns a list of Bio::Annotation::Reference objects
445             associated with this phenotype.
446             Returns : A list of Bio::Annotation::Reference objects.
447             Args :
448              
449             =cut
450              
451             sub each_Reference {
452 24     24 1 1123 my ( $self ) = @_;
453            
454 24 100       90 return @{ $self->{ "_references" } } if exists($self->{ "_references" });
  20         99  
455 4         8 return ();
456             } # each_Reference
457              
458              
459             =head2 add_References
460              
461             Title : add_References
462             Usage : $obj->add_References( @refs );
463             or
464             $obj->add_References( $ref );
465             Function: Pushes one or more Bio::Annotation::Reference objects
466             into the list of References.
467             Returns :
468             Args : Bio::Annotation::Reference object(s).
469              
470             =cut
471              
472             sub add_References {
473 4     4 1 16 my ( $self, @values ) = @_;
474              
475 4 50       15 return unless( @values );
476              
477 4         11 foreach my $value ( @values ) {
478 12         22 $self->_check_ref_type( $value, "Bio::Annotation::Reference" );
479             }
480            
481 4         8 push( @{ $self->{ "_references" } }, @values );
  4         26  
482            
483             } # add_References
484              
485              
486             =head2 remove_References
487              
488             Title : remove_References()
489             Usage : $obj->remove_References();
490             Function: Deletes (and returns) the list of Bio::Annotation::Reference objects
491             associated with this phenotype.
492             Returns : A list of Bio::Annotation::Reference objects.
493             Args :
494              
495             =cut
496              
497             sub remove_References {
498 11     11 1 26 my ( $self ) = @_;
499            
500 11         34 my @a = $self->each_Reference();
501 11         27 $self->{ "_references" } = [];
502 11         51 return @a;
503              
504             } # remove_References
505              
506              
507              
508              
509             =head2 each_CytoPosition
510              
511             Title : each_CytoPosition()
512             Usage : @cps = $obj->each_CytoPosition();
513             Function: Returns a list of Bio::Map::CytoPosition objects
514             associated with this phenotype.
515             Returns : A list of Bio::Map::CytoPosition objects.
516             Args :
517              
518             =cut
519              
520             sub each_CytoPosition {
521 24     24 1 2355 my ( $self ) = @_;
522            
523 24 100       78 return @{$self->{"_cyto_positions"}} if exists($self->{"_cyto_positions"});
  20         73  
524 4         9 return ();
525             } # each_CytoPosition
526              
527              
528             =head2 add_CytoPositions
529              
530             Title : add_CytoPositions
531             Usage : $obj->add_CytoPositions( @cps );
532             or
533             $obj->add_CytoPositions( $cp );
534             Function: Pushes one or more Bio::Map::CytoPosition objects
535             into the list of CytoPositions.
536             Returns :
537             Args : Bio::Map::CytoPosition object(s).
538              
539             =cut
540              
541             sub add_CytoPositions {
542 4     4 1 14 my ( $self, @values ) = @_;
543            
544 4 50       14 return unless( @values );
545              
546 4         11 foreach my $value ( @values ) {
547 6         19 $self->_check_ref_type( $value, "Bio::Map::CytoPosition" );
548             }
549            
550 4         9 push( @{ $self->{ "_cyto_positions" } }, @values );
  4         21  
551            
552             } # add_CytoPositions
553              
554              
555             =head2 remove_CytoPositions
556              
557             Title : remove_CytoPositions
558             Usage : $obj->remove_CytoPositions();
559             Function: Deletes (and returns) the list o fBio::Map::CytoPosition objects
560             associated with this phenotype.
561             Returns : A list of Bio::Map::CytoPosition objects.
562             Args :
563              
564             =cut
565              
566             sub remove_CytoPositions {
567 11     11 1 26 my ( $self ) = @_;
568            
569 11         33 my @a = $self->each_CytoPosition();
570 11         21 $self->{ "_cyto_positions" } = [];
571 11         29 return @a;
572              
573             } # remove_CytoPositions
574              
575              
576              
577              
578             =head2 each_Correlate
579              
580             Title : each_Correlate()
581             Usage : @corrs = $obj->each_Correlate();
582             Function: Returns a list of Bio::Phenotype::Correlate objects
583             associated with this phenotype.
584             (Correlates are correlating phenotypes in different species;
585             inspired by mouse correlates of human phenotypes in the OMIM
586             database.)
587             Returns : A list of Bio::Phenotype::Correlate objects.
588             Args :
589              
590             =cut
591              
592             sub each_Correlate {
593 24     24 1 2197 my ( $self ) = @_;
594              
595 24 100       73 return @{ $self->{ "_correlates" } } if exists($self->{ "_correlates" });
  20         73  
596 4         10 return ();
597             } # each_Correlate
598              
599              
600              
601              
602             =head2 add_Correlates
603              
604             Title : add_Correlates
605             Usage : $obj->add_Correlates( @corrs );
606             or
607             $obj->add_Correlates( $corr );
608             Function: Pushes one or more Bio::Phenotype::Correlate objects
609             into the list of Correlates.
610             Returns :
611             Args : Bio::Phenotype::Correlate object(s).
612              
613             =cut
614              
615             sub add_Correlates {
616 4     4 1 16 my ( $self, @values ) = @_;
617            
618 4 50       18 return unless( @values );
619              
620 4         10 foreach my $value ( @values ) {
621 6         23 $self->_check_ref_type( $value, "Bio::Phenotype::Correlate" );
622             }
623            
624 4         9 push( @{ $self->{ "_correlates" } }, @values );
  4         24  
625            
626             } # add_Correlates
627              
628              
629             =head2 remove_Correlates
630              
631             Title : remove_Correlates
632             Usage : $obj->remove_Correlates();
633             Function: Deletes (and returns) the list of Bio::Phenotype::Correlate objects
634             associated with this phenotype.
635             Returns : A list of Bio::Phenotype::Correlate objects.
636             Args :
637              
638             =cut
639              
640             sub remove_Correlates {
641 11     11 1 24 my ( $self ) = @_;
642            
643 11         31 my @a = $self->each_Correlate();
644 11         43 $self->{ "_correlates" } = [];
645 11         28 return @a;
646              
647             } # remove_Correlates
648              
649              
650              
651              
652             =head2 each_Measure
653              
654             Title : each_Measure()
655             Usage : @ms = $obj->each_Measure();
656             Function: Returns a list of Bio::Phenotype::Measure objects
657             associated with this phenotype.
658             (Measure is for biochemically defined phenotypes
659             or any other types of measures.)
660             Returns : A list of Bio::Phenotype::Measure objects.
661             Args :
662              
663             =cut
664              
665             sub each_Measure {
666 21     21 1 1688 my ( $self ) = @_;
667            
668 21 100       48 return @{ $self->{ "_measures" } } if exists($self->{ "_measures" });
  17         49  
669 4         9 return ();
670             } # each_Measure
671              
672              
673             =head2 add_Measures
674              
675             Title : add_Measures
676             Usage : $obj->add_Measures( @ms );
677             or
678             $obj->add_Measures( $m );
679             Function: Pushes one or more Bio::Phenotype::Measure objects
680             into the list of Measures.
681             Returns :
682             Args : Bio::Phenotype::Measure object(s).
683              
684             =cut
685              
686             sub add_Measures {
687 2     2 1 7 my ( $self, @values ) = @_;
688            
689 2 50       8 return unless( @values );
690              
691 2         6 foreach my $value ( @values ) {
692 4         10 $self->_check_ref_type( $value, "Bio::Phenotype::Measure" );
693             }
694            
695 2         4 push( @{ $self->{ "_measures" } }, @values );
  2         10  
696            
697             } # add_Measures
698              
699              
700             =head2 remove_Measures
701              
702             Title : remove_Measures
703             Usage : $obj->remove_Measures();
704             Function: Deletes (and returns) the list of Bio::Phenotype::Measure objects
705             associated with this phenotype.
706             Returns : A list of Bio::Phenotype::Measure objects.
707             Args :
708              
709             =cut
710              
711             sub remove_Measures {
712 11     11 1 24 my ( $self ) = @_;
713            
714 11         25 my @a = $self->each_Measure();
715 11         21 $self->{ "_measures" } = [];
716 11         21 return @a;
717              
718             } # remove_Measures
719              
720              
721              
722              
723             =head2 each_keyword
724              
725             Title : each_keyword()
726             Usage : @kws = $obj->each_keyword();
727             Function: Returns a list of key words [scalars, most likely Strings]
728             associated with this phenotype.
729             Returns : A list of scalars.
730             Args :
731              
732             =cut
733              
734             sub each_keyword {
735 21     21 1 3452 my ( $self ) = @_;
736            
737 21 100       51 return @{ $self->{ "_keywords" } } if exists($self->{ "_keywords" });
  17         56  
738 4         7 return ();
739             } # each_keyword
740              
741              
742             =head2 add_keywords
743              
744             Title : add_keywords
745             Usage : $obj->add_keywords( @kws );
746             or
747             $obj->add_keywords( $kw );
748             Function: Pushes one or more keywords [scalars, most likely Strings]
749             into the list of key words.
750             Returns :
751             Args : scalar(s).
752              
753             =cut
754              
755             sub add_keywords {
756 2     2 1 10 my ( $self, @values ) = @_;
757              
758 2 50       9 return unless( @values );
759              
760 2         6 push( @{ $self->{ "_keywords" } }, @values );
  2         15  
761            
762             } # add_keywords
763              
764              
765             =head2 remove_keywords
766              
767             Title : remove_keywords
768             Usage : $obj->remove_keywords();
769             Function: Deletes (and returns) the list of key words [scalars,
770             most likely Strings] associated with this phenotype.
771             Returns : A list of scalars.
772             Args :
773              
774             =cut
775              
776             sub remove_keywords {
777 11     11 1 29 my ( $self ) = @_;
778            
779 11         32 my @a = $self->each_keyword();
780 11         22 $self->{ "_keywords" } = [];
781 11         29 return @a;
782              
783             } # remove_keywords
784              
785              
786              
787              
788             =head2 each_DBLink
789              
790             Title : each_DBLink()
791             Usage : @dbls = $obj->each_DBLink();
792             Function: Returns a list of Bio::Annotation::DBLink objects
793             associated with this phenotype.
794             Returns : A list of Bio::Annotation::DBLink objects.
795             Args :
796              
797             =cut
798              
799             sub each_DBLink {
800 21     21 1 36 my ( $self ) = @_;
801            
802 21 100       51 return @{ $self->{ "_db_links" } } if exists($self->{ "_db_links" });
  17         50  
803 4         7 return ();
804             }
805              
806              
807             =head2 add_DBLinks
808              
809             Title : add_DBLinks
810             Usage : $obj->add_DBLinks( @dbls );
811             or
812             $obj->add_DBLinks( $dbl );
813             Function: Pushes one or more Bio::Annotation::DBLink objects
814             into the list of DBLinks.
815             Returns :
816             Args : Bio::Annotation::DBLink object(s).
817              
818             =cut
819              
820             sub add_DBLinks {
821 2     2 1 8 my ( $self, @values ) = @_;
822              
823 2 50       8 return unless( @values );
824              
825 2         6 foreach my $value ( @values ) {
826 4         11 $self->_check_ref_type( $value, "Bio::Annotation::DBLink" );
827             }
828            
829 2         5 push( @{ $self->{ "_db_links" } }, @values );
  2         12  
830            
831             } # add_DBLinks
832              
833              
834             =head2 remove_DBLinks
835              
836             Title : remove_DBLinks
837             Usage : $obj->remove_DBLinks();
838             Function: Deletes (and returns) the list of Bio::Annotation::DBLink objects
839             associated with this phenotype.
840             Returns : A list of Bio::Annotation::DBLink objects.
841             Args :
842              
843             =cut
844              
845             sub remove_DBLinks {
846 11     11 1 22 my ( $self ) = @_;
847            
848 11         31 my @a = $self->each_DBLink();
849 11         20 $self->{ "_db_links" } = [];
850 11         22 return @a;
851              
852             } # remove_DBLinks
853              
854              
855              
856              
857             =head2 each_Genotype
858              
859             Title : each_Reference()
860             Usage : @gts = $obj->each_Reference();
861             Function: Returns a list of "Genotype" objects
862             associated with this phenotype.
863             {* the "genotypes" data member and its methods certainly will/needs to be
864             changed/improved in one way or another since there is
865             no "Genotype" class yet, CZ 09/06/02 *}
866             Returns : A list of "Genotype" objects.
867             Args :
868              
869             =cut
870              
871             sub each_Genotype {
872 21     21 1 3381 my ( $self ) = @_;
873            
874 21 100       48 return @{ $self->{ "_genotypes" } } if exists($self->{ "_genotypes" });
  17         75  
875 4         6 return ();
876             } # each_Genotype
877              
878              
879             =head2 add_Genotypes
880              
881             Title : add_Genotypes
882             Usage : $obj->add_Genotypes( @gts );
883             or
884             $obj->add_Genotypes( $gt );
885             Function: Pushes one or more "Genotypes"
886             into the list of "Genotypes".
887             Returns :
888             Args : "Genotypes(s)".
889              
890             =cut
891              
892             sub add_Genotypes {
893 2     2 1 8 my ( $self, @values ) = @_;
894            
895 2 50       8 return unless( @values );
896              
897             #foreach my $value ( @values ) {
898             # $self->_check_ref_type( $value, "Bio::GenotypeI" );
899             #}
900            
901 2         4 push( @{ $self->{ "_genotypes" } }, @values );
  2         12  
902            
903             } # add_Genotypes
904              
905              
906             =head2 remove_Genotypes
907              
908             Title : remove_Genotypes
909             Usage : $obj->remove_Genotypes();
910             Function: Deletes (and returns) the list of "Genotype" objects
911             associated with this phenotype.
912             Returns : A list of "Genotype" objects.
913             Args :
914              
915             =cut
916              
917             sub remove_Genotypes {
918 11     11 1 23 my ( $self ) = @_;
919              
920 11         27 my @a = $self->each_Genotype();
921 11         22 $self->{ "_genotypes" } = [];
922 11         24 return @a;
923              
924             } # remove_Genotypes
925              
926              
927             =head2 _check_ref_type
928              
929             Title : _check_ref_type
930             Usage : $self->_check_ref_type( $value, "Bio::Annotation::DBLink" );
931             Function: Checks for the correct type.
932             Returns :
933             Args : The value to be checked, the expected class.
934              
935             =cut
936              
937             sub _check_ref_type {
938 70     70   119 my ( $self, $value, $expected_class ) = @_;
939              
940 70 50       435 if ( ! defined( $value ) ) {
    50          
    50          
941 0           $self->throw( ( caller( 1 ) )[ 3 ] .": Found [undef"
942             ."] where [$expected_class] expected" );
943             }
944             elsif ( ! ref( $value ) ) {
945 0           $self->throw( ( caller( 1 ) )[ 3 ] .": Found scalar"
946             ." where [$expected_class] expected" );
947             }
948             elsif ( ! $value->isa( $expected_class ) ) {
949 0           $self->throw( ( caller( 1 ) )[ 3 ] .": Found [". ref( $value )
950             ."] where [$expected_class] expected" );
951             }
952             } # _check_ref_type
953              
954              
955              
956             1;