How to print hash keys inside unit tests? [duplicate] - perl

It appears that simply putting a say, print, etc into a .t doesn't work. The output is hidden. So when using Test::More and Test::Tester how can I simply print something? I want this so I can play with some code while determining how to test it. note: it's ok if it's sent to stderr or only viewable using verbose. Also I dried using diag but that didn't appear to work just anywhere in the test.

If you run a test script directly, you will see the output of print -- tests are just Perl code. However, if you run your tests using a harness, what you see in the output will be determined by the harness, especially its verbosity level, and by whether you print to STDOUT or STDERR.
For another way to print messages within tests, see Diagnostics in the documentation for Test::More, notably:
diag(...);
note(...);
Experimenting with a script like this will quickly illustrate how things work:
# Example usages:
# perl some_test.t # We see everything in output.
# prove some_test.t # We see only diag() and STDERR.
# prove -v some_test.t # Everything again.
# In some_test.t
use strict;
use warnings;
use Test::More;
pass;
diag("diag()");
note("note()");
print "STDOUT\n";
print STDERR "STDERR\n";
done_testing;

Related

How to manually create TAP output

There is a great Perl module
Test::More that everybody uses for
unit testing. Here is the very simple script t/sample_1.t:
use Test::More tests => 1;
fail('This test fails');
I wanted to write script that does the same thing, but without
Test::More.
I've read several the docs about TAP (test anything protocol) to find out how to write the script. I've read:
Wikipedia article about TAP
TAP specification
Unfortunately the documentation wasn't enough. I had to examine the output of script that uses Test::More to find out that I need to output diagnostics to STDERR (there was nothing about this in the docs).
So, I have written a script that does completely the same things as the script with Test::More script. Here is the listing of t/sample_2.t:
$| = 1;
print "1..1\n";
print "not ok 1 - This test fails\n";
print STDERR "# Failed test 'This test fails'\n";
print STDERR "# at t/sample_1.t line 3.\n";
print STDERR "# Looks like you failed 1 test of 1.\n";
exit 1;
But when using prove these 2 scripts output different things. The line "# Failed test 'This test fails'" in prove is displayed on different lines for different tests. Here is the screenshot:
I've written a test scripts that uses Capture::Tiny to check that STDERR, STDOUT and exit code for both scripts a identical. And the script shows that both scripts output the same things.
I've stored all the test files and a test script at GitHub repo.
My question. How should I write Perl unit test without Test::More to have the same output as with Test::More.
PS If you are interested why I need this. I need this to solve the issue of my Perl module Test::Whitespaces.
While I've got absolutely no frickin idea what's going on, I can get the outputs to match (visually at least) by including the following before any other output to STDERR:
print STDERR "\r";
This makes them match visually when run through prove or plain old perl. However, this is NOT what Test::More is doing.
The TAP you're outputting is per spec; if prove wants to treat it differently from the TAP Test::More is outputting, I'd argue that's a bug (or at least an oddity) in prove. Personally when I've written Test modules, I've always used Test::Builder or wrapped Test::More to output the TAP. Each of these is a core module. This seems to be what the majority of Test modules tend to do.
At last I have found out what is going on.
hobbs has advised me to use Test::Builder. I created test script with
Test::Builder that worked exaclty as the script with Test::More (here
it is).
Then I started examinig source code of Test::Builder to find out why the
source of such behaviour. Here is the part of lib/TB2/Formatter/TAP/Base.pm
file:
# Emit old style comment failure diagnostics
sub _comment_diagnostics {
my($self, $result) = #_;
...
# Start on a new line if we're being output by Test::Harness.
# Makes it easier to read
$self->$out_method("\n") if ($out_method eq 'err') and $ENV{HARNESS_ACTIVE};
$self->$diag_method($msg);
return;
}
So, this is the answer. prove sets up special environment variable
HARNESS_ACTIVE and Test::More and friends puts additional line break symbol
"\n" before any diagnostics that are printed to STDERR.
At last I've created test script that outputs exactly the same as the script
written with Test::More. Source code of the script.
I really don't like this solution. It took me and outher peopler much time to
find out what is going on. I'm sure that the task of pretty output should be
solved in TAP parsers, and not in TAP producers.
=(

Reopen STDERR/STDOUT to write to combined logfile with timestamps

I basically want to reopen STDERR/STDOUT so they write to one logfile with both the stream and the timestamp included on every line. So print STDERR "Hello World" prints STDERR: 20130215123456: Hello World. I don't want to rewrite all my print statements into function calls, also some of the output will be coming from external processes via system() calls anyway which I won't be able to rewrite.
I also need for the output to be placed in the file "live", i.e. not only written when the process completes.
(p.s. I'm not asking particularly for details of how to generate timestamps, just how to redirect to a file and prepend a string)
I've worked out the following code, but it's messy:
my $mode = ">>";
my $file = "outerr.txt";
open(STDOUT, "|-", qq(perl -e 'open(FILE, "$mode", "$file"); while (<>) { print FILE "STDOUT: \$\_"; }'));
open(STDERR, "|-", qq(perl -e 'open(FILE, "$mode", "$file"); while (<>) { print FILE "STDERR: \$\_"; }'));
(The above doesn't add dates, but that should be trivial to add)
I'm looking for a cleaner solution, one that doesn't require quoting perl code and passing it on the command line, or at least module that hides some of the complexity. Looking at the code for Capture::Tiny it doesn't look like it can handle writing a part of output, though I'm not sure about that. annotate-output only works on an external command sadly, I need this to work on both external commands and ordinary perl printing.
The child launched via system doesn't write to STDOUT because it does not have access to variables in your program. Therefore, means having code run on a Perl file handle write (e.g. tie) won't work.
Write another script that runs your script with STDOUT and STDERR replaced with pipes. Read from those pipes and print out the modified output. I suggest using IPC::Run to do this, because it'll save you from using select. You can get away without it if you combine STDOUT and STDERR in one stream.

Perl - New definition of myprint() or Overload print command

I am a newb to Perl. I am writing some scripts and want to define my own print called myprint() which will print the stuff passed to it based on some flags (verbose/debug flag)
open(FD, "> /tmp/abc.txt") or die "Cannot create abc.txt file";
print FD "---Production Data---\n";
myprint "Hello - This is only a comment - debug data";
Can someone please help me with some sample code to for myprint() function?
Do you care more about writing your own logging system, or do you want to know how to put logging statements in appropriate parts of your program which you can turn off (and, incur little performance penalty when they are turned off)?
If you want a logging system that is easy to start using, but also offers a world of features which you can incrementally discover and use, Log::Log4perl is a good option. It has an easy mode, which allows you to specify the desired logging level, and emits only those logging messages that are above the desired level.
#!/usr/bin/env perl
use strict; use warnings;
use File::Temp qw(tempfile);
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init({level => $INFO});
my ($fh, $filename) = tempfile;
print $fh "---Production Data---\n";
WARN 'Wrote something somewhere somehow';
The snippet also shows a better way of opening a temporary file using File::Temp.
As for overriding the built-in print … It really isn't a good idea to fiddle with built-ins except in very specific circumstances. perldoc perlsub has a section on Overriding Built-in Functions. The accepted answer to this question lists the Perl built-ins that cannot be overridden. print is one of those.
But, then, one really does not need to override a built-in to write a logging system.
So, if an already-written logging system does not do it for you, you really seem to be asking "how do I write a function that prints stuff conditionally depending on the value of a flag?"
Here is one way:
#!/usr/bin/env perl
package My::Logger;
{
use strict; use warnings;
use Sub::Exporter -setup => {
exports => [
DEBUG => sub {
return sub {} unless $ENV{MYDEBUG};
return sub { print 'DEBUG: ' => #_ };
},
]
};
}
package main;
use strict; use warnings;
# You'd replace this with use My::Logger qw(DEBUG) if you put My::Logger
# in My/Logger.pm somewhere in your #INC
BEGIN {
My::Logger->import('DEBUG');
}
sub nicefunc {
print "Hello World!\n";
DEBUG("Isn't this a nice function?\n");
return;
}
nicefunc();
Sample usage:
$ ./yy.pl
Hello World!
$ MYDEBUG=1 ./yy.pl
Hello World!
DEBUG: Isn't this a nice function?
I wasn't going to answer this because Sinan already has the answer I'd recommend, but tonight I also happened to be working on the "Filehandle References" chapter to the upcoming Intermediate Perl. That are a couple of relevant paragraphs which I'll just copy directly without adapting them to your question:
IO::Null and IO::Interactive
Sometimes we don't want to send our output anywhere, but we are forced
to send it somewhere. In that case, we can use IO::Null to create
a filehandle that simply discards anything that we give it. It looks
and acts just like a filehandle, but does nothing:
use IO::Null;
my $null_fh = IO::Null->new;
some_printing_thing( $null_fh, #args );
Other times, we want output in some cases but not in others. If we are
logged in and running our program in our terminal, we probably want to
see lots of output. However, if we schedule the job through cron, we
probably don't care so much about the output as long as it does the job.
The IO::Interactive module is smart enough to tell the difference:
use IO::Interactive;
print { is_interactive } 'Bamboo car frame';
The is_interactive subroutine returns a filehandle. Since the
call to the subroutine is not a simple scalar variable, we surround
it with braces to tell Perl that it's the filehandle.
Now that you know about "do nothing" filehandles, you can replace some
ugly code that everyone tends to write. In some cases you want output
and in some cases you don't, so many people use a post-expression
conditional to turn off a statement in some cases:
print STDOUT "Hey, the radio's not working!" if $Debug;
Instead of that, you can assign different values to $debug_fh based
on whatever condition you want, then leave off the ugly if $Debug
at the end of every print:
use IO::Null;
my $debug_fh = $Debug ? *STDOUT : IO::Null->new;
$debug_fh->print( "Hey, the radio's not working!" );
The magic behind IO::Null might give a warning about "print() on
unopened filehandle GLOB" with the indirect object notation (e.g.
print $debug_fh) even though it works just fine. We don't get that
warning with the direct form.

Problem with perl signal INT

I have the following perl code on windows activestate perl 5.8
$SIG{INT}=\&clean;
...
sub clean {
print 'cleaning...';
...
...
exit 0;
}
but when i try to close my program by Ctrl^c it didn't enter the sub clean at all could someone help why did i miss something ?
It seems that Windows doesn't provide signals as in Unix.
From man perlwin32:
Signal handling may not behave as on Unix platforms (where it doesn't
exactly "behave", either :). For instance, calling "die()" or "exit()"
from signal handlers will cause an exception, since most implementations
of "signal()" on Win32 are severely crippled. Thus, signals may
work only for simple things like setting a flag variable in the handler.
Using signals under this port should currently be considered
unsupported.
I'd say no. I can't see anything wrong with what you're doing. I wrote a test program that actually runs:
#!/usr/bin/perl
use strict;
use warnings;
$SIG{INT}=\&clean;
sub clean {
print 'caught';
}
sleep 10;
Tested on Linux, this works as expected, but I don't have AS perl handy to try it. Try it yourself on your machine.
Also, print to STDERR to ensure it's not something very odd going on with print buffering.
I found that the script given by #ijw (modified to be what it is below) does not work under Active State Perl version v5.10.1:
This is perl, v5.10.1 built for MSWin32-x86-multi-thread
(with 2 registered patches, see perl -V for more detail)
My modification below adds the autoflush calls (as otherwise the sleep
below would not show the print statement output at all while
sleeping):
#!/usr/bin/perl
use IO;
use strict;
use warnings;
# Set autoflushing on to stdout and stderr. Otherwise, system() call and stdout output does not show up in proper sequence,
# especially on Windows:
STDOUT->autoflush(1);
STDERR->autoflush(1);
$SIG{INT}=\&clean;
sub clean {
print "caught\n";
exit (0);
}
print "before sleep\n";
sleep 100;
print "after sleep and then exiting\n";
exit (0);
When I commented out the following lines in that script above:
$SIG{INT}=\&clean;
sub clean {
print "caught\n";
exit (0);
}
And then hitting CTRL-C during the sleep, the script does terminate and show this message:
Terminating on signal SIGINT(2)
Hence it must actually still be true (well, for ActiveState Perl v5.10.1) what man perlwin32 states:
... most implementations of "signal()" on Win32 are severely crippled. ...
For future reference:
perlmonks refers to the use of Win32::API to setup a call to the SetConsoleCtrlHandler Win32 function.
All about SetConsoleCtrlHandler.

How do I run a Perl script from within a Perl script?

I've got a Perl script that needs to execute another Perl script. This second script can be executed directly on the command line, but I need to execute it from within my first program. I'll need to pass it a few parameters that would normally be passed in when it's run standalone (the first script runs periodically, and executes the second script under a certain set of system conditions).
Preliminary Google searches suggest using backticks or a system() call. Are there any other ways to run it? (I'm guessing yes, since it's Perl we're talking about :P ) Which method is preferred if I need to capture output from the invoked program (and, if possible, pipe that output as it executes to stdout as though the second program were invoked directly)?
(Edit: oh, now SO suggests some related questions. This one is close, but not exactly the same as what I'm asking. The second program will likely take an hour or more to run (lots of I/O), so I'm not sure a one-off invocation is the right fit for this.)
You can just do it.
{
local #ARGV = qw<param1 param2 param3>;
do '/home/buddy/myscript.pl';
}
Prevents the overhead of loading in another copy of perl.
The location of your current perl interpreter can be found in the special variable $^X. This is important if perl is not in your path, or if you have multiple perl versions available but which to make sure you're using the same one across the board.
When executing external commands, including other Perl programs, determining if they actually ran can be quite difficult. Inspecting $? can leave lasting mental scars, so I prefer to use IPC::System::Simple (available from the CPAN):
use strict;
use warnings;
use IPC::System::Simple qw(system capture);
# Run a command, wait until it finishes, and make sure it works.
# Output from this program goes directly to STDOUT, and it can take input
# from your STDIN if required.
system($^X, "yourscript.pl", #ARGS);
# Run a command, wait until it finishes, and make sure it works.
# The output of this command is captured into $results.
my $results = capture($^X, "yourscript.pl", #ARGS);
In both of the above examples any arguments you wish to pass to your external program go into #ARGS. The shell is also avoided in both of the above examples, which gives you a small speed advantage, and avoids any unwanted interactions involving shell meta-characters. The above code also expects your second program to return a zero exit value to indicate success; if that's not the case, you can specify an additional first argument of allowable exit values:
# Both of these commands allow an exit value of 0, 1 or 2 to be considered
# a successful execution of the command.
system( [0,1,2], $^X, "yourscript.pl", #ARGS );
# OR
capture( [0,1,2, $^X, "yourscript.pl", #ARGS );
If you have a long-running process and you want to process its data while it's being generated, then you're probably going to need a piped open, or one of the more heavyweight IPC modules from the CPAN.
Having said all that, any time you need to be calling another Perl program from Perl, you may wish to consider if using a module would be a better choice. Starting another program carries quite a few overheads, both in terms of start-up costs, and I/O costs for moving data between processes. It also significantly increases the difficulty of error handling. If you can turn your external program into a module, you may find it simplifies your overall design.
All the best,
Paul
I can think of a few ways to do this. You already mentioned the first two, so I won't go into detail on them.
backticks: $retVal = `perl somePerlScript.pl`;
system() call
eval
The eval can be accomplished by slurping the other file into a string (or a list of strings), then 'eval'ing the strings. Heres a sample:
#!/usr/bin/perl
open PERLFILE, "<somePerlScript.pl";
undef $/; # this allows me to slurp the file, ignoring newlines
my $program = <PERLFILE>;
eval $program;
4 . do: do 'somePerlScript.pl'
You already got good answers to your question, but there's always the posibility to take a different point of view: maybe you should consider refactoring the script that you want to run from the first script. Turn the functionality into a module. Use the module from the first and from the second script.
If you need to asynchronously call your external script -you just want to launch it and not wait for it to finish-, then :
# On Unix systems, either of these will execute and just carry-on
# You can't collect output that way
`myscript.pl &`;
system ('myscript.pl &');
# On Windows systems the equivalent would be
`start myscript.pl`;
system ('start myscript.pl');
# If you just want to execute another script and terminate the current one
exec ('myscript.pl');
Use backticks if you need to capture the output of the command.
Use system if you do not need to capture the output of the command.
TMTOWTDI: so there are other ways too, but those are the two easiest and most likely.
See the perlipc documentation for several options for interprocess communication.
If your first script merely sets up the environment for the second script, you may be looking for exec.
#!/usr/bin/perl
use strict;
open(OUTPUT, "date|") or die "Failed to create process: $!\n";
while (<OUTPUT>)
{
print;
}
close(OUTPUT);
print "Process exited with value " . ($? >> 8) . "\n";
This will start the process date and pipe the output of the command to the OUTPUT filehandle which you can process a line at a time. When the command is finished you can close the output filehandle and retrieve the return value of the process. Replace date with whatever you want.
I wanted to do something like this to offload non-subroutines into an external file to make editing easier. I actually made this into a subroutine. The advantage of this way is that those "my" variables in the external file get declared in the main namespace. If you use 'do' they apparently don't migrate to the main namespace. Note the presentation below doesn't include error handling
sub getcode($) {
my #list;
my $filename = shift;
open (INFILE, "< $filename");
#list = <INFILE>;
close (INFILE);
return \#list;
}
# and to use it:
my $codelist = [];
$codelist = getcode('sourcefile.pl');
eval join ("", #$codelist);