File Coverage

blib/lib/Test/Spy.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	8	8	100.0
condition	7	11	63.6
subroutine	17	17	100.0
pod	5	5	100.0
total	94	98	95.9

$Test::Spy::VERSION = '0.003';
use v5.10;
use strict;
use warnings;

use Moo;
use Mooish::AttributeBuilder;
use Carp qw(croak);

use Test::Spy::Method;
use Test::Spy::Observer;
use Test::Spy::Object;

has param 'interface' => (
	isa => sub {
		my @allowed = qw(strict lax warn);
		croak "interface can be any of: @allowed"
			unless grep { $_[0] eq $_ } @allowed;
	},
	default => sub { 'strict' }
);

has field '_mocked_subs' => (
	default => sub { {} },
);

has field 'object' => (
	lazy => 1,
	clearer => -hidden
);

has option 'context' => (
	writer => 1,
	clearer => 1,
);

has option 'base' => (
	writer => 1,
	trigger => '_clear_object',
);

with qw(Test::Spy::Interface);

{
	my ($self, $method_name) = @_;

	croak "method $method_name was not mocked!";
}

{
	my ($self) = @_;

	my %methods = %{$self->_mocked_subs};
	my %init_hash;

	my $base = $self->has_base
		? ref $self->base ? $self->base : $self->base->new
		: undef;

	return Test::Spy::Object->_new(
		%{$base // {}},
		__base => $base,
		__spy => $self,
	);
}

{
	my ($self, $method_name, @returns) = @_;

	my $method = $self->_mocked_subs->{$method_name} = Test::Spy::Method->new(method_name => $method_name);

	if (@returns) {
		$method->should_return(@returns);
	}

	return $method;
}

{
	my ($self, $method_name) = @_;

	return $self->_mocked_subs->{$method_name} = Test::Spy::Observer->new(method_name => $method_name);
}

{
	my ($self, $method_name) = @_;

	return $self->_mocked_subs->{$method_name}
		// $self->_no_method($method_name);
}

{
	my ($self) = @_;

	$self->clear_context;

	my %methods = %{$self->_mocked_subs};
	for my $method_name (keys %methods) {
		$methods{$method_name}->clear;
	}

	return;
}

{
	my ($self) = @_;

	my $context = $self->context;
	croak 'no context was set in ' . ref $self
		unless $self->has_context && $context;

	return $self->_mocked_subs->{$context}->call_history
		// $self->_no_method($context);
}

{
	my ($self) = @_;

	return $self->_mocked_subs->{$self->context}->_clear_call_history;
}

1;

# ABSTRACT: build mocked interfaces and examine call data easily