#!/usr/bin/perl use utf8; package KiokuDB::Test::Fixture::TypeMap::Default; use Moose; use Encode; use Test::More; use Test::Moose; use Try::Tiny; use KiokuDB::Test::Person; use KiokuDB::Test::Employee; use KiokuDB::Test::Company; use namespace::clean -except => 'meta'; use constant required_backend_roles => qw(TypeMap::Default); use Tie::RefHash; use constant HAVE_DATETIME => try { require DateTime }; use constant HAVE_DATETIME_FMT => try { require DateTime::Format::Strptime }; use constant HAVE_URI => try { require URI }; use constant HAVE_URI_WITH_BASE => try { require URI::WithBase }; use constant HAVE_AUTHEN_PASSPHRASE => try { require Authen::Passphrase::SaltedDigest }; use constant HAVE_PATH_CLASS => try { require Path::Class }; use constant HAVE_IXHASH => try { require Tie::IxHash }; use constant HAVE_MX_TRAITS => try { require MooseX::Traits }; use constant HAVE_MX_OP => try { require MooseX::Object::Pluggable }; { package Some::Role; use Moose::Role; has role_attr => ( is => "rw" ); package Some::Other::Role; use Moose::Role; has other_role_attr => ( is => "rw" ); package Some::Third::Role; use Moose::Role; sub a_role_method { "hello" } package Some::Class; use Moose; if ( KiokuDB::Test::Fixture::TypeMap::Default::HAVE_MX_TRAITS ) { with qw(MooseX::Traits); } if ( KiokuDB::Test::Fixture::TypeMap::Default::HAVE_MX_OP ) { with qw(MooseX::Object::Pluggable); } has name => ( is => "rw" ); } with qw(KiokuDB::Test::Fixture) => { -excludes => 'required_backend_roles' }; sub create { tie my %refhash, 'Tie::RefHash'; $refhash{["foo"]} = "bar"; $refhash{"blah"} = "oink"; my %ixhash; tie %ixhash, 'Tie::IxHash' if HAVE_IXHASH; %ixhash = ( first => 1, second => "yes", third => "maybe", fourth => "a charm" ); my $homer = KiokuDB::Test::Employee->new( name => "Homer Simpson", company => KiokuDB::Test::Company->new( name => "Springfield Power Plant", ), ); Some::Role->meta->apply($homer); $homer->role_attr("foo"); my $foo = "blah"; my @x = ( 1 ); return ( scalar => \$foo, refhash => \%refhash, coderef => sub { $x[0]++; }, HAVE_IXHASH ? ( ixhash => \%ixhash ) : (), HAVE_DATETIME ? ( datetime => { obj => DateTime->now } ) : (), HAVE_DATETIME_FMT ? ( datetime_fmt => { obj => DateTime->now(formatter => DateTime::Format::Strptime->new( pattern => '%F' ) ) } ) : (), HAVE_PATH_CLASS ? ( path_class => { obj => Path::Class::file('bar', 'foo.txt') } ) : (), HAVE_URI ? ( uri => { obj => URI->new('http://www.google.com/') } ) : (), HAVE_URI_WITH_BASE ? ( with_base => { obj => URI::WithBase->new( URI->new('foo'), URI->new('http://www.google.com/') ), }, ) : (), HAVE_AUTHEN_PASSPHRASE ? ( passphrase => { obj => Authen::Passphrase::SaltedDigest->new( algorithm => "SHA-1", salt_random => 20, passphrase => "passphrase" ), }, ) : (), HAVE_MX_TRAITS ? ( traits => { obj => Some::Class->new_with_traits( traits => [qw(Some::Other::Role Some::Third::Role)], name => "blah", other_role_attr => "foo", ), }, ) : (), HAVE_MX_OP ? ( op_one => do { my $obj = Some::Class->new( name => "first" ); $obj->load_plugin("+Some::Other::Role"); $obj->other_role_attr("after"); $obj; }, op_two => do { my $obj = Some::Class->new( name => "second" ); $obj->load_plugin("+Some::Other::Role"); $obj->other_role_attr("after"); $obj->load_plugin("+Some::Third::Role"); $obj; }, ) : (), homer => $homer, ); } sub verify { my $self = shift; { my $s = $self->new_scope; my $scalar = $self->lookup_ok("scalar"); is( ref($scalar), "SCALAR", "reftype for scalar" ); is( $$scalar, "blah", "value" ); } $self->no_live_objects; { my $s = $self->new_scope; my $rh = $self->lookup_ok("refhash"); is( ref($rh), "HASH", "plain hash" ); isa_ok( tied(%$rh), "Tie::RefHash", "tied" ); is_deeply( [ sort { ref($a) ? -1 : ( ref($b) ? 1 : ( $a cmp $b ) ) } keys %$rh ], [ ["foo"], "blah" ], "keys" ); } $self->no_live_objects; { my $s = $self->new_scope; my $c = $self->lookup_ok("coderef"); is( ref($c), "CODE", "coderef" ); is( $c->(), 1, "invoke closure" ); is( $c->(), 2, "invoke closure" ); } $self->no_live_objects; { my $s = $self->new_scope; my $c = $self->lookup_ok("coderef"); is( ref($c), "CODE", "coderef" ); is( $c->(), 1, "invoke closure" ); is( $c->(), 2, "invoke closure" ); $self->store_ok($c); } $self->no_live_objects; { my $s = $self->new_scope; my $c = $self->lookup_ok("coderef"); is( ref($c), "CODE", "coderef" ); is( $c->(), 3, "closure updated" ); } $self->no_live_objects; { my $s = $self->new_scope; my $homer = $self->lookup_ok("homer"); isa_ok( $homer, "KiokuDB::Test::Person" ); is( $homer->name, "Homer Simpson", "class attr" ); does_ok( $homer, "Some::Role", "does runtime role" ); is( $homer->role_attr, "foo", "role attr" ); ok( $homer->meta->is_anon_class, "anon class" ); isa_ok( $homer->company, "KiokuDB::Test::Company" ); undef $homer; } if ( HAVE_IXHASH ) { $self->no_live_objects; my $s = $self->new_scope; my $ix = $self->lookup_ok("ixhash"); is( ref($ix), "HASH", "plain hash" ); isa_ok( tied(%$ix), "Tie::IxHash", "tied" ); is_deeply( [ keys %$ix ], [ qw(first second third fourth) ], "key order preserved" ); } if ( HAVE_DATETIME ) { $self->no_live_objects; my $s = $self->new_scope; my $date = $self->lookup_ok("datetime")->{obj}; isa_ok( $date, "DateTime" ); } if ( HAVE_DATETIME_FMT ) { $self->no_live_objects; my $s = $self->new_scope; my $date = $self->lookup_ok("datetime_fmt")->{obj}; isa_ok( $date, "DateTime" ); SKIP: { skip "Not possible with JSON atm", 1 if ( ( $self->directory->backend->can("serializer") and $self->directory->backend->serializer->isa('KiokuDB::Serializer::JSON') ) or $self->directory->backend->does("KiokuDB::Backend::Serialize::JSON") or $self->directory->backend->does("KiokuDB::Backend::Serialize::JSPON") ); isa_ok( $date->formatter, "DateTime::Format::Strptime" ); } } if ( HAVE_URI ) { $self->no_live_objects; my $s = $self->new_scope; my $uri = $self->lookup_ok("uri")->{obj}; isa_ok( $uri, "URI" ); is( "$uri", "http://www.google.com/", "uri" ); } if ( HAVE_URI_WITH_BASE ) { $self->no_live_objects; my $s = $self->new_scope; my $uri = $self->lookup_ok("with_base")->{obj}; isa_ok( $uri, "URI::WithBase" ); isa_ok( $uri->base, "URI" ); } if ( HAVE_PATH_CLASS ) { $self->no_live_objects; my $s = $self->new_scope; my $file = $self->lookup_ok("path_class")->{obj}; isa_ok( $file, "Path::Class::Entity" ); isa_ok( $file, "Path::Class::File" ); is( $file->basename, "foo.txt", "basename" ); } if ( HAVE_MX_TRAITS ) { $self->no_live_objects; my $s = $self->new_scope; my $obj = $self->lookup_ok("traits")->{obj}; does_ok( $obj, "Some::Other::Role" ); does_ok( $obj, "Some::Third::Role" ); is( $obj->other_role_attr, "foo", "trait attr" ); is( $obj->name, "blah", "normal attr" ); } if ( HAVE_MX_OP ) { $self->no_live_objects; my $s = $self->new_scope; my $one = $self->lookup_ok("op_one"); does_ok( $one, "Some::Other::Role" ); is( $one->other_role_attr, "after", "role attr" ); my $two = $self->lookup_ok("op_two"); does_ok( $two, "Some::Other::Role" ); does_ok( $two, "Some::Third::Role" ); is( eval { $two->other_role_attr }, "after", "role attr" ); } } __PACKAGE__ __END__