Bio/Phenotype/Phenotype.pm

   1 #
   2 # BioPerl module for Bio::Phenotype::Phenotype
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Christian M. Zmasek <czmasek-at-burnham.org> or <cmzmasek@yahoo.com>
   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<bioperl-l@bioperl.org>
  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 use strict;
 128
 129 use Bio::Species;
 130 use Bio::Variation::VariantI;
 131 use Bio::Annotation::DBLink;
 132 use Bio::Annotation::Reference;
 133 use Bio::Phenotype::Measure;
 134 use Bio::Phenotype::Correlate;
 135 use Bio::Map::CytoPosition;
 136 use Bio::Range;
 137
 138
 139 use base qw(Bio::Root::Root Bio::Phenotype::PhenotypeI);
 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     my( $class,@args ) = @_;
 161
 162     my $self = $class->SUPER::new( @args );
 163
 164     my ( $name,
 165          $description,
 166          $species,
 167          $comment )
 168     = $self->_rearrange( [ qw( NAME
 169                                DESCRIPTION
 170                                SPECIES
 171                                COMMENT ) ], @args );
 172
 173     $self->init();
 174
 175     $name                           && $self->name( $name );
 176     $description                    && $self->description( $description );
 177     $species                        && $self->species( $species );
 178     $comment                        && $self->comment( $comment );
 179
 180     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     my( $self ) = @_;
 198
 199
 200     $self->name( "" );
 201     $self->description( "" );
 202     my $species = Bio::Species->new();
 203     $species->classification( qw( sapiens Homo ) );
 204     $self->species( $species );
 205     $self->comment( "" );
 206     $self->remove_Correlates();
 207     $self->remove_References();
 208     $self->remove_CytoPositions();
 209     $self->remove_gene_symbols();
 210     $self->remove_Genotypes();
 211     $self->remove_DBLinks();
 212     $self->remove_keywords();
 213     $self->remove_Variants();
 214     $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     my ( $self, $value ) = @_;
 233
 234     if ( defined $value ) {
 235         $self->{ "_name" } = $value;
 236     }
 237
 238     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     my $self = shift;
 257     return $self->{ "_description" } = shift if(@_);
 258     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     my ( $self, $value ) = @_;
 275
 276     if ( defined $value ) {
 277         $self->_check_ref_type( $value, "Bio::Species" );
 278         $self->{ "_species" } = $value;
 279     }
 280
 281     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     my $self = shift;
 299     return $self->{ "_comment" } = shift if(@_);
 300     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     my ( $self ) = @_;
 317
 318     return @{$self->{"_gene_symbols"}} if exists($self->{"_gene_symbols"});
 319     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     my ( $self, @values ) = @_;
 338
 339     return unless( @values );
 340
 341     push( @{ $self->{ "_gene_symbols" } }, @values );
 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     my ( $self ) = @_;
 358
 359     my @a = $self->each_gene_symbol();
 360     $self->{ "_gene_symbols" } = [];
 361     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      my ( $self ) = @_;
 385
 386      return @{ $self->{ "_variants" } } if exists($self->{ "_variants" });
 387      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     my ( $self, @values ) = @_;
 405
 406     return unless( @values );
 407
 408     foreach my $value ( @values ) {
 409         $self->_check_ref_type( $value, "Bio::Variation::VariantI" );
 410     }
 411
 412     push( @{ $self->{ "_variants" } }, @values );
 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     my ( $self ) = @_;
 430
 431     my @a = $self->each_Variant();
 432     $self->{ "_variants" } = [];
 433     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     my ( $self ) = @_;
 453
 454     return @{ $self->{ "_references" } } if exists($self->{ "_references" });
 455     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     my ( $self, @values ) = @_;
 474
 475     return unless( @values );
 476
 477     foreach my $value ( @values ) {
 478         $self->_check_ref_type( $value, "Bio::Annotation::Reference" );
 479     }
 480
 481     push( @{ $self->{ "_references" } }, @values );
 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     my ( $self ) = @_;
 499
 500     my @a = $self->each_Reference();
 501     $self->{ "_references" } = [];
 502     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     my ( $self ) = @_;
 522
 523     return @{$self->{"_cyto_positions"}} if exists($self->{"_cyto_positions"});
 524     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     my ( $self, @values ) = @_;
 543
 544     return unless( @values );
 545
 546     foreach my $value ( @values ) {
 547         $self->_check_ref_type( $value, "Bio::Map::CytoPosition" );
 548     }
 549
 550     push( @{ $self->{ "_cyto_positions" } }, @values );
 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     my ( $self ) = @_;
 568
 569     my @a = $self->each_CytoPosition();
 570     $self->{ "_cyto_positions" } = [];
 571     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     my ( $self ) = @_;
 594
 595     return @{ $self->{ "_correlates" } } if exists($self->{ "_correlates" });
 596     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     my ( $self, @values ) = @_;
 617
 618     return unless( @values );
 619
 620     foreach my $value ( @values ) {
 621         $self->_check_ref_type( $value, "Bio::Phenotype::Correlate" );
 622     }
 623
 624     push( @{ $self->{ "_correlates" } }, @values );
 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     my ( $self ) = @_;
 642
 643     my @a = $self->each_Correlate();
 644     $self->{ "_correlates" } = [];
 645     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     my ( $self ) = @_;
 667
 668     return @{ $self->{ "_measures" } } if exists($self->{ "_measures" });
 669     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     my ( $self, @values ) = @_;
 688
 689     return unless( @values );
 690
 691     foreach my $value ( @values ) {
 692         $self->_check_ref_type( $value, "Bio::Phenotype::Measure" );
 693     }
 694
 695     push( @{ $self->{ "_measures" } }, @values );
 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     my ( $self ) = @_;
 713
 714     my @a = $self->each_Measure();
 715     $self->{ "_measures" } = [];
 716     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     my ( $self ) = @_;
 736
 737     return @{ $self->{ "_keywords" } } if exists($self->{ "_keywords" });
 738     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     my ( $self, @values ) = @_;
 757
 758     return unless( @values );
 759
 760     push( @{ $self->{ "_keywords" } }, @values );
 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     my ( $self ) = @_;
 778
 779     my @a = $self->each_keyword();
 780     $self->{ "_keywords" } = [];
 781     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     my ( $self ) = @_;
 801
 802     return @{ $self->{ "_db_links" } } if exists($self->{ "_db_links" });
 803     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     my ( $self, @values ) = @_;
 822
 823     return unless( @values );
 824
 825     foreach my $value ( @values ) {
 826         $self->_check_ref_type( $value, "Bio::Annotation::DBLink" );
 827     }
 828
 829     push( @{ $self->{ "_db_links" } }, @values );
 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     my ( $self ) = @_;
 847
 848     my @a = $self->each_DBLink();
 849     $self->{ "_db_links" } = [];
 850     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     my ( $self ) = @_;
 873
 874     return @{ $self->{ "_genotypes" } } if exists($self->{ "_genotypes" });
 875     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     my ( $self, @values ) = @_;
 894
 895     return unless( @values );
 896
 897     #foreach my $value ( @values ) {
 898     #    $self->_check_ref_type( $value, "Bio::GenotypeI" );
 899     #}
 900
 901     push( @{ $self->{ "_genotypes" } }, @values );
 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     my ( $self ) = @_;
 919
 920     my @a = $self->each_Genotype();
 921     $self->{ "_genotypes" } = [];
 922     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     my ( $self, $value, $expected_class ) = @_;
 939
 940     if ( ! defined( $value ) ) {
 941         $self->throw( ( caller( 1 ) )[ 3 ] .": Found [undef"
 942         ."] where [$expected_class] expected" );
 943     }
 944     elsif ( ! ref( $value ) ) {
 945         $self->throw( ( caller( 1 ) )[ 3 ] .": Found scalar"
 946         ." where [$expected_class] expected" );
 947     }
 948     elsif ( ! $value->isa( $expected_class ) ) {
 949         $self->throw( ( caller( 1 ) )[ 3 ] .": Found [". ref( $value )
 950         ."] where [$expected_class] expected" );
 951     }
 952 } # _check_ref_type
 953
 954
 955
 956 1;