Method-Delegation
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
t/delegate.t view on Meta::CPAN
maybe_to => 'fourth',
);
delegate(
methods => [qw/oui non/],
maybe_to => 'fifth',
else_return => 'fail!',
);
sub foo { return 'foo' }
}
ok my $object = First->new,
'We should be able to create an object which delegates to another object';
is $object->name, 'Second', '... and have the delegated methods work';
is $object->reverse('foobar'), 'raboof',
'... and we can send arguments, if needed';
ok !$object->this, '... and methods we cannot delegate return false';
is $object->non, 'fail!',
'... and else_return can specify a return value if the method returns false';
is $object->shortcut, 'something',
'Our "maybe_to" shortcut should work as intended';
ok !$object->faily_fail, '... even if the delegated object does not exist';
is $object->maybe_something, 'something', 'Using "maybe_to" works as expected';
# exceptions
# main:: is not a class and we have nothing to delegate to,
# but that doesn't stop us from testing exceptions
my %delegate;
throws_ok { delegate(%delegate) }
qr/\QYou must supply a 'to' argument to delegate()/,
'Not specifing a method to delegate to should fail';
$delegate{to} = 'frobnitz';
throws_ok { delegate(%delegate) }
qr/\QYou must supply a 'methods' argument to delegate()/,
'... not specifing methods to delegate should fail';
$delegate{methods} = qr/name/;
throws_ok { delegate(%delegate) }
qr/\QI don't know how to delegate to 'frobnitz' from/,
'... and specifying something "weird" for methods should fail';
$delegate{methods} = '111egal method name';
throws_ok { delegate(%delegate) }
qr/\QIllegal method name: '111egal method name'/,
'... and specifying illegal method names should fail';
$delegate{maybe_to} = 'whatever';
throws_ok { delegate(%delegate) }
qr/\QYou supplied both 'maybe_to' and 'to'. I don't know which to use./,
'Supplying both "to" and "maybe_to" should fail';
done_testing;
{
package Second;
sub new {
my $class = shift;
return bless {} => $class;
}
sub name { return __PACKAGE__ }
}
{
package Third;
sub new { bless {} => shift }
sub frobnicate {
my ( $self, $string ) = @_;
return scalar reverse $string;
}
sub returns_something { 'something' }
}
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.706 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )