Data::ObjectDriverは遅いのか

ネットをうろうろしてて、こんな記事を見つけた
ObjectDriver使えねえ。。

Data::ObjectDriverのあまりの遅さにビックリして自分で同じ機能を書き直したら、速度にして約10倍以上に跳ね上がった。そもそもmemcachedを使わずに裸のDBIでやった方がmemcachedアリのObjectDriverより速いんだから。読み込みループがですよ。すなわち300回実行したら299回はmemcachedを使っている筈のObjectDriverが、300回DBアクセスするDBIより遅いわけ。キャッシュの意味がねぇ(;´Д｀)y-~ 言語を絶する。バカどもは最低でもベンチマーク取ってから人に勧めろよ

2008年10月の記事なので大分古いけど、日本ではDODの使用例とか感想がさっぱりないので気になった。
上の記事にベンチマーク結果もコードも貼ってないので、自分でベンチマークを取ってみた。

MySQL, memcached共にlocalにある環境でbenchmarkを実行し、結果は以下の通り。
ついでなので、DBICも一緒に計測した。DBICでcacheする場合のスマートに書く方法を知らべるのが面倒だったので、愚直に書いた。
_poolが付いているものは、MySQLとの接続を1度しか行わないもの。

Rate  DBIC DBIC_pool  DOD  DBI DOD_MemCached DBI_pool DBIC_MemCached DBI_MemCached
DBIC             435/s    --      -59% -75% -76%          -92%     -95%           -96%          -97%
DBIC_pool       1058/s  143%        -- -40% -41%          -80%     -87%           -89%          -93%
DOD             1751/s  302%       65%   --  -3%          -67%     -78%           -82%          -88%
DBI             1805/s  315%       71%   3%   --          -66%     -77%           -82%          -88%
DOD_MemCached   5263/s 1109%      397% 201% 192%            --     -34%           -47%          -65%
DBI_pool        8000/s 1738%      656% 357% 343%           52%       --           -19%          -46%
DBIC_MemCached  9901/s 2174%      836% 465% 449%           88%      24%             --          -34%
DBI_MemCached  14925/s 3328%     1310% 752% 727%          184%      87%            51%            --

素のDBIよりDOD+memcachedの方が全然早いじゃん。
DBICで透過的にcacheする状態だと、DOD+memcachedのどっちが早いのか気になるところ。


以下にbenchmark用コードを貼っておく

#!/usr/bin/env perl

# 2009/03/13
# MySQL 5.0.27
# memcached 1.2.6
# perl v5.8.8
# Data::ObjectDriver 0.06
# DBIx::Class 0.08012
# Cache::Memcached::Fast 0.14

package DOD;
use strict;
use warnings;
use base qw(Data::ObjectDriver::BaseObject);
use Data::ObjectDriver::Driver::DBI;

__PACKAGE__->install_properties(
{   columns     => [ 'id', 'word', 'text' ],
primary_key => ['id'],
datasource  => 'test',
driver      => Data::ObjectDriver::Driver::DBI->new(
dsn       => 'dbi:mysql:dod',
username  => 'dod',
password  => '',
reuse_dbh => 1,
),
}
);

package DODMemCached;
use strict;
use warnings;
use base qw(Data::ObjectDriver::BaseObject);
use Data::ObjectDriver::Driver::DBI;
use Data::ObjectDriver::Driver::Cache::Memcached;
use Cache::Memcached::Fast;
__PACKAGE__->install_properties(
{   columns     => [ 'id', 'word', 'text' ],
primary_key => ['id'],
datasource  => 'test',
driver => Data::ObjectDriver::Driver::Cache::Memcached->new(
cache => Cache::Memcached::Fast->new(
{ servers => ['localhost:11211'] }
),
fallback => Data::ObjectDriver::Driver::DBI->new(
dsn       => 'dbi:mysql:dod',
username  => 'dod',
password  => '',
reuse_dbh => 1,
),
),
}
);

package DBIC::Schema::Test;
use strict;
use warnings;
use base qw/DBIx::Class/;
__PACKAGE__->load_components("Core");
__PACKAGE__->table("test");
__PACKAGE__->add_columns(
"id",
{   data_type     => "INT",
default_value => undef,
is_nullable   => 0,
size          => 11
},
"word",
{   data_type     => "TEXT",
default_value => undef,
is_nullable   => 0,
size          => 65535,
},
"text",
{   data_type     => "TEXT",
default_value => undef,
is_nullable   => 1,
size          => 65535,
},
);
__PACKAGE__->set_primary_key("id");

package DBIC::Schema;
use strict;
use warnings;
use base qw/DBIx::Class::Schema/;

__PACKAGE__->load_classes(qw/Test/);

package main;
use strict;
use warnings;
use DBI;
use Cache::Memcached::Fast;
use Benchmark qw(cmpthese);
my @connect_info = ( 'dbi:mysql:dod', 'dod', '' );
my $count  = shift || 10_000;
my $pool   = DBI->connect(@connect_info);
my $schema = DBIC::Schema->connect(@connect_info);
my $cache = Cache::Memcached::Fast->new( { servers => ['localhost:11211'] } );

cmpthese(
$count,
{   'DBI' => sub {
my $dbh = DBI->connect(@connect_info);
my $sth
= $dbh->prepare(
'SELECT test.id, test.word, test.text FROM test WHERE id = 1'
);
$sth->execute;
my $row = $sth->fetchrow_hashref;
$sth->finish;
$dbh->disconnect;
},
'DBI_pool' => sub {
my $sth
= $pool->prepare(
'SELECT test.id, test.word, test.text FROM test WHERE id = 1'
);
$sth->execute;
my $row = $sth->fetchrow_hashref;
$sth->finish;
},
'DBI_MemCached' => sub {
my $row = $cache->get('DBI_MemCached-Test-1');
unless ($row) {
my $dbh = DBI->connect(@connect_info);
my $sth
= $dbh->prepare(
'SELECT test.id, test.word, test.text FROM test WHERE id = 1'
);
$sth->execute;
my $row = $sth->fetchrow_hashref;
$sth->finish;
$dbh->disconnect;
$cache->set( 'DBI_MemCached-Test-1', $row );
}
},

'DOD'                => sub { my $row = DOD->lookup(1); },
'DOD_MemCached' => sub { my $row = DODMemCached->lookup(1); },

'DBIC' => sub {
my $s   = DBIC::Schema->connect(@connect_info);
my $row = $s->resultset('Test')->find(1);
},
'DBIC_pool' => sub {
my $row = $schema->resultset('Test')->find(1);
},
'DBIC_MemCached' => sub {
my $row = $cache->get('DBIC_MemCached-Test-1');
unless ($row) {
my $s = DBIC::Schema->connect(@connect_info);
$row = $s->resultset('Test')->find(1);
$cache->set( 'DBIC_MemCached-Test-1', $row );
}
},
}
);
$pool->disconnect;