But when I move the wait() call to the end of the script, thus below the reading of the handles, it never hangs, not even with a value like 200000 2 million.

I think your buffer space is full, so the writer gets blocked, and wait effectively waits forever, because you never start reading — the writer is blocked forever.

That's exactly it. Here's the problem in graphical form, in case it helps:

+---------------------+----------------------+
| Parent              | Child                |
+---------------------+----------------------+
| - open3(...);       |                      |
| - wait();           | - ...                |   |
|   - Waits for child | - print 1027;        |   |
|     to end.         | - print 1028;        |   |
|                     | - print 1029;        |   T
|                     | - print 1030;        |   i
|                     | - print 1031;        |   m
|                     |   - Pipe full.       |   e
|                     |     Waits for parent |   |
|                     |     to empty it.     |   |
|                     |                      |   v
| Still waiting...    | Still waiting...     |
+---------------------+----------------------+
[download]

When I see open3, I expect to see an IO::Select object.

Fix:

#!/usr/bin/perl

use strict;
use warnings;

use IO::Select ();
use IPC::Open3 qw( open3 );

$|++;

my $BLOCK_SIZE = 1024;

my $script = shift;
my $pid = open3(undef, \*OUT, \*ERR, "./$script @ARGV");

my $r_sel = IO::Select->new(\*OUT, \*ERR);

my $out = '';
my $err = '';

MAIN_LOOP:
for (;;) {
   my @r = $r_sel->can_read();

   foreach (@r) {
      last MAIN_LOOP if eof($_);
      my $dp = ($_ == \*OUT ? \$out : \$err);
      1 while read($_, $$dp, $BLOCK_SIZE, length($$dp));
   }
}

waitpid($pid, 0);  # Reap child.

print("STDOUT: $out\n");
print("STDERR: $err\n");
[download]

Tested.

It gets more complex if you have multiple children, or if you do bidirectional communication. Refer to Using 'select' to handle multiple sockets to do those things.

I think you can use -s $_ instead of $BLOCK_SIZE on linux (thus eliminating the need for the while loop), but it doesn't work on other OSes such as FreeBSD.

If you try to read from the child’s stdout writer and their stderr writer, you’ll have problems with blocking, which means you’ll want to use select() or the IO::Select, which means you’d best use sysread() instead of readline() for normal stuff.

Sounds right to me. Why not try it?

UPDATE: Oh, now I see it. It's the wait(). You're trying to let the process finish but it can't finish because it has filled it's STDOUT buffer and can't continue. It works with small numbers because the buffer doesn't fill. Remove that wait() and your code runs to completion.

UPDATE 2: For what it's worth, Expect is, in my experience, a better tool for this type of job. The documentation is a total mess but if you've ever used the TCL Expect it works the same way. Unlike IPC::Open3, it takes care of all the messy buffering and deadlocking problems. All you have to do is write the matching code.

-sam

So the calls before were crank calls or did you think it was a different radio station back then?

Ok, seriously I know this doesn't help you at all with your problem but it is nice to point out every now and then how much of a contribution some monks make. You have been a monk since 2000-06-19 and have posted 2,346 times (as of this posting). Of those, only 20 are questions and it has been over 3 years since your last one. Thanks - hope you find the help you need given how much you have provided others.

Oh ... um ... those were like ... other jeffas ... or something. Huh huh huh huh.

Big thanks for the compliments, L~R, and a big thanks to everyone else on this thread for providing great answers and work arounds. I believe i am simply going to remove the wait() call as i really don't need to query the exit status of the exec'ed script after all. I am trying to avoid storing STDOUT and STDERR into scalars as well, hoping to keep them out of memory any more than necessary. Unfortunately, it seems to me that using backticks and shell redirection is the best way to go with this ... i was trying to avoid that, but i am also likely being too pedantic.

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

Moving the wait is not enough

