DBD::mysqlとリファレンス

DBD::mysqlがなかなかリファレンスを手放してくれないのです。

以下が検証用のコード。

use strict;
use Scalar::Util qw(weaken);
use Data::Dumper;
use DBI;

my $dbh = DBI->connect('dbi:mysql:database=〜', 'user', 'pass') || die DBI->errstr;

my $sql = sprintf(<<__SQL__, );
select ?
__SQL__

my $sth = $dbh->prepare($sql) || die $dbh->errstr;
my $out = undef;
{
    my $obj = DBDMySQLTest->new('abcde');
    $sth->execute($obj) || die $sth->errstr;
    weaken($out = $obj);
}

print "(1) execute finished\n";
print Dumper($out);

while(my $ref = $sth->fetch()){  }

print "(2) fetch finished\n";
print Dumper($out);

$sth->finish();

print "(3) after finish() call\n";
print Dumper($out);

$sth->execute('Another value');
print "(4) after execute() call with another param\n";
print Dumper($out);

$sth->finish();
$dbh->disconnect() || die $dbh->errstr();

package DBDMySQLTest;
use overload '""' => sub {$$_[0] };
sub new {bless \ $_[1], $_[0]}

見たいのは、$sth->execute()に渡したDBDMySQLTestオブジェクト $obj のリファレンスが、どのタイミングで解放されるかです。こいつが解放されない限り$objは消えることができません。

結果は以下の通り。

(1) execute finished
$VAR1 = bless( do{\(my $o = 'abcde')}, 'DBDMySQLTest' );
(2) fetch finished
$VAR1 = bless( do{\(my $o = 'abcde')}, 'DBDMySQLTest' );
(3) after finish() call
$VAR1 = bless( do{\(my $o = 'abcde')}, 'DBDMySQLTest' );
(4) after execute() call with another param
$VAR1 = undef;

fetch終了とかfinishじゃあ、$sth内のリファレンスは解放してくれないようです。違う生け贄を$sth->execute()に渡せば離してくれます。まるですっぽんのようですな。

なお、 $sth 自体がGCされたときも手放してくれます。これも手かも。

ちなみに、なんでこんな検証をしたかというと、Class::DBIでいつまで経ってもキャッシュが消えない現象に苦しんだからです*1 *2。このときキャッシュに残ってた値は、削除済みステータスのオブジェクトだったため、retrieveしても何もできず致命的な状態に・・・。

Class::DBIの内部キャッシュは、弱参照を利用して値をリフレッシュします。そのため、意図しないところでリファレンスを握られてしまうと、いつまで経ってもキャッシュがリフレッシュされないのです。

*1:現象が出たのは2005年頃の古いバージョンのClass::DBIです。しかも、今更Class::DBI使うなんて・・・ね。

*2:なお、この現象が出たのは、「プライマリキーでhas_a関連を結ぶ」と言うだめっぽい使い方をしたからですw