$Test::Mocha::Spy::VERSION
=
'0.62_02'
;
our
$AUTOLOAD
;
my
%DEFAULT_STUBS
= (
can
=> Test::Mocha::MethodStub->new(
name
=>
'can'
,
args
=> [Types::Standard::Str],
responses
=> [
sub
{
my
(
$self
,
$method_name
) =
@_
;
return
if
!
$self
->__object->can(
$method_name
);
return
sub
{
$AUTOLOAD
=
$method_name
;
goto
&AUTOLOAD
;
};
}
],
),
ref
=> Test::Mocha::MethodStub->new(
name
=>
'ref'
,
args
=> [],
responses
=> [
sub
{
my
(
$self
) =
@_
;
return
ref
(
$self
->__object );
}
],
),
);
sub
__new {
my
(
$class
,
$object
) =
@_
;
Carp::croak
"Can't spy on an unblessed reference"
if
!Scalar::Util::blessed(
$object
);
my
$args
=
$class
->SUPER::__new;
$args
->{object} =
$object
;
$args
->{stubs} = {
map
{
$_
=> [
$DEFAULT_STUBS
{
$_
} ] }
keys
%DEFAULT_STUBS
};
return
bless
$args
,
$class
;
}
sub
__object {
my
(
$self
) =
@_
;
return
$self
->{object};
}
sub
AUTOLOAD {
my
(
$self
,
@args
) =
@_
;
Test::Mocha::Util::check_slurpy_arg(
@args
);
my
$method_name
= Test::Mocha::Util::extract_method_name(
$AUTOLOAD
);
my
$method_call
= Test::Mocha::MethodCall->new(
invocant
=>
$self
,
name
=>
$method_name
,
args
=> \
@args
,
caller
=> [Test::Mocha::Util::find_caller],
);
if
(
$self
->__CaptureMode ) {
if
(
!
$self
->__object->can(
$method_name
)
&&
$method_name
ne
'ref'
)
{
Carp::croak(
sprintf
qq{Can't %s object method "%s" because it can't be located via package "%s"}
,
$self
->__CaptureMode,
$method_name
,
ref
(
$self
->__object )
);
}
$self
->__CaptureMethodCall(
$method_call
);
return
;
}
push
@{
$self
->__calls },
$method_call
;
if
(
my
$stub
=
$self
->__find_stub(
$method_call
) ) {
return
$stub
->execute_next_response(
$self
,
@args
);
}
Carp::croak(
sprintf
qq{Can't call object method "%s" because it can't be located via package "%s"}
,
$method_name
,
ref
(
$self
->__object )
)
if
!
$self
->__object->can(
$method_name
);
return
$self
->__object->
$method_name
(
@args
);
}
sub
isa {
my
(
$self
,
$class
) =
@_
;
return
1
if
$self
->SUPER::isa(
$class
);
$AUTOLOAD
=
'isa'
;
goto
&AUTOLOAD
;
}
sub
DOES {
my
(
$self
,
$role
) =
@_
;
return
1
if
$role
eq __PACKAGE__;
return
if
!
ref
$self
;
$AUTOLOAD
=
'DOES'
;
goto
&AUTOLOAD
;
}
sub
can {
my
(
$self
,
$method_name
) =
@_
;
return
if
$method_name
eq
'CARP_TRACE'
;
$AUTOLOAD
=
'can'
;
goto
&AUTOLOAD
;
}
sub
DESTROY { }
1;