I am trying to read unbufferd data from a pipe in Perl. For example in the program below:
open FILE,"-|","iostat -dx 10 5";
$old=select FILE;
$|=1;
select $old;
$|=1;
foreach $i (<FILE>) {
print "GOT: $i\n";
}
iostat spits out data every 10 seconds (five times). You would expect this program to do the same. However, instead it appears to hang for 50 seconds (i.e. 10x5), after which it spits out all the data.
How can I get the to return whatever data is available (in an unbuffered manner), without waiting all the way for EOF?
P.S. I have seen numerous references to this under Windows - I am doing this under Linux.
#!/usr/bin/env perl
use strict;
use warnings;
open(PIPE, "iostat -dx 10 1 |") || die "couldn't start pipe: $!";
while (my $line = <PIPE>) {
print "Got line number $. from pipe: $line";
}
close(PIPE) || die "couldn't close pipe: $! $?";
If it is fine to wait in your Perl script instead on the linux command, this should work.
I don't think Linux will give control back to the Perl script before the command execution is completed.
#!/usr/bin/perl -w
my $j=0;
while($j!=5)
{
open FILE,"-|","iostat -dx 10 1";
$old=select FILE;
$|=1;
select $old;
$|=1;
foreach $i (<FILE>)
{
print "GOT: $i";
}
$j++;
sleep(5);
}
I have below code working for me
#!/usr/bin/perl
use strict;
use warnings;
open FILE,"-|","iostat -dx 10 5";
while (my $old=<FILE>)
{
print "GOT: $old\n";
}
The solutions so far did not work for me with regards to unbuffering (Windows ActiveState Perl 5.10).
According to http://perldoc.perl.org/PerlIO.html, "To get an unbuffered stream specify an unbuffered layer (e.g. :unix ) in the open call:".
So
open(PIPE, '-|:unix', 'iostat -dx 10 1') or die "couldn't start pipe: $!";
while (my $line = <PIPE>) {
print "Got $line";
}
close(PIPE);
which worked in my case.
Related
I'm trying to capture the output my perl code generates both from print and similar statements and external commands.
Due to design constraints I can't use solutions like Capture::Tiny. I need to forward the output to the buffer variable as soon as it is generated and I need to be able to differentiate between STDOUT and STDERR. Ideally a solution for external commands would essentially work just like system apart from being able to capture STDOUT and STDERR instead of printing them.
My code is supposed to:
Save the old STDOUT/STDERR file handles.
Create a new ones for both STDERR and STDOUT.
Redirect all the output to this place.
Print a couple of things.
Restore the old filehandles.
Do something with the captured output, e.g. print it.
However I'm unable to capture the output generated from external commands. I can't do it with IPC::Run3 nor with IPC::Open3.
#!/usr/bin/perl -CSDAL
use warnings;
use strict;
use IPC::Open3;
#use IPC::Run3;
# Save old filehandles
open(my $oldout, ">&STDOUT") or die "Can't dup STDOUT: $!";
open(my $olderr, ">&STDERR") or die "Can't dup STDERR: $!";
my $buffer = "";
close(STDOUT);
close(STDERR);
open(STDOUT, '>', \$buffer) or die "Can't redirect STDOUT: $!";
*STDERR = *STDOUT; # In this example STDOUT and STDERR are printed to the same buffer.
print "1: Test\n";
#run3 ["date"], undef, \*STDOUT, \*STDERR; # This doesn't work as expected
my $pid = open3("<&STDIN", ">&STDOUT", ">&STDERR", "date");
waitpid($pid,0); # Nor does this.
print STDERR "2: Test\n";
open(STDOUT, ">&", $oldout) or die "Can't dup \$oldout: $!";
open(STDERR, ">&", $olderr) or die "Can't dup \$olderr: $!";
print "Restored!\n";
print $buffer;
Expected result:
Restored!
1: Test
Mo 25. Mär 13:44:53 CET 2019
2: Test
Actual result:
Restored!
1: Test
2: Test
I don't have a solution to offer you, however I can provide some explanations as to the behavior you are seeing.
First, IPC::Open3 is not supposed to work when your filehandles are variables; see this question for more explanations.
Now, why isn't IPC::Run3 working? First, notice that if don't redirect STDERR and run
run3 ["date"], undef, \$buffer, { append_stdout => 1 };
instead of
run3 ["date"], undef, \*STDOUT;
then it works as expected. (you need to add { append_stdout => 1 } or your previous outputs to $buffer will be overwritten)
To understand what's happening, in your program, after
open(STDOUT, '>', \$buffer) or die "Can't redirect STDOUT: $!";
Add
print STDERR ref(\$buffer), "\n"
print STDERR ref(\*STDOUT), "\n"
Which will print
SCALAR
GLOB
That's exactly what IPC::Run3::run3 will do to know what to do with the "stdout" you give it (see the source: _fh_for_child_output, which is called by run3):
if it's a scalar, then a temporary file is used (the corresponding line is $fh = $fh_cache{$what} ||= tempfile, where tempfile is a function from File::Temp.
On the other hand, when stdout is a GLOB (or tied to IO::Handle), that filehandle is used directly (that's this line of code).
Which explains why when you call run3 with \$buffer it works, but not with \*STDOUT.
When redirecting STDERR as well, and calling
run3 ["date"], undef, \$buffer, \$buffer, { append_stdout => 1, append_stderr => 1 };
, things start to appear weird. I don't understand what's happening, but I'll share here what I found, and hopefully someone will make sense of it.
I modified the source of IPC::Run3 and added
open my $FP, '>', 'logs.txt' or die "Can't open: $!";
at the beginning of the sub run3. When running, I only see
Restored!
1: Test
on STDOUT (my terminal), but logs.txt contains the date (something in the lines of Mon Mar 25 17:49:44 CET 2019).
Investing a bit reveals that fileno $FP returns 1 (which, unless I mistaken, is usually STDOUT (but you closed it, so I'm no so surprised that its descriptor can be reused)), and fileno STDOUT returns 2 (this might depend on your Perl version and other opened filehandles though). What seems to be happening is that system assumes that STDOUT is the file descriptor 1 and thus prints to $FP instead of STDOUT (I'm just guessing though).
Please feel free to comment/edit if you understand what's happening.
I ended up with the following code:
#!/usr/bin/perl -CSDAL
use warnings;
use strict;
use IPC::Run3;
use IO::Scalar;
use Encode;
use utf8;
# Save old filehandles
open(my $oldout, ">&STDOUT") or die "Can't dup STDOUT: $!";
open(my $olderr, ">&STDERR") or die "Can't dup STDERR: $!";
open(my $FH, "+>>:utf8", undef) or die $!;
$FH->autoflush;
close(STDOUT);
close(STDERR);
open(STDOUT, '>&', $FH) or die "Can't redirect STDOUT: $!";
open(STDERR, '>&', $FH) or die "Can't redirect STDOUT: $!";
print "1: Test\n";
run3 ["/bin/date"], undef, $FH, $FH, { append_stdout => 1, append_stderr => 1 };
print STDERR "2: Test\n";
open(STDOUT, ">&", $oldout) or die "Can't dup \$oldout: $!";
open(STDERR, ">&", $olderr) or die "Can't dup \$olderr: $!";
print "Restored!\n";
seek($FH, 0, 0);
while(<$FH>)
{
# No idea why this is even required
print Encode::decode_utf8($_);
}
close($FH);
This is far from what I originally wanted, but appears to be working at least.
The issues I have with this are:
I need an anonymous file handle creating clutter on the hard disk.
For some reason I need to fix the encoding manually.
Thank you very much to the people who dedicated their time helping me out here.
Is there a reason you need to use the parent's STDOUT and STDERR? IPC::Open3 is easily capable of redirecting the child's STDOUT and STDERR to unrelated handles in the parent which you can read from.
use strict;
use warnings;
use IPC::Open3;
my $pid = open3 undef, my $outerr, undef, 'date';
my $output = do { local $/; readline $outerr };
waitpid $pid, 0;
my $exit = $? >> 8;
This will read STDOUT and STDERR together, if you want to read them separately you need to pass my $stderr = Symbol::gensym as the third argument (as shown in the IPC::Open3 docs), and use a non-blocking loop to avoid deadlocking when reading both handles. IO::Async::Process or similar can fully automate this for you, but IPC::Run3 provides a much simpler solution if you only need to store the output in scalar variables. IPC::Run3 and Capture::Tiny can also both easily be fatpacked for deployment in scripts.
This is not an answer yet, but it seems like open3 requires STDOUT to be a regular tty file handle at the time you call open3, for example:
use feature qw(say);
use strict;
use warnings;
use IPC::Open3;
use Symbol 'gensym';
{
local *STDOUT; # <-- if you comment out this line open3 works as expected
my ($chld_in, $chld_out);
my $chld_err = gensym;
my $pid;
eval {
$pid = open3($chld_in, $chld_out, $chld_err, "date");
};
if ( $# ) {
say "IPC::Open::open3 failed: '$#'";
}
print "-> $_" for <$chld_out>;
waitpid $pid, 0;
# say "Cannot print to invalid handle..";
}
say "ok";
Output:
ma. 25. mars 16:00:01 +0100 2019
ok
Note that the arrow -> in the beginning of the line is missing,
so nothing can be read from $chld_out in this case. However, if I comment out the line:
local *STDOUT;
The output is:
-> ma. 25. mars 16:01:10 +0100 2019
ok
Here is a main script that exec the perl script "fork.pl"
#!/bin/bash
OUTPUT=`./fork.pl`
echo "$OUTPUT"
And the fork.pl:
#!/usr/bin/perl
use strict;
use warnings;
use POSIX;
my $pid = fork();
if ($pid == 0) {
sleep(5);
print("child: $pid\n");
}
else {
print("parent: $pid\n")
}
The backtick implies a wait, but I would like to not wait for the last child.
thanks
One of the ways to not to wait for the termination, is to start in the background while redirecting the output to a file. Then try to read the lines with the shell's read.
For example, a hack to read the first line:
./fork.pl > temp.out &
sleep 1
read OUTPUT < temp.out
Alternatively, without sleep, but limited to a do/done block:
./fork.pl | while read OUTPUT; do
# use $OUTPUT here
break # first line only, or loop conditionally
done
It needs to detach from parent and to redirect the input/output :
if ($pid == 0) {
my $mysid = setsid();
open (STDIN, "</dev/null");
open (STDOUT, ">/dev/null");
open (STDERR, ">&STDOUT");
sleep(5);
print("child: $pid\n");
}
In Perl 5, I can create a filehandle to a string and read or write from the string as if it were a file. This is great for working with tests or templates.
For example:
use v5.10; use strict; use warnings;
my $text = "A\nB\nC\n";
open(my $fh, '<', \$text);
while(my $line = readline($fh)){
print $line;
}
How can I do that in Perl 6? The following doesn't work for Perl 6 (at least not for my instance of Perl6 running on MoarVM 2015.01 from the January 2015 release of Rakudo Star on 64-bit CentOS 6.5):
# Warning: This code does not work
use v6;
my $text = "A\nB\nC\n";
my $fh = $text;
while (my $line = $fh.get ) {
$line.say;
}
# Warning: Example of nonfunctional code
I get the error message:
No such method 'get' for invocant of type 'Str'
in block <unit> at string_fh.p6:8
It's not very surprising that Perl5's open(my $fh, '<', \$text) is not the same as Perl6's my $fh = $text;. So the question is: How does one create a virtual file handle from a string in Perl 6 like open(my $fh, '<', \$str) in Perl 5? Or is that something that has yet to be implemented?
UPDATE (writing to a filehandle in Perl 5)
Likewise, you can write to string filehandles in Perl 5:
use v5.10; use strict; use warnings;
my $text = "";
open(my $fh, '>', \$text);
print $fh "A";
print $fh "B";
print $fh "C";
print "My string is '$text'\n";
Outputs:
My string is 'ABC'
I haven't seen anything remotely similar in Perl 6, yet.
Reading
The idiomatic way to read line-by-line is the .lines method, which is available on both Str and IO::Handle.
It returns a lazy list which you can pass on to for, as in
my $text = "A\nB\nC\n";
for $text.lines -> $line {
# do something with $line
}
Writing
my $scalar;
my $fh = IO::Handle.new but
role {
method print (*#stuff) { $scalar ~= #stuff };
method print-nl { $scalar ~= "\n" }
};
$fh.say("OH HAI");
$fh.say("bai bai");
say $scalar
# OH HAI
# bai bai
(Adapted from #perl6, thanks to Carl Mäsak.)
More advanced cases
If you need a more sophisticated mechanism to fake file handles, there's IO::Capture::Simple and IO::String in the ecosystem.
For example:
use IO::Capture::Simple;
my $result;
capture_stdout_on($result);
say "Howdy there!";
say "Hai!";
capture_stdout_off();
say "Captured string:\n" ~$result;
I have a Perl script with contains
open (FILE, '<', "$ARGV[0]") || die "Unable to open $ARGV[0]\n";
while (defined (my $line = <FILE>)) {
# do stuff
}
close FILE;
and I would like to run this script on all .pp files in a directory, so I have written a wrapper script in Bash
#!/bin/bash
for f in /etc/puppet/nodes/*.pp; do
/etc/puppet/nodes/brackets.pl $f
done
Question
Is it possible to avoid the wrapper script and have the Perl script do it instead?
Yes.
The for f in ...; translates to the Perl
for my $f (...) { ... } (in the case of lists) or
while (my $f = ...) { ... } (in the case of iterators).
The glob expression that you use (/etc/puppet/nodes/*.pp) can be evaluated inside Perl via the glob function: glob '/etc/puppet/nodes/*.pp'.
Together with some style improvements:
use strict; use warnings;
use autodie; # automatic error handling
while (defined(my $file = glob '/etc/puppet/nodes/*.pp')) {
open my $fh, "<", $file; # lexical file handles, automatic error handling
while (defined( my $line = <$fh> )) {
do stuff;
}
close $fh;
}
Then:
$ /etc/puppet/nodes/brackets.pl
This isn’t quite what you asked, but another possibility is to use <>:
while (<>) {
my $line = $_;
# do stuff
}
Then you would put the filenames on the command line, like this:
/etc/puppet/nodes/brackets.pl /etc/puppet/nodes/*.pp
Perl opens and closes each file for you. (Inside the loop, the current filename and line number are $ARGV and $. respectively.)
Jason Orendorff has the right answer:
From Perlop (I/O Operators)
The null filehandle <> is special: it can be used to emulate the behavior of sed and awk, and any other Unix filter program that takes a list of filenames, doing the same to each line of input from all of them. Input from <> comes either from standard input, or from each file listed on the command line.
This doesn't require opendir. It doesn't require using globs or hard coding stuff in your program. This is the natural way to read in all files that are found on the command line, or piped from STDIN into the program.
With this, you could do:
$ myprog.pl /etc/puppet/nodes/*.pp
or
$ myprog.pl /etc/puppet/nodes/*.pp.backup
or even:
$ cat /etc/puppet/nodes/*.pp | myprog.pl
take a look at this documentation it explains all you need to know
#!/usr/bin/perl
use strict;
use warnings;
my $dir = '/tmp';
opendir(DIR, $dir) or die $!;
while (my $file = readdir(DIR)) {
# We only want files
next unless (-f "$dir/$file");
# Use a regular expression to find files ending in .pp
next unless ($file =~ m/\.pp$/);
open (FILE, '<', $file) || die "Unable to open $file\n";
while (defined (my $line = <FILE>)) {
# do stuff
}
}
closedir(DIR);
exit 0;
I would suggest to put all filenames to array and then use this array as parameters list to your perl method or script. Please see following code:
use Data::Dumper
$dirname = "/etc/puppet/nodes";
opendir ( DIR, $dirname ) || die "Error in opening dir $dirname\n";
my #files = grep {/.*\.pp/} readdir(DIR);
print Dumper(#files);
closedir(DIR);
Now you can pass \#files as parameter to any perl method.
my #x = <*>;
foreach ( #x ) {
chomp;
if ( -f "$_" ) {
print "process $_\n";
# do stuff
next;
};
};
Perl can shell out to execute system commands in various ways, the most straightforward is using backticks ``
use strict;
use warnings FATAL => 'all';
my #ls = `ls /etc/puppet/nodes/*.pp`;
for my $f ( #ls ) {
open (my $FILE, '<', $f) || die "Unable to open $f\n";
while (defined (my $line = <$FILE>)) {
# do stuff
}
close $FILE;
}
(Note: you should always use strict; and use warnings;)
i have a script, that parse log and find errors and warnings.
And i want to use user-friendly interpretation of this log.
For this reason, i use notepad.
Here is code:
use v5.16;
use strict;
use warnings;
use Win32::Clipboard;
use threads;
use utf8;
my $kp = Win32::Clipboard->new();
my $output = shift || "out_log.txt";
#my ($input, $output)=#ARGV;
#open my $ih, "<", $input or die "can't open input file with log\n";
open my $oh, ">", $output or die "can't open output file with log\n";
my #alls=split /\n/,$kp->Get();
for my $k(0..$#alls){
$_ = $alls[$k];
if(/^ERR.+|^WARN.+/){
print {$oh} qq(at position $k --> ).$_."\n";
}
}
my $thread =
threads->create(sub{
$SIG{INT}=sub{die"All good\n";};
qx(notepad $output);
}
);
print qq(type 'y' for quit);
do{
print "want to quit?\n>" ;
chomp;
do{
say "I will kill this thread";
$thread->kill('INT') if defined($thread);
say "and delete output";
unlink $output;
exit(0);
}if (m/y/);
}while(<>);
It falls down, when i trying to kill thread which run notepad.
How to do this, using signals and threads? Is it possible?
And your ideas about solution, please.
Thanks!
This isn't working because your SIGINT never gets passed to notepad. So it never gets closed. (And that handler - probably never gets processed).
You need to approach this differently. Look at Win32::Process for some examples of how to spawn/kill a notepad process.
my $ProcessObj;
Win32::Process::Create( $ProcessObj,
"C:\\Windows\\system32\\notepad.exe",
"notepad", 0, NORMAL_PRIORITY_CLASS, "." )
or die $!;
And then you can use
$ProcessObj -> Kill(1);
I'd suggest using Thread::Semaphore or some sort of shared variable to decide if you want to kill your notepad.