File Coverage

blib/lib/KiokuDB/Test/Fixture/TypeMap/Default.pm

Criterion	Covered	Total	%
statement	166	211	78.6
branch	13	30	43.3
condition	0	9	0.0
subroutine	27	29	93.1
pod	0	3	0.0
total	206	282	73.0

#!/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__