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 Test::Moose;

use KiokuDB::Backend::Serialize::JSPON;
use KiokuDB::Backend::Serialize::JSON;
use KiokuDB::Entry;
use KiokuDB::Reference;

{
    package KiokuDB_Test_Foo;
    use Moose;

    with qw(KiokuDB::Backend::Serialize::JSON);
}

my $entry = KiokuDB::Entry->new(
    id => "foo",
    class => "Hello",
    class_meta => {
        roles => [qw(Greeting)],
    },
    root => 1,
    data => {
        id => "id_attribute",
        bar => KiokuDB::Reference->new( id => "bar", is_weak => 1 ),
        foo => { '$ref' => "lala" },
        'public::moose' => 'elk',
    },
);

my $tied = KiokuDB::Entry->new(
    tied => "H",
    data => KiokuDB::Entry->new(
        id => "bar",
        data => {
            foo => "bar",
        },
    ),
);

{
    my $x = KiokuDB_Test_Foo->new;

    does_ok( $x, "KiokuDB::Backend::TypeMap::Default" );
    does_ok( $x, "KiokuDB::Backend::Serialize" );

    isa_ok( $x->default_typemap, "KiokuDB::TypeMap::Default::JSON" );

    isa_ok( $x->collapser, "KiokuDB::Backend::Serialize::JSPON::Collapser" );

    isa_ok( $x->expander, "KiokuDB::Backend::Serialize::JSPON::Expander" );


    my $jspon = $x->collapse_jspon($entry);

    is_deeply(
        $jspon,
        {
            __CLASS__ => "Hello",
            __META__  => { roles => [qw(Greeting)] },
            id        => "foo",
            data      => {
                "public::id"            => "id_attribute",
                bar                     => { '$ref' => "bar.data", weak => 1 },
                foo                     => { 'public::$ref' => "lala" },
                'public::public::moose' => "elk",
            },
            root      => JSON::true,
        },
        "collapsed jspon",
    );

    my $obj = $x->expand_jspon($jspon);

    is_deeply( $obj->data, $entry->data, "expanded jspon" );


    is( $obj->id, "foo", "ID" );
    is( $obj->class, "Hello", "class" );

    ok( !$obj->deleted, "not deleted" );
    ok( $obj->root, "root" );

    my $json = $x->serialize($entry);

    ok( !ref($json), "json is not a ref" );

    ok( !utf8::is_utf8($json), "already encoded (not unicode)" );

    is_deeply( $x->deserialize($json), $entry, "round tripping" );
}

{
    my $x = KiokuDB_Test_Foo->new(
        id_field => "_id",
        class_field => "class",
        inline_data => 1,
    );

    my $jspon = $x->collapse_jspon($entry);

    is_deeply(
        $jspon,
        {
            class                   => "Hello",
            __META__                => { roles => [qw(Greeting)] },
            _id                     => "foo",
            root                    => JSON::true,
            id                      => "id_attribute",
            bar                     => { '$ref' => "bar", weak => 1 },
            foo                     => { 'public::$ref' => "lala" },
            'public::public::moose' => "elk",
        },
        "collapsed jspon",
    );

    my $obj = $x->expand_jspon($jspon);

    is_deeply( $obj->data, $entry->data, "expanded jspon" );


    is( $obj->id, "foo", "ID" );
    is( $obj->class, "Hello", "class" );

    ok( !$obj->deleted, "not deleted" );
    ok( $obj->root, "root" );
}

{
    my $x = KiokuDB_Test_Foo->new;

    my $jspon = $x->collapse_jspon($tied);

    is_deeply(
        $jspon,
        {
            tied => "H",
            data => {
                id => "bar",
                data => { foo => "bar" },
            },
        },
        "collapsed jspon",
    );

    my $obj = $x->expand_jspon($jspon);

    isa_ok( $obj->data, "KiokuDB::Entry" );

    is_deeply( $obj->data->data, $tied->data->data, "expanded jspon" );

    ok( !$obj->has_id, "no id" );
    ok( !$obj->has_class, "no class" );

    ok( !$obj->deleted, "not deleted" );
    ok( !$obj->root, "not root" );

    is( $obj->tied, "H", "'tied' field" );

    $jspon->{tied} = "HASH";

    my $legacy = $x->expand_jspon($jspon);

    is( $legacy->tied, "H", "legacy 'tied' field upgraded" );

}


done_testing;