File Coverage

Bio/Factory/DriverFactory.pm
Criterion Covered Total %
statement 35 37 94.5
branch 3 6 50.0
condition n/a
subroutine 10 10 100.0
pod 4 4 100.0
total 52 57 91.2


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