Bio/Factory/DriverFactory.pm

   1 # $Id$
   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://bioperl.org/wiki/Mailing_lists  - 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 the
  43 web:
  44
  45   http://bugzilla.open-bio.org/
  46
  47 =head1 AUTHOR - Jason Stajich
  48
  49 Email Jason Stajich E<lt>jason@bioperl.orgE<gt>
  50
  51 =head1 APPENDIX
  52
  53 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
  54
  55 =cut
  56
  57 #'
  58 package Bio::Factory::DriverFactory;
  59 use strict;
  60 use File::Spec;
  61
  62 use vars qw(%DRIVERS);
  63
  64 use base qw(Bio::Root::Root);
  65
  66 BEGIN {
  67     %DRIVERS = ();
  68 }
  69
  70 sub new {
  71     my ($class, @args) = @_;
  72     my $self = $class->SUPER::new(@args);
  73     return $self;
  74 }
  75
  76 =head2 register_driver
  77
  78  Title   : register_driver
  79  Usage   : $factory->register_driver("genscan", "Bio::Tools::Genscan");
  80  Function: Registers a driver a factory class should be able to instantiate.
  81
  82            This method can be called both as an instance and as a class
  83            method.
  84
  85  Returns :
  86  Args    : Key of the driver (string) and the module implementing the driver
  87            (string).
  88
  89 =cut
  90
  91 sub register_driver {
  92     my ($self, @args) = @_;
  93     my %drivers = @args;
  94
  95     foreach my $drv (keys(%drivers)) {
  96         # note that this doesn't care whether $self is the class or the object
  97         $self->driver_table()->{$drv} = $drivers{$drv};
  98     }
  99 }
 100
 101 =head2 driver_table
 102
 103  Title   : driver_table
 104  Usage   : $table = $factory->driver_table();
 105  Function: Returns a reference to the hash table storing associations of
 106            methods with drivers.
 107
 108            You use this table to look up registered methods (keys) and
 109            drivers (values).
 110
 111            In this implementation the table is class-specific and therefore
 112            shared by all instances. You can override this in a derived class,
 113            but note that this method can be called both as an instance and a
 114            class method.
 115
 116            This will be the table used by the object internally. You should
 117            definitely know what you're doing if you modify the table's
 118            contents. Modifications are shared by _all_ instances, those present
 119            and those yet to be created.
 120
 121  Returns : A reference to a hash table.
 122  Args    :
 123
 124
 125 =cut
 126
 127 sub driver_table {
 128     my ($self, @args) = @_;
 129
 130     return \%DRIVERS;
 131 }
 132
 133 =head2 get_driver
 134
 135  Title   : get_driver
 136  Usage   : $module = $factory->get_driver("genscan");
 137  Function: Returns the module implementing a driver registered under the
 138            given key.
 139  Example :
 140  Returns : A string.
 141  Args    : Key of the driver (string).
 142
 143 =cut
 144
 145 sub get_driver {
 146     my ($self, $key) = @_;
 147
 148     if(exists($self->driver_table()->{$key})) {
 149         return $self->driver_table()->{$key};
 150     }
 151     return;
 152 }
 153
 154 =head2 _load_module
 155
 156  Title   : _load_module
 157  Usage   : $self->_load_module("Bio::Tools::Genscan");
 158  Function: Loads up (like use) a module at run time on demand.
 159  Example :
 160  Returns : TRUE on success
 161  Args    :
 162
 163 =cut
 164
 165 sub _load_module {
 166     my ($self, $name) = @_;
 167     my ($module, $load, $m);
 168     $module = "_<$name.pm";
 169     return 1 if $main::{$module};
 170     $load = "$name.pm";
 171
 172     $load = File::Spec->catfile((split(/::/,$load)));
 173     eval {
 174         require $load;
 175     };
 176     if ( $@ ) {
 177         $self->throw("$load: $name cannot be found: ".$@);
 178     }
 179     return 1;
 180 }
 181
 182 1;