pax_global_header00006660000000000000000000000064122053764170014521gustar00rootroot0000000000000052 comment=6338b86da47f9ead3b5164eb6be1cb5d97da020a perl-Test-TinyMocker-0.03/000075500000000000000000000000001220537641700154025ustar00rootroot00000000000000perl-Test-TinyMocker-0.03/.perlcriticrc000064400000000000000000000014631220537641700200740ustar00rootroot00000000000000verbose = [%p] %m at %f line %l, near '%r'\n severity = 2 [TestingAndDebugging::RequireUseWarnings] [-Miscellanea::RequireRcsKeywords] [-Documentation::RequirePodSections] [-Documentation::RequirePodLinksIncludeText] [-Modules::RequireVersionVar] [-ControlStructures::ProhibitPostfixControls] [-ErrorHandling::RequireCheckingReturnValueOfEval] [Variables::ProhibitPunctuationVars] allow = $@ $! [-ValuesAndExpressions::ProhibitNoisyQuotes] # we export a set of symbols, and we do syntactic sugar [-Modules::ProhibitAutomaticExportation] [-Subroutines::ProhibitSubroutinePrototypes] [-Subroutines::RequireArgUnpacking] [-Subroutines::RequireFinalReturn] [-TestingAndDebugging::ProhibitNoStrict] [-TestingAndDebugging::ProhibitNoWarnings] [ValuesAndExpressions::ProhibitMagicNumbers] allowed_values = 0 1 2 3 perl-Test-TinyMocker-0.03/.perltidyrc000064400000000000000000000022071220537641700175650ustar00rootroot00000000000000-l=79 # Max line width is 79 cols -i=4 # Indent level is 4 cols -ci=4 # Continuation indent is 4 cols -b -se # Errors to STDERR -vt=2 # Maximal vertical tightness -cti=0 # No extra indentation for closing brackets -pt=1 # Medium parenthesis tightness -bt=1 # Medium brace tightness -sbt=1 # Medium square bracket tightness -bbt=1 # Medium block brace tightness -nsfs # No space before semicolons -nolq # Don't outdent long quoted strings -wbb="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" # Break before all operators # extras/overrides/deviations from PBP --maximum-line-length=79 # be less generous --warning-output # Show warnings --maximum-consecutive-blank-lines=2 # default is 1 --nohanging-side-comments # troublesome for commented out code -isbc # block comments may only be indented if they have some space characters before the # -ci=2 # Continuation indent is 2 cols # we use version control, so just rewrite the file -b # for the up-tight folk :) -pt=2 # High parenthesis tightness -bt=2 # High brace tightness -sbt=2 # High square bracket tightness perl-Test-TinyMocker-0.03/AUTHORS000064400000000000000000000000421220537641700164460ustar00rootroot00000000000000Alexis Sukrieh Jérôme Bourgeois perl-Test-TinyMocker-0.03/Changes000064400000000000000000000006261220537641700167010ustar00rootroot00000000000000Revision history for Test-TinyMocker 0.03 [Sawyer X] * Supporting arrayrefs for multiple methods, adding "methods". * Refactoring symbol flattening. 0.02 08/24/2010 [Jérôme Bourgeois] * Support for the 'unmock' function. * Make sure it's not possible to mock an unknown mehtod. 0.01 08/22/2010 [Alexis Sukrieh] * First version, provide the 'mock' function. perl-Test-TinyMocker-0.03/MANIFEST000064400000000000000000000005251220537641700165350ustar00rootroot00000000000000.perlcriticrc .perltidyrc AUTHORS Changes ignore.txt lib/Test/TinyMocker.pm Makefile.PL MANIFEST README t/00-load.t t/01_mock.t t/02_unmock.t t/03_mock_error.t t/04_unmock_error.t t/05_multiple_mock.t t/06_multiple_unmock.t t/manifest.t t/pod-coverage.t t/pod.t META.yml Module meta-data (added by MakeMaker) perl-Test-TinyMocker-0.03/META.yml000064400000000000000000000010671220537641700166570ustar00rootroot00000000000000--- #YAML:1.0 name: Test-TinyMocker version: 0.03 abstract: a very simple tool to mock external modules author: - Alexis Sukrieh license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Test::More: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 perl-Test-TinyMocker-0.03/Makefile.PL000064400000000000000000000010351220537641700173530ustar00rootroot00000000000000use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Test::TinyMocker', AUTHOR => q{Alexis Sukrieh }, VERSION_FROM => 'lib/Test/TinyMocker.pm', ABSTRACT_FROM => 'lib/Test/TinyMocker.pm', LICENSE => 'perl', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Test-TinyMocker-*' }, ); perl-Test-TinyMocker-0.03/README000064400000000000000000000013731220537641700162660ustar00rootroot00000000000000Test-TinyMocker use Test::More; use Test::TinyMocker; mock 'Some::Module' => method 'some_method' => should { return $mocked_value; }; # or mock 'Some::Module::some_method' => should { return $mocked_value; }; # Some::Module::some_method() will now always return $mocked_value; This module was inspired by Gugod's blog, after the article published about mocking in Ruby and Perl: http://gugod.org/2009/05/mocking.html This module was first part of the test tools provided by Dancer in its own t directory (previously named C). A couple of developers asked me if I could released this module as a real Test:: distribution on CPAN, so here it is. perl-Test-TinyMocker-0.03/ignore.txt000064400000000000000000000001751220537641700174310ustar00rootroot00000000000000blib* Makefile Makefile.old Build Build.bat _build* pm_to_blib* *.tar.gz .lwpcookies cover_db pod2htm*.tmp Test-TinyMocker-* perl-Test-TinyMocker-0.03/lib/000075500000000000000000000000001220537641700161505ustar00rootroot00000000000000perl-Test-TinyMocker-0.03/lib/Test/000075500000000000000000000000001220537641700170675ustar00rootroot00000000000000perl-Test-TinyMocker-0.03/lib/Test/TinyMocker.pm000064400000000000000000000131571220537641700215200ustar00rootroot00000000000000package Test::TinyMocker; use strict; use warnings; use Carp qw{ croak }; use vars qw(@EXPORT $VERSION); use base 'Exporter'; $VERSION = '0.03'; my $mocks = {}; @EXPORT = qw(mock unmock should method methods); sub method($) {@_} sub methods($) {@_} sub should(&) {@_} sub mock { croak 'useless use of mock with one or less parameter' if scalar @_ < 2; my $sub = pop; my @symbols = _flat_symbols(@_); foreach my $symbol (@symbols) { croak "unknown symbol: $symbol" unless _symbol_exists($symbol); _save_sub($symbol); _bind_coderef_to_symbol($symbol, $sub); } } sub unmock { croak 'useless use of unmock without parameters' unless scalar @_; my @symbols = _flat_symbols(@_); foreach my $symbol (@symbols) { croak "unkown method $symbol" unless $mocks->{$symbol}; { no strict 'refs'; no warnings 'redefine', 'prototype'; *{$symbol} = delete $mocks->{$symbol}; } } } sub _flat_symbols { if (@_ == 2) { return ref $_[1] eq 'ARRAY' ? map {qq{$_[0]::$_}} @{$_[1]} : qq{$_[0]::$_[1]}; } else { return ref $_[0] eq 'ARRAY' ? @{$_[0]} : $_[0]; } } sub _symbol_exists { my ($symbol) = @_; { no strict 'refs'; no warnings 'redefine', 'prototype'; return defined *{$symbol}{CODE}; } } sub _bind_coderef_to_symbol { my ($symbol, $sub) = @_; { no strict 'refs'; no warnings 'redefine', 'prototype'; *{$symbol} = $sub; } } sub _save_sub { my ($name) = @_; { no strict 'refs'; $mocks->{$name} ||= *{$name}{CODE}; } return $name; } 1; __END__ =head1 NAME Test::TinyMocker - a very simple tool to mock external modules =head1 SYNOPSIS use Test::More; use Test::TinyMocker; mock 'Some::Module' => method 'some_method' => should { return $mocked_value; }; # or mock 'Some::Module' => methods [ 'this_method', 'that_method' ] => should { return $mocked_value; }; # or mock 'Some::Module::some_method' => should { return $mocked_value; }; # Some::Module::some_method() will now always return $mocked_value; # To restore the original method unmock 'Some::Module::some_method'; # or unmock 'Some::Module' => method 'some_method'; # or unmock 'Some::Module' => methods [ 'this_method', 'that_method' ]; =head1 EXPORT =head2 mock($module, $method_or_methods, $sub) This function allows you to overwrite the given method with an arbitrary code block. This lets you simulate soem kind of behaviour for your tests. Alternatively, this method can be passed only two arguments, the first one will be the full path of the method (pcakge name + method name) and the second one the coderef. Syntactic sugar is provided (C, C and C) in order to let you write sweet mock statements: # This: mock('Foo::Bar', 'a_method', sub { return 42;}); # is the same as: mock 'Foo::Bar' => method 'a_method' => should { return 42 }; # or: mock 'Foo::Bar::a_method' => should { return 42 }; # or also: mock('Foo::Bar::a_method', sub { return 42;}); Using multiple methods at the same time can be done with arrayrefs: # This: mock('Foo::Bar', ['a_method', 'b_method'], sub { 42 } ); # is the same as: mock 'Foo::Bar' => methods ['a_method', 'b_method'] => should { 42 }; =head2 unmock($module, $method_or_methods) Syntactic sugar is provided (C and C) in order to let you write sweet unmock statements: # This: unmock('Foo::Bar', 'a_method'); # is the same as: unmock 'Foo::Bar' => method 'a_method'; And using multiple methods at the same time: unmock 'Foo::Bar' => methods ['a_method', 'b_method']; =head2 method Syntactic sugar for mock() =head2 methods Syntactic sugar for mock() =head2 should Syntactic sugar for mock() =head1 AUTHOR Alexis Sukrieh, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Test::TinyMocker You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS This module was inspired by Gugod's blog, after the article published about mocking in Ruby and Perl: L This module was first part of the test tools provided by Dancer in its own t directory (previously named C). A couple of developers asked me if I could released this module as a real Test:: distribution on CPAN, so here it is. =head1 LICENSE AND COPYRIGHT Copyright 2010 Alexis Sukrieh. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut perl-Test-TinyMocker-0.03/t/000075500000000000000000000000001220537641700156455ustar00rootroot00000000000000perl-Test-TinyMocker-0.03/t/00-load.t000064400000000000000000000002541220537641700171670ustar00rootroot00000000000000use Test::More tests => 1; BEGIN { use_ok( 'Test::TinyMocker' ) || print "Bail out! "; } diag( "Testing Test::TinyMocker $Test::TinyMocker::VERSION, Perl $], $^X" ); perl-Test-TinyMocker-0.03/t/01_mock.t000064400000000000000000000021461220537641700172660ustar00rootroot00000000000000use strict; use warnings; use Test::More; use Test::TinyMocker; { package Foo::Bar; sub baz { "day" } } # original value is Foo::Bar::baz(), "day", "initial value is ok"; # basic syntax mock('Foo::Bar', 'baz', sub { return $_[0] + 1 }); is Foo::Bar::baz(1), 2, "basic syntax"; mock 'Foo::Bar' => method 'baz' => should { "night" }; is Foo::Bar::baz(), "night", "static mocked value"; my $counter = 0; mock 'Foo::Bar' => method 'baz' => should { $counter++; }; is Foo::Bar::baz(), 0, "dynamic mocked value"; is Foo::Bar::baz(), 1, "dynamic mocked value"; mock('Foo::Bar::baz', sub { return $_[0] + 3 }); is Foo::Bar::baz(1), 4, "2 args syntax"; mock 'Foo::Bar::baz' => should { $_[0] + 2 }; is Foo::Bar::baz(1), 3, "2 args syntax with sugar"; eval { mock }; like( $@, qr{useless use of mock with one}, "no call of mock without parameter" ); eval { mock 'Foo' }; like( $@, qr{useless use of mock with one}, "no call of mock with one parameter" ); eval { mock 'Foo::Bar' => method 'faked' => should { return } }; like( $@, qr{unknown symbol:}, "no mock non exists function" ); done_testing; perl-Test-TinyMocker-0.03/t/02_unmock.t000064400000000000000000000012421220537641700176260ustar00rootroot00000000000000use strict; use warnings; use Test::More; use Test::TinyMocker; { package Foo::Bar; sub baz { "day" } } # original value is Foo::Bar::baz(), "day", "initial value is ok"; # mock new comportement mock('Foo::Bar', 'baz', sub { return 'night' }); # unmock unmock('Foo::Bar', 'baz'); is Foo::Bar::baz(), "day", "original value"; # mock new comportement mock('Foo::Bar', 'baz', sub { return 'night' }); # unmock unmock('Foo::Bar::baz'); is Foo::Bar::baz(), "day", "original value"; # mock new comportement mock('Foo::Bar', 'baz', sub { return 'night' }); # unmock unmock 'Foo::Bar' => method 'baz'; is Foo::Bar::baz(), "day", "original value"; done_testing; perl-Test-TinyMocker-0.03/t/03_mock_error.t000064400000000000000000000006401220537641700204760ustar00rootroot00000000000000use strict; use warnings; use Test::More; use Test::TinyMocker; eval { mock }; like( $@, qr{useless use of mock with one}, "no call of mock without parameter" ); eval { mock 'Foo' }; like( $@, qr{useless use of mock with one}, "no call of mock with one parameter" ); eval { mock 'Foo::Bar' => method 'faked' => should { return } }; like( $@, qr{unknown symbol:}, "no mock non exists function" ); done_testing; perl-Test-TinyMocker-0.03/t/04_unmock_error.t000064400000000000000000000006601220537641700210440ustar00rootroot00000000000000use strict; use warnings; use Test::More; use Test::TinyMocker; eval { unmock }; like( $@, qr{useless use of unmock}, "no call unmock without parameter" ); eval { unmock 'Module::Will' => method 'not_exists' }; like( $@, qr{unkown method}, "no recover nuknown method" ); done_testing; perl-Test-TinyMocker-0.03/t/05_multiple_mock.t000064400000000000000000000041231220537641700212020ustar00rootroot00000000000000use strict; use warnings; # this covers the exact same stuff from 01-mock.t # but uses more than one method to override using "methods" use Test::More; use Test::TinyMocker; { package Foo::Bar; sub baz { "day" } sub qux { "way" } } # original value is Foo::Bar::baz(), "day", "first initial value is ok"; is Foo::Bar::qux(), "way", "second initial value is ok"; # basic syntax mock('Foo::Bar', [ 'baz', 'qux' ], sub { return $_[0] + 1 }); cmp_ok Foo::Bar::baz(1), '==', 2, "basic syntax for baz"; cmp_ok Foo::Bar::qux(1), '==', 2, "basic syntax for qux"; mock 'Foo::Bar' => methods ['baz','qux'] => should { "night" }; is Foo::Bar::baz(), "night", "static mocked value for baz"; is Foo::Bar::qux(), "night", "static mocked value for qux"; my $counter = 0; mock 'Foo::Bar' => methods [ 'baz', 'qux' ] => should { $counter++; }; cmp_ok Foo::Bar::baz(), '==', 0, "dynamic mocked value for baz"; cmp_ok Foo::Bar::qux(), '==', 1, "dynamic mocked value for qux"; cmp_ok Foo::Bar::baz(), '==', 2, "dynamic mocked value for baz"; cmp_ok Foo::Bar::qux(), '==', 3, "dynamic mocked value for qux"; mock('Foo::Bar::baz', sub { return $_[0] + 3 }); mock('Foo::Bar::qux', sub { return $_[0] + 3 }); cmp_ok Foo::Bar::baz(1), '==', 4, "2 args syntax for baz"; cmp_ok Foo::Bar::qux(1), '==', 4, "2 args syntax for qux"; mock ['Foo::Bar::baz','Foo::Bar::qux'] => should { $_[0] + 2 }; is Foo::Bar::baz(1), 3, "2 args syntax with sugar for baz"; is Foo::Bar::qux(1), 3, "2 args syntax with sugar for qux"; eval { mock }; like( $@, qr{useless use of mock with one}, "no call of mock without parameter" ); eval { mock 'Foo' }; like( $@, qr{useless use of mock with one}, "no call of mock with one parameter" ); eval { mock ['Foo','Bar'] }; like( $@, qr{useless use of mock with one}, "no call of mock with one parameter" ); eval { mock 'Foo::Bar' => method 'faked' => should { return } }; like( $@, qr{unknown symbol:}, "no mock non exists function" ); eval { mock 'Foo::Bar' => methods [ 'faked', 'baked' ] => should { return } }; like( $@, qr{unknown symbol:}, "no mock non exists function" ); done_testing; perl-Test-TinyMocker-0.03/t/06_multiple_unmock.t000064400000000000000000000021521220537641700215460ustar00rootroot00000000000000use strict; use warnings; # this covers the exact same stuff from 02-unmock.t # but uses more than one method to override using "methods" use Test::More; use Test::TinyMocker; { package Foo::Bar; sub baz { "day" } sub qux { "way" } } # original value is Foo::Bar::baz(), "day", "initial value for baz is ok"; is Foo::Bar::qux(), "way", "initial value for qux is ok"; # mock new comportement mock('Foo::Bar', [ 'baz', 'qux' ], sub { return 'night' }); # unmock unmock('Foo::Bar', [ 'baz', 'qux' ]); is Foo::Bar::baz(), "day", "original value for baz"; is Foo::Bar::qux(), "way", "original value for qux"; # mock new comportement mock('Foo::Bar', [ 'baz', 'qux' ], sub { return 'night' }); # unmock unmock(['Foo::Bar::baz','Foo::Bar::qux']); is Foo::Bar::baz(), "day", "original value for baz"; is Foo::Bar::qux(), "way", "original value for qux"; # mock new comportement mock('Foo::Bar', ['baz', 'qux'], sub { return 'night' }); # unmock unmock 'Foo::Bar' => methods [ 'baz', 'qux' ]; is Foo::Bar::baz(), "day", "original value for baz"; is Foo::Bar::qux(), "way", "original value for qux"; done_testing; perl-Test-TinyMocker-0.03/t/manifest.t000064400000000000000000000004201220537641700176340ustar00rootroot00000000000000#!perl -T use strict; use warnings; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } eval "use Test::CheckManifest 0.9"; plan skip_all => "Test::CheckManifest 0.9 required" if $@; ok_manifest(); perl-Test-TinyMocker-0.03/t/pod-coverage.t000064400000000000000000000010471220537641700204070ustar00rootroot00000000000000use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); perl-Test-TinyMocker-0.03/t/pod.t000064400000000000000000000003501220537641700166120ustar00rootroot00000000000000#!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok();