I am trying to monitor the output of an external command with AnyEvent::Subprocess:
use feature qw(say);
use strict;
use warnings;
use AnyEvent::Subprocess;
my $job = AnyEvent::Subprocess->new(
delegates => [ 'StandardHandles', 'CompletionCondvar' ],
code => 'myscript.pl',
);
my $run = $job->run;
my $condvar = $run->delegate('completion_condvar');
$run->delegate('stdout')->handle->on_read(
sub {
my ( $handle ) = #_;
my $line = $handle->rbuf;
chomp $line;
say "Got output: '$line'";
$handle->rbuf = ""; # clear buffer
}
);
my $done = $condvar->recv;
In general, I do not have access to the source code of the external script, so I cannot insert commands like STDOUT->autoflush(1) into the script (if the script happens to be a Perl script).
Here is the test script I used for testing:
myscript.pl:
use feature qw(say);
use strict;
use warnings;
#STDOUT->autoflush(1);
sleep 1;
say "data 1";
sleep 1;
say "data 2";
sleep 1;
say "data 3";
The output is coming all at once after myscript.pl finishes. I want to print each line from myscript.pl as it becomes available. How can this be done without modifying myscript.pl ?
Related
Given the following code, the user will see it printed 3 times, one time a second "Hello World!".
#!/bin/perl
$| = 1;
use feature ':5.10';
use strict;
use warnings;
use constant PERL_SCRIPT => '$|=1; foreach (0..3) {say "World!"; sleep 1}';
open ( my $h, '-|', '/bin/perl', '-wE', PERL_SCRIPT() ) or die $!;
while (<$h>) {
print "Hello $_";
}
How can I achieve this same effect with IPC::Run3? Note, I don't want buffering. I want this to stream.
Why am I using IPC::Run3? I want to stdin to be pointed to /dev/null. And, I don't want to have to have to do the actual redirection with another shell exec.
First of all, you could simply use the following along with your existing code if you don't otherwise need STDIN in the parent.
open(STDIN, '<', '/dev/null') or die $!;
I don't think you can with IPC::Run3, but you can with IPC::Run.
use IPC::Run qw( run );
run [ $^X, -wE => PERL_SCRIPT ],
\undef,
sub { print "Hello $_[0]" };
If you wanted to use a pipe, you could use the following:
use IPC::Run qw( start );
use Symbol qw( gensym );
my $h =
start [ $^X, -wE => PERL_SCRIPT ],
\undef,
'>pipe', my $pipe = gensym;
print "Hello $_" while <$pipe>;
$h->finish();
(You can't use run because that waits for the child to finish.)
I want to write:
... | my_filter | myperlprogram
But I do not know how to run my_filter until I have started myperlprogram.
Can I somehow in myperlprogram loop STDIN through my_filter before reading it?
I am thinking something like:
pipe($a,$b);
if(not fork()) {
close STDOUT;
open STDOUT, $b;
exec "my_filter --with the correct --options";
} else {
close STDIN
open STDIN, $a
}
# continue reading STDIN now looped through `my_filter`
It's not at all clear from the description why a simple
open STDIN, '-|', 'your_filter', '--option1', ...
will not do.
The way I see the problem is: To filter the STDIN for the script, by using an external program which is run from inside the script once the script is running (so, not with a pipeline). With IPC::Run
use warnings;
use strict;
use feature 'say';
use IPC::Run qw(start pump finish);
my $filtered_in;
FILTER_IN: {
my #cmd = qw(a_filter.pl); # add filter's options/arguments
my $h = start \#cmd, \my $in, \$filtered_in;
while (<>) {
$in = $_;
pump $h while length $in;
# Wait for filter's output -- IF WANT to process lines as received
pump $h until $filtered_in =~ /\n\z/;
chomp $filtered_in; # process/use filter's output
$filtered_in .= '|'; # as it's coming (if needed)
}
finish $h or die "Cleanup returned: $?";
};
say $filtered_in // 'no input';
This allows one to process filter's lines of output as they are emitted. If that is not needed but we only want to accumulate filter's output for later then you don't need the code under # Wait for...
Simplest test with a_filter.pl such as
use warnings;
use strict;
STDOUT->autoflush(1);
my $cnt = 0;
while (<>) { print "line ", ++$cnt, ": ", $_ }
and then run
echo "a\nfew\nlines" | script.pl
with output
line 1: a|line 2: few|line 3: lines|
from our toy processing in script.pl above.
This will filter input via a file as well,
script.pl < input.txt
a parsing script I am using looks like that
use strict;
use warnings;
use 5.010;
use autodie;
my (#header, #fh);
while ( <> ) {
if ( /^(\d+)/ ) {
my $n = int $1 / 1000;
unless ( $fh[$n] ) {
my $file = sprintf 'file%d.txt', $n+1;
open $fh[$n], '>', $file;
print { $fh[$n] } #header;
}
print { $fh[$n] } $_;
}
else {
push #header, $_;
}
}
close $_ for grep $_, #fh;
The file I pass to the script is processed an the output is in file1 file2 ..... how can I modify the scripot that there is an additional paramter to the script with which the output is modified to be file1_1 file1_2... if the additional paramter is 1 if the additional paramter would be 2 it would be file2_1 file2_......
If I were to make a change like that, I would make that parameter optional, so as not to break other dependencies. Since you are already relying on #ARGV, that means that we cannot simply shift the parameter, or we must make the parameter non-optional.
E.g.:
my $prefix = shift; # non-optional parameter now
...
my $file = sprintf 'file%s_%d.txt', $prefix, $n+1
But if this program is then used by someone or something that does not expect that parameter, it will remove a file from the input and break the program.
Instead, you can use the rudimentary switch parsing on the command line with the -s switch, or use Getopt::Long, which is a popular module for this purpose.
perl -s program.pl -prefix=1 input1 input2 ...
And then inside the program, either use our $prefix or $main::prefix, so that you do not get strict errors. Then you can also check if $prefix is defined, and handle it accordingly. E.g.:
if (defined $main::prefix) {
$main::prefix .= "_"; # append "_"
} else {
$main::prefix = ""; # empty string
}
my $file = sprintf 'file%s%d.txt', $prefix, $n + 1;
Or using Getopt::Long:
use strict;
use warnings;
use Getopt::Long;
my $prefix;
GetOptions("prefix=s" => \$xyz);
Usage:
perl program.pl -prefix=1 input1 input2 ...
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();
I've got a subroutine that delares a format in an eval expression. If this subroutine gets called more than once, perl warns that a format has been redefined.
This code:
use warnings;
routine();
routine();
sub routine{
my $s = "FAIL";
my $def = "format =\n#<<<<#>>>>\n\$s, \$s\n.";
eval $def;
write;
}
prints
FAIL FAIL
Format STDOUT redefined at (eval 2) line 1.
FAIL FAIL
Is it possible to delete the format declaration at the end of the subroutine?
Here is a simple solution that uses a flag to avoid redefining the format.
use strict;
use warnings;
routine();
routine();
my $format_defined;
sub routine{
my $s = "FAIL";
if (!$format_defined) {
my $def = "format =\n#<<<<#>>>>\n\$s, \$s\n.";
eval $def;
$format_defined = 1;
}
write;
}
Here is a more sophisticated solution that allows for the format to be redefined for each call. It uses a temporary filehandle in place of STDOUT that redirects the output to a scalar, which you can then print to STDOUT.
routine('FAIL');
routine('PASS');
sub routine{
my $s = shift;
format REPORT =
#<<<<#>>>>
$s, $s
.
my $report;
open my $fh, '>', \$report;
select $fh;
$~ = 'REPORT';
write;
close $fh;
select STDOUT;
print $report;
}