File Coverage

blib/lib/Class/DBI/Plugin/MultiDatabases.pm

Criterion	Covered	Total	%
statement	39	82	47.5
branch	3	22	13.6
condition	0	3	0.0
subroutine	8	13	61.5
pod	4	7	57.1
total	54	127	42.5

package Class::DBI::Plugin::MultiDatabases;

use strict;
use Carp;
use base qw(Class::Data::Inheritable);
use vars qw($VERSION);

$VERSION = 0.1;

##############################################################################

sub import {
	my $me    = shift;
	my $class = (caller)[0];

	unless( UNIVERSAL::isa($class, 'Class::DBI') ){
		croak __PACKAGE__, " can be used only by Class::DBI and its subclass.";
	}

	no strict 'refs';
	for my $sym (qw/change_db change_db set_connections db_Main
	        save_db_Main clear_db_Main is_imported_class effected_classes/){
		*{"$class\::$sym"} = \&{ $sym };
	}

	$me->is_imported_class($class);

	$class->mk_classdata('current_dbh');
	$class->mk_classdata('_dbnames');
	$class->mk_classdata('_clear_object');
	$class->mk_classdata('_DSNs');
	$class->mk_classdata('_targetClasses');

	$class->_dbnames( {} );
	$class->_DSNs( {} ); # Data Source Name
	$class->_targetClasses( {} );

	if( $class->can('clear_object_index') ){
		$class->_clear_object(1);
	}

}

##############################################################################

{ # sub is_imported_class
	my $class;
	sub is_imported_class {
		my $self = shift;

		if($class){ return $class eq $self; }

		$class = shift; # only once
	}
}

##############################################################################

# See Also http://wiki.class-dbi.com/index.cgi?UsingMultipleDatabases

sub set_connections {
	my $class = shift;
	my %keys  = @_;
	$class->_DSNs(\%keys);
}


sub change_db {
	my ($class, $dsn_key) = @_;

	unless( $class->is_imported_class ){
		croak "change_db() must be called by the imported class.";
	}

	if($class->_dbnames->{$dsn_key}){

		# $class may not be contained in _targetClasses
		$class->current_dbh($dsn_key);

		for my $subclass ( $class->effected_classes ){
			$subclass->current_dbh($dsn_key);
		}

	}
	else{
		$class->_dbnames->{$dsn_key} = 1;
		$class->current_dbh($dsn_key);

		unless( $class->_DSNs->{$dsn_key} ){
			return undef;
		}

		my @args = @{ $class->_DSNs->{$dsn_key} };
		Ima::DBI->set_db($dsn_key, @args);
	}

	for my $subclass ( $class->effected_classes ){
		$subclass->clear_object_index() if($class->_clear_object());
	}

	return $dsn_key;
}


sub db_Main {
	my $proto  = shift;
	my $method = 'db_' . $proto->current_dbh();

	if(ref($proto) and $proto->{__db_Main}){
		return $proto->{__db_Main};
	}

	if(!ref($proto)){
		$proto->_targetClasses->{$proto} = 1;
	}

	$proto->$method;
}


sub save_db_Main {
	my $proto  = shift;

	unless(ref($proto)){
		die "save_db_Main() can't be used as a clsas method.";
	}

	my $method = "db_" . $proto->current_dbh();

	$proto->{__db_Main} = $proto->$method;
}


sub clear_db_Main {
	my $proto  = shift;

	unless(ref($proto)){
		die "save_db_Main() can't be used as a clsas method.";
	}

	my $saved = $proto->{__db_Main};

	$proto->{__db_Main} = undef;

	return $saved;
}


sub effected_classes {
	my $class = shift;
	my @classes;

	for my $target ( keys %{ $class->_targetClasses } ){
		push @classes, $target;
	}

	return @classes;
}


##############################################################################
1;
__END__