#!perl -w # $Id$ use strict; use warnings; my $initialstorage; BEGIN { use lib 't/lib'; use Handel::Test; use Scalar::Util qw/refaddr/; eval 'use Test::MockObject 1.07'; if (!$@) { plan tests => 29; } else { plan skip_all => 'Test::MockObject 1.07 not installed'; }; $initialstorage = bless {}, 'Handel::Storage'; Test::MockObject->fake_module('Handel::Storage' => ( new => sub {$initialstorage}, _item_storage => sub {} )); use_ok('Handel::Base'); use_ok('Handel::Exception', ':try'); }; ## get storage on class { my $storage = Handel::Base->storage; isa_ok($storage, 'Handel::Storage', 'storage returns Handel::Storage'); is(refaddr $storage, refaddr $initialstorage, 'class storage call returns class storage'); }; ## get storage on object with no object storage { my $base = bless {}, 'Handel::Base'; my $storage = $base->storage; isa_ok($storage, 'Handel::Storage', 'storage returns Handel::Storage'); is(refaddr $storage, refaddr $initialstorage, 'object storage call returns class storage'); }; ## get storage on object with with object storage first { my $storage = bless {}, 'Handel::Storage'; my $base = bless {storage => $storage}, 'Handel::Base'; my $newstorage = $base->storage; isa_ok($newstorage, 'Handel::Storage', 'storage returns Handel::Storage'); is(refaddr $newstorage, refaddr $storage, 'object storage call returns object storage'); isnt(refaddr $newstorage, refaddr $initialstorage, 'object storage no class storage'); }; ## set item storage if item class is set and no _item_storage exists { my $storage = Test::MockObject->new; $storage->set_false('_item_storage'); $storage->mock('item_storage', sub { my ($self, $s) = @_; $self->{'is'} = $s if $s; return $self->{'is'}; }); my $itemstorage = Test::MockObject->new; Test::MockObject->fake_module('FakeItemClass' => ( storage => sub {$itemstorage} )); my $base = bless{item_class => 'FakeItemClass', storage => $storage}, 'Handel::Base'; my $newstorage = $base->storage; is(refaddr $newstorage, refaddr $storage, 'storage returned object storage'); is(refaddr $itemstorage, refaddr $newstorage->item_storage, 'item storage set if item_class is set'); ok($storage->called('item_storage'), 'item_storage was called'); }; ## don't item storage if item class is set but _item_storage exists { my $storage = Test::MockObject->new; $storage->set_true('_item_storage'); $storage->set_always('item_storage' => 'foo'); Test::MockObject->fake_new('FakeItemClass'); my $base = bless{item_class => 'FakeItemClass', storage => $storage}, 'Handel::Base'; my $newstorage = $base->storage; is(refaddr $newstorage, refaddr $storage, 'storage returned object storage'); ok(!$storage->called('item_storage'), 'never called item_Storage'); is($newstorage->item_storage, 'foo', 'item storage left alone'); }; ## pass args to setup if specified { my $storage = Test::MockObject->new; $storage->set_true('_item_storage'); $storage->mock('setup' => sub { my ($self, $args) = @_; $self->{'args'} = $args if $args; return $self->{'args'}; }); my $base = bless{storage => $storage}, 'Handel::Base'; my $newstorage = $base->storage({'foo' => 'bar'}); ok($storage->called('setup'), 'setup called with args'); is_deeply($newstorage->{'args'}, {'foo' => 'bar'}, 'setup called with args'); }; ## don't assign storage if it's not a Handel::Storage subclass { my $storage = Test::MockObject->new; $storage->set_true('_item_storage'); my $newstorage = Test::MockObject->new; my $base = bless {storage => $storage}, 'Handel::Base'; $base->storage($storage); is(refaddr $base->storage, refaddr $storage, 'non isa storage not set'); }; ## assign storage to class if it's a Handel::Storage subclass { my $storage = Test::MockObject->new; $storage->set_true('_item_storage'); my $newstorage = Test::MockObject->new; $newstorage->set_true('_item_storage'); $newstorage->set_isa('Handel::Storage'); Handel::Base->storage($newstorage); is(refaddr $Handel::Base::_storage, refaddr $newstorage, 'isa storage set'); }; ## assign storage to object if it's a Handel::Storage subclass { my $storage = Test::MockObject->new; $storage->set_true('_item_storage'); my $newstorage = Test::MockObject->new; $newstorage->set_true('_item_storage'); $newstorage->set_isa('Handel::Storage'); my $base = bless {storage => $storage}, 'Handel::Base'; $base->storage($newstorage); is(refaddr $base->storage, refaddr $newstorage, 'isa storage set'); }; ## has_storage returns undef if nothing is set on class { local $Handel::Base::_storage = undef; is(Handel::Base->has_storage, undef, 'has no storage'); }; ## has_storage returns undef if nothing is set on object { local $Handel::Base::_storage = undef; my $base = bless {}, 'Handel::Base'; is($base->has_storage, undef, 'has no storage'); }; ## has_storage returns 1 if set on class { local $Handel::Base::_storage = 1; is(Handel::Base->has_storage, 1, 'has class storage'); }; ## has_storage returns 1 if set on class { local $Handel::Base::_storage = 1; my $base = bless {}, 'Handel::Base'; is($base->has_storage, 1, 'has class storage'); }; ## has_storage returns 1 if set on object { local $Handel::Base::_storage = undef; my $base = bless {storage => 1}, 'Handel::Base'; is($base->has_storage, 1, 'has class storage'); }; # get supers storage { Test::MockObject->fake_new('MyStorage'); @MyStorage::ISA = 'Handel::Base'; $MyStorage::_storage = undef; my $clonestorage = bless {}, 'Handel::Storage'; Test::MockObject->fake_module('Handel::Storage' => ( clone => sub {$clonestorage} )); my $storage = bless {}, 'Handel::Storage'; local $Handel::Base::_storage = $storage; my $newstorage = MyStorage->storage; is(refaddr $newstorage, refaddr $clonestorage, 'received clone storage from super'); }; # don't get supers storage if it's not the same as our storage class { Test::MockObject->fake_new('MyStorage'); @MyStorage::ISA = 'Handel::Base'; $MyStorage::_storage = undef; my $createstorage = bless {}, 'Handel::Storage'; Test::MockObject->fake_module('Handel::Storage' => ( new => sub {$createstorage} )); my $storage = bless {}, 'Not::Handel::Storage'; local $Handel::Base::_storage = $storage; my $newstorage = MyStorage->storage; is(refaddr $newstorage, refaddr $createstorage, 'received new storage from self'); }; # get supers storage and unset cloned item storage { Test::MockObject->fake_new('MyStorage'); @MyStorage::ISA = 'Handel::Base'; $MyStorage::_storage = undef; my $clonestorage = bless {_item_storage => 1}, 'Handel::Storage'; Test::MockObject->fake_module('Handel::Storage' => ( clone => sub {$clonestorage}, _item_storage => sub { my $self = shift; if (@_) { $self->{'_item_storage'} = shift; }; return $self->{'_item_storage'}; } )); my $storage = bless {}, 'Handel::Storage'; local $Handel::Base::_storage = $storage; my $newstorage = MyStorage->storage; is(refaddr $newstorage, refaddr $clonestorage, 'received clone storage from super'); is($newstorage->_item_storage, undef, 'item storage was unset'); };