view release on metacpan or  search on metacpan

lib/Class/DBI/Plugin/MultiDatabases.pm  view on Meta::CPAN

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.";
	}