#!/usr/bin/perl package KiokuDB::Test::Fixture::Small; use Moose; use Test::More; use Test::Exception; use Scalar::Util qw(refaddr); use KiokuDB::Test::Person; use KiokuDB::Test::Employee; use KiokuDB::Test::Company; sub p; use namespace::clean -except => 'meta'; sub p { my @args = @_; unshift @args, "name" if @args % 2; KiokuDB::Test::Person->new(@args); } with qw(KiokuDB::Test::Fixture) => { -excludes => [qw/populate sort/] }; sub sort { -100 } has [qw(joe oscar)] => ( isa => "Str", is => "rw", ); sub create { return ( KiokuDB::Test::Employee->new( name => "joe", age => 52, parents => [ KiokuDB::Test::Person->new( name => "mum", age => 78, ) ], company => KiokuDB::Test::Company->new( name => "OHSOME SOFTWARE KTHX" ), ), KiokuDB::Test::Person->new( name => "oscar", age => 3, ), ); } sub populate { my $self = shift; { my $s = $self->new_scope; my ( $joe, $oscar ) = $self->create; isa_ok( $joe, "KiokuDB::Test::Person" ); isa_ok( $joe, "KiokuDB::Test::Employee" ); isa_ok( $oscar, "KiokuDB::Test::Person" ); my ( $joe_id, $oscar_id ) = $self->store_ok($joe, $oscar); $self->joe($joe_id); $self->oscar($oscar_id); $self->live_objects_are($joe, $joe->company, @{ $joe->parents }, $oscar); } $self->no_live_objects; } sub verify { my $self = shift; $self->txn_lives(sub { my ( $joe, $oscar ) = my @objs = $self->lookup_ok( $self->joe, $self->oscar ); isa_ok( $joe, "KiokuDB::Test::Person" ); isa_ok( $joe, "KiokuDB::Test::Employee" ); isa_ok( $oscar, "KiokuDB::Test::Person" ); my $entry = $self->directory->live_objects->object_to_entry($joe); ok( $entry->has_object, "entry is associated with object" ); is( refaddr($entry->object), refaddr($joe), "the right object" ); is( $joe->name, "joe", "name" ); ok( my $parents = $joe->parents, "parents" ); is( ref($parents), "ARRAY", "array ref" ); is( scalar(@$parents), 1, "one parent" ); isa_ok( $parents->[0], "KiokuDB::Test::Person" ); is( $parents->[0]->name, "mum", "parent name" ); ok( my $company = $joe->company, "company" ); isa_ok( $company, "KiokuDB::Test::Company" ); is( $oscar->name, "oscar", "name" ); lives_ok { $self->directory->lookup("no_such_id") } "lookup of nonexistent ID is nonfatal"; }); } __PACKAGE__ __END__