blog.nomadscafe.jp

Class::DBIで同じ構造の複数データベース扱う時には、まかまかさんのClass::DBI::Plugin::MultiDatabases(後で知った)や、Class::DBIのWikiにあるけど、さらにmod_perl上でのTips

ちょっと実際書いたコードと違うので全くこの通りでうごくかどうか心配なのですが、複数データベースに接続をするモジュールを下のように書いてみる。

package Object;

use strict;
use DBI;
use base qw(Class::DBI);
use Class::DBI::Plugin::NoCache;
use MyConfig;#データベースの接続情報を返すモジュールとする

__PACKAGE__->mk_classdata('dbhandles',{});
__PACKAGE__->mk_classdata('dbh_key');
__PACKAGE__->nocache(1);

sub change_db{
	my $class = shift;
	return Object->dbh_key(@_);
}

sub db_Main{
	my $proto = shift;
	my $self = ref($proto) || $proto;
	
	my $dbhandles = Object->dbhandles;
	my $key = $self->dbh_key;
	$key ||= "キーのデフォルト";
	
	return $self->_croak("Could not get dbh_key") unless $key;
	
	return $dbhandles->{$key} if($dbhandles->{$key});
	
	#MyConfigはデータベースの接続情報を返す
	my $confing=MyConfig->new($key)
		or return $self->_croak("Could not get dbh config");
		
	my $dbh = DBI->connect_cached(
		"dbi:mysql:".$config->dsn.":".$config->dbhost,
		$config->dbuser,$config->dbpass,
		{$self->_default_attributes}
	) or return $self->_croak("Could not connect to database");
	
	$dbhandles->{$key}=$dbh;
	Object->dbhandles($dbhandles);
	
	return $dbh;
}

1;

Cacheのこともあるので、Class::DBI::Plugin::NoCacheも使用してます。
これでこのモジュールを継承して使用します

package Object::CD;

use strict;
use base qw(Object);

__PACKAGE__->table('cds');
__PACKAGE__->column(All => qw/cdid title artist/);
__PACKAGE__->has_many(tracks => 'Object::Track');

package main;

Object::CD->change_db('dbA');
my $cd = Object::CD->retrieve(123);
my $tracks = $cd->tracks;

Object::CD->change_db('dbB');
Object::CD->retrieve_all();

たぶん、これはまとも動いてくれると思います。has_many、has_aも正しく動くでしょう。
けどこれを、mod_perl環境でうごかすと、

最初のアクセスで、

Object::CD->change_db('dbA');
my $cd = Object::CD->retrieve(123);
my $tracks = $cd->tracks;

としてしまうと、以降のアクセスで、デフォルトのDBを使いたくても、

my $cd = Object::CD->retrieve(123);
my $tracks = $cd->tracks;

としてしまったときに、デフォルトではなく、dbAが返ってくる（ことがある)ようになってしまいます。
dbh_keyをObjectモジュールのClassDataに保存してますから、グローバルな値として次のリクエストでも使われてしまうのです。

対策として、

Object::CD->change_db('デフォルトのキー');

を必ず入れる。例えば、CGI::Appのprerunなどに挿入しておけばOKです。もしくは、ApacheのCleanupHandlerを利用する手もあります。CleanupHandlerはリクエストのトランザクション終了後に呼び出される後処理Handlerで、register_cleanup()で登録をすることができます。これを使います。上記のchange_dbを以下のようにします。

sub change_db{
	my $class = shift;
	if(@_ > 0 && exists $ENV{MOD_PERL}){
		#classdataのdbh_keyを保持してしまうので、cleanup handlerで消す。
		#CGI.pmのソースが参考になる
		require Apache;
		my $r = Apache->request;
		$r->register_cleanup(sub{
			Object->dbh_key(0);
		});
	}
	return Object->dbh_key(@_);
}

リクエストの処理終了後に、dbh_keyに「0」をいれることで、値をresetしています。
mod_perl2への対応等はCGI.pmのソースをみるのがよさそうです。CGI.pmもglobalな変数の片付けをregister_cleanupを利用して行ってました。

Class::DBIとTemplate-Toolkitでマジ生産性あがりました。Apacheのプロセスのメモリサイズも増えそうだけど。バナーの管理ページ7つ分。10日間で完了。