The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
##
## Tests for Pixie::LiveObjectManager
##

use lib 't/lib';
use blib;
use strict;
use warnings;

use Test::More qw( no_plan );
use Test::Exception;
use Scalar::Util qw( weaken isweak );

use MockPixie qw( $pixie );

BEGIN { use_ok( 'Pixie::LiveObjectManager' ); }

$pixie->mock( lock_strategy => sub { } );

my $lom = Pixie::LiveObjectManager->new;

isa_ok( $lom->{_live_cache}, 'HASH', '_live_cache' );

## set_pixie
$lom->set_pixie( $pixie );
ok( isweak( $lom->{pixie} ), 'set_pixie' );

## cache: _insert / _get / _delete / _size / _keys
{
    my $obj = bless {}, 'Foo';

    is( $lom->cache_size, 0,           'cache_size' );
    is_deeply( [$lom->cache_keys], [], 'cache_keys' );

    my ($oid, $obj2) = $lom->cache_insert( $obj );
    ok( $oid,        ' cache_insert returns oid' );
    is( $obj2, $obj, ' cache_insert return obj' );

    ok( isweak( $lom->{_live_cache}{$oid} ), 'obj in cache is a weak copy' );
    is( $lom->cache_size, 1, 'cache_size' );

    my @keys = $lom->cache_keys;
    is( $keys[0], $oid, 'cache_keys' );

    my $obj3 = $lom->cache_get( $oid );
    is( $obj3, $obj, 'cache_get' );

    my $obj4 = $lom->cache_delete( $oid );
    isa_ok( $obj4, 'Pixie::ObjectInfo', 'cache_delete' );
    is( $obj4->the_object, $obj,        ' points to obj' );
    is( $lom->cache_get( $oid ), undef, ' cant get from cache anymore' );
}


## get_oid_for / get_info_for / get_info_for_oid
{
    my $obj = bless {}, 'Foo';
    my $oid = $lom->get_oid_for( $obj );
    ok( $oid, 'get_oid_for( obj )' );
    throws_ok
      { $lom->get_oid_for( bless {}, 'Pixie::ObjectInfo' ) }
      qr/can.t get oid for/i,
      'get_oid_for( object info';

    my $info1 = $lom->get_info_for( $obj );
    isa_ok( $info1, 'Pixie::ObjectInfo', 'get_info_for( obj )' );

    $lom->cache_insert( $obj );
    my $info2 = $lom->get_info_for( $oid );
    isa_ok( $info2, 'Pixie::ObjectInfo', 'get_info_for( oid )' );

    $lom->cache_delete( $oid );
    is( $lom->get_info_for( $oid ), undef, 'get_info_for( oid ), not cached' );
}

## bind_object_to_oid
{
    my $obj = bless {}, 'Foo';
    my $oid = 'test oid';

    no warnings;
    local *Pixie::get_the_current_lock_strategy = sub { };
    use warnings;

    my $ret = $lom->bind_object_to_oid( $obj => $oid );
    ok( $ret, 'bind_object_to_oid' );
  TODO: {
	local $TODO = 'return self';
	is( $ret, $lom, ' bind_object_to_oid retval' );
    }

    is( $obj->PIXIE::oid, $oid, ' sets oid' );

    # try overwriting another obj's info:
    $lom->cache_insert( $obj );

    my $obj2 = bless {}, 'Bar';
    $lom->bind_object_to_oid( $obj2 => $oid );
    is( $obj2->PIXIE::oid, $oid, 'bind_object_to_oid, overwrite obj w/same oid' );
  TODO: {
	local $TODO = 'remove info from old object?';
	is( $obj2->PIXIE::get_info->the_object, $obj2, ' points to right obj' );
	isnt( $obj->PIXIE::oid, $oid, ' old object oid reset' );
    }
}

## assert_ownership_of
{
    my $obj = bless {}, 'Foo';

    $pixie->mock( manages_object => sub { 1 } );
    ok( $lom->assert_ownership_of( $obj ), 'assert_ownership_of' );

    $pixie->mock( manages_object => sub { 0 } );
    throws_ok
      { $lom->assert_ownership_of( $obj ) }
      qr/not managed by/,
      'assert_ownership_of (not managed by me)';
}

## lock_object / unlock_object
{
    my $obj = bless {}, 'Foo';

    $pixie->mock( store             => sub { $_[0] } )
          ->mock( manages_object    => sub { 1 } )
          ->mock( lock_object_for   => sub { 'locked' } )
          ->mock( unlock_object_for => sub { 'unlocked' } );
    is( $lom->lock_object( $obj ), 'locked',     'lock_object' );
    is( $lom->unlock_object( $obj ), 'unlocked', 'unlock_object' );

    is( $lom->lock_strategy_for( $obj => 'foo' ), 'foo', 'lock_strategy_for (set)' );
    is( $lom->lock_strategy_for( $obj ), 'foo',          'lock_strategy_for (get)' );
}

## DESTROY
{
    my $obj = bless {}, 'Foo';
    $lom->cache_insert( $obj );
    ok( $obj->PIXIE::get_info, 'object has info before destroy' );

    weaken( $lom ); # call DESTROY
    is( $lom, undef, 'obj manager destroyed when weakened' );
    ok( !$obj->Pixie::Info::px_get_info, 'object has no info after destroy' );
}