+------------------------+----------------------+
| Parent                 | Child                |
+------------------------+----------------------+
| - open3(...);          |                      |
| - <OUT>                | - ...                |   |
|   - Waits for child to | - print STDERR 1027; |   |
|     write to STDOUT or | - print STDERR 1028; |   |
|     for child to end.  | - print STDERR 1029; |   T
|                        | - print STDERR 1030; |   i
|                        | - print STDERR 1031; |   m
|                        |   - Pipe full.       |   e
|                        |     Waits for parent |   |
|                        |     to empty it.     |   |
|                        |                      |   v
| Still waiting...       | Still waiting...     |
+------------------------+----------------------+
[download]

With my snippet below, you don't have to store the stuff in memory. You can do whatever you want to with it when you read it it. For example, the following prints it out a line at a time, prefixed with the handle name:

my %lookup = (
   \*OUT => [ \*OUT, 'STDOUT', '' ],
   \*ERR => [ \*ERR, 'STDERR', '' ],
);

MAIN_LOOP:
for (;;) {
   my @r = $r_sel->can_read();

   foreach my $fh (@r) {
      last MAIN_LOOP if eof($fh);

      my $buf_ptr = $lookup{$fh}[2];
      1 while read($fh, $$buf_ptr, $BLOCK_SIZE, length($$buf_ptr));

      print("$lookup{$fh}[1]: $1")
         while $$buf_ptr =~ s/^(.*\n)//;
   }
}

foreach my $fh (keys %lookup) {
   print("$lookup{$fh}[1]: $lookup{$fh}[2]\n")
      if length $lookup{$fh}[2];
}
[download]

Alternatively, you could use IPC::Run. Instead of a scalar, you can pass the address of a callback to be called when text is received from the child. (Search for \&out.)

HTH,

I suggest IPC::Run3.

perl -MIPC::Run3 -lw 
run3('./script.pl',undef,\$out,\$err);
print "STDOUT: $out";
print "STDERR: $err"
__END__
[download]

To maintain full control over all aspects of pipes, buffering, batching (e.g. reading and writing 1000 records at a time between two external programs) and so on (my external program is usually RDBMS or TSDBMS related), I usually need to write my own classes to manage open3, instead of using Run3, e.g. something like:

use IPC::Open3;
use POSIX ":sys_wait_h";

package Query;  
sub new {
    my $self = shift;
    my %opt = @_;
    $self = \%opt;
    defined $self -> { SERVICE }
        or $self -> { SERVICE } = 'defaultqueryprog';
    if ( defined $self -> { SEND } ) {
        my $pid = open3 my $wh, my $rh, my $eh,
            $self -> { SERVICE }
            or warn "$!: " . $self -> { SERVICE } . "\n"
            && exit $?;
        $self -> { WH } = $wh;
        $self -> { RH } = $rh;
        $self -> { EH } = $eh;
        $self -> { PID } = $pid;
        write $wh $self -> { SEND } . "\n";
    }
    else {
        my $pid = open3 undef(), my $rh, my $eh,
            $self -> { SERVICE }
            or warn "$!: " . $self -> { SERVICE } . "\n"
            && exit $?;
        $self -> { RH } = $rh;
        $self -> { EH } = $eh;
        $self -> { PID } = $pid;
    }
    return bless $self; # note the pipe is not closed!
}
sub fetch {
    my $self = shift;
    my $rh = $self -> { RH };
    my $eh = $self -> { EH };
    my $oneliner = !wantarray;
    unless ( $oneliner &&= <$rh> ) {
        # cleanup if and only if flushing the pipe
        my @out = <$rh>;
        close $rh;
        my @err = <$eh>;
        close $eh;
        $self -> { STDERR } = \@err;
        waitpid $self -> { PID },0;
        delete $self -> { PID };
        return @out;
    }
    return $oneliner;
}

sub fetcherror { # similar to fetch but on $self -> { EH };
...
}
sub shut {
    my $self = shift;
    close $self -> { RH }, $self -> { EH };
    $sts = $?;
    waitpid $self -> { PID }, 0;
    delete $self -> { PID };
    return $sts;
}
1;
[download]