Test-Mock-Cmd-0.7/000755 000766 000024 00000000000 13024542041 014151 5ustar00dmueystaff000000 000000 Test-Mock-Cmd-0.7/Build.PL000644 000766 000024 00000001100 12140765257 015453 0ustar00dmueystaff000000 000000 use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Test::Mock::Cmd', license => 'perl', dist_author => 'Daniel Muey ', dist_version_from => 'lib/Test/Mock/Cmd.pm', requires => { 'Test::More' => 0, # for testing, I know I know: Test::XT 'Test::Carp' => 0, # for testing # 'Test::Output' => 0, # for testing }, add_to_cleanup => ['Test-Mock-Cmd-*'], ); $builder->create_build_script(); Test-Mock-Cmd-0.7/Changes000644 000766 000024 00000001310 13024541147 015445 0ustar00dmueystaff000000 000000 Revision history for Test-Mock-Cmd 0.7 Thu Dec 15 10:18:13 2016 - rt119171: (Thanks Frank Bicknel!) fix qr/qx confusion - Change rt to github 0.6 Fri May 3 10:42:53 2013 - rt 84976: Add .t example - rt 84975: (Thanks for the idea SCHWERN!) add selective-mocking-factory-hash support 0.5 Thu Dec 15 16:05:42 2011 Update pod testing to not call plan twice (i.e. when the optional module is not available) 0.4 Thu Dec 15 14:13:50 2011 update copyright/license per employer 0.3 Sun Dec 11 15:43:32 2011 add named function support to import() w/ PDO and tests 0.2 Tue Dec 6 04:37:24 2011 rt 73042 v0.2 TODOs 0.1 Thu Dec 1 17:37:07 2011 Initial release. Test-Mock-Cmd-0.7/lib/000755 000766 000024 00000000000 13024542041 014717 5ustar00dmueystaff000000 000000 Test-Mock-Cmd-0.7/Makefile.PL000644 000766 000024 00000001145 12140765257 016142 0ustar00dmueystaff000000 000000 use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Test::Mock::Cmd', AUTHOR => 'Daniel Muey ', VERSION_FROM => 'lib/Test/Mock/Cmd.pm', ABSTRACT_FROM => 'lib/Test/Mock/Cmd.pm', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, # for testing, I know I know: Test::XT 'Test::Carp' => 0, # for testing # 'Test::Output' => 0, # for testing }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Test-Mock-Cmd-*' }, ); Test-Mock-Cmd-0.7/MANIFEST000644 000766 000024 00000000700 12140765361 015311 0ustar00dmueystaff000000 000000 Build.PL Changes lib/Test/Mock/Cmd.pm lib/Test/Mock/Cmd/TestUtils.pm lib/Test/Mock/Cmd/TestUtils/X.pm lib/Test/Mock/Cmd/TestUtils/Y.pm Makefile.PL MANIFEST This list of files README t/00.load.t t/01.system.t t/02.qx.t t/03.exec.t t/perlcritic.t t/perltidy.t t/pod-coverage.t t/pod.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Test-Mock-Cmd-0.7/META.json000644 000766 000024 00000001653 13024542041 015577 0ustar00dmueystaff000000 000000 { "abstract" : "Mock system(), exec(), and qx() for testing", "author" : [ "Daniel Muey " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150001", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Test-Mock-Cmd", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Test::Carp" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "version" : "0.7" } Test-Mock-Cmd-0.7/META.yml000644 000766 000024 00000001045 13024542041 015422 0ustar00dmueystaff000000 000000 --- abstract: 'Mock system(), exec(), and qx() for testing' author: - 'Daniel Muey ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150001' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-Mock-Cmd no_index: directory: - t - inc requires: Test::Carp: '0' Test::More: '0' version: '0.7' Test-Mock-Cmd-0.7/README000644 000766 000024 00000001132 13024541132 015026 0ustar00dmueystaff000000 000000 Test-Mock-Cmd version 0.7 DOCUMENTATION See POD for documentation. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install Alternatively, to install with Module::Build, you can use the following commands: perl Build.PL ./Build ./Build test ./Build install DEPENDENCIES See DEPENDENCIES section in POD, 'requires' key in Build.PL, or 'PREREQ_PM' key in Makefile.PL COPYRIGHT AND LICENCE Copyright (C) 2011, Daniel Muey This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Test-Mock-Cmd-0.7/t/000755 000766 000024 00000000000 13024542041 014414 5ustar00dmueystaff000000 000000 Test-Mock-Cmd-0.7/t/00.load.t000644 000766 000024 00000010640 13024541664 015751 0ustar00dmueystaff000000 000000 use Test::More tests => 47; system("echo foo"); use Test::Carp; BEGIN { use_ok( 'Test::Mock::Cmd', sub { 1 } ); use_ok( 'Test::Mock::Cmd', sub { 1 }, sub { 2 }, sub { 3 } ); use_ok( 'Test::Mock::Cmd', 'system' => sub { 1 }, 'exec' => sub { 2 }, 'qx' => sub { 3 } ); use_ok( 'Test::Mock::Cmd', {} ); use_ok( 'Test::Mock::Cmd', {}, {}, {} ); use_ok( 'Test::Mock::Cmd', 'system' => {}, 'exec' => {}, 'qx' => {} ); # basic permutations of mixed args, no need to go crazy eh? use_ok( 'Test::Mock::Cmd', sub { 1 }, {}, {} ); use_ok( 'Test::Mock::Cmd', 'system' => sub { 1 }, 'exec' => {}, 'qx' => {} ); use_ok( 'Test::Mock::Cmd', {}, sub { 2 }, {} ); use_ok( 'Test::Mock::Cmd', 'system' => {}, 'exec' => sub { 2 }, 'qx' => {} ); use_ok( 'Test::Mock::Cmd', {}, {}, sub { 3 } ); use_ok( 'Test::Mock::Cmd', 'system' => {}, 'exec' => {}, 'qx' => sub { 3 } ); use_ok( 'Test::Mock::Cmd', {}, sub { 2 }, sub { 3 } ); use_ok( 'Test::Mock::Cmd', 'system' => {}, 'exec' => sub { 2 }, 'qx' => sub { 3 } ); use_ok( 'Test::Mock::Cmd', sub { 1 }, {}, sub { 3 } ); use_ok( 'Test::Mock::Cmd', 'system' => sub { 1 }, 'exec' => {}, 'qx' => sub { 3 } ); use_ok( 'Test::Mock::Cmd', sub { 1 }, sub { 2 }, {} ); use_ok( 'Test::Mock::Cmd', 'system' => sub { 1 }, 'exec' => sub { 2 }, 'qx' => {} ); } diag("Testing Test::Mock::Cmd $Test::Mock::Cmd::VERSION"); my $import = sub { require Test::Mock::Cmd; Test::Mock::Cmd->import(@_) }; my $arg_regex = qr/import\(\) requires a 1-3 key hash, 1 code\/hash reference, or 3 code\/hash references as arguments/; my $code_regex = qr/Not a CODE or HASH reference/; my $key_regex = qr/Key is not system\, exec\, or qx/; does_croak_that_matches( $import, $arg_regex ); does_croak_that_matches( $import, sub { 1 }, sub { 2 }, $key_regex ); does_croak_that_matches( $import, sub { 1 }, sub { 2 }, sub { 3 }, sub { 4 }, $key_regex ); does_croak_that_matches( $import, {}, {}, $key_regex ); does_croak_that_matches( $import, {}, {}, {}, {}, $key_regex ); does_croak_that_matches( $import, 1, $code_regex ); does_croak_that_matches( $import, 1, sub { 2 }, sub { 3 }, $code_regex ); does_croak_that_matches( $import, sub { 1 }, 2, sub { 3 }, $code_regex ); does_croak_that_matches( $import, sub { 1 }, sub { 2 }, 3, $code_regex ); does_croak_that_matches( $import, 1, {}, {}, $code_regex ); does_croak_that_matches( $import, {}, 2, {}, $code_regex ); does_croak_that_matches( $import, {}, {}, 3, $code_regex ); does_croak_that_matches( $import, 'system' => sub { 1 }, 'exec' => '2', 'qx' => sub { 3 }, $code_regex ); does_croak_that_matches( $import, 'sytsem' => sub { 1 }, 'exec' => sub { 2 }, $key_regex ); does_croak_that_matches( $import, 'system' => {}, 'exec' => '2', 'qx' => {}, $code_regex ); does_croak_that_matches( $import, 'sytsem' => {}, 'exec' => {}, $key_regex ); my $cr = Test::Mock::Cmd::_transmogrify_to_code( { "foo" => sub { return "FOO" } }, sub { return "BAR" } ); is( ref($cr), 'CODE', "transmogrify returns CODE when given a hash" ); is( $cr->("foo"), "FOO", "transmogrify given known key does key CODE" ); is( $cr->("not in hash"), "BAR", "transmogrify given unknown key does given default CODE" ); my $cr2 = Test::Mock::Cmd::_transmogrify_to_code( { "baz" => sub { return "BAZ" } }, sub { return "WOP" } ); is( ref($cr2), 'CODE', "subsequent transmogrify returns CODE when given a hash" ); is( $cr2->("baz"), "BAZ", "subsequent transmogrify given known key does key CODE" ); is( $cr2->("not in hash"), "WOP", "subsequent transmogrify given unknown key does given default CODE" ); is( ref($cr), 'CODE', "transmogrify not changed by subsequent: returns CODE when given a hash" ); is( $cr->("foo"), "FOO", "transmogrify not changed by subsequent: given known key does key CODE" ); is( $cr->("not in hash"), "BAR", "transmogrify not changed by subsequent: given unknown key does given default CODE" ); my $cre = Test::Mock::Cmd::_transmogrify_to_code( {}, sub { return "ZIG" } ); is( ref($cre), 'CODE', "transmogrify returns CODE when given empty hash" ); is( $cre->("foo"), "ZIG", "transmogrify: given key in other check does its own CODE" ); is( $cre->("baz"), "ZIG", "transmogrify: given key in other check does its own CODE" ); is( $cre->("not in hash"), "ZIG", "transmogrify emptyhash: given unknown key does given default CODE" ); Test-Mock-Cmd-0.7/t/01.system.t000644 000766 000024 00000007177 12140765262 016372 0ustar00dmueystaff000000 000000 use Test::More tests => 20; use Test::Mock::Cmd::TestUtils; # use Test::Output; # See rt 72976 BEGIN { *stdout_like = \&Test::Mock::Cmd::TestUtils::tmp_stdout_like_rt_72976; } use Test::Mock::Cmd::TestUtils::X; BEGIN { SKIP: { skip '/bin/echo is required for these tests.', 8 if !-x '/bin/echo'; stdout_like( sub { my $rrc = Test::Mock::Cmd::TestUtils::X::i_call_system( "/bin/echo", "unmocked system in other package defined before mock system list" ); is( $rrc, 0, "unmocked system() in other package defined before mock, RC true (list)" ); }, qr/unmocked system in other package defined before mock system list/, 'unmocked system() in other package defined before mock, list' ); stdout_like( sub { my $rrc = Test::Mock::Cmd::TestUtils::X::i_call_system("/bin/echo unmocked system in other package defined before mock system string"); is( $rrc, 0, "unmocked system() in other package defined before mock, RC true (string)" ); }, qr/unmocked system in other package defined before mock system string/, 'unmocked system() in other package defined before mock, string' ); stdout_like( sub { my $rrc = system( "/bin/echo", "unmocked system list" ); is( $rrc, 0, "unmocked system() RC true (list)" ); }, qr/unmocked system list/, 'unmocked system() list' ); stdout_like( sub { my $rrc = system("/bin/echo unmocked system string"); is( $rrc, 0, "unmocked system() RC true (string)" ); }, qr/unmocked system string/, 'unmocked system() string' ); } } use Test::Mock::Cmd \&Test::Mock::Cmd::TestUtils::test_more_is_like_return_42; use Test::Mock::Cmd::TestUtils::Y; diag("Testing Test::Mock::Cmd $Test::Mock::Cmd::VERSION"); my $rc = system( 'I am system', 'I am system', 'system() mocked' ); is( $rc, 42, "system() mocked RV" ); my $rca = Test::Mock::Cmd::TestUtils::Y::i_call_system( 'I am system in pkg', 'I am system in pkg', 'system() in pkg loaded after mocking is mocked' ); is( $rca, 42, "system() in an other class (loaded after mocking) mocked RV list" ); SKIP: { skip '/bin/echo is required for these tests.', 8 if !-x '/bin/echo'; stdout_like( sub { my $rrc = Test::Mock::Cmd::TestUtils::X::i_call_system( "/bin/echo", "system call defined before mocking list not affected" ); is( $rrc, 0, "system call defined before mocking not affected RC correct (list)" ); }, qr/system call defined before mocking list/, 'orig_system() list' ); stdout_like( sub { my $rrc = Test::Mock::Cmd::TestUtils::X::i_call_system("/bin/echo system call defined before mocking string not affected"); is( $rrc, 0, "system call defined before mocking not affected RC correct (string)" ); }, qr/system call defined before mocking string/, 'orig_system() list' ); stdout_like( sub { my $rrc = Test::Mock::Cmd::orig_system( "/bin/echo", "orig_system list" ); is( $rrc, 0, "orig_system() RC correct (list)" ); }, qr/orig_system list/, 'orig_system() list' ); stdout_like( sub { my $rrc = Test::Mock::Cmd::orig_system("/bin/echo orig_system string"); is( $rrc, 0, "orig_system() RC correct (string)" ); }, qr/orig_system string/, 'orig_system() string' ); } Test-Mock-Cmd-0.7/t/02.qx.t000644 000766 000024 00000011361 12140765262 015465 0ustar00dmueystaff000000 000000 use Test::More tests => 42; use Test::Mock::Cmd::TestUtils; use Test::Mock::Cmd::TestUtils::X; BEGIN { SKIP: { skip '/bin/echo is required for these tests.', 12 if !-x '/bin/echo'; my $scalar = qx(/bin/echo qx scalar); my @array = qx(/bin/echo qx array); like( $scalar, qr/qx scalar/, 'qx scalar before mocking' ); like( $array[0], qr/qx array/, 'qx array before mocking' ); my $scalara = `/bin/echo back ticks scalar`; my @arraya = `/bin/echo back ticks array`; like( $scalara, qr/back ticks scalar/, 'back ticks scalar before mocking' ); like( $arraya[0], qr/back ticks array/, 'back ticks array before mocking' ); my $scalarb = readpipe('/bin/echo readpipe scalar'); my @arrayb = readpipe('/bin/echo readpipe array'); like( $scalarb, qr/readpipe scalar/, 'readpipe scalar before mocking' ); like( $arrayb[0], qr/readpipe array/, 'readpipe array before mocking' ); my $scalarc = Test::Mock::Cmd::TestUtils::X::i_call_qx(); my @arrayc = Test::Mock::Cmd::TestUtils::X::i_call_qx(); like( $scalarc, qr/QX/, 'qx class scalar before mocking' ); like( $arrayc[0], qr/QX/, 'qx class array before mocking' ); my $scalard = Test::Mock::Cmd::TestUtils::X::i_call_backticks(); my @arrayd = Test::Mock::Cmd::TestUtils::X::i_call_backticks(); like( $scalard, qr/BT/, 'back ticks class scalar before mocking' ); like( $arrayd[0], qr/BT/, 'back ticks class array before mocking' ); my $scalare = Test::Mock::Cmd::TestUtils::X::i_call_readpipe('/bin/echo class readpipe scalar'); my @arraye = Test::Mock::Cmd::TestUtils::X::i_call_readpipe('/bin/echo class readpipe array'); like( $scalare, qr/readpipe scalar/, 'qx class scalar before mocking' ); like( $arraye[0], qr/readpipe array/, 'qx class array before mocking' ); } } use Test::Mock::Cmd sub { my ($cmd) = @_; return Test::Mock::Cmd::TestUtils::test_more_is_like_return_42( $cmd, $cmd, $cmd ); }; use Test::Mock::Cmd::TestUtils::Y; diag("Testing Test::Mock::Cmd $Test::Mock::Cmd::VERSION"); SKIP: { skip '/bin/echo is required for these tests.', 30 if !-x '/bin/echo'; my $scalar = qx(/bin/echo qx scalar); my @array = qx(/bin/echo qx array); is( $scalar, 42, 'qx scalar after mocking' ); is( $array[0], 42, 'qx array after mocking' ); my $scalara = `/bin/echo back ticks scalar`; my @arraya = `/bin/echo back ticks array`; is( $scalara, 42, 'back ticks scalar after mocking' ); is( $arraya[0], 42, 'back ticks array after mocking' ); my $scalarb = readpipe('/bin/echo readpipe scalar'); my @arrayb = readpipe('/bin/echo readpipe array'); is( $scalarb, 42, 'readpipe scalar after mocking' ); is( $arrayb[0], 42, 'readpipe array after mocking' ); my $scalarc = Test::Mock::Cmd::TestUtils::Y::i_call_qx('/bin/echo class qx scalar'); my @arrayc = Test::Mock::Cmd::TestUtils::Y::i_call_qx('/bin/echo class qx array'); is( $scalarc, 42, 'qx class scalar after mocking' ); is( $arrayc[0], 42, 'qx class array after mocking' ); my $scalard = Test::Mock::Cmd::TestUtils::Y::i_call_backticks('/bin/echo class back ticks scalar'); my @arrayd = Test::Mock::Cmd::TestUtils::Y::i_call_backticks('/bin/echo class back ticks array'); is( $scalard, 42, 'back ticks class scalar after mocking' ); is( $arrayd[0], 42, 'back ticks class array after mocking' ); my $scalare = Test::Mock::Cmd::TestUtils::Y::i_call_readpipe('/bin/echo class readpipe scalar'); my @arraye = Test::Mock::Cmd::TestUtils::Y::i_call_readpipe('/bin/echo class readpipe array'); is( $scalare, 42, 'qx class scalar after mocking' ); is( $arraye[0], 42, 'qx class array after mocking' ); my $scalarf = Test::Mock::Cmd::TestUtils::X::i_call_qx(); my @arrayf = Test::Mock::Cmd::TestUtils::X::i_call_qx(); like( $scalarf, qr/QX/, 'qx class scalar before mocking - not affected' ); like( $arrayf[0], qr/QX/, 'qx class array before mocking- not affected' ); my $scalarg = Test::Mock::Cmd::TestUtils::X::i_call_backticks(); my @arrayg = Test::Mock::Cmd::TestUtils::X::i_call_backticks(); like( $scalarg, qr/BT/, 'back ticks class scalar before mocking - not affected' ); like( $arrayg[0], qr/BT/, 'back ticks class array before mocking - not affected' ); my $scalarh = Test::Mock::Cmd::TestUtils::X::i_call_readpipe('/bin/echo class readpipe scalar'); my @arrayh = Test::Mock::Cmd::TestUtils::X::i_call_readpipe('/bin/echo class readpipe array'); like( $scalarh, qr/readpipe scalar/, 'qx class scalar before mocking - not affected' ); like( $arrayh[0], qr/readpipe array/, 'qx class array before mocking - not affected' ); } Test-Mock-Cmd-0.7/t/03.exec.t000644 000766 000024 00000011423 12140765262 015761 0ustar00dmueystaff000000 000000 use Test::More tests => 12; use Test::Mock::Cmd::TestUtils; # use Test::Output; # See rt 72976 BEGIN { *stdout_like = \&Test::Mock::Cmd::TestUtils::tmp_stdout_like_rt_72976; } use Test::Mock::Cmd::TestUtils::X; BEGIN { SKIP: { skip '/bin/echo is required for these tests.', 4 if !-x '/bin/echo'; stdout_like( sub { Test::Mock::Cmd::TestUtils::do_in_fork( sub { Test::Mock::Cmd::TestUtils::X::i_call_exec( "/bin/echo", "unmocked exec in other package defined before mock exec list" ); ok( 0, 'unmocked class exec() list did not exit' ); } ); }, qr/unmocked exec in other package defined before mock exec list/, 'unmocked exec() in other package defined before mock, list' ); stdout_like( sub { Test::Mock::Cmd::TestUtils::do_in_fork( sub { Test::Mock::Cmd::TestUtils::X::i_call_exec("/bin/echo unmocked exec in other package defined before mock exec string"); ok( 0, 'unmocked class exec() string did not exit' ); } ); }, qr/unmocked exec in other package defined before mock exec string/, 'unmocked exec() in other package defined before mock, string' ); stdout_like( sub { Test::Mock::Cmd::TestUtils::do_in_fork( sub { # Statement unlikely to be reached ... no warnings 'exec'; doesn't help so we combine into one statement exec( "/bin/echo", "unmocked exec defined before mock exec list" ) || ok( 0, 'unmocked exec() list did not exit' ); } ); }, qr/unmocked exec defined before mock exec list/, 'unmocked exec() defined before mock, list' ); stdout_like( sub { Test::Mock::Cmd::TestUtils::do_in_fork( sub { # Statement unlikely to be reached ... no warnings 'exec'; doesn't help so we combine into one statement exec("/bin/echo unmocked exec defined before mock exec string") || ok( 0, 'unmocked exec() string did not exit' ); } ); }, qr/unmocked exec defined before mock exec string/, 'unmocked exec() defined before mock, string' ); } } use Test::Mock::Cmd \&Test::Mock::Cmd::TestUtils::test_more_is_like_return_42; use Test::Mock::Cmd::TestUtils::Y; diag("Testing Test::Mock::Cmd $Test::Mock::Cmd::VERSION"); my $rc = exec( 'I am exec', 'I am exec', 'exec() mocked' ); is( $rc, 42, "exec() mocked RV" ); my $rca = Test::Mock::Cmd::TestUtils::Y::i_call_exec( 'I am exec in pkg', 'I am exec in pkg', 'exec() in pkg loaded after mocking is mocked' ); is( $rca, 42, "exec() in an other class (loaded after mocking) mocked RV list" ); SKIP: { skip '/bin/echo is required for these tests.', 4 if !-x '/bin/echo'; stdout_like( sub { Test::Mock::Cmd::TestUtils::do_in_fork( sub { Test::Mock::Cmd::TestUtils::X::i_call_exec( "/bin/echo", "exec call defined before mocking list not affected" ); ok( 0, 'unmocked class exec() list did not exit' ); } ); }, qr/exec call defined before mocking list not affected/, 'exec call defined before mocking list not affected' ); stdout_like( sub { Test::Mock::Cmd::TestUtils::do_in_fork( sub { Test::Mock::Cmd::TestUtils::X::i_call_exec("/bin/echo exec call defined before mocking string not affected"); ok( 0, 'unmocked class exec() string did not exit' ); } ); }, qr/exec call defined before mocking string not affected/, 'exec call defined before mocking string not affected' ); stdout_like( sub { Test::Mock::Cmd::TestUtils::do_in_fork( sub { Test::Mock::Cmd::orig_exec( "/bin/echo", "orig_exec list" ); ok( 0, 'unmocked exec() list did not exit' ); } ); }, qr/orig_exec list/, 'orig_exec list' ); stdout_like( sub { Test::Mock::Cmd::TestUtils::do_in_fork( sub { Test::Mock::Cmd::orig_exec("/bin/echo orig_exec string"); ok( 0, 'unmocked exec() string did not exit' ); } ); }, qr/orig_exec string/, 'orig_exec string' ); } Test-Mock-Cmd-0.7/t/perlcritic.t000644 000766 000024 00000000427 12140765262 016756 0ustar00dmueystaff000000 000000 #!perl -T use Test::More; plan skip_all => 'Critic tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::Perl::Critic'; plan skip_all => 'Test::Perl::Critic required for testing PBP compliance' if $@; Test::Perl::Critic::all_critic_ok(); Test-Mock-Cmd-0.7/t/perltidy.t000644 000766 000024 00000000410 12140765263 016443 0ustar00dmueystaff000000 000000 #!perl -T use Test::More; plan skip_all => 'PerlTidy tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::PerlTidy'; plan skip_all => 'Test::PerlTidy required for testing PerlTidy-ness' if $@; Test::PerlTidy::run_tests(); Test-Mock-Cmd-0.7/t/pod-coverage.t000644 000766 000024 00000000576 12140765263 017177 0ustar00dmueystaff000000 000000 #!perl -T use Test::More; plan skip_all => 'POD tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::Pod::Coverage 1.04'; if ($@) { plan skip_all => 'Test::Pod::Coverage 1.04 required for testing POD coverage'; } else { plan tests => 1; } pod_coverage_ok('Test::Mock::Cmd'); # test mods have no POD so no all_pod_coverage_ok(); Test-Mock-Cmd-0.7/t/pod.t000644 000766 000024 00000000361 12140765263 015376 0ustar00dmueystaff000000 000000 #!perl -T use Test::More; plan skip_all => 'POD tests are only run in RELEASE_TESTING mode.' unless $ENV{'RELEASE_TESTING'}; eval 'use Test::Pod 1.14'; plan skip_all => 'Test::Pod v1.14 required for testing POD' if $@; all_pod_files_ok(); Test-Mock-Cmd-0.7/lib/Test/000755 000766 000024 00000000000 13024542041 015636 5ustar00dmueystaff000000 000000 Test-Mock-Cmd-0.7/lib/Test/Mock/000755 000766 000024 00000000000 13024542041 016527 5ustar00dmueystaff000000 000000 Test-Mock-Cmd-0.7/lib/Test/Mock/Cmd/000755 000766 000024 00000000000 13024542041 017232 5ustar00dmueystaff000000 000000 Test-Mock-Cmd-0.7/lib/Test/Mock/Cmd.pm000644 000766 000024 00000022035 13024541125 017574 0ustar00dmueystaff000000 000000 package Test::Mock::Cmd; use strict; use warnings; use Carp (); $Test::Mock::Cmd::VERSION = '0.7'; sub import { if ( @_ == 3 || @_ == 5 || @_ == 7 ) { my ( $class, %override ) = @_; for my $k ( keys %override ) { if ( $k ne 'system' && $k ne 'exec' && $k ne 'qx' ) { Carp::croak('Key is not system, exec, or qx'); } if ( ref( $override{$k} ) ne 'CODE' && ref( $override{$k} ) ne 'HASH' ) { Carp::croak('Not a CODE or HASH reference'); } } no warnings 'redefine'; *CORE::GLOBAL::system = _transmogrify_to_code( $override{'system'}, \&orig_system ) if $override{'system'}; *CORE::GLOBAL::exec = _transmogrify_to_code( $override{'exec'}, \&orig_exec ) if $override{'exec'}; *CORE::GLOBAL::readpipe = _transmogrify_to_code( $override{'qx'}, \&orig_qx ) if $override{'qx'}; return 1; } if ( @_ == 4 ) { for my $idx ( 1 .. 3 ) { Carp::croak('Not a CODE or HASH reference') if ref( $_[$idx] ) ne 'CODE' && ref( $_[$idx] ) ne 'HASH'; } } elsif ( @_ == 2 ) { Carp::croak('Not a CODE or HASH reference') if ref( $_[1] ) ne 'CODE' and ref( $_[1] ) ne 'HASH'; } else { Carp::croak( __PACKAGE__ . '->import() requires a 1-3 key hash, 1 code/hash reference, or 3 code/hash references as arguments' ); } no warnings 'redefine'; *CORE::GLOBAL::system = _transmogrify_to_code( $_[1], \&orig_system ); *CORE::GLOBAL::exec = _transmogrify_to_code( $_[2] || $_[1], \&orig_exec ); *CORE::GLOBAL::readpipe = _transmogrify_to_code( $_[3] || $_[1], \&orig_qx ); } # This doesn't make sense w/ the once-set-always-set behavior of these functions and it's just weird so we leave it out for now. # If there is a way to get it to take effect like other use/no then patches welcome! # sub unimport { # no warnings 'redefine'; # *CORE::GLOBAL::system = \&orig_system; # it'd be nice to assign the CORE::system directly instead of the \&orig_system # *CORE::GLOBAL::exec = \&orig_exec; # it'd be nice to assign the CORE::exec directly instead of the \&orig_exec # *CORE::GLOBAL::readpipe = \&orig_qx; # it'd be nice to assign the CORE::readpipe directly instead of the \&orig_qx # } sub orig_system { # goto &CORE::system won't work here, but it'd be nice return CORE::system(@_); } sub orig_exec { # goto &CORE::exec won't work here, but it'd be nice return CORE::exec(@_); } sub orig_qx { # goto &CORE::readpipe won't work here, but it'd be nice return CORE::readpipe( $_[0] ); # we use $_[0] because @_ results in something like 'sh: *main::_: command not found' } sub _transmogrify_to_code { my ( $val, $orig ) = @_; return $val if ref($val) eq 'CODE'; return sub { if ( exists $val->{ $_[0] } ) { return $val->{ $_[0] }->(@_); } else { goto &$orig; } }; } 1; __END__ =encoding utf8 =head1 NAME Test::Mock::Cmd - Mock system(), exec(), and qx() for testing =head1 VERSION This document describes Test::Mock::Cmd version 0.7 =head1 SYNOPSIS use Test::Mock::Cmd 'system' => \&my_cmd_mocker, 'qx' => \&my_cmd_mocker; or use Test::Mock::Cmd \&my_cmd_mocker; or use Test::Mock::Cmd \&my_mock_system, \&my_mock_exec, \&my_mock_qx; or use Test::Mock::Cmd 'system' => { … }, 'qx' => { … }; # can mix and match hash ref and code ref or use Test::Mock::Cmd { … }; or use Test::Mock::Cmd { … }, { … }, { … }; # can mix and match hash ref and code ref Typical testing usage example: use Test::More; our $current_system = sub { diag( explain( \@_ ) ); return 0; }; use Test::Mock::Cmd 'system' => sub { $current_system->(@_) }; use Foo; … { my $sys; local $current_system = sub { $sys = \@_ }; foo(1); is($sys, undef, 'foo() does not call system w/ true arg'); $sys = undef; # just in case foo(); isnt($sys, undef, 'foo() calls system by default'); is_deeply($sys, [qw(/bin/chibby -wibby foo)], 'foo() calls system with expected args); } { local $current_system = sub { return 0 }; ok foo(), 'foo() returns true when system() works'; } { local $current_system = sub { return 1 }; ok !foo(), 'foo() returns false when system() fails'; } … done_testing; =head1 DESCRIPTION Mock system(), exec(), qx() (AKA `` and readpipe()) with your own functions in order to test code that may call them. Some uses might be: =over 4 =item 1 avoid actually running the system command, just pretend we did (simulate [un]expected output, return values, etc) =item 2 test various return value handling (e.g. the system command core dumps how does the object handle that) =item 3 test that the arguments that will be passed to a system command are correct =item 4 simulate that really hard to reproduce low level edge case to make sure your code works correctly on affected systems =item 5 etc etc =back =head1 INTERFACE =head2 Commence mocking Per the synopsis, you can provide import() with a hash whose keys are 'system', 'exec', or 'qx' and whose values are the code reference you want to replace the key's functionality with, 1 code reference to replace all 3 functions or 3 code references to replace system(), exec(), and qx() (in that order). As of v0.6 you can pass in a hash instead of a coderef that will generate a handler that defaults to the original call if the first argument given is not a key in said hash. use Test::Mock::Cmd 'system' => { 'git' => sub { … }, }; system('git', …); # calls your function system('whatever', …); # calls the original system =head3 Caveat Any code loaded before the mock functions are setup will retain normal system(), etc behavior. (even if the system() does not happen until much later!) use X; # has functions that call system() use Test::Mock::Cmd ... use Y; # has functions that call system() X::i_call_system(...); # normal system() happens Y::i_call_system(...); # mocked system() happens =head2 Getting access to the original, un-mocked, functionality. None of these are exportable. =over =item Test::Mock::Cmd::orig_system() Original, not-mocked L =item Test::Mock::Cmd::orig_exec() Original, not-mocked L =item Test::Mock::Cmd::orig_qx() Original, not-mocked L =back =head1 DIAGNOSTICS =over =item C<< Not a CODE or HASH reference >> The given value is not a code reference or a hash reference and should be one or the other. =item C<< Key is not system, exec, or qx >> A key in your argument hash is invalid. =item C<< Test::Mock::Cmd->import() requires a 1-3 key hash, 1 code/hash reference, or 3 code/hash references as arguments >> You are not passing in the required one or three arguments. =back =head1 CONFIGURATION AND ENVIRONMENT Test::Mock::Cmd requires no configuration files or environment variables. =head1 DEPENDENCIES None. =head1 INCOMPATIBILITIES None reported. =head1 BUGS AND FEATURES Please report any bugs or feature requests (and a pull request for bonus points) through the issue tracker at L. =head1 See Also L for a more complex (and much heavier) object based approach to this. =head1 AUTHOR Daniel Muey C<< >> =head1 LICENCE AND COPYRIGHT Copyright (c) 2011 cPanel, Inc. C<< > >>. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. Test-Mock-Cmd-0.7/lib/Test/Mock/Cmd/TestUtils/000755 000766 000024 00000000000 13024542041 021172 5ustar00dmueystaff000000 000000 Test-Mock-Cmd-0.7/lib/Test/Mock/Cmd/TestUtils.pm000644 000766 000024 00000003544 13024541053 021540 0ustar00dmueystaff000000 000000 package Test::Mock::Cmd::TestUtils; use strict; use warnings; sub do_in_fork { my ( $code, @args ) = @_; my $pid = fork(); if ( not defined $pid ) { die "Could not fork: $!"; } elsif ( $pid == 0 ) { $code->(@args); exit 1; } else { waitpid( $pid, 0 ); # parent } } sub test_more_is_like_return_42 { my ( $got, $expected, $name ) = @_; ref($expected) eq 'Regexp' ? Test::More::like( $got, $expected, $name ) : Test::More::is( $got, $expected, $name ); return 42; } # use Test::Output; # rt 72976 # The Perl::Critic test failures will go away when this temp workaround goes away sub tmp_stdout_like_rt_72976 { my ( $func, $regex, $name ) = @_; my $output = ''; { unlink "tmp.$$.tmp"; no warnings 'once'; open OLDOUT, '>&STDOUT' or die "Could not dup STDOUT: $!"; ## no critic close STDOUT; open STDOUT, '>', "tmp.$$.tmp" or die "Could not redirect STDOUT: $!"; # \$output does not capture system() # open STDOUT, '>', \$output or die "Could not redirect STDOUT: $!"; $func->(); open STDOUT, '>&OLDOUT' or die "Could not restore STDOUT: $!"; ## no critic open my $fh, '<', "tmp.$$.tmp" or die "Could not open temp file: $!"; while ( my $line = <$fh> ) { $output .= $line; } close $fh; unlink "tmp.$$.tmp"; } # use Data::Dumper;diag(Dumper([$output,$regex,$name])); Test::More::like( $output, $regex, $name ); } 1; __END__ =head1 LICENCE AND COPYRIGHT Copyright (c) 2011 cPanel, Inc. C<< > >>. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available. Test-Mock-Cmd-0.7/lib/Test/Mock/Cmd/TestUtils/X.pm000644 000766 000024 00000001147 13024541062 021744 0ustar00dmueystaff000000 000000 package Test::Mock::Cmd::TestUtils::X; use strict; use warnings; sub i_call_system { system(@_); } sub i_call_exec { exec(@_); } sub i_call_readpipe { readpipe( $_[0] ); } sub i_call_qx { qx(/bin/echo QX); } sub i_call_backticks { `/bin/echo BT`; } 1; __END__ =head1 LICENCE AND COPYRIGHT Copyright (c) 2011 cPanel, Inc. C<< > >>. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available. Test-Mock-Cmd-0.7/lib/Test/Mock/Cmd/TestUtils/Y.pm000644 000766 000024 00000001147 13024541063 021746 0ustar00dmueystaff000000 000000 package Test::Mock::Cmd::TestUtils::Y; use strict; use warnings; sub i_call_system { system(@_); } sub i_call_exec { exec(@_); } sub i_call_readpipe { readpipe( $_[0] ); } sub i_call_qx { qx(/bin/echo QX); } sub i_call_backticks { `/bin/echo BT`; } 1; __END__ =head1 LICENCE AND COPYRIGHT Copyright (c) 2011 cPanel, Inc. C<< > >>. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available.