#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Set::Object;
use constant HAVE_URI => eval { require URI };
use constant HAVE_DATETIME => eval { require DateTime; require DateTime::Duration };
use constant HAVE_PATH_CLASS => eval { require Path::Class };
use ok "KiokuDB::TypeMap::Entry::Callback";
use ok "KiokuDB::TypeMap::Entry::Passthrough";
use ok "KiokuDB::TypeMap";
use ok "KiokuDB::Backend::Hash";
use ok "KiokuDB";
{
package KiokuDB_Test_Foo;
use Moose;
has foo => (
isa => "Set::Object",
is => "ro",
);
has scalar_ref => (
is => "ro",
default => sub { my $x = "foo"; \$x },
);
has scalar_ref_ref => (
is => "ro",
default => sub { my $x = "foo"; my $y = \$x; \$y },
);
if ( ::HAVE_DATETIME ) {
has date => (
isa => "DateTime",
is => "ro",
default => sub { DateTime->now },
);
has duration => (
isa => "DateTime::Duration",
is => "ro",
default => sub {
DateTime::Duration->new(
years => 3,
months => 5,
weeks => 1,
days => 1,
hours => 6,
minutes => 15,
seconds => 45,
nanoseconds => 12000,
);
},
);
}
if ( ::HAVE_URI ) {
has uri => (
isa => "URI",
is => "ro",
default => sub { URI->new("http://www.google.com") },
);
}
if ( ::HAVE_PATH_CLASS ) {
has stuff => (
isa => "Path::Class::File",
is => "ro",
default => sub { Path::Class::file("foo.jpg") },
);
}
}
foreach my $format ( qw(memory storable json), eval { require YAML::XS; "yaml" } ) {
my $t = KiokuDB::TypeMap->new(
isa_entries => {
'Set::Object' => KiokuDB::TypeMap::Entry::Callback->new(
intrinsic => 1,
collapse => "members",
expand => "new",
),
'Path::Class::File' => KiokuDB::TypeMap::Entry::Callback->new(
intrinsic => 1,
collapse => "stringify",
expand => "new",
),
'Path::Class::Dir' => KiokuDB::TypeMap::Entry::Callback->new(
intrinsic => 1,
collapse => "stringify",
expand => "new",
),
'URI' => KiokuDB::TypeMap::Entry::Callback->new(
intrinsic => 1,
collapse => "as_string",
expand => "new",
),
'DateTime' => ( $format eq 'json' )
? KiokuDB::TypeMap::Entry::Callback->new( intrinsic => 1, collapse => "epoch", expand => sub { shift->from_epoch( epoch => $_[0] ) } )
: KiokuDB::TypeMap::Entry::Passthrough->new( intrinsic => 1 ),
},
);
my $k = KiokuDB->new(
backend => KiokuDB::Backend::Hash->new( serializer => $format ),
typemap => $t,
);
my $id;
{
my $foo = KiokuDB_Test_Foo->new(
foo => Set::Object->new(
KiokuDB_Test_Foo->new,
),
);
my $s = $k->new_scope;
$id = $k->store($foo);
ok( $id, "got id" );
}
{
my $s = $k->new_scope;
my $foo = $k->lookup($id);
isa_ok( $foo, "KiokuDB_Test_Foo" );
is( ref($foo->scalar_ref), "SCALAR", "scalar ref" );
is_deeply( $foo->scalar_ref, \"foo", "value" );
{
local $TODO = $format eq 'yaml' && "YAML incorrectly thinks scalar refs with weaken backref magic are objects";
is( ref($foo->scalar_ref_ref), "REF", "scalar ref (REF reftype)" );
is_deeply( $foo->scalar_ref_ref, \\"foo", "value" );
}
if ( HAVE_DATETIME ) {
isa_ok( $foo->date, "DateTime" );
isa_ok( $foo->duration, "DateTime::Duration" );
}
if ( HAVE_URI ) {
isa_ok( $foo->uri, "URI" );
}
if ( HAVE_PATH_CLASS ) {
isa_ok( $foo->stuff, "Path::Class::File" );
is( $foo->stuff->basename, 'foo.jpg', "value" );
}
isa_ok( $foo->foo, "Set::Object" );
isa_ok( ( $foo->foo->members )[0], "KiokuDB_Test_Foo", 'set enumeration' );
}
}
done_testing;