|
0
|
1 # $Id: DriverFactory.pm,v 1.10 2002/12/01 00:05:20 jason Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Factory::DriverFactory
|
|
|
4 #
|
|
|
5 # Cared for by Jason Stajich <jason@bioperl.org> and
|
|
|
6 # Hilmar Lapp <hlapp@gmx.net>
|
|
|
7 #
|
|
|
8 # Copyright Jason Stajich, Hilmar Lapp
|
|
|
9 #
|
|
|
10 # You may distribute this module under the same terms as perl itself
|
|
|
11
|
|
|
12 # POD documentation - main docs before the code
|
|
|
13
|
|
|
14 =head1 NAME
|
|
|
15
|
|
|
16 Bio::Factory::DriverFactory - Base class for factory classes loading drivers
|
|
|
17
|
|
|
18 =head1 SYNOPSIS
|
|
|
19
|
|
|
20 #this class is not instantiable
|
|
|
21
|
|
|
22 =head1 DESCRIPTION
|
|
|
23
|
|
|
24 This a base class for factory classes that load drivers. Normally, you don't
|
|
|
25 instantiate this class directly.
|
|
|
26
|
|
|
27 =head1 FEEDBACK
|
|
|
28
|
|
|
29 =head2 Mailing Lists
|
|
|
30
|
|
|
31 User feedback is an integral part of the evolution of this
|
|
|
32 and other Bioperl modules. Send your comments and suggestions preferably
|
|
|
33 to one of the Bioperl mailing lists.
|
|
|
34 Your participation is much appreciated.
|
|
|
35
|
|
|
36 bioperl-l@bioperl.org - General discussion
|
|
|
37 http://bio.perl.org/MailList.html - About the mailing lists
|
|
|
38
|
|
|
39 =head2 Reporting Bugs
|
|
|
40
|
|
|
41 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
42 the bugs and their resolution. Bug reports can be submitted via email
|
|
|
43 or the web:
|
|
|
44
|
|
|
45 bioperl-bugs@bio.perl.org
|
|
|
46 http://bugzilla.bioperl.org/
|
|
|
47
|
|
|
48 =head1 AUTHOR - Jason Stajich
|
|
|
49
|
|
|
50 Email Jason Stajich E<lt>jason@bioperl.orgE<gt>
|
|
|
51
|
|
|
52 =head1 APPENDIX
|
|
|
53
|
|
|
54 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
|
|
|
55
|
|
|
56 =cut
|
|
|
57
|
|
|
58 #'
|
|
|
59 package Bio::Factory::DriverFactory;
|
|
|
60 use strict;
|
|
|
61 use Bio::Root::Root;
|
|
|
62 use Bio::Root::IO;
|
|
|
63
|
|
|
64 use vars qw(@ISA %DRIVERS);
|
|
|
65
|
|
|
66 @ISA = qw(Bio::Root::Root);
|
|
|
67
|
|
|
68 BEGIN {
|
|
|
69 %DRIVERS = ();
|
|
|
70 }
|
|
|
71
|
|
|
72 sub new {
|
|
|
73 my ($class, @args) = @_;
|
|
|
74 my $self = $class->SUPER::new(@args);
|
|
|
75 return $self;
|
|
|
76 }
|
|
|
77
|
|
|
78 =head2 register_driver
|
|
|
79
|
|
|
80 Title : register_driver
|
|
|
81 Usage : $factory->register_driver("genscan", "Bio::Tools::Genscan");
|
|
|
82 Function: Registers a driver a factory class should be able to instantiate.
|
|
|
83
|
|
|
84 This method can be called both as an instance and as a class
|
|
|
85 method.
|
|
|
86
|
|
|
87 Returns :
|
|
|
88 Args : Key of the driver (string) and the module implementing the driver
|
|
|
89 (string).
|
|
|
90
|
|
|
91 =cut
|
|
|
92
|
|
|
93 sub register_driver {
|
|
|
94 my ($self, @args) = @_;
|
|
|
95 my %drivers = @args;
|
|
|
96
|
|
|
97 foreach my $drv (keys(%drivers)) {
|
|
|
98 # note that this doesn't care whether $self is the class or the object
|
|
|
99 $self->driver_table()->{$drv} = $drivers{$drv};
|
|
|
100 }
|
|
|
101 }
|
|
|
102
|
|
|
103 =head2 driver_table
|
|
|
104
|
|
|
105 Title : driver_table
|
|
|
106 Usage : $table = $factory->driver_table();
|
|
|
107 Function: Returns a reference to the hash table storing associations of
|
|
|
108 methods with drivers.
|
|
|
109
|
|
|
110 You use this table to look up registered methods (keys) and
|
|
|
111 drivers (values).
|
|
|
112
|
|
|
113 In this implementation the table is class-specific and therefore
|
|
|
114 shared by all instances. You can override this in a derived class,
|
|
|
115 but note that this method can be called both as an instance and a
|
|
|
116 class method.
|
|
|
117
|
|
|
118 This will be the table used by the object internally. You should
|
|
|
119 definitely know what you're doing if you modify the table's
|
|
|
120 contents. Modifications are shared by _all_ instances, those present
|
|
|
121 and those yet to be created.
|
|
|
122
|
|
|
123 Returns : A reference to a hash table.
|
|
|
124 Args :
|
|
|
125
|
|
|
126
|
|
|
127 =cut
|
|
|
128
|
|
|
129 sub driver_table {
|
|
|
130 my ($self, @args) = @_;
|
|
|
131
|
|
|
132 return \%DRIVERS;
|
|
|
133 }
|
|
|
134
|
|
|
135 =head2 get_driver
|
|
|
136
|
|
|
137 Title : get_driver
|
|
|
138 Usage : $module = $factory->get_driver("genscan");
|
|
|
139 Function: Returns the module implementing a driver registered under the
|
|
|
140 given key.
|
|
|
141 Example :
|
|
|
142 Returns : A string.
|
|
|
143 Args : Key of the driver (string).
|
|
|
144
|
|
|
145 =cut
|
|
|
146
|
|
|
147 sub get_driver {
|
|
|
148 my ($self, $key) = @_;
|
|
|
149
|
|
|
150 if(exists($self->driver_table()->{$key})) {
|
|
|
151 return $self->driver_table()->{$key};
|
|
|
152 }
|
|
|
153 return undef;
|
|
|
154 }
|
|
|
155
|
|
|
156 =head2 _load_module
|
|
|
157
|
|
|
158 Title : _load_module
|
|
|
159 Usage : $self->_load_module("Bio::Tools::Genscan");
|
|
|
160 Function: Loads up (like use) a module at run time on demand.
|
|
|
161 Example :
|
|
|
162 Returns : TRUE on success
|
|
|
163 Args :
|
|
|
164
|
|
|
165 =cut
|
|
|
166
|
|
|
167 sub _load_module {
|
|
|
168 my ($self, $name) = @_;
|
|
|
169 my ($module, $load, $m);
|
|
|
170 $module = "_<$name.pm";
|
|
|
171 return 1 if $main::{$module};
|
|
|
172 $load = "$name.pm";
|
|
|
173
|
|
|
174 my $io = new Bio::Root::IO();
|
|
|
175 # catfile comes from IO
|
|
|
176 $load = $io->catfile((split(/::/,$load)));
|
|
|
177 eval {
|
|
|
178 require $load;
|
|
|
179 };
|
|
|
180 if ( $@ ) {
|
|
|
181 $self->throw("$load: $name cannot be found: ".$@);
|
|
|
182 }
|
|
|
183 return 1;
|
|
|
184 }
|
|
|
185
|
|
|
186 1;
|
