#!/usr/bin/env perl
use strict;
use warnings;
use Scalar::Util qw(refaddr);
use Test::More;
use Test::Exception;
use KiokuDB;
use Test::Requires 'DBD::SQLite';
use DBIx::Class::Optional::Dependencies;
my $deploy_deps;
BEGIN {
$deploy_deps = DBIx::Class::Optional::Dependencies->req_list_for('deploy');
}
use Test::Requires $deploy_deps;
{
package MyApp::DB::Result::Foo;
use base qw(DBIx::Class::Core);
__PACKAGE__->load_components(qw(KiokuDB));
__PACKAGE__->table('foo');
__PACKAGE__->add_columns(qw(id name object));
__PACKAGE__->set_primary_key('id');
__PACKAGE__->kiokudb_column('object');
package MyApp::DB;
use base qw(DBIx::Class::Schema);
__PACKAGE__->load_components(qw(Schema::KiokuDB));
__PACKAGE__->register_class( Foo => qw(MyApp::DB::Result::Foo));
package Foo;
use Moose;
has name => ( isa => "Str", is => "ro" );
has obj => ( isa => "Object", is => "ro", weak_ref => 1 );
__PACKAGE__->meta->make_immutable;
}
my $dir = KiokuDB->connect(
'dbi:SQLite:dbname=:memory:',
schema => "MyApp::DB",
create => 1,
live_objects => {
clear_leaks => 1,
leak_tracker => sub {
my $i = $Test::Builder::Level || 1;
$i++ until (caller($i))[1] eq __FILE__;
local $Test::Builder::Level = $i + 2;
fail("no leaks");
diag("leaked @_"),
},
},
);
$dir->txn_do( scope => 1, body => sub {
$dir->insert( foo => my $obj = Foo->new );
$dir->backend->schema->resultset("Foo")->create({ id => 1, name => "foo", object => $obj });
my $row = $dir->backend->schema->resultset("Foo")->create({ id => 2, name => "foo", object => "foo" });
isa_ok( $row->object, 'Foo', 'inflated from constructor' );
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
foreach my $id ( 1, 2 ) {
$dir->txn_do( scope => 1, body => sub {
my $row = $dir->backend->schema->resultset("Foo")->find(1);
isa_ok( $row, "MyApp::DB::Result::Foo" );
isa_ok( $row->object, "Foo" );
is( $dir->object_to_id( $row->object ), "foo", "kiokudb ID" );
});
}
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
$dir->backend->schema->resultset("Foo")->create({ id => 3, name => "foo", object => Foo->new });
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
my $row = $dir->backend->schema->resultset("Foo")->find(3);
isa_ok( $row, "MyApp::DB::Result::Foo" );
isa_ok( $row->object, "Foo" );
isnt( $dir->object_to_id( $row->object ), "foo", "kiokudb ID" );
$row->object( Foo->new );
isa_ok( $row->object, "Foo", "weakened object with no other refs" );
throws_ok {
$row->update;
} qr/not in storage/, "can't update object without related KiokuDB objects being in storage";
lives_ok { $row->store } "store method works";
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
my $row = $dir->backend->schema->resultset("Foo")->find(1);
my $foo = Foo->new( obj => $row );
$dir->insert( with_dbic => $foo );
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
my $foo = $dir->lookup("with_dbic");
isa_ok( $foo->obj, "DBIx::Class::Row" );
is( $foo->obj->id, 1, "ID" );
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
ok( $dir->exists('dbic:row:["Foo",3]'), "dbic row exists" );
my $foo = $dir->lookup('dbic:row:["Foo",3]');
isa_ok( $foo, "DBIx::Class::Row" );
is( $foo->id, 3, "ID" );
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
my $row = $dir->backend->schema->resultset("Foo")->find(2);
my $foo = Foo->new( obj => $row );
$dir->insert( another => $foo );
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
# to cover the ->search branch (as opposed to ->find)
my @foo = $dir->lookup("with_dbic", "another");
isa_ok( $foo[0]->obj, "DBIx::Class::Row" );
is( $foo[0]->obj->id, 1, "ID" );
isa_ok( $foo[1]->obj, "DBIx::Class::Row" );
is( $foo[1]->obj->id, 2, "ID" );
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
my $obj = $dir->backend->schema->resultset("entries")->find('with_dbic');
is( $dir->object_to_id($obj), 'with_dbic', "object to ID of row fetched using 'find'");
isa_ok( $obj, "Foo" );
isa_ok( $obj->obj, "DBIx::Class::Row" );
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
my $rs = $dir->backend->schema->resultset("Foo")->search({ id => [ 1, 3 ] });
my $foo = Foo->new( obj => $rs );
$dir->insert( with_rs => $foo );
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
my $foo = $dir->lookup("with_rs");
isa_ok( $foo, "Foo" );
my $rs = $foo->obj;
isa_ok( $rs, "DBIx::Class::ResultSet" );
is( refaddr($rs->result_source->schema), refaddr($dir->backend->schema), "schema restored in resultset handle" );
is_deeply(
[ sort { $a->id <=> $b->id } $rs->all ],
[ sort { $a->id <=> $b->id } $dir->backend->schema->resultset("Foo")->search({ id => [ 1, 3 ]})->all ],
"result set works"
);
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
my $rs = $dir->backend->schema->resultset("Foo")->search({ id => [ 1, 3 ] });
my $foo = Foo->new( obj => $dir->backend->schema );
$dir->insert( with_schema => $foo );
});
# FIXME register it as immutable
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
$dir->txn_do( scope => 1, body => sub {
my $foo = $dir->lookup("with_schema");
isa_ok( $foo, "Foo" );
my $rs = $foo->obj;
my $schema = $foo->obj;
isa_ok( $schema, "DBIx::Class::Schema" );
is( refaddr($schema), refaddr($dir->backend->schema), "schema restored" );
});
is_deeply( [ $dir->live_objects->live_objects ], [], "no live objects" );
done_testing;