#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw(refaddr reftype blessed); use Storable qw(dclone); use ok 'KiokuDB::TypeMap::Entry::Callback'; use ok 'KiokuDB::TypeMap::Entry::Ref'; use ok 'KiokuDB::TypeMap::Resolver'; use ok 'KiokuDB::Collapser'; use ok 'KiokuDB::Linker'; use ok 'KiokuDB::LiveObjects'; use ok 'KiokuDB::Backend::Hash'; use Tie::RefHash; { package KiokuDB_Test_Foo; use Moose; has bar => ( is => "rw" ); package KiokuDB_Test_Bar; use Moose; has blah => ( is => "rw" ); } tie my %h, 'Tie::RefHash'; $h{KiokuDB_Test_Bar->new( blah => "two" )} = "bar"; my $obj = KiokuDB_Test_Foo->new( bar => \%h, ); for my $i ( 0, 1 ) { my $tr = KiokuDB::TypeMap::Resolver->new( typemap => KiokuDB::TypeMap->new( entries => { 'Tie::RefHash' => KiokuDB::TypeMap::Entry::Callback->new( intrinsic => $i, collapse => "STORABLE_freeze", expand => sub { my ( $class, @args ) = @_; my $self = (bless [], $class); $self->STORABLE_thaw(0, @args); return $self; }, ), ARRAY => KiokuDB::TypeMap::Entry::Ref->new, HASH => KiokuDB::TypeMap::Entry::Ref->new, }, ), ); my $v = KiokuDB::Collapser->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); my $l = KiokuDB::Linker->new( backend => KiokuDB::Backend::Hash->new, live_objects => KiokuDB::LiveObjects->new, typemap_resolver => $tr, ); my $sv = $v->live_objects->new_scope; my $sl = $l->live_objects->new_scope; my ( $buffer, @ids ) = $v->collapse( objects => [ $obj ] ); my $entries = $buffer->_entries; is( scalar(@ids), 1, "one root set ID" ); my $copy = dclone($entries); $l->live_objects->register_entry( $_->id => $_ ) for values %$entries; my $loaded = $l->expand_object($copy->{$ids[0]}); isa_ok( $loaded, "KiokuDB_Test_Foo" ); is( ref(my $h = $loaded->bar), "HASH", "KiokuDB_Test_Foo->bar is a hash" ); isa_ok( tied(%$h), "Tie::RefHash", "tied to Tie::RefHash" ); } done_testing;