← Back to branch summary

~ubuntu-branches/ubuntu/lucid/bioperl/lucid

« back to all changes in this revision

Viewing changes to Bio/Cluster/ClusterFactory.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matt Hope
  • Date: 2004-04-18 14:24:11 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040418142411-gr92uexquw4w8liq
Tags: 1.4-1
* New upstream release
* Examples and working code are installed by default to usr/bin,
  this has been moved to usr/share/doc/bioperl/bin

Show diffs side-by-side

added added

removed removed

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