Let me elaborate.
Say I have perl program
(whch was shamelessly copied and edited from perl
http://perldoc.perl.org/perlfaq8.html#How-can-I-open-a-pipe-both-to-and-from-a-command%3f
)
use IPC::Open3;
use Symbol qw(gensym);
use IO::File;
local *CATCHOUT = IO::File->new_tmpfile;
local *CATCHERR = IO::File->new_tmpfile;
my $pid = open3(gensym, ">&CATCHOUT", ">&CATCHERR", "ping -t localhost");
#waitpid($pid, 0);
seek $_, 0, 0 for \*CATCHOUT, \*CATCHERR;
while( <CATCHOUT> ) {
print $_;
}
But the problem with the above program is it will to a sort of readtoEnd() of the STDOUT belonging to the program ping.exe in this case and allow it ti be read all at once.
But what I want to be able to do is to read the STDOUT as it is being written out to STDOUT.
if I remove waitforpid() then program exits immediately, so that doesn't help either.
Is that Possible ? If so, can you please point me in the right direction.
Update:
Drats!!!! I missed the | symbol... which is essential for piping the output out of ping and into the perl script!!!
use IPC::Open3 qw( open3 );
open(local *CHILD_STDIN, '<', '/dev/null') or die $!;
my $pid = open3(
'<&CHILD_STDIN',
my $child stdout,
'>&STDERR',
'ping', '-t', 'localhost',
);
while (<$child_stdout>) {
chomp;
print("Got: <<<$_>>>\n");
}
waitpid($pid, 0);
But that can be written as
open(my $ping_fh, '-|', 'ping', '-t', 'localhost') or die $!;
while (<$ping_fh>) {
chomp;
print("Got: <<<$_>>>\n");
}
close($ping_fh);
This just shows the proper usage. If these don't work, it's an unrelated problem: ping is buffering it's IO when not connected to a terminal. You can fool it using a pseudo-tty.
One of the strengths (or weaknesses) of perl is that there is more than one way to do things. This works:
perl -e 'open(F,"ping localhost|"); while(<F>) { s/ms/Milliseconds/; print $_; }'
Just put the s/ms/Milliseconds/ to show that the data is being read and changed
Not sure exactly what you have wrong with Open3
Related
I am writing a simple script using IPC::Open3. The script produces no output to either stdout or stderr, while I would expect output to both.
The complete source code:
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use IPC::Open3;
pipe my $input, my $output or die $!;
my $pid = open3(\*STDIN, $output, \*STDERR, 'dd', 'if=/usr/include/unistd.h') or die $!;
while(<$input>) {
print $_."\n";
}
waitpid $pid, 0;
I am fairly certain that I am using IPC::Open3 incorrectly. However, I am still confused as to what I should be doing.
It's the pipe. Without knowing why it's there I can't say more. This works fine.
my $reader;
my $pid = open3(\*STDIN, $reader, \*STDERR, 'dd', 'if=/usr/include/unistd.h') or die $!;
while(<$reader>) {
print $_."\n";
}
waitpid $pid, 0;
I realize it's probably just an example, but in case it's not... this is complete overkill for what you're doing. You can accomplish that with backticks.
print `dd if=/usr/include/unistd.h`
IPC::Open3 is a bit overcomplicated. There are better modules such as IPC::Run and IPC::Run3.
use strict;
use warnings;
use IPC::Run3;
run3(['perl', '-e', 'warn "Warning!"; print "Normal\n";'],
\*STDIN, \*STDOUT, \*STDERR
);
Your program suffers from the following problems:
\*STDIN (open STDIN as a pipe tied to the child's STDIN) should be <&STDIN (use the parent's STDIN as the child's STDIN).
\*STDERR (open STDERR as a pipe tied to the child's STDERR) should be >&STDERR (use the parent's STDERR as the child's STDERR).
The value you place in $output is being ignored and overwritten. Fortunately, it's being overwritten with a correct value!
You use print $_."\n";, but $_ is already newline-terminated. Either chomp first, or don't add a newline.
open3 isn't a system call, so it doesn't set $!.
open3 doesn't return false on error; it throws an exception.
So we get something like:
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw( say );
use IPC::Open3;
my $pid = open3('<&STDIN', my $output, '>&STDERR',
'dd', 'if=/usr/include/unistd.h');
while (<$output>) {
chomp;
say "<$_>";
}
waitpid($pid, 0);
How can I force Perl script to die if anything is written to STDERR ?
Such action should be done instantly, when such output happen, or even before, to prevent that output...
This doesn't seem like an especially smart idea, but a tied filehandle should work. According to the perltie manpage:
When STDERR is tied, its PRINT method will be called to issue warnings and error messages. This feature is temporarily disabled during the call, which means you can use warn() inside PRINT without starting a recursive loop.
So something like this (adapted from the manpage example) ought to work:
package FatalHandle;
use strict;
use warnings;
sub TIEHANDLE { my $i; bless \$i, shift }
sub PRINT {
my $r = shift;
die "message to STDERR: ", #_;
}
package main;
tie *STDERR, "FatalHandle";
warn "this should be fatal.";
print "Should never get here.";
And that outputs (with exit code 255):
message to STDERR: this should be fatal. at fh.pl line 17.
Here's a method that works no matter how STDERR (fd 2) is written to, even if it's a C extension that doesn't use Perl's STDERR variable to do so. It will even kill child processes that write to STDERR!
{
pipe(my $r, my $w)
or die("Can't create pipe: $!\n");
open(STDERR, '>&', $w)
or die("Can't dup pipe: $!\n");
close($r);
}
print "abc\n";
print "def\n";
print STDERR "xxx\n";
print "ghi\n";
print "jkl\n";
$ perl a.pl
abc
def
$ echo $?
141
Doesn't work on Windows. Doesn't work if you add a SIGPIPE handler.
While running following Perl program, the output of the child script is printed to the terminal instead of going into $v. Please let me know how to fix it.
open (OUTPUT, '>', \$v);
select OUTPUT;
$| = 1;
open (SUB, "| sh print_user_input.sh");
print SUB "Hello World\n";
close(SUB);
close(OUTPUT);
select STDOUT;
print "Output: $v\n";
The output of the program is:
Hello World
Output:
select doesn't change STDOUT.
open '>', \$buf does not create a system file handle. (Who would read from it and place the data in $buf? Another process cannot write directly to $buf, even if were a perl a process.)
One solution:
use IPC::Run3 qw( run3 );
run3 [ 'sh', 'print_user_input.sh' ],
\"Hello World\n",
\my $v;
You've got 2 problems. select does not change STDOUT, it just changes Perl's idea of which filehandle it should be printing to. And in-memory filehandles like you're trying to use only work inside a single Perl process; you can't use them in child processes.
You want to look at IPC::Open3 or a similar module.
Using IPC::Open2's open2 function:
#!/usr/bin/env perl
use strict;
use warnings;
use IPC::Open2;
my $pid = open2( \*CHLD_OUT, \*CHLD_IN, 'sh print_user_input.sh' );
print CHLD_OUT "Hello World\n";
close CHLD_OUT;
my $output = do { local $/; <CHLD_OUT> };
print "Output: $output";
I need to modify an existing Perl program. I want to pipe a string (which can contain multiple lines) through an external program and read the output from this program. This external program is used to modify the string. Let's simply use cat as a filter program. I tried it like this, but it doesn't work. (Output of cat goes to STDOUT instead of being read by perl.)
#!/usr/bin/perl
open(MESSAGE, "| cat |") or die("cat failed\n");
print MESSAGE "Line 1\nLine 2\n";
my $message = "";
while (<MESSAGE>)
{
$message .= $_;
}
close(MESSAGE);
print "This is the message: $message\n";
I've read that this isn't supported by Perl because it may end up in a deadlock, and I can understand it. But how do I do it then?
You can use IPC::Open3 to achieve bi-directional communication with child.
use strict;
use IPC::Open3;
my $pid = open3(\*CHLD_IN, \*CHLD_OUT, \*CHLD_ERR, 'cat')
or die "open3() failed $!";
my $r;
for(my $i=1;$i<10;$i++) {
print CHLD_IN "$i\n";
$r = <CHLD_OUT>;
print "Got $r from child\n";
}
This involves system programming, so it’s more than a basic question. As written, your main program doesn’t require full-duplex interaction with the external program. Dataflow travels in one direction, namely
string → external program → main program
Creating this pipeline is straightforward. Perl’s open has a useful mode explained in the “Safe pipe opens” section of the perlipc documentation.
Another interesting approach to interprocess communication is making your single program go multiprocess and communicate between—or even amongst—yourselves. The open function will accept a file argument of either "-|" or "|-" to do a very interesting thing: it forks a child connected to the filehandle you’ve opened. The child is running the same program as the parent. This is useful for safely opening a file when running under an assumed UID or GID, for example. If you open a pipe to minus, you can write to the filehandle you opened and your kid will find it in his STDIN. If you open a pipe from minus, you can read from the filehandle you opened whatever your kid writes to his STDOUT.
This is an open that involves a pipe, which gives nuance to the return value. The perlfunc documentation on open explains.
If you open a pipe on the command - (that is, specify either |- or -| with the one- or two-argument forms of open), an implicit fork is done, so open returns twice: in the parent process it returns the pid of the child process, and in the child process it returns (a defined) 0. Use defined($pid) or // to determine whether the open was successful.
To create the scaffolding, we work in right-to-left order using open to fork a new process at each step.
Your main program is already running.
Next, fork a process that will eventually become the external program.
Inside the process from step 2
First fork the string-printing process so as to make its output arrive on our STDIN.
Then exec the external program to perform its transformation.
Have the string-printer do its work and then exit, which kicks up to the next level.
Back in the main program, read the transformed result.
With all of that set up, all you have to do is implant your suggestion at the bottom, Mr. Cobb.
#! /usr/bin/env perl
use 5.10.0; # for defined-or and given/when
use strict;
use warnings;
my #transform = qw( tr [A-Za-z] [N-ZA-Mn-za-m] ); # rot13
my #inception = (
"V xabj, Qnq. Lbh jrer qvfnccbvagrq gung V pbhyqa'g or lbh.",
"V jnf qvfnccbvagrq gung lbh gevrq.",
);
sub snow_fortress { print map "$_\n", #inception }
sub hotel {
given (open(STDIN, "-|") // die "$0: fork: $!") { # / StackOverflow hiliter
snow_fortress when 0;
exec #transform or die "$0: exec: $!";
}
}
given (open(my $fh, "-|") // die "$0: fork: $!") {
hotel when 0;
print while <$fh>;
close $fh or warn "$0: close: $!";
}
Thanks for the opportunity to write such a fun program!
You can use the -n commandline switch to effectively wrap your existing program code in a while-loop... look at the man page for -n:
LINE:
while (<>) {
... # your program goes here
}
Then you can use the operating system's pipe mechanism directly
cat file | your_perl_prog.pl
(Edit)
I'll try to explain this more carefully...
The question is not clear about what part the perl program plays: filter or final stage. This works in either case, so I will assume it is the latter.
'your_perl_prog.pl' is your existing code. I'll call your filter program 'filter'.
Modify your_perl_prog.pl so that the shebang line has an added '-n' switch: #!/usr/bin/perl -n or #!/bin/env "perl -n"
This effectively puts a while(<>){} loop around the code in your_perl_prog.pl
add a BEGIN block to print the header:
BEGIN {print "HEADER LINE\n");}
You can read each line with '$line = <>;' and process/print
Then invoke the lot with
cat sourcefile |filter|your_perl_prog.pl
I want to expand on #Greg Bacon's answer without changing it.
I had to execute something similar, but wanted to code without
the given/when commands, and also found there was explicit exit()
calls missing because in the sample code it fell through and exited.
I also had to make it also work on a version running ActiveState perl,
but that version of perl does not work.
See this question How to read to and write from a pipe in perl with ActiveState Perl?
#! /usr/bin/env perl
use strict;
use warnings;
my $isActiveStatePerl = defined(&Win32::BuildNumber);
sub pipeFromFork
{
return open($_[0], "-|") if (!$isActiveStatePerl);
die "active state perl cannot cope with dup file handles after fork";
pipe $_[0], my $child or die "cannot create pipe";
my $pid = fork();
die "fork failed: $!" unless defined $pid;
if ($pid) { # parent
close $child;
} else { # child
open(STDOUT, ">&=", $child) or die "cannot clone child to STDOUT";
close $_[0];
}
return $pid;
}
my #transform = qw( tr [A-Za-z] [N-ZA-Mn-za-m] ); # rot13
my #inception = (
"V xabj, Qnq. Lbh jrer qvfnccbvagrq gung V pbhyqa'g or lbh.",
"V jnf qvfnccbvagrq gung lbh gevrq.",
);
sub snow_fortress { print map "$_\n", #inception }
sub hotel
{
my $fh;
my $pid = pipeFromFork($fh); # my $pid = open STDIN, "-|";
defined($pid) or die "$0: fork: $!";
if (0 == $pid) {
snow_fortress;
exit(0);
}
open(STDIN, "<&", $fh) or die "cannot clone to STDIN";
exec #transform or die "$0: exec: $!";
}
my $fh;
my $pid = pipeFromFork($fh); # my $pid = open my $fh, "-|";
defined($pid) or die "$0: fork: $!";
if (0 == $pid) {
hotel;
exit(0);
}
print while <$fh>;
close $fh or warn "$0: close: $!";
the simplest -- not involving all these cool internals -- way to do what the OP needs, is to use a temporary file to hold the output until the external processor is done, like so:
open ToTemp, "|/usr/bin/tac>/tmp/MyTmp$$.whee" or die "open the tool: $!";
print ToTemp $TheMessageWhateverItIs;
close ToTemp;
my $Result = `cat /tmp/MyTmp$$.whee`; # or open and read it, or use File::Slurp, etc
unlink "/tmp/MyTmp$$.whee";
Of course, this isn't going to work for something interactive, but co-routines appear to be out of the scope of the original question.
I'd like to close STDOUT to prevent my code from outputing a particular image that I need for further computation but do not want on my web page.
So i want to close STDOUT, do what I have to do with my code, then reopen STDOUT to output stuff to a web page. (Not to a file)
What I tried is:
close STDOUT;
# my code here
open STDOUT;
This doesn't work...
Thanks
There are several ways to approach your problem, and many of them do not require you to close STDOUT and risk fubaring your program's standard I/O channels.
For example, you can use the (1-arg) select command to direct the output of print commands somewhere else temporarily.
print $stuff_you_want_to_send_to_STDOUT;
select(NOT_STDOUT);
# now default print sends things to NOT_STDOUT.
# This doesn't need to be a real filehandle, though you may get warning
# messages if it is not.
...;
print $the_image_you_dont_want_to_go_to_STDOUT;
...;
select(STDOUT);
# now print sends things to STDOUT agin
print $more_stuff_you_do_want_to_go_to_STDOUT;
You can also reassign the *STDOUT glob at run-time without closing any handles.
*OLD_STDOUT = *STDOUT;
print $for_STDOUT;
*STDOUT = *NOT_STDOUT; # again, doesn't need to be a real filehandle
print $stuff_to_suppress;
*STDOUT = *OLD_STDOUT; # restore original STDOUT
print $more_stuff_for_STDOUT;
It's bad to close STDOUT since much assumes it's always open. It's better to redirect it to /dev/null (unix) or nul (Windows).
If you want to redirect the file descriptor,
use Sub::ScopeFinalizer qw( scope_finalizer );
{
open(my $backup_fh, '>&', \*STDOUT) or die $!;
my $guard = scope_finalizer { open(STDOUT, '>&', $backup_fh) or die $!; };
open(STDOUT, '>', '/dev/null') or die $!;
...
}
If you just want to redirect STDOUT,
{
local *STDOUT;
open(STDOUT, '>', '/dev/null') or die $!;
...
}
If you just want to redirect the default output handle,
use Sub::ScopeFinalizer qw( scope_finalizer );
{
open(my $null_fh, '>', '/dev/null') or die $!;
my $backup_fh = select($null_fh);
my $guard = scope_finalizer { select($backup_fh); };
...
}
You can implement something to catch STDOUT like so:
sub stdout_of (&) {
my $code = shift;
local *STDOUT;
open STDOUT, '>', \(my $stdout_string = '')
or die "reopen STDOUT: $!";
$code->();
return $stdout_string;
}
And then use it like so:
my $stdout = stdout_of { print "hello world" };
Localizing the filehandle inside stdout_of() allows you to avoid the tricks of closing and re-opening STDOUT.
Read the documentation for open.
Search for "Here is a script that saves, redirects, and restores STDOUT and STDERR using various methods".
What you want to do is not close STDOUT, but rather redirect it to /dev/null temporarily.
To (re)open STDOUT or STDERR as an in-memory file, close it first:
close STDOUT;
open STDOUT, '>', \$variable or die "Can't open STDOUT: $!";
From the perl doc: http://perldoc.perl.org/functions/open.html
You have a : after your close, don't do that. The open above should also work with jus
open STDOUT;
This thread in perl monks might help you too: http://www.perlmonks.org/?node_id=635010
I checked 2 ways:
via select
via *OLD_STDOUT = * STDOUT, and see they are not usable in common case.
The reason is these 2 approachs redirect STDOUT only if "print" or something else is used in a Perl Script. But if you use "system()" call or call subscript, their output got to standard STDOUT anyway =((.
My point of view, the indeed solution is to be:
#!/usr/bin/perl -w
my $file1 = "/tmp/out.txt";
my $file2 = "/tmp/err.txt";
open my $oldSTDOUT, ">&STDOUT";
open OLDERR, ">&",\*STDERR;
open(STDOUT, ">$file1") or print("Can't redirect stdout: to $file1 ");
open(STDERR, ">$file2") or print("Can't redirect stderr: to $file2 ");
print "THIS OUTPUT ISN'T GOT TO STANDARD OUTPUT\n";
system("pwd"); # this output isn;t got to standard output too, that is right!
close(STDOUT);
close(STDERR);
open STDOUT, ">>&", $oldSTDOUT;
open STDERR, ">>&OLDERR";
print "BUT THIS OUTPUT IS SEEN IN A STANDARD OUTPUT\n";
I checked this solution and it worked for me.