comparison variant_effect_predictor/Bio/Factory/ObjectFactory.pm @ 0:1f6dce3d34e0

Uploaded
author mahtabm
date Thu, 11 Apr 2013 02:01:53 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:1f6dce3d34e0
1 # $Id: ObjectFactory.pm,v 1.1.2.1 2003/03/27 10:07:56 lapp Exp $
2 #
3 # BioPerl module for Bio::Factory::ObjectFactory
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, 2003.
13 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2003.
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::Factory::ObjectFactory - Instantiates a new Bio::Root::RootI (or derived class) through a factory
30
31 =head1 SYNOPSIS
32
33 use Bio::Factory::ObjectFactory;
34
35 my $factory = new Bio::Factory::ObjectFactory(-type => 'Bio::Ontology::GOterm');
36 my $term = $factory->create_object(-name => 'peroxisome',
37 -ontology => 'Gene Factory',
38 -identifier => 'GO:0005777');
39
40
41 =head1 DESCRIPTION
42
43 This object will build L<Bio::Root::RootI> 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 CONTRIBUTORS
71
72 This is mostly copy-and-paste with subsequent adaptation from
73 Bio::Seq::SeqFactory by Jason Stajich. Most credits should in fact go
74 to him.
75
76 =head1 APPENDIX
77
78 The rest of the documentation details each of the object methods.
79 Internal methods are usually preceded with a _
80
81 =cut
82
83
84 # Let the code begin...
85
86
87 package Bio::Factory::ObjectFactory;
88 use vars qw(@ISA);
89 use strict;
90
91 use Bio::Root::Root;
92 use Bio::Factory::ObjectFactoryI;
93
94 @ISA = qw(Bio::Root::Root Bio::Factory::ObjectFactoryI);
95
96 =head2 new
97
98 Title : new
99 Usage : my $obj = new Bio::Factory::ObjectFactory();
100 Function: Builds a new Bio::Factory::ObjectFactory object
101 Returns : Bio::Factory::ObjectFactory
102 Args : -type => string, name of a L<Bio::Root::RootI> derived class.
103 There is no default.
104 -interface => string, name of the interface or class any type
105 specified needs to at least implement.
106 The default is Bio::Root::RootI.
107
108 =cut
109
110 sub new {
111 my($class,@args) = @_;
112
113 my $self = $class->SUPER::new(@args);
114
115 my ($type,$interface) = $self->_rearrange([qw(TYPE INTERFACE)], @args);
116
117 $self->{'_loaded_types'} = {};
118 $self->interface($interface || "Bio::Root::RootI");
119 $self->type($type) if $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 a new object of the previously set type.
130
131 This object allows us to genericize the instantiation of
132 objects.
133
134 You must have provided -type at instantiation, or have
135 called type($mytype) before you can call this method.
136
137 Returns : an object of the type returned by type()
138
139 The return type is configurable using new(-type =>"..."),
140 or by calling $self->type("My::Fancy::Class").
141 Args : Initialization parameters specific to the type of
142 object we want. Check the POD of the class you set as type.
143
144 =cut
145
146 sub create_object {
147 my ($self,@args) = @_;
148
149 my $type = $self->type(); # type has already been loaded upon set
150 return $type->new(-verbose => $self->verbose, @args);
151 }
152
153 =head2 type
154
155 Title : type
156 Usage : $obj->type($newval)
157 Function: Get/set the type of object to be created.
158
159 This may be changed at any time during the lifetime of this
160 factory.
161
162 Returns : value of type (a string)
163 Args : newvalue (optional, a string)
164
165
166 =cut
167
168 sub type{
169 my $self = shift;
170
171 if(@_) {
172 my $type = shift;
173 if($type && (! $self->{'_loaded_types'}->{$type})) {
174 eval {
175 $self->_load_module($type);
176 };
177 if( $@ ) {
178 $self->throw("module for '$type' failed to load: ".
179 $@);
180 }
181 my $o = bless {},$type;
182 if(!$self->_validate_type($o)) { # this may throw an exception
183 $self->throw("'$type' is not valid for factory ".ref($self));
184 }
185 $self->{'_loaded_types'}->{$type} = 1;
186 }
187 return $self->{'type'} = $type;
188 }
189 return $self->{'type'};
190 }
191
192 =head2 interface
193
194 Title : interface
195 Usage : $obj->interface($newval)
196 Function: Get/set the interface or base class that supplied types
197 must at least implement (inherit from).
198 Example :
199 Returns : value of interface (a scalar)
200 Args : on set, new value (a scalar or undef, optional)
201
202
203 =cut
204
205 sub interface{
206 my $self = shift;
207 my $interface = shift;
208
209 if($interface) {
210 return $self->{'interface'} = $interface;
211 }
212 return $self->{'interface'};
213 }
214
215 =head2 _validate_type
216
217 Title : _validate_type
218 Usage :
219 Function: Called to let derived factories validate the type set
220 via type().
221
222 The default implementation here checks whether the supplied
223 object skeleton implements the interface set via -interface
224 upon factory instantiation.
225
226 Example :
227 Returns : TRUE if the type is to be considered valid, and FALSE otherwise.
228 Instead of returning FALSE this method may also just throw
229 an informative exception.
230 Args : A hash reference blessed into the specified type, allowing
231 queries like isa().
232
233
234 =cut
235
236 sub _validate_type{
237 my ($self,$obj) = @_;
238
239 if(! $obj->isa($self->interface())) {
240 $self->throw("invalid type: '".ref($obj).
241 "' does not implement '".$self->interface()."'");
242 }
243 return 1;
244 }
245
246 #####################################################################
247 # aliases for naming consistency or other reasons #
248 #####################################################################
249
250 *create = \&create_object;
251
252 1;