The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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;