I'm trying to use Test::More to unit test Perl functions that print to the screen.
I understand that this output may interfere with tools such as prove.
How can I capture this output so I can print it with diag(), and also run tests on the output itself?
UPDATE: IMHO, the correct answer to this question ought to be to use Test::Output:
#!/usr/bin/perl
use strict; use warnings;
use Test::More tests => 1;
use Test::Output;
sub myfunc { print "This is a test\n" }
stdout_is(\&myfunc, "This is a test\n", 'myfunc() returns test output');
Output:
C:\Temp> tm
1..1
ok 1 - myfunc() returns test output
I am leaving the original answer for reference as, I believe, it still illustrates a useful technique.
You can localize STDOUT and reopen to a scalar before calling the function, restore afterward:
#!/usr/bin/perl
use strict; use warnings;
use Test::More tests => 1;
sub myfunc { print "This is a test\n" }
sub invoke {
my $sub = shift;
my $stdout;
{
local *STDOUT;
open STDOUT, '>', \$stdout
or die "Cannot open STDOUT to a scalar: $!";
$sub->(#_);
close STDOUT
or die "Cannot close redirected STDOUT: $!";
}
return $stdout;
}
chomp(my $ret = invoke(\&myfunc));
ok($ret eq "This is a test", "myfunc() prints test string" );
diag("myfunc() printed '$ret'");
Output:
C:\Temp> tm
1..1
ok 1 - myfunc() prints test string
# myfunc() printed 'This is a test'
For versions of perl older than 5.8, you probably need to use IO::Scalar, but I do not know much about how things worked before 5.8.
I'd look at letting a module handle this for you. Look at Capture::Tiny.
If this is code that you are writing yourself, change it so that the print statements don't use a default filehandle. Instead, give yourself a way to set the output filehandle to anything you like:
sub my_print {
my $self = shift;
my $fh = $self->_get_output_fh;
print { $fh } #_;
}
sub _get_output_fh { $_[0]->{_output} || \*STDOUT }
sub _set_output_fh { $_[0]->{_output} = $_[1] } # add validation yourself
When you test, you can call _set_output_fh to give it your testing filehandle (perhaps even an IO::Null handle). When another person wants to use your code but capture the output, they don't have to bend over backward to do it because they can supply their own filehandle.
When you find a part of your code that is hard to test or that you have to jump through hoops to work with, you probably have a bad design. I'm still amazed at how testing code makes these things apparent, because I often wouldn't think about them. If it's hard to test, make it easy to test. You generally win if you do that.
Related
#!/bin/perl
open( $WP, ">/home/Octa.txt" );
# Subroutine test
sub test {
$var1 = shift;
print $WP "TESTING\n";
}
# Subroutine func
sub func {
$var = shift;
if ( $var eq "Ocat" ) {
print $WP "String found\n";
test($var);
}
else {
print $WP "String not found\n";
}
}
$var3 = "Octa";
func($var3);
The issue is that the code is not able to write anything within the test subroutine or within the if condition of the 'funcsubroutine, but it prints in theelse` part of the 'func' subroutine.
First off, there is a typo -- you test $var against "Ocat", while Octa is intended.
So the test subroutine never gets called and only String not found is printed.
With that corrected and with the output file in a user writeable location, your program works.
However, some improvements are necessary.
use warnings;
use strict;
my $file = 'Octa.txt';
open my $WP, '>', $file or die "Can't open $file: $!";
my $var3 = "Octa";
func($WP, $var3);
#Subroutine test
sub test{
my ($fh, $var1) = #_;
print $fh "TESTING\n";
}
#Subroutine func
sub func{
my ($fh, $var) = #_;
if ($var eq "Octa"){
print $fh "String found\n";
test($fh, $var);
}
else {
print $fh "String not found\n";
}
}
I've changed the output file name since a user normally may not write to /home directory.
Comments
It is much better to use the three-argument form of open, in which case you get a lexical file handle which can be passed around nicely and is scoped. This question is a good example of how a global file handle can make things confusing, to say the least.
Always check the open call. For one thing, can you really write to /home directory?
Please always start programs with use warnings; and use strict;
There is another possibility for failure, which brings together practices in the comments above.
A file in /home normally isn't writeable by a user, in which case the posted program cannot work.
But without a check of open (which will fail) and without use warnings (which would be printed every time we touch the invalid $WH filehandle) we will not see any of these errors; instead, the program will quietly run and complete but it won't write the output file.
Suppose we have:
sub test {
print "testing\n";
}
If there is a case where I want to have it print to stderr instead of stdout, is there a way I can call the subroutine to do this? Or can I capture the output to a variable and then use warn? I'm fairly new to perl.
Yes there is. print sends its output to the "selected" filehandle, which is usually STDOUT. But Perl provides the select function for you to change it.
select(STDERR);
&test; # send output to STDERR
select(STDOUT); # restore default output handle
The select function returns the previously selected filehandle, so you can capture it and restore it later.
my $orig_select = select(STDERR);
&test;
select($orig_select);
Perl's dynamic scoping via local() is not often used, but this strikes me as a good application for it:
test(); # to stdout
{
open(local *STDOUT, ">&STDERR") or die "dup out to err: $!";
test(); # to stderr, locally calling it "STDOUT"
}
test(); # to stdout again
The call to test() in the block above -- as well as to anything that test() itself might call -- will have STDOUT dynamically scoped to your duplicate of STDERR. When control leaves the block, even if by die()ing, STDOUT will be restored to whatever it was before the block
Generalized:
sub out2err(&) {
my $user_block = shift;
open(local *STDOUT, ">&STDERR") or die $!;
$user_block->();
}
test(); # to stdout
out2err { test() }; # to stderr
test(); # to stdout
Meanwhile, you can also "capture a subroutine's print output to a variable."
Just pass a scalar ref to open:
#! /usr/bin/env perl
use common::sense;
use autodie;
sub tostring (&) {
my $s;
open local *STDOUT, '>', \$s;
shift->();
$s
}
sub fake {
say 'lalala';
say 'more stuff';
say 1 + 1, ' = 2';
say for #_;
}
for (tostring { fake(1, 2, 3) }) {
s/\n/\\n/g;
say "Captured as string: >>>$_<<<";
}
Output:
Captured as string: >>>lalala\nmore stuff\n2 = 2\n1\n2\n3\n<<<
This work for me
local *STDOUT;
open(STDOUT, ">", \$Result);
&test();
print $Result;
I need to know how to customize my own errors in Perl. For instance, here's some code:
my $filename = 'filaname1.exe';
print "Copying $filename";
copy("$dir_root\\$filename", "$spcl_dir\\$filename");
if ($? == "0") {
print " - Success!\n";
}
else { print " - Failure!\n"; }
I tried to write this and "catch" the error and print "Failure" when I don't get an exit code of 0, and print "Success" when I do. I need to know how I can customize this; I don't really want to use die or anything like that where it will give a somewhat cryptic error (to the end user).
Thanks!
You need to read the documentation on $? in perlvar. This value is:
The status returned by the last pipe
close, backtick ("``") command,
successful call to wait() or
waitpid(), or from the system()
operator.
Your call to copy (presumably from File::Copy) doesn't far into any of those categories, so $? isn't set.
However, if you read the documentation for File::Copy, you'll see that its function all "return 1 on success, 0 on failure". So you can simplify your code a lot.
#!/usr/bin/perl
use strict; use warnings;
use File::Copy;
if (copy('notthere', 'somewhere else')) {
warn "success\n";
} else {
warn "failure: $!\n";
}
Note that I've used "warn" rather than "print" so that the errors go to STDERR. Note, also, the use of $! to display the operating system error. This can, of course, be omitted if it's not user-friendly enough.
Are you using File::Copy? You must be using something, because copy() isn't a perl keyword or built-in function.
The documentation of File::Copy doesn't refer to $? at all, so that's probably your mistake. You want to check the return value, and only if it's zero, refer to $!.
use strict;
use File::Copy qw(copy);
my ($from, $to) = #ARGV;
my $res = copy ($from, $to);
if( $res ){
print "Okay\n";
}
else{
print "Not Okay: $!\n";
}
I want to pass a lexical file handle to a subroutine using a named argument, but the following does not compile:
#!/usr/bin/perl -w
use strict;
my $log_fh;
my $logname = "my.log";
sub primitive {
my ($fh, $m) = #_;
print $fh $m;
}
sub sophisticated {
my ($args) = #_;
print $args->{m};
print $args->{fh} $args->{m} ;
}
open $log_fh, ">", $logname;
print $log_fh "Today I learned ...\n";
primitive($log_fh,"... the old way works ...\n");
sophisticated({
fh=>$log_fh,
m=>"... and the new way requires an intervention by SO.",
});
close $log_fh;
The complaint is:
Scalar found where operator expected at ./lexical.file.handle.pl line 15, near
} $args"
(Missing operator before $args?)
$ perl --version
This is perl, v5.10.1
It works O.K. when I use the primitive technique of passing arguments, and the named-argument hash technique works for the message portion, just not for the file handle portion. Do I need a new version of print ?
When you've got a complex expression that returns a filehandle (like $args->{fh}) you'll need to disambiguate the syntax a bit by adding some extra curlies:
print { $args->{fh} } $args->{m};
This is due to the weird way the print operator is designed, with no comma between the filehandle and the list of stuff to print.
Alternatively, you could grab the filehandle out of your arguments hashref first, e.g.
my $fh = $args->{fh};
print $fh $args->{m};
friedo's answer covers your problem, but there's a stylistic issue I'd like to point out. You don't need to wrap everything in an anonymous hash to emulate named arguments. A hash initializer is just a list interpreted as key/value pairs. Passing such a list to a sub provides a cleaner syntax for the caller:
sub sophisticated {
my %arg = #_;
print $arg{m};
print {$arg{fh}} $arg{m};
}
sophisticated(fh => $log_fh, m => "Hello, world!\n");
Requirement is to pass module name and function name from the command-line argument.
I need to get the command-line argument in the program and I need to call that function from that module
For example, calling a try.pl program with 2 arguments: MODULE1(Module name) Display(Function name)
perl try.pl MODULE1 Display
I want to some thing like this, but its not working, please guide me:
use $ARGV[0];
& $ARGV[0]::$ARGV[1]();
Assuming the function is not a class method, try this:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package (); ${package}::$function()";
die $# if $#;
Keep in mind that this technique is wide open to code injection. (The arguments could easily contain any Perl code instead of a module name.)
There's many ways to do this. One of them is:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package; 1" or die $#;
$package->$function();
Note the the first argument of the function will be $package.
Assuming the module exports the function, this should do:
perl -Mmodule -e function
If you want to make sure your perl script is secure (or at least, prevent yourself from accidentally doing something stupid), I'd avoid doing any kind of eval on data passed in to the script without at least some kind of checking. But, if you're doing some kind of checking anyway, and you end up explicitly checking the input, you might as well explicitly spell out witch methods you want to call. You could set up a hash with 'known good' methods, thus documenting everything that you want callable and protecting yourself at the same time.
my %routines = (
Module => {
Routine1 => \&Module::Method,
Routine2 => \&Module::Method2,
},
Module2 => {
# and so on
},
);
my $module = shift #ARGV;
my $routine = shift #ARGV;
if (defined $module
&& defined $routine
&& exists $routines{$module} # use `exists` to prevent
&& exists $routines{$module}{$routine}) # unnecessary autovivication
{
$routines{$module}{$routine}->(#ARGV); # with remaining command line args
}
else { } # error handling
As a neat side effect of this method, you can simply iterate through the methods available for any kind of help output:
print "Available commands:\n";
foreach my $module (keys %routines)
{
foreach my $routine (keys %$module)
{
print "$module::$routine\n";
}
}
As per Leon's, if the perl module doesn't export it, you can call it like so
perl -MMyModule -e 'MyModule::doit()'
provided that the sub is in that package.
If it exports the sub all the time (in #EXPORT), then Leon's will work:
perl -MMyModule -e doit
If it is an optional export (in #EXPORT_OK), then you can do it like this.
perl -MMyModule=doit -e doit
But the first will work in any case where the sub is defined to the package, and I'd probably use that one over the last one.
Always start your Perl like this:
use strict;
use warnings 'all';
Then do this:
no strict 'refs';
my ($class, $method) = #_;
(my $file = "$class.pm") =~ s/::/\//g;
require $file;
&{"$class\::$method"}();
Whatever you do, try not to eval "$string" ever.
Well, for your revised question, you can do this:
use strict;
use warnings;
{
no strict;
use Symbol qw<qualify>;
my $symb = qualify( $ARGV[1], $ARGV[0] );
unless ( defined &{$symb} ) {
die "&$ARGV[1] not defined to package $ARGV[0]\::";
}
&{$symb};
}
And because you're specifying it on the command line, the easiest way to include from the command line is the -M flag.
perl -MMyModule try.pl MyModule a_subroutine_which_does_something_cool
But you can always
eval "use $ARGV[0];";
But that's highly susceptible to injection:
perl try.pl "Carp; `do something disastrous`;" no_op
I'd use UNIVERSAL::require. It allows you to require or use a module from a variable. So your code would change to something like this:
use UNIVERSAL::require;
$ARGV[0]->use or die $UNIVERSAL::require::ERROR;
$ARGV[0]::$ARGV[1]();
Disclaimer: I did not test that code and I agree Robert P's comment about there probably being a better solution than passing these as command line arguments.