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 use strict;
  72 use File::Spec;
  73
  74 use vars qw(%DRIVERS);
  75
  76 use base qw(Bio::Root::Root);
  77
  78 BEGIN {
  79     %DRIVERS = ();
  80 }
  81
  82 sub new {
  83     my ($class, @args) = @_;
  84     my $self = $class->SUPER::new(@args);
  85     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     my ($self, @args) = @_;
 105     my %drivers = @args;
 106
 107     foreach my $drv (keys(%drivers)) {
 108         # note that this doesn't care whether $self is the class or the object
 109         $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     my ($self, @args) = @_;
 141
 142     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     my ($self, $key) = @_;
 159
 160     if(exists($self->driver_table()->{$key})) {
 161         return $self->driver_table()->{$key};
 162     }
 163     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     my ($self, $name) = @_;
 179     my ($module, $load, $m);
 180     $module = "_<$name.pm";
 181     return 1 if $main::{$module};
 182     $load = "$name.pm";
 183
 184     $load = File::Spec->catfile((split(/::/,$load)));
 185     eval {
 186         require $load;
 187     };
 188     if ( $@ ) {
 189         $self->throw("$load: $name cannot be found: ".$@);
 190     }
 191     return 1;
 192 }
 193
 194 1;