I have a main setup script which sets up the test env and stores data in some variables:
package main;
use Test::Harness;
our $foo, $xyz, $pqr;
($foo, $xyz, $pqr) = &subroutinesetup();
# ^ here
#test_files = glob "t/*";
print "Executing test #test\n";
runtests(#test_files);
In the test folder I have a testsuite (t/testsuite1.t, testsuite2.t etc.).
How can I access the value of $foo inside the testsuite1.t?
package main;
use Test::More;
$actual = getActual();
is($foo, $actual, passfoor);
# ^ here
done_testing();
Use Storable to store data in first script and retrieve it from other.
main.pl
($foo, $xyz, $pqr) = &subroutinesetup();
store ($foo, "/home/chankey/testsuite.$$") or die "could not store";
system("perl", "testsuite.pl", $$) == 0 or die "error";
testsuite.pl
my $parentpid = shift;
my $ref = retrieve("/home/chankey/testsuite.$parentpid") or die "couldn't retrieve";
print Dumper $ref;
You've received the $foo in $ref. Now use it the way you want.
You can't share a variable directly, because a new Perl process is started for each test file.
As noted in the documentation of Test::Harness, you should switch to TAP::Harness. It's more flexible: for example, it provides the test_args mechanism to pass arguments to test scripts.
$ cat 1.pl
#!/usr/bin/perl
use warnings;
use strict;
use TAP::Harness;
my $harness = 'TAP::Harness'->new({
test_args => [ qw( propagate secret ) ]
});
$harness->runtests('1.t');
__END__
$ cat 1.t
#!/usr/bin/perl
use warnings;
use strict;
use Test::More;
my %args = #ARGV;
is($args{propagate}, 'secret', 'propagated');
done_testing();
Related
I am trying to call a second script from the main script. When I am passing the argument in the command itself using capture, it's working. But when I am trying to send the command and arguments separately in capture function it's giving me an error that it can't find the specified file.
Second script
#!/usr/bin/perl
use 5.010;
use strict;
use warnings;
my $word= $ARGV[0];
my $crpyt = "$word crypted";
print "$crpyt\n";
my $decrypt = "$word decrypted";
print "$decrypt\n";
main.pl
#!/usr/bin/perl
use 5.010;
use strict;
use warnings;
use IPC::System::Simple qw(capture capturex);
my $cmd= 'perl xyz.pl Hello';
my #arr = capture($cmd);
print "$arr[0]";
print "$arr[1]\n";
This is working
Output:
Hello crypted
Hello decrypted
BUT
main.pl
#!/usr/bin/perl
use 5.010;
use strict;
use warnings;
use IPC::System::Simple qw(capture capturex);
my $cmd= 'perl xyz.pl';
my #arg=("Hello");
my #arr = capture($cmd,#arg);
print "$arr[0]";
print "$arr[1]\n";
This is not working. It says
"perl xyz.pl" failed to start: "The system cannot find the file specified" at main.pl line 11
If you only pass a single scalar, capture expects it to be a shell command.
As such, capture('perl xyz.pl Hello') works.
If you pass multiple scalars, capture expects the first to be a path to a program to execute. The rest are passed as arguments.
As such, capture('perl xyz.pl', 'Hello') doesn't work.
You could use
use IPC::System::Simple qw( capture );
my #cmd = ( 'perl', 'xyz.pl', 'Hello' );
capture(#cmd)
But you never want to use capture unless you pass a single scalar that's a shell command. Use capturex when passing a path and arguments.
use IPC::System::Simple qw( capturex );
my #cmd = ( 'perl', 'xyz.pl', 'Hello' );
capturex(#cmd)
But let's say you get the string perl xyz.pl from elsewhere. A shell needs to be invoked, so we need to convert the arguments in to shell literals.
use IPC::System::Simple qw( capture );
use String::ShellQuote qw( shell_quote );
my $cmd = 'perl xyz.pl';
my #extra_args = 'Hello';
my $full_cmd = $cmd . ' ' . shell_quote(#extra_args);
capture($cmd)
Alternatively,
use IPC::System::Simple qw( capturex );
my $cmd = 'perl xyz.pl';
my #extra_args = 'Hello';
capturex('sh', '-c', 'eval $0 "$#"', $cmd, #extra_args)
I am debugging a test in MPEG::Audio::Frame. If I run this test, I get:
$ cpan -g MPEG::Audio::Frame
$ tar zxvf MPEG-Audio-Frame-0.09.tar.gz
$ cd MPEG-Audio-Frame-0.09
$ perl Makefile.PL
$ make
$ perl -I./blib/lib t/04-tie.t
1..5
ok 1 - use MPEG::Audio::Frame;
ok 2 - 'tie' isa 'MPEG::Audio::Frame'
Not a HASH reference at blib/lib/MPEG/Audio/Frame.pm line 273, <DATA> line 1.
# Looks like your test exited with 255 just after 2.
I narrowed down the problem to the following minimal example:
package My::Module;
use feature qw(say);
use strict;
use warnings;
use overload '""' => \&asbin;
sub asbin {
my $self = shift;
$self->{binhead} # $self is not yet a hash, so execution stops here.
}
sub TIEHANDLE {
bless \$_[1], $_[0]
}
sub READLINE {}
sub read {
say "reading..";
my $pkg = shift;
my $fh = shift || 0; # Why is the stringification operator called here?
}
package main;
use feature qw(say);
use strict;
use warnings;
tie *FH, 'My::Module', *DATA;
My::Module->read(\*DATA);
<FH>;
__DATA__
abc
Why is the stringification operator called for the statement My::Module->read(\*DATA) ?
shift || 0 will want to coerce the argument in shift to a scalar. There is no boolify or numify function overloads defined for My::Module, so Perl will use your stringify function.
To avoid evaluating the object in scalar context, you could rephrase it as
my $fh = #_ ? shift : 0;
$fh = shift;
$fh = 0 unless ref($fh) || $fh;
or define a bool function overload.
I have the following perl script, that takes in a parameters' file and stores it into a hash. I want to modify & pass this hash to another perl script that I am calling using the system command:
script1.pl
#!/usr/bin/perl -w
# usage perl script1.pl script1.params
# script1.params file looks like this:
# PROJECTNAME=>project_dir
# FASTALIST=>samples_fastq.csv
use Data::Dumper;
my $paramfile = $ARGV[0];
# open parameter file
open PARAM, $paramfile or die print $!;
# save it in a hash
my %param;
while(<PARAM>)
{
chomp;
#r = split('=>');
$param{$r[0]}=$r[1];
}
# define directories
# add to parameters' hash
$param{'INDIR'} = $param{'PROJECTNAME'}.'/input';
$param{'OUTDIR'} = $param{'PROJECTNAME'}.'/output';
.... do something ...
# #samples is a list of sample names
foreach (#samples)
{
# for each sample, pass the hash values & sample name to a separate script
system('perl script2.pl <hash> $_');
}
script2.pl
#!/usr/bin/perl -w
use Data::Dumper;
## usage <script2.pl> <hash> <samplename>
# something like getting and printing the hash
my #string = $ARGV[0];
print #string;
If you can help me showing how to pass and get the hash object (something simple like printing the hash object in the second script would do), then I'd appreciate your help.
Thanks!
What you're looking for is something called serialisation. It's difficult to directly represent a memory structure in such a way as to pass it between processes, because of all sorts of fun things like pointers and buffers.
So you need to turn your hash into something simple enough to hand over in a single go.
Three key options for this in my opinion:
Storable - a perl core module that lets you freeze and thaw a data structure for this sort of purpose.
JSON - a text based representation of a hash-like structure.
XML - bit like JSON, but with slightly different strengths/weaknesses.
Which you should use depends a little on how big your data structure is.
Storable is probably the simplest, but it's not going to be particularly portable.
There's also Data::Dumper that's an option too, as it prints data structures. Generally though, I'd suggest that has all the downsides of all the above - you still need to parse it like JSON/XML but it's also not portable.
Example using Storable:
use strict;
use warnings;
use Storable qw ( freeze );
use MIME::Base64;
my %test_hash = (
"fish" => "paste",
"apples" => "pears"
);
my $frozen = encode_base64 freeze( \%test_hash );
system( "perl", "some_other_script.pl", $frozen );
Calling:
use strict;
use warnings;
use Storable qw ( thaw );
use Data::Dumper;
use MIME::Base64;
my ($imported_scalar) = #ARGV;
print $imported_scalar;
my $thing = thaw (decode_base64 $imported_scalar ) ;
print Dumper $thing;
Or:
my %param = %{ thaw (decode_base64 $imported_scalar ) };
print Dumper \%param;
This will print:
BAoIMTIzNDU2NzgEBAQIAwIAAAAKBXBhc3RlBAAAAGZpc2gKBXBlYXJzBgAAAGFwcGxlcw==
$VAR1 = {
'apples' => 'pears',
'fish' => 'paste'
};
Doing the same with JSON - which has the advantage of being passed as plain text, and in a general purpose format. (Most languages can parse JSON):
#!/usr/bin/env perl
use strict;
use warnings;
use JSON;
my %test_hash = (
"fish" => "paste",
"apples" => "pears"
);
my $json_text = encode_json ( \%test_hash );
print "Encoded: ",$json_text,"\n";
system( "perl", "some_other_script.pl", quotemeta $json_text );
Calling:
#!/usr/bin/env perl
use strict;
use warnings;
use JSON;
use Data::Dumper;
my ($imported_scalar) = #ARGV;
$imported_scalar =~ s,\\,,g;
print "Got: ",$imported_scalar,"\n";
my $thing = decode_json $imported_scalar ;
print Dumper $thing;
Need the quotemeta and the removal of slashes unfortunately, because the shell interpolates them. This is the common problem if you're trying to do this sort of thing.
I have two scripts and two conf file (actually perl scripts too):
conf1.pl
#some_array = ({name =>"orange", deny = > "yes"},
{name =>"apple", deny = > "no"});
conf2.pl
#some_array = ({name =>"male", deny = > "yes"},
{name =>"female", deny = > "no"});
script.pl
#!/usr/bin/perl -w
use strict;
our %deny = ();
call_another_script.pl_somehow_with_param conf1.pl
call_another_script.pl_somehow_with_param conf2.pl
foreach my $key (%deny) {
print $deny{$key},"\n";
}
another_script.pl
#!/usr/bin/perl -w
my $conf_file = shift;
do $conf_file;
foreach my $item (#some_array) {
print $item->{name},"\n";
if (defined $deny) {
$deny{$item{name}}++ if $item{deny} eq "yes";
}
}
I would like to call another_script.pl with conf filenames from script.pl so %deny will be visible in another_script.pl. And I dont wanna use Perl modules and I want to have scripts in separate files.
For example
./another_script.pl conf2.pl
and
./script
This problem is what modules are designed to solve. What you are asking is similar to "how do I conditionally execute code with out if?". We can tell you how to do it, but it isn't a good idea.
conf1.pl
#!/usr/bin/perl
use strict;
use warnings;
our #a = (1 .. 10);
conf2.pl
#!/usr/bin/perl
use strict;
use warnings;
our #a = ("a" .. "j");
master.pl
#!/usr/bin/perl
use strict;
use warnings;
our %deny;
do "conf1.pl";
do "child.pl";
do "conf2.pl";
do "child.pl";
use Data::Dumper;
print Dumper \%deny;
child.pl
#!/usr/bin/perl
use strict;
use warnings;
our %deny;
our #a;
for my $item (#a) {
$deny{$item}++;
}
From
http://www.serverwatch.com/tutorials/article.php/1128981/The-Perl-Basics-You-Need-To-Know.htm
Making Variables Global With Strict Pragma On
First you use:
use strict;
Then you use:
use vars qw( %hash #array);
This declares the named variables as package globals in the current
package. They may be referred to within the same file and package with their
unqualified names; and in different files/packages with their fully qualified
names.
That's all that I was needed!
I am unit testing a component that requires user input. How do I tell Test::More to use some input that I predefined so that I don't need to enter it manually?
This is what I have now:
use strict;
use warnings;
use Test::More;
use TestClass;
*STDIN = "1\n";
foreach my $file (#files)
{
#this constructor asks for user input if it cannot find the file (1 is ignore);
my $test = TestClass->new( file=> #files );
isa_ok( $test, 'TestClass');
}
done_testing;
This code does press enter but the function is retrieving 0 not 1;
If the program reads from STDIN, then just set STDIN to be the open filehandle you want it to be:
#!perl
use strict;
use warnings;
use Test::More;
*STDIN = *DATA;
my #a = <STDIN>;
is_deeply \#a, ["foo\n", "bar\n", "baz\n"], "can read from the DATA section";
my $fakefile = "1\n2\n3\n";
open my $fh, "<", \$fakefile
or die "could not open fake file: $!";
*STDIN = $fh;
my #b = <STDIN>;
is_deeply \#b, ["1\n", "2\n", "3\n"], "can read from a fake file";
done_testing;
__DATA__;
foo
bar
baz
You may want to read more about typeglobs in perldoc perldata and more about turning strings into fake files in the documentation for open (look for "Since v5.8.0, perl has built using PerlIO by default.") in perldoc perlfunc.
The following minimal script seems to work:
#!/usr/bin/perl
package TestClass;
use strict;
use warnings;
sub new {
my $class = shift;
return unless <STDIN> eq "1\n";
bless {} => $class;
}
package main;
use strict;
use warnings;
use Test::More tests => 1;
{
open my $stdin, '<', \ "1\n"
or die "Cannot open STDIN to read from string: $!";
local *STDIN = $stdin;
my $test = TestClass->new;
isa_ok( $test, 'TestClass');
}
Output:
C:\Temp> t
1..1
ok 1 - The object isa TestClass