File Coverage

blib/lib/Test/Double/Mock.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch			n/a
condition	2	3	66.6
subroutine	11	11	100.0
pod	1	6	16.6
total	52	58	89.6

package Test::Double::Mock;

use strict;
use warnings;
use Class::Monadic qw(monadic);
use Scalar::Util qw(weaken);
use Test::Double::Mock::Expectation;

{
    my %MOCKS = ();
    sub wrap {
        my ($class, $instance) = @_;
        $MOCKS{$instance} ||= $class->new(
            package  => ref($instance),
            instance => $instance,
        );
        weaken($instance);
        return $MOCKS{$instance};
    }

    sub reset_all {
        %MOCKS = ();
    }

    sub verify_result_all {
        my $all_result;
        for my $instance (values %MOCKS) {
            for (@{$instance->{expectations}}) {
                my $result = $_->verify_result;
                $all_result->{$_->{method}} = $result;
            }
        }
        return $all_result;
    }

    sub verify_all {
        for my $instance (values %MOCKS) {
            $_->verify for @{$instance->{expectations}};
        }
    }
}

sub new {
    my ($class, %args) = @_;
    bless { %args, expectations => [] }, $class;
}

sub expects {
    my ($self, $method) = @_;

    my $expectation = Test::Double::Mock::Expectation->new(
        package => $self->{package},
        method  => $method,
    );

    monadic($self->{instance})->add_methods($method => $expectation->behavior);
    push @{ $self->{expectations} }, $expectation;

    return $expectation;
}

1;
__END__