Thanks for the input which seems to have brought me a huge step forward. I did some tests and tries and following the code and my findings for future reference.
Since there was such a strong bias towards putting anything into a module, I tried your quiet radical way of
#!/usr/bin/perl
use NaServer qw(run);
run(@ARGV);
First I had to rewrite my example, adopting it towards real-life in order to have something on which I can prove, that I can test what I want to test even if it is wrapped into module. The background was, that I wanted to write an integration-test, which takes some command-line arguments, feeds them to the tested script and checks, if the output is what I expect. Here comes the script-version, which is the common way of handling user-input but is hard to test.
Script Version
The test-stcript; the tested script is beneath the DATA-token. This code does not run, due to a redefinition of a sub_say. (At least not the testing-code, the tested script just runs fine.)
#!/usr/bin/perl -w
use warnings;
use strict;
use feature qw(switch say);
use English;
use Test::More tests => 20; #'no_plan';
use Test::MockObject;
use Test::Output;
use Test::Trap;
my $mock = Test::MockObject->new();
$mock->fake_module ('NaServer',
new => sub { return 'NaServer' },
get_val => sub { return 500 },
);
use_ok( 'NaServer' ) or exit; ## includes 'use NaServer;'
# Construction of $s just for testing
my $s = NaServer->new( 'sim8aXXXXXX', 1, 6 );
isa_ok( $s, 'NaServer');
# ==================================
# = Tests of the script start here =
# ==================================
use File::Slurp;
#my $script = 'script_to_test_with_subs.pl'; # used __DATA__ instead
my $code_to_test = do { local $/; <DATA> };
my @cases = (
{
name => 'wrong_threshold',
argv => 'hudriwudri',
expected_stdout => qr'invalid argument',
expected_stderr => '',
expected_exit => 3,
},
{
name => 'high_threshold',
argv => 1000,
expected_stdout => qr'OK',
expected_stderr => '',
expected_exit => 0,
}
);
foreach my $case (@cases) {
use_ok('NaServer');
can_ok( 'NaServer', 'new');
can_ok( 'NaServer', 'get_val');
my @r = trap {
$ARGV[0] = $case->{'argv'};
#eval read_file($script);
eval $code_to_test; ## no critic (ProhibitStringyEval)
if (defined $EVAL_ERROR) { die $EVAL_ERROR };
};
if ($trap->die) {
croak $trap->die;
}
if ($trap->warn) {
foreach (@{$trap->warn}) {
warn $_ . "\n";
}
}
like ( $trap->stdout, $case->{'expected_stdout'},
"$case->{'name'}: stdout as expected" );
is ( $trap->stderr, $case->{'expected_stderr'},
"$case->{'name'}: stderr as expected" );
is ( $trap->exit, $case->{'expected_exit'},
"$case->{'name'}: exit-value as expected" );
}
__DATA__
# ==================
# = Script to Test =
# ==================
#!/usr/bin/perl -w
use warnings;
use strict;
use feature qw(switch say);
use NaServer;
my $threshold = $ARGV[0] || exit 3;
if ($threshold =~ /\d+/) {
my $session = NaServer->new();
my $val = $session->get_val();
if ($val > $threshold ) {
say_it ("Value to high: " . $val);
exit 2;
} else {
say_it ("Value OK ($val)");
exit 0;
}
} else {
say 'invalid argument';
exit 3;
}
sub say_it {
my $msg = shift;
say $msg;
return;
}
Module-Version of the same logic and functionality.
As suggested by moritz I put all logic into a module. This should be easier to test.
Extension-Module (NaServerExt.pm, replacement for the "Script to Test" in the above example)
package NaServerExt;
# this is a wrapper around the *dummy version* of NaServer !!
use strict;
use warnings;
use feature qw( say );
use Carp;
use NaServer;
sub run {
my ($self, @argv) = @_;
my $threshold = $argv[0] || croak 'no arguments';
if ($threshold =~ /\d+/) {
my $session = NaServer->new();
my $val = $session->get_val();
if ($val > $threshold ) {
_say_it ("Value to high: " . $val);
exit 2;
} else {
_say_it ("Value OK ($val)");
exit 0;
}
} else {
say 'invalid argument';
exit 3;
}
}
sub _say_it {
my $msg = shift;
say $msg;
return;
}
1;
__END__
=pod
=head1 USAGE
This module substitutes a script using NaServer.pm (the dummy-version
+only!).
This way it is easier to test.
It could be used by a script like this:
#!/usr/bin/perl -w
use warnings;
use strict;
use NaServerExt;
NaServerExt->run(@ARGV);
__END__
Do not forget: This is just for demonstrating something about testing
+and has
nearly to nothing to do with NetApps NaServer modules!!
=cut
Testscript (NaServerExt.t)
The above module allows to write a clean and relatively simple test, with mocking and various user-input simulated.
#!/usr/bin/perl -w
use warnings;
use strict;
use feature qw( say );
use English;
use Test::More tests => 26; #'no_plan';
use Test::MockObject;
use Test::Output;
use Test::Trap;
my $mock = Test::MockObject->new();
$mock->fake_module ('NaServer',
new => sub { return 'NaServer' },
get_val => sub { return 500 },
);
use_ok( 'NaServer' ) or exit; ## includes 'use NaServer;'
# Construction of $s just for testing
my $s = NaServer->new( 'sim8aXXXXXX', 1, 6 );
isa_ok( $s, 'NaServer');
# ==================================
# = Tests of the module start here =
# ==================================
my @cases = (
{
name => 'wrong_threshold',
argv => 'hudriwudri',
expected_stdout => qr'invalid argument',
expected_stderr => '',
expected_exit => 3,
},
{
name => 'high_threshold',
argv => 1000,
expected_stdout => qr'OK',
expected_stderr => '',
expected_exit => 0,
},
{
name => 'low_threshold',
argv => 20,
expected_stdout => qr'Value\ to\ high',
expected_stderr => '',
expected_exit => 2,
}
);
foreach my $case (@cases) {
use_ok('NaServer');
can_ok( 'NaServer', 'new');
can_ok( 'NaServer', 'get_val');
use_ok('NaServerExt');
can_ok('NaServerExt', 'run');
my @r = trap {
NaServerExt->run($case->{'argv'});
};
if ($trap->die) {
croak $trap->die;
}
if ($trap->warn) {
foreach (@{$trap->warn}) {
warn $_ . "\n";
}
}
like ( $trap->stdout, $case->{'expected_stdout'},
"$case->{'name'}: stdout as expected" );
is ( $trap->stderr, $case->{'expected_stderr'},
"$case->{'name'}: stderr as expected" );
is ( $trap->exit, $case->{'expected_exit'},
"$case->{'name'}: exit-value as expected" );
}
Conclusion
Since the radical approach of writing minimal scripts and several layers of modules makes the code easier to test, I will try to redesign the script in this direction. Thanks again!
Appendix
The NaServer.pm, if someone wants to play with the examples above:
package NaServer;
# this is just a dummy version of NetApps NaServer !!
use strict;
use warnings;
use Carp;
sub new {
my $class = shift;
my $self = {};
bless \$self, $class;
}
sub get_val {
return rand 1000;
}
1;
|