Bill Moseley scribbled on 4/12/07 9:11 PM:
> Ok, I just have to ask. What are people doing for dbh caching?
> I know this comes up often:
>
>
> http://thread.gmane.org/gmane.comp.lang.perl.modules.dbi.rose-db-object/1138/focus=1140
>
here's my (admittedly buggy) code for doing this. It caches a single dbh for
each unique RDB registry entry combination of domain.type.dsn. I know that it
breaks under mod_perl -- anyone spot why? (the error I get is from Pg:
"prepared
statement 'dbdpg_1' already exists" after first request, because %cache seems
to
be shared across all apache child processes).
First the RDBO subclass:
------------------------------------------
package My::RDBO;
use My::DB;
use base qw( Rose::DB::Object );
use Rose::Class::MakeMethods::Generic (scalar => ['debug']);
our %cache; # DBI object cache
sub init_db
{
my $class = shift;
my %o = @_;
unless (exists $o{debug})
{
$o{debug} = $class->debug || $ENV{PERL_DEBUG} || 0;
}
my $db = My::DB->new(%o);
if ($db->cache_dbh)
{
my $i = $db->idx;
if ( exists $cache{$i}
and defined $cache{$i}->{dbh}
and (time() - $cache{$i}->{age}) < $db->timeout
and $db->ping($cache{$i}->{dbh}))
{
$cache{$i}->{cnt}++;
$db->logger(
"using cached dbh for $class (called $cache{$i}->{cnt}
times)")
if $db->debug > 1;
$db->dbh($cache{$i}->{dbh});
}
else
{
$db->logger("creating new dbh for $i") if $db->debug;
if (exists $cache{$i}->{dbh})
{
$cache{$i}->{dbh}
->disconnect; # explicitly disconnect old handle
}
my $dbh = $db->dbh;
$cache{$i} = {
dbh => $dbh,
age => time(),
cnt => 1,
dbi => "$dbh"
};
}
if (exists $cache{$i})
{
$db->logger("dbh = $cache{$i}->{dbh}")
if $db->debug > 1;
}
}
return $db;
}
1;
and the RDB subclass:
------------------------------------
package My::DB;
use base qw( Rose::DB );
use Rose::Object::MakeMethods::Generic (
'scalar --get_set_init' => [qw(timeout debug logfh cache_dbh)],
);
sub init_timeout { '3600' }
sub init_logfh { *STDERR{IO} }
sub init_debug { 0 }
sub init_cache_dbh { 1 }
sub ping
{
my $self = shift;
my $dbh = shift || $self->dbh;
my $ret = 0;
my $prev_alarm = 0;
eval {
local $SIG{__DIE__} = sub { $self->logger("ping died: $@"); return 0
};
local $SIG{__WARN__} = sub { return (0); };
local $SIG{ALRM} = sub { return (0); };
$self->logger('setting alarm') if $self->debug > 1;
$prev_alarm = CORE::alarm(2);
$self->logger("alarm = $prev_alarm") if $self->debug > 1;
$ret = $dbh->do("select 1");
$self->logger('ping ok') if $self->debug > 1;
};
$prev_alarm ? CORE::alarm($prev_alarm) : CORE::alarm(0);
$self->logger('alarm reset to ' . $prev_alarm) if $self->debug > 1;
return ($@) ? 0 : $ret;
}
# unique name for cache
sub idx
{
my $self = shift;
return join('::', $self->domain, $self->type, $self->dsn);
}
# overriden to prevent automatic DBI->disconnect
sub release_dbh
{
my $self = shift;
return 1 if $self->cache_dbh;
$self->logger("releasing dbh") if $self->debug;
$self->SUPER::release_dbh(@_);
}
sub logger
{
my $self = shift;
my @msg = @_;
for my $m (@msg)
{
print {$self->logfh} join(' ', $self->loglabel, $m, "\n");
}
}
sub loglabel
{
my $self = shift;
my $time = localtime();
return '[' . $time . '] ' . '[' . $self->nick . '] ';
}
sub nick
{
my $self = shift;
return
join('.', $self->domain, $self->type,
$self->database . '@' . $self->host);
}
1;
--
Peter Karman . http://peknet.com/ . [EMAIL PROTECTED]
-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys-and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV
_______________________________________________
Rose-db-object mailing list
[EMAIL PROTECTED]
https://lists.sourceforge.net/lists/listinfo/rose-db-object
