use
5.008;
use
constant {
true
=> !!1,
false
=> !!0 };
BEGIN {
has
attr
=> (
is
=>
'rwp'
,
isa
=> CodeRef,
handles_via
=>
'Code'
,
handles
=> {
'my_execute'
=>
'execute'
,
'my_execute_list'
=>
'execute_list'
,
'my_execute_method'
=>
'execute_method'
,
'my_execute_method_list'
=>
'execute_method_list'
,
'my_execute_method_scalar'
=>
'execute_method_scalar'
,
'my_execute_method_void'
=>
'execute_method_void'
,
'my_execute_scalar'
=>
'execute_scalar'
,
'my_execute_void'
=>
'execute_void'
,
},
default
=>
sub
{
sub
{} },
);
};
can_ok(
'My::Class'
,
'my_execute'
);
subtest
'Testing my_execute'
=>
sub
{
my
$e
= exception {
my
$coderef
=
sub
{
'code'
};
my
$object
= My::Class->new(
attr
=>
$coderef
);
$object
->my_execute( 1, 2, 3 );
};
is(
$e
,
undef
,
'no exception thrown running execute example'
);
};
can_ok(
'My::Class'
,
'my_execute_list'
);
subtest
'Testing my_execute_list'
=>
sub
{
my
$e
= exception {
my
$context
;
my
$coderef
=
sub
{
$context
=
wantarray
();
'code'
};
my
$object
= My::Class->new(
attr
=>
$coderef
);
my
$result
=
$object
->my_execute_list( 1, 2, 3 );
is_deeply(
$result
, [
'code'
],
q{$result deep match}
);
ok(
$context
,
q{$context is true}
);
};
is(
$e
,
undef
,
'no exception thrown running execute_list example'
);
};
can_ok(
'My::Class'
,
'my_execute_method'
);
subtest
'Testing my_execute_method'
=>
sub
{
my
$e
= exception {
my
$coderef
=
sub
{
'code'
};
my
$object
= My::Class->new(
attr
=>
$coderef
);
$object
->my_execute_method( 1, 2, 3 );
};
is(
$e
,
undef
,
'no exception thrown running execute_method example'
);
};
can_ok(
'My::Class'
,
'my_execute_method_list'
);
subtest
'Testing my_execute_method_list'
=>
sub
{
my
$e
= exception {
my
$context
;
my
$coderef
=
sub
{
$context
=
wantarray
();
'code'
};
my
$object
= My::Class->new(
attr
=>
$coderef
);
my
$result
=
$object
->my_execute_method_list( 1, 2, 3 );
is_deeply(
$result
, [
'code'
],
q{$result deep match}
);
ok(
$context
,
q{$context is true}
);
};
is(
$e
,
undef
,
'no exception thrown running execute_method_list example'
);
};
can_ok(
'My::Class'
,
'my_execute_method_scalar'
);
subtest
'Testing my_execute_method_scalar'
=>
sub
{
my
$e
= exception {
my
$context
;
my
$coderef
=
sub
{
$context
=
wantarray
();
'code'
};
my
$object
= My::Class->new(
attr
=>
$coderef
);
my
$result
=
$object
->my_execute_method_scalar( 1, 2, 3 );
is(
$result
,
'code'
,
q{$result is 'code'}
);
ok( !(
$context
),
q{$context is false}
);
};
is(
$e
,
undef
,
'no exception thrown running execute_method_scalar example'
);
};
can_ok(
'My::Class'
,
'my_execute_method_void'
);
subtest
'Testing my_execute_method_void'
=>
sub
{
my
$e
= exception {
my
$context
;
my
$coderef
=
sub
{
$context
=
wantarray
();
'code'
};
my
$object
= My::Class->new(
attr
=>
$coderef
);
my
$result
=
$object
->my_execute_method_void( 1, 2, 3 );
is(
$result
,
undef
,
q{$result is undef}
);
is(
$context
,
undef
,
q{$context is undef}
);
};
is(
$e
,
undef
,
'no exception thrown running execute_method_void example'
);
};
can_ok(
'My::Class'
,
'my_execute_scalar'
);
subtest
'Testing my_execute_scalar'
=>
sub
{
my
$e
= exception {
my
$context
;
my
$coderef
=
sub
{
$context
=
wantarray
();
'code'
};
my
$object
= My::Class->new(
attr
=>
$coderef
);
my
$result
=
$object
->my_execute_scalar( 1, 2, 3 );
is(
$result
,
'code'
,
q{$result is 'code'}
);
ok( !(
$context
),
q{$context is false}
);
};
is(
$e
,
undef
,
'no exception thrown running execute_scalar example'
);
};
can_ok(
'My::Class'
,
'my_execute_void'
);
subtest
'Testing my_execute_void'
=>
sub
{
my
$e
= exception {
my
$context
;
my
$coderef
=
sub
{
$context
=
wantarray
();
'code'
};
my
$object
= My::Class->new(
attr
=>
$coderef
);
my
$result
=
$object
->my_execute_void( 1, 2, 3 );
is(
$result
,
undef
,
q{$result is undef}
);
is(
$context
,
undef
,
q{$context is undef}
);
};
is(
$e
,
undef
,
'no exception thrown running execute_void example'
);
};
subtest
q{Using execute_method (extended example)}
=>
sub
{
my
$e
= exception {
{
has
name
=> (
is
=>
'ro'
,
isa
=> Str,
default
=>
'Main Process'
,
);
my
$NULL_CODEREF
=
sub
{};
has
_debug
=> (
is
=>
'ro'
,
isa
=> CodeRef,
handles_via
=>
'Code'
,
handles
=> {
debug
=>
'execute_method'
},
default
=>
sub
{
$NULL_CODEREF
},
init_arg
=>
'debug'
,
);
sub
_do_stuff {
my
$self
=
shift
;
$self
->debug(
'continuing process'
);
return
;
}
sub
run_process {
my
$self
=
shift
;
$self
->debug(
'starting process'
);
$self
->_do_stuff;
$self
->debug(
'ending process'
);
}
}
my
$p1
= My::Processor->new(
name
=>
'First Process'
);
$p1
->run_process;
my
@got
;
my
$p2
= My::Processor->new(
name
=>
'Second Process'
,
debug
=>
sub
{
my
(
$processor
,
$message
) =
@_
;
push
@got
,
sprintf
(
'%s: %s'
,
$processor
->name,
$message
);
},
);
$p2
->run_process;
my
@expected
= (
'Second Process: starting process'
,
'Second Process: continuing process'
,
'Second Process: ending process'
,
);
is_deeply( \
@got
, \
@expected
,
q{\@got deep match}
);
};
is(
$e
,
undef
,
'no exception thrown running example'
);
};
done_testing;