branch-1-6/Bio/Cluster/ClusterFactory.pm

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