Bio/Cluster/ClusterFactory.pm

   1 #
   2 # BioPerl module for Bio::Cluster::ClusterFactory
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Hilmar Lapp <hlapp at gmx.net>
   7 #
   8 # Copyright Hilmar Lapp
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 #
  13 # (c) Hilmar Lapp, hlapp at gmx.net, 2002.
  14 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
  15 #
  16 # You may distribute this module under the same terms as perl itself.
  17 # Refer to the Perl Artistic License (see the license accompanying this
  18 # software package, or see http://www.perl.com/language/misc/Artistic.html)
  19 # for the terms under which you may use, modify, and redistribute this module.
  20 #
  21 # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  22 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  23 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  24 #
  25
  26 # POD documentation - main docs before the code
  27
  28 =head1 NAME
  29
  30 Bio::Cluster::ClusterFactory - Instantiates a new Bio::ClusterI (or derived class) through a factory
  31
  32 =head1 SYNOPSIS
  33
  34     use Bio::Cluster::ClusterFactory;
  35     # if you don't provide a default type, the factory will try
  36     # some guesswork based on display_id and namespace
  37     my $factory = Bio::Cluster::ClusterFactory->new(-type => 'Bio::Cluster::UniGene');
  38     my $clu = $factory->create_object(-description => 'NAT',
  39                                       -display_id  => 'Hs.2');
  40
  41
  42 =head1 DESCRIPTION
  43
  44 This object will build L<Bio::ClusterI> objects generically.
  45
  46 =head1 FEEDBACK
  47
  48 =head2 Mailing Lists
  49
  50 User feedback is an integral part of the evolution of this and other
  51 Bioperl modules. Send your comments and suggestions preferably to
  52 the Bioperl mailing list.  Your participation is much appreciated.
  53
  54   bioperl-l@bioperl.org                  - General discussion
  55   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  56
  57 =head2 Support
  58
  59 Please direct usage questions or support issues to the mailing list:
  60
  61 I<bioperl-l@bioperl.org>
  62
  63 rather than to the module maintainer directly. Many experienced and
  64 reponsive experts will be able look at the problem and quickly
  65 address it. Please include a thorough description of the problem
  66 with code and data examples if at all possible.
  67
  68 =head2 Reporting Bugs
  69
  70 Report bugs to the Bioperl bug tracking system to help us keep track
  71 of the bugs and their resolution. Bug reports can be submitted via the
  72 web:
  73
  74   https://redmine.open-bio.org/projects/bioperl/
  75
  76 =head1 AUTHOR - Hilmar Lapp
  77
  78 Email hlapp at gmx.net
  79
  80
  81 =head1 APPENDIX
  82
  83 The rest of the documentation details each of the object methods.
  84 Internal methods are usually preceded with a _
  85
  86 =cut
  87
  88
  89 # Let the code begin...
  90
  91
  92 package Bio::Cluster::ClusterFactory;
  93 use strict;
  94
  95 use Bio::Root::Root;
  96
  97 use base qw(Bio::Factory::ObjectFactory);
  98
  99 =head2 new
 100
 101  Title   : new
 102  Usage   : my $obj = Bio::Cluster::ClusterFactory->new();
 103  Function: Builds a new Bio::Cluster::ClusterFactory object
 104  Returns : Bio::Cluster::ClusterFactory
 105  Args    : -type => string, name of a ClusterI derived class.
 106                     If not provided, the factory will have to guess
 107                     from ID and namespace, which may or may not be
 108                     successful.
 109
 110 =cut
 111
 112 sub new {
 113     my($class,@args) = @_;
 114
 115     my $self = $class->SUPER::new(@args);
 116
 117     $self->interface("Bio::ClusterI");
 118     $self->type($self->type) if $self->type;
 119
 120     return $self;
 121 }
 122
 123
 124 =head2 create_object
 125
 126  Title   : create_object
 127  Usage   : my $seq = $factory->create_object(<named parameters>);
 128  Function: Instantiates new Bio::ClusterI (or one of its child classes)
 129
 130            This object allows us to genericize the instantiation of
 131            cluster objects.
 132
 133  Returns : L<Bio::ClusterI> compliant object
 134            The return type is configurable using new(-type =>"...").
 135  Args    : initialization parameters specific to the type of cluster
 136            object we want.  Typically
 137            -display_id  => $name
 138            -description => description of the cluster
 139            -members     => arrayref, members of the cluster
 140
 141 =cut
 142
 143 sub create_object {
 144    my ($self,@args) = @_;
 145
 146    my $type = $self->type();
 147    if(! $type) {
 148        # we need to guess this
 149        $type = $self->_guess_type(@args);
 150        $self->throw("No cluster type set and unable to guess.") unless $type;
 151        $self->type($type);
 152    }
 153    return $type->new(-verbose => $self->verbose, @args);
 154 }
 155
 156 =head2 _guess_type
 157
 158  Title   : _guess_type
 159  Usage   :
 160  Function: Guesses the right type of L<Bio::ClusterI> implementation
 161            based on initialization parameters for the prospective
 162            object.
 163  Example :
 164  Returns : the type (a string, the module name)
 165  Args    : initialization parameters to be passed to the prospective
 166            cluster object
 167
 168
 169 =cut
 170
 171 sub _guess_type{
 172     my ($self,@args) = @_;
 173     my $type;
 174
 175     # we can only guess from a certain number of arguments
 176     my ($dispid, $ns, $members) =
 177         $self->_rearrange([qw(DISPLAY_ID
 178                               NAMESPACE
 179                               MEMBERS
 180                               )], @args);
 181     # Unigene namespace or ID?
 182     if($ns && (lc($ns) eq "unigene")) {
 183         $type = 'Bio::Cluster::UniGene';
 184     } elsif($dispid && ($dispid =~ /^Hs\.[0-9]/)) {
 185         $type = 'Bio::Cluster::UniGene';
 186     }
 187     # what else could we look for?
 188     return $type;
 189 }
 190
 191 1;