lib/Bio/Factory/DriverFactory.pm

   1 #
   2 # BioPerl module for Bio::Factory::DriverFactory
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason@bioperl.org> and
   7 #              Hilmar Lapp <hlapp@gmx.net>
   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<bioperl-l@bioperl.org>
  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 E<lt>jason@bioperl.orgE<gt>
  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
  72 use strict;
  73 use File::Spec;
  74
  75 use vars qw(%DRIVERS);
  76
  77 use base qw(Bio::Root::Root);
  78
  79 BEGIN {
  80     %DRIVERS = ();
  81 }
  82
  83 sub new {
  84     my ($class, @args) = @_;
  85     my $self = $class->SUPER::new(@args);
  86     return $self;
  87 }
  88
  89 =head2 register_driver
  90
  91  Title   : register_driver
  92  Usage   : $factory->register_driver("genscan", "Bio::Tools::Genscan");
  93  Function: Registers a driver a factory class should be able to instantiate.
  94
  95            This method can be called both as an instance and as a class
  96            method.
  97
  98  Returns :
  99  Args    : Key of the driver (string) and the module implementing the driver
 100            (string).
 101
 102 =cut
 103
 104 sub register_driver {
 105     my ($self, @args) = @_;
 106     my %drivers = @args;
 107
 108     foreach my $drv (keys(%drivers)) {
 109         # note that this doesn't care whether $self is the class or the object
 110         $self->driver_table()->{$drv} = $drivers{$drv};
 111     }
 112 }
 113
 114 =head2 driver_table
 115
 116  Title   : driver_table
 117  Usage   : $table = $factory->driver_table();
 118  Function: Returns a reference to the hash table storing associations of
 119            methods with drivers.
 120
 121            You use this table to look up registered methods (keys) and
 122            drivers (values).
 123
 124            In this implementation the table is class-specific and therefore
 125            shared by all instances. You can override this in a derived class,
 126            but note that this method can be called both as an instance and a
 127            class method.
 128
 129            This will be the table used by the object internally. You should
 130            definitely know what you're doing if you modify the table's
 131            contents. Modifications are shared by _all_ instances, those present
 132            and those yet to be created.
 133
 134  Returns : A reference to a hash table.
 135  Args    :
 136
 137
 138 =cut
 139
 140 sub driver_table {
 141     my ($self, @args) = @_;
 142
 143     return \%DRIVERS;
 144 }
 145
 146 =head2 get_driver
 147
 148  Title   : get_driver
 149  Usage   : $module = $factory->get_driver("genscan");
 150  Function: Returns the module implementing a driver registered under the
 151            given key.
 152  Example :
 153  Returns : A string.
 154  Args    : Key of the driver (string).
 155
 156 =cut
 157
 158 sub get_driver {
 159     my ($self, $key) = @_;
 160
 161     if(exists($self->driver_table()->{$key})) {
 162         return $self->driver_table()->{$key};
 163     }
 164     return;
 165 }
 166
 167 =head2 _load_module
 168
 169  Title   : _load_module
 170  Usage   : $self->_load_module("Bio::Tools::Genscan");
 171  Function: Loads up (like use) a module at run time on demand.
 172  Example :
 173  Returns : TRUE on success
 174  Args    :
 175
 176 =cut
 177
 178 sub _load_module {
 179     my ($self, $name) = @_;
 180     my ($module, $load, $m);
 181     $module = "_<$name.pm";
 182     return 1 if $main::{$module};
 183     $load = "$name.pm";
 184
 185     $load = File::Spec->catfile((split(/::/,$load)));
 186     eval {
 187         require $load;
 188     };
 189     if ( $@ ) {
 190         $self->throw("$load: $name cannot be found: ".$@);
 191     }
 192     return 1;
 193 }
 194
 195 1;