Choosing Class::DBI::(mysql|SQLite|*) classes at runtime

[prev] [thread] [next] [Date index for 2004/07/07]

Hi all,

I've been using Class::DBI::mysql->set_up_table all over the code for
one of my modules which worked excellent until I started to write unit
tests for this module. For obvious reasons I don't want to access a
mysql server and don't want to change the code of the modules to use
Class::DBI::SQLite instead. I searched a bit but didn't find any
suggestion how to provide dynamic base-class choosing. 

I've came up with this solution [1] which works perfectly for me but 
maybe I am doing something terrible stupid here.

Please have a look, and suggest a better way to achieve this behavior.
If there is none, I will add this to the cookbook section of the wiki.

Regards,
  Sebastian


---cut---

package Exparse::DBI;

use Exparse::Config;

use Class::DBI;
use base 'Class::DBI';

use Carp;

my $data_source = Exparse::Config->dsn;
my %dbc = Exparse::Config->dbc;

__PACKAGE__->set_db( 'Main', $data_source, $dbc{user}, $dbc{password} );

sub set_up_table {
  my $class = shift;

  if ( UNIVERSAL::can( $Exparse::DBI::ISA[0], 'set_up_table' ) ) {
	 # my ancestor already supports set_up_table, so everything is OK
	 Exparse::DBI->SUPER::set_up_table( @_ );
  } else {
	 # oh horror, we are on our own

	 # try to load an Class::DBI extension for the DBI driver class
	 require "Class/DBI/$dbc{driver}.pm";
	 my $base = "Class::DBI::$dbc{driver}";

	 # check if this extension supports set_up_table
	 croak( "Database driver $dbc{driver} does not support set_up_table" )
		unless ( UNIVERSAL::can( $base, 'set_up_table' ) );

	 # reparent Exparse::DBI and thus all classes using it for db access
	 # to the extended Class::DBI version
	 $Exparse::DBI::ISA[0] = $base;

	 # for some strange reasons the reparenting will
	 # be in place just after we leave this function so
	 # we have to call parents set_up_table manually
	 my $s_u_t = 'Class::DBI::%s::set_up_table( $class, @_ )';
	 eval( sprintf( $s_u_t, $dbc{driver} ) );
	 croak( "$@" ) if $@;

  }
}


---cut---