Blame lib/Test/MockModule.pm

Packit 11f908
package Test::MockModule;
Packit 11f908
use strict qw/subs vars/;
Packit 11f908
use vars qw/$VERSION/;
Packit 11f908
use Scalar::Util qw/reftype weaken/;
Packit 11f908
use Carp;
Packit 11f908
use SUPER;
Packit 11f908
$VERSION = '0.13';
Packit 11f908
Packit 11f908
my %mocked;
Packit 11f908
sub new {
Packit 11f908
	my $class = shift;
Packit 11f908
	my ($package, %args) = @_;
Packit 11f908
	if ($package && (my $existing = $mocked{$package})) {
Packit 11f908
		return $existing;
Packit 11f908
	}
Packit 11f908
Packit 11f908
	croak "Cannot mock $package" if $package && $package eq $class;
Packit 11f908
	unless (_valid_package($package)) {
Packit 11f908
		$package = 'undef' unless defined $package;
Packit 11f908
		croak "Invalid package name $package";
Packit 11f908
	}
Packit 11f908
Packit 11f908
	unless ($args{no_auto} || ${"$package\::VERSION"}) {
Packit 11f908
		(my $load_package = "$package.pm") =~ s{::}{/}g;
Packit 11f908
		TRACE("$package is empty, loading $load_package");
Packit 11f908
		require $load_package;
Packit 11f908
	}
Packit 11f908
Packit 11f908
	TRACE("Creating MockModule object for $package");
Packit 11f908
	my $self = bless {
Packit 11f908
		_package => $package,
Packit 11f908
		_mocked  => {},
Packit 11f908
	}, $class;
Packit 11f908
	$mocked{$package} = $self;
Packit 11f908
	weaken $mocked{$package};
Packit 11f908
	return $self;
Packit 11f908
}
Packit 11f908
Packit 11f908
sub DESTROY {
Packit 11f908
	my $self = shift;
Packit 11f908
	$self->unmock_all;
Packit 11f908
}
Packit 11f908
Packit 11f908
sub get_package {
Packit 11f908
	my $self = shift;
Packit 11f908
	return $self->{_package};
Packit 11f908
}
Packit 11f908
Packit 11f908
sub redefine {
Packit 11f908
	my ($self, @mocks) = (shift, @_);
Packit 11f908
Packit 11f908
	while ( my ($name, $value) = splice @mocks, 0, 2 ) {
Packit 11f908
		my $sub_name = $self->_full_name($name);
Packit 11f908
		my $coderef = *{$sub_name}{'CODE'};
Packit 11f908
		if ('CODE' ne ref $coderef) {
Packit 11f908
			croak "$sub_name does not exist!";
Packit 11f908
		}
Packit 11f908
	}
Packit 11f908
Packit 11f908
	return $self->mock(@_);
Packit 11f908
}
Packit 11f908
Packit 11f908
sub mock {
Packit 11f908
	my $self = shift;
Packit 11f908
Packit 11f908
	while (my ($name, $value) = splice @_, 0, 2) {
Packit 11f908
		my $code = sub { };
Packit 11f908
		if (ref $value && reftype $value eq 'CODE') {
Packit 11f908
			$code = $value;
Packit 11f908
		} elsif (defined $value) {
Packit 11f908
			$code = sub {$value};
Packit 11f908
		}
Packit 11f908
Packit 11f908
		TRACE("$name: $code");
Packit 11f908
		croak "Invalid subroutine name: $name" unless _valid_subname($name);
Packit 11f908
		my $sub_name = _full_name($self, $name);
Packit 11f908
		if (!$self->{_mocked}{$name}) {
Packit 11f908
			TRACE("Storing existing $sub_name");
Packit 11f908
			$self->{_mocked}{$name} = 1;
Packit 11f908
			if (defined &{$sub_name}) {
Packit 11f908
				$self->{_orig}{$name} = \&$sub_name;
Packit 11f908
			} else {
Packit 11f908
				$self->{_orig}{$name} = undef;
Packit 11f908
			}
Packit 11f908
		}
Packit 11f908
		TRACE("Installing mocked $sub_name");
Packit 11f908
		_replace_sub($sub_name, $code);
Packit 11f908
	}
Packit 11f908
}
Packit 11f908
Packit 11f908
sub noop {
Packit 11f908
    my $self = shift;
Packit 11f908
    $self->mock($_,1) for @_;
Packit 11f908
}
Packit 11f908
Packit 11f908
sub original {
Packit 11f908
	my $self = shift;
Packit 11f908
	my ($name) = @_;
Packit 11f908
	return carp _full_name($self, $name) . " is not mocked"
Packit 11f908
		unless $self->{_mocked}{$name};
Packit 11f908
	return defined $self->{_orig}{$name} ? $self->{_orig}{$name} : $self->{_package}->super($name);
Packit 11f908
}
Packit 11f908
sub unmock {
Packit 11f908
	my $self = shift;
Packit 11f908
Packit 11f908
	for my $name (@_) {
Packit 11f908
		croak "Invalid subroutine name: $name" unless _valid_subname($name);
Packit 11f908
Packit 11f908
		my $sub_name = _full_name($self, $name);
Packit 11f908
		unless ($self->{_mocked}{$name}) {
Packit 11f908
			carp $sub_name . " was not mocked";
Packit 11f908
			next;
Packit 11f908
		}
Packit 11f908
Packit 11f908
		TRACE("Restoring original $sub_name");
Packit 11f908
		_replace_sub($sub_name, $self->{_orig}{$name});
Packit 11f908
		delete $self->{_mocked}{$name};
Packit 11f908
		delete $self->{_orig}{$name};
Packit 11f908
	}
Packit 11f908
	return $self;
Packit 11f908
}
Packit 11f908
Packit 11f908
sub unmock_all {
Packit 11f908
	my $self = shift;
Packit 11f908
	foreach (keys %{$self->{_mocked}}) {
Packit 11f908
		$self->unmock($_);
Packit 11f908
	}
Packit 11f908
}
Packit 11f908
Packit 11f908
sub is_mocked {
Packit 11f908
	my $self = shift;
Packit 11f908
	my ($name) = shift;
Packit 11f908
	return $self->{_mocked}{$name};
Packit 11f908
}
Packit 11f908
Packit 11f908
sub _full_name {
Packit 11f908
	my ($self, $sub_name) = @_;
Packit 11f908
	sprintf "%s::%s", $self->{_package}, $sub_name;
Packit 11f908
}
Packit 11f908
Packit 11f908
sub _valid_package {
Packit 11f908
	defined($_[0]) && $_[0] =~ /^[a-z_]\w*(?:::\w+)*$/i;
Packit 11f908
}
Packit 11f908
Packit 11f908
sub _valid_subname {
Packit 11f908
	$_[0] =~ /^[a-z_]\w*$/i;
Packit 11f908
}
Packit 11f908
Packit 11f908
sub _replace_sub {
Packit 11f908
	my ($sub_name, $coderef) = @_;
Packit 11f908
	# from Test::MockObject
Packit 11f908
	local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /redefined/ };
