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;
