#!/usr/bin/perl use strict; use warnings; use Test::TempDir; use Path::Class; use Storable qw(nstore retrieve); use Scalar::Util qw(blessed); use Try::Tiny; use KiokuDB; # no long running tests my $large = 0; use Benchmark qw(cmpthese); my $f = (require KiokuDB::Test::Fixture::ObjectGraph)->new; sub construct { $f->create; } sub bench { my $dir = dir(tempdir); my $storable = $dir->file("foo.storable")->stringify; my $mxsd_hash = KiokuDB->connect("hash", serializer => "storable" ); my $mxsd_files = KiokuDB->connect("files:dir=" . $dir->subdir("mxsd_files"), create => 1, global_lock => 1 ); my $mxsd_bdb_txn = KiokuDB->connect("bdb:dir=" . $dir->subdir("mxsd_bdb_txn"), create => 1 ); my $mxsd_sqlite = KiokuDB->connect("dbi:SQLite:dbname=" . $dir->file("sqlite.db"), serializer => "storable" ); $mxsd_sqlite->backend->dbh->do("PRAGMA default_synchronous = OFF"); $mxsd_sqlite->backend->deploy; my $mxsd_mysql = try { KiokuDB->connect("dbi:mysql:test", serializer => "storable") } catch { warn @_ }; $mxsd_mysql && $mxsd_mysql->backend->deploy({ add_drop_table => 1, producer_args => { mysql_version => 5 } }); my $mxsd_pg = try { KiokuDB->connect("dbi:Pg:dbname=test", serializer => "storable") } catch { warn $@ }; $mxsd_pg && $mxsd_pg->backend->deploy({ add_drop_table => 1 }); $dir->subdir("mxsd_bdb_dumb")->mkpath; my $mxsd_bdb_dumb = KiokuDB->new( backend => KiokuDB::Backend::BDB->new( manager => { home => $dir->subdir("mxsd_bdb_dumb"), transactions => 0, create => 1, }, ), ); my $mxsd_couch; if ( my $uri = $ENV{KIOKU_COUCHDB_URI} ) { require KiokuDB::Backend::CouchDB; require AnyEvent::CouchDB; my $couch = AnyEvent::CouchDB::couch($uri); my $name = $ENV{KIOKU_COUCHDB_NAME} || "kioku-$$"; my $db = $couch->db($name); try { $db->drop }; $db->create; $mxsd_couch = KiokuDB->connect("couchdb:uri=$uri;db=$name"); $mxsd_couch->{__guard} = Scope::Guard->new(sub { $db->drop }); } warn "\nwriting...\n"; $mxsd_bdb_txn->backend->txn_do(sub { $mxsd_files->backend->txn_do(sub { return; cmpthese(-3, { #null => sub { my @objs = construct(); }, mxsd_hash => sub { my @objs = construct(); my $s = $mxsd_hash->new_scope; $mxsd_hash->store(grep { blessed($_) } @objs) }, mxsd_files => sub { my @objs = construct(); my $s = $mxsd_files->new_scope; $mxsd_files->store(grep { blessed($_) } @objs) }, mxsd_bdb => sub { my @objs = construct(); my $s = $mxsd_bdb_dumb->new_scope; $mxsd_bdb_dumb->store(grep { blessed($_) } @objs) }, mxsd_bdb_txn => sub { my @objs = construct(); my $s = $mxsd_bdb_txn->new_scope; $mxsd_bdb_txn->store(grep { blessed($_) } @objs) }, mxsd_sqlite => sub { my @objs = construct(); my $s = $mxsd_sqlite->new_scope; $mxsd_sqlite->store(grep { blessed($_) } @objs) }, ( $mxsd_mysql ? ( mxsd_mysql => sub { my @objs = construct(); my $s = $mxsd_mysql->new_scope; $mxsd_mysql->store(grep { blessed($_) } @objs) } ) : () ), ( $mxsd_pg ? ( mxsd_pg => sub { my @objs = construct(); my $s = $mxsd_pg->new_scope; $mxsd_pg->store(grep { blessed($_) } @objs) } ) : () ), ( $mxsd_couch ? ( mxsd_couch => sub { my @objs = construct(); my $s = $mxsd_couch->new_scope; $mxsd_couch->store(grep { blessed($_) } @objs) } ) : () ), storable => sub { nstore([ construct() ], $storable) }, }); }); }); warn "\nreading...\n"; nstore([ construct() ], $storable); my @hash_ids = do { my @objs = construct(); my $s = $mxsd_hash->new_scope; $mxsd_hash->store(grep { blessed($_) } @objs) }; my @files_ids = $mxsd_files->txn_do(sub { my @objs = construct(); my $s = $mxsd_files->new_scope; $mxsd_files->store(grep { blessed($_) } @objs) }); my @bdb_d_ids = do { my @objs = construct(); my $s = $mxsd_bdb_dumb->new_scope; $mxsd_bdb_dumb->store(grep { blessed($_) } @objs) }; my @bdb_t_ids = do { my @objs = construct(); my $s = $mxsd_bdb_txn->new_scope; $mxsd_bdb_txn->backend->txn_do(sub { $mxsd_bdb_txn->store(grep { blessed($_) } @objs) }); }; my @sqlite_t_ids = do { my @objs = construct(); my $s = $mxsd_sqlite->new_scope; $mxsd_sqlite->backend->txn_do(sub { $mxsd_sqlite->store(grep { blessed($_) } @objs) }); }; my @mysql_t_ids = $mxsd_mysql ? do { my @objs = construct(); my $s = $mxsd_mysql->new_scope; $mxsd_mysql->backend->txn_do(sub { $mxsd_mysql->store(grep { blessed($_) } @objs) }); } : (); my @pg_t_ids = $mxsd_pg ? do { my @objs = construct(); my $s = $mxsd_pg->new_scope; $mxsd_pg->backend->txn_do(sub { $mxsd_pg->store(grep { blessed($_) } @objs) }); } : (); my @couch_ids = $mxsd_couch ? do { my @objs = construct(); my $s = $mxsd_couch->new_scope; $mxsd_couch->store(grep { blessed($_) } @objs) } : (); cmpthese(-3, { storable => sub { my $objs = retrieve($storable) }, mxsd_hash => sub { my $s = $mxsd_hash->new_scope; my @objs = $mxsd_hash->lookup(@hash_ids) }, mxsd_files => sub { my $s = $mxsd_files->new_scope; my @objs = $mxsd_files->lookup(@files_ids) }, mxsd_bdb => sub { my $s = $mxsd_bdb_dumb->new_scope; my @objs = $mxsd_bdb_dumb->lookup(@bdb_d_ids) }, mxsd_bdb_txn => sub { my $s = $mxsd_bdb_txn->new_scope; my @objs = $mxsd_bdb_txn->lookup(@bdb_t_ids) }, mxsd_sqlite => sub { my $s = $mxsd_sqlite->new_scope; my @objs = $mxsd_sqlite->lookup(@sqlite_t_ids) }, ( $mxsd_mysql ? ( mxsd_mysql => sub { my $s = $mxsd_mysql->new_scope; my @objs = $mxsd_mysql->lookup(@mysql_t_ids) } ) : () ), ( $mxsd_pg ? ( mxsd_pg => sub { my $s = $mxsd_pg->new_scope; my @objs = $mxsd_pg->lookup(@pg_t_ids) } ) : () ), ( $mxsd_couch ? ( mxsd_couch => sub { my $s = $mxsd_couch->new_scope; my @objs = $mxsd_couch->lookup(@couch_ids) } ) : () ), }); } bench();