Packit 11f908
	if (defined $coderef) {
Packit 11f908
		*{$sub_name} = $coderef;
Packit 11f908
	} else {
Packit 11f908
		TRACE("removing subroutine: $sub_name");
Packit 11f908
		my ($package, $sub) = $sub_name =~ /(.*::)(.*)/;
Packit 11f908
		my %symbols = %{$package};
Packit 11f908
Packit 11f908
		# save a copy of all non-code slots
Packit 11f908
		my %slot;
Packit 11f908
		foreach (qw(ARRAY FORMAT HASH IO SCALAR)) {
Packit 11f908
			next unless defined(my $elem = *{$symbols{$sub}}{$_});
Packit 11f908
			$slot{$_} = $elem;
Packit 11f908
		}
Packit 11f908
Packit 11f908
		# clear the symbol table entry for the subroutine
Packit 11f908
		undef *$sub_name;
Packit 11f908
Packit 11f908
		# restore everything except the code slot
Packit 11f908
		return unless keys %slot;
Packit 11f908
		foreach (keys %slot) {
Packit 11f908
			*$sub_name = $slot{$_};
Packit 11f908
		}
Packit 11f908
	}
Packit 11f908
}
Packit 11f908
Packit 11f908
# Log::Trace stubs
Packit 11f908
sub TRACE {}
Packit 11f908
sub DUMP  {}
Packit 11f908
Packit 11f908
1;
Packit 11f908
Packit 11f908
=pod
Packit 11f908
Packit 11f908
=head1 NAME
Packit 11f908
Packit 11f908
Test::MockModule - Override subroutines in a module for unit testing
Packit 11f908
Packit 11f908
=head1 SYNOPSIS
Packit 11f908
Packit 11f908
	use Module::Name;
Packit 11f908
	use Test::MockModule;
Packit 11f908
Packit 11f908
	{
Packit 11f908
		my $module = Test::MockModule->new('Module::Name');
Packit 11f908
		$module->mock('subroutine', sub { ... });
Packit 11f908
		Module::Name::subroutine(@args); # mocked
Packit 11f908
Packit 11f908
		#Same effect, but this will die() if other_subroutine()
Packit 11f908
		#doesn't already exist, which is often desirable.
Packit 11f908
		$module->redefine('other_subroutine', sub { ... });
Packit 11f908
	}
Packit 11f908
Packit 11f908
	Module::Name::subroutine(@args); # original subroutine
Packit 11f908
Packit 11f908
	# Working with objects
Packit 11f908
	use Foo;
Packit 11f908
	use Test::MockModule;
Packit 11f908
	{
Packit 11f908
		my $mock = Test::MockModule->new('Foo');
Packit 11f908
		$mock->mock(foo => sub { print "Foo!\n"; });
Packit 11f908
Packit 11f908
		my $foo = Foo->new();
Packit 11f908
		$foo->foo(); # prints "Foo!\n"
Packit 11f908
	}
Packit 11f908
Packit 11f908
=head1 DESCRIPTION
Packit 11f908
Packit 11f908
C<Test::MockModule> lets you temporarily redefine subroutines in other packages
Packit 11f908
for the purposes of unit testing.
Packit 11f908
Packit 11f908
A C<Test::MockModule> object is set up to mock subroutines for a given
Packit 11f908
module. The object remembers the original subroutine so it can be easily
Packit 11f908
restored. This happens automatically when all MockModule objects for the given
Packit 11f908
module go out of scope, or when you C<unmock()> the subroutine.
Packit 11f908
Packit 11f908
=head1 METHODS
Packit 11f908
Packit 11f908
=over 4
Packit 11f908
Packit 11f908
=item new($package[, %options])
Packit 11f908
Packit 11f908
Returns an object that will mock subroutines in the specified C<$package>.
Packit 11f908
Packit 11f908
If there is no C<$VERSION> defined in C<$package>, the module will be
Packit 11f908
automatically loaded. You can override this behaviour by setting the C<no_auto>
Packit 11f908
option:
Packit 11f908
Packit 11f908
	my $mock = Test::MockModule->new('Module::Name', no_auto => 1);
Packit 11f908
Packit 11f908
=item get_package()
Packit 11f908
Packit 11f908
Returns the target package name for the mocked subroutines
Packit 11f908
Packit 11f908
=item is_mocked($subroutine)
Packit 11f908
Packit 11f908
Returns a boolean value indicating whether or not the subroutine is currently
Packit 11f908
mocked
Packit 11f908
Packit 11f908
=item mock($subroutine =E<gt> \E<amp>coderef)
Packit 11f908
Packit 11f908
Temporarily replaces one or more subroutines in the mocked module. A subroutine
Packit 11f908
can be mocked with a code reference or a scalar. A scalar will be recast as a
Packit 11f908
subroutine that returns the scalar.
Packit 11f908
Packit 11f908
The following statements are equivalent:
Packit 11f908
Packit 11f908
	$module->mock(purge => 'purged');
Packit 11f908
	$module->mock(purge => sub { return 'purged'});
Packit 11f908
Packit 11f908
When dealing with references, things behave slightly differently. The following
Packit 11f908
statements are B<NOT> equivalent:
Packit 11f908
Packit 11f908
	# Returns the same arrayref each time, with the localtime() at time of mocking
Packit 11f908
	$module->mock(updated => [localtime()]);
Packit 11f908
	# Returns a new arrayref each time, with up-to-date localtime() value
Packit 11f908
	$module->mock(updated => sub { return [localtime()]});
Packit 11f908
Packit 11f908
The following statements are in fact equivalent:
Packit 11f908
Packit 11f908
	my $array_ref = [localtime()]
Packit 11f908
	$module->mock(updated => $array_ref)
Packit 11f908
	$module->mock(updated => sub { return $array_ref });
Packit 11f908
Packit 11f908
Packit 11f908
However, C<undef> is a special case. If you mock a subroutine with C<undef> it
Packit 11f908
will install an empty subroutine
Packit 11f908
Packit 11f908
	$module->mock(purge => undef);
Packit 11f908
	$module->mock(purge => sub { });
Packit 11f908
Packit 11f908
rather than a subroutine that returns C<undef>:
Packit 11f908
Packit 11f908
	$module->mock(purge => sub { undef });
Packit 11f908
Packit 11f908
You can call C<mock()> for the same subroutine many times, but when you call
Packit 11f908
C<unmock()>, the original subroutine is restored (not the last mocked
Packit 11f908
instance).
Packit 11f908
Packit 11f908
B<MOCKING + EXPORT>
Packit 11f908
Packit 11f908
If you are trying to mock a subroutine exported from another module, this may
Packit 11f908
not behave as you initialy would expect, since Test::MockModule is only mocking
Packit 11f908
at the target module, not anything importing that module. If you mock the local
Packit 11f908
package, or use a fully qualified function name, you will get the behavior you
Packit 11f908
desire:
Packit 11f908
Packit 11f908
	use Test::MockModule;
Packit 11f908
	use Test::More;
Packit 11f908
	use POSIX qw/strftime/;
Packit 11f908
Packit 11f908
	my $posix = Test::MockModule->new("POSIX");
Packit 11f908
Packit 11f908
	$posix->mock("strftime", "Yesterday");
Packit 11f908
	is strftime("%D", localtime(time)), "Yesterday", "`strftime` was mocked successfully"; # Fails
Packit 11f908
	is POSIX::strftime("%D", localtime(time)), "Yesterday", "`strftime` was mocked successfully"; # Succeeds
Packit 11f908
Packit 11f908
	my $main = Test::MockModule->new("main", no_auto => 1);
Packit 11f908
	$main->mock("strftime", "today");
Packit 11f908
	is strftime("%D", localtime(time)), "today", "`strftime` was mocked successfully"; # Succeeds
Packit 11f908
Packit 11f908
If you are trying to mock a subroutine that was exported into a module that you're
Packit 11f908
trying to test, rather than mocking the subroutine in its originating module,
Packit 11f908
you can instead mock it in the module you are testing:
Packit 11f908
Packit 11f908
	package MyModule;
Packit 11f908
	use POSIX qw/strftime/;
Packit 11f908
Packit 11f908
	sub minus_twentyfour
Packit 11f908
	{
Packit 11f908
		return strftime("%a, %b %d, %Y", localtime(time - 86400));
Packit 11f908
	}
Packit 11f908
Packit 11f908
	package main;
Packit 11f908
	use Test::More;
Packit 11f908
	use Test::MockModule;
Packit 11f908
Packit 11f908
	my $posix = Test::MockModule->new("POSIX");
Packit 11f908
	$posix->mock("strftime", "Yesterday");
Packit 11f908
Packit 11f908
	is MyModule::minus_twentyfour(), "Yesterday", "`minus-tewntyfour` got mocked"; # fails
Packit 11f908
Packit 11f908
	my $mymodule = Test::MockModule->new("MyModule", no_auto => 1);
Packit 11f908
	$mymodule->mock("strftime", "Yesterday");
Packit 11f908
	is MyModule::minus_twentyfour(), "Yesterday", "`minus-tewntyfour` got mocked"; # suceeds
Packit 11f908
Packit 11f908
=item redefine($subroutine)
Packit 11f908
Packit 11f908
The same behavior as C<mock()>, but this will preemptively check to be
Packit 11f908
sure that all passed subroutines actually exist. This is useful to ensure that
Packit 11f908
if a mocked module's interface changes the test doesn't just keep on testing a
Packit 11f908
code path that no longer behaves consistently with the mocked behavior.
Packit 11f908
Packit 11f908
=item original($subroutine)
Packit 11f908
Packit 11f908
Returns the original (unmocked) subroutine
Packit 11f908
Packit 11f908
=item unmock($subroutine [, ...])
Packit 11f908
Packit 11f908
Restores the original C<$subroutine>. You can specify a list of subroutines to
Packit 11f908
C<unmock()> in one go.
Packit 11f908
Packit 11f908
=item unmock_all()
Packit 11f908
Packit 11f908
Restores all the subroutines in the package that were mocked. This is
Packit 11f908
automatically called when all C<Test::MockObject> objects for the given package
Packit 11f908
go out of scope.
Packit 11f908
Packit 11f908
=item noop($subroutine [, ...])
Packit 11f908
Packit 11f908
Given a list of subroutine names, mocks each of them with a no-op subroutine. Handy
Packit 11f908
for mocking methods you want to ignore!
Packit 11f908
Packit 11f908
    # Neuter a list of methods in one go
Packit 11f908
    $module->noop('purge', 'updated');
Packit 11f908
Packit 11f908
=back
Packit 11f908
Packit 11f908
=head1 SEE ALSO
Packit 11f908
Packit 11f908
L<Test::MockObject::Extends>
Packit 11f908
Packit 11f908
L<Sub::Override>
Packit 11f908
Packit 11f908
=head1 AUTHORS
Packit 11f908
Packit 11f908
Current Maintainer: Geoff Franks <gfranks@cpan.org>
Packit 11f908
Packit 11f908
Original Author: Simon Flack E<lt>simonflk _AT_ cpan.orgE<gt>
Packit 11f908
Packit 11f908
=head1 COPYRIGHT
Packit 11f908
Packit 11f908
Copyright 2004 Simon Flack E<lt>simonflk _AT_ cpan.orgE<gt>.
Packit 11f908
All rights reserved
Packit 11f908
Packit 11f908
You may distribute under the terms of either the GNU General Public License or
Packit 11f908
the Artistic License, as specified in the Perl README file.
Packit 11f908
Packit 11f908
=cut