Mercurial > repos > mahtabm > ensembl
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; |