view release on metacpan or  search on metacpan

lib/Test/Mocha/Spy.pm  view on Meta::CPAN

package Test::Mocha::Spy;
# ABSTRACT: Spy objects
$Test::Mocha::Spy::VERSION = '0.67';
use parent 'Test::Mocha::SpyBase';
use strict;
use warnings;

use Carp 1.22 ();
use Scalar::Util ();
use Test::Mocha::MethodCall;
use Test::Mocha::MethodStub;
use Test::Mocha::Util ();
use Types::Standard   ();
use if $] lt '5.025', 'UNIVERSAL::ref';

our $AUTOLOAD;

my %DEFAULT_STUBS = (
    can => Test::Mocha::MethodStub->new(
        # can() should return a reference to AUTOLOAD() for all methods
        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(
        # ref() is a special stub because we use UNIVERSAL::ref which
        # allows us to call it as a method even though it's not a method
        # in the wrapped object.
        name      => 'ref',
        args      => [],
        responses => [
            sub {
                my ($self) = @_;
                return ref( $self->__object );
            }
        ],
    ),
);

sub __new {
    # uncoverable pod
    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);