File Coverage

Bio/Cluster/ClusterFactory.pm
Criterion Covered Total %
statement 27 28 96.4
branch 7 10 70.0
condition 2 6 33.3
subroutine 6 6 100.0
pod 2 2 100.0
total 44 52 84.6


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Cluster::ClusterFactory
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Hilmar Lapp
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 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
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://github.com/bioperl/bioperl-live/issues
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 2     2   1057 use strict;
  2         2  
  2         50  
94              
95 2     2   6 use Bio::Root::Root;
  2         2  
  2         40  
96              
97 2     2   6 use base qw(Bio::Factory::ObjectFactory);
  2         1  
  2         625  
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 2     2 1 411 my($class,@args) = @_;
114              
115 2         15 my $self = $class->SUPER::new(@args);
116              
117 2         4 $self->interface("Bio::ClusterI");
118 2 100       6 $self->type($self->type) if $self->type;
119              
120 2         5 return $self;
121             }
122              
123              
124             =head2 create_object
125              
126             Title : create_object
127             Usage : my $seq = $factory->create_object();
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 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 5     5 1 691 my ($self,@args) = @_;
145              
146 5         17 my $type = $self->type();
147 5 100       15 if(! $type) {
148             # we need to guess this
149 1         4 $type = $self->_guess_type(@args);
150 1 50       2 $self->throw("No cluster type set and unable to guess.") unless $type;
151 1         4 $self->type($type);
152             }
153 5         16 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 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 1     1   2 my ($self,@args) = @_;
173 1         2 my $type;
174              
175             # we can only guess from a certain number of arguments
176 1         4 my ($dispid, $ns, $members) =
177             $self->_rearrange([qw(DISPLAY_ID
178             NAMESPACE
179             MEMBERS
180             )], @args);
181             # Unigene namespace or ID?
182 1 50 33     14 if($ns && (lc($ns) eq "unigene")) {
    50 33        
183 0         0 $type = 'Bio::Cluster::UniGene';
184             } elsif($dispid && ($dispid =~ /^Hs\.[0-9]/)) {
185 1         4 $type = 'Bio::Cluster::UniGene';
186             }
187             # what else could we look for?
188 1         3 return $type;
189             }
190              
191             1;