die statement of perl sript as subcommand, passed to IPC::Run causes process to hang [rt.cpan.org #93301]

[toddr]

trafficstars

Migrated from rt.cpan.org#93301 (status was 'new')

Requestors:

• [email protected]

Attachments:

• IPC_run_test.pl
• test_big_data.dat
• transform_sep.pl

From [email protected] on 2014-02-24 05:46:03:

Hi,

If command to be executed is perl script and perl script die, then IPC::run methods doesnt return. it just hang up. For example, in the attached perl scripts IPC_run_test.pl uses IPC::run to call transform_sep.pl. if transform_sep.pl die, IPC::Run call in IPC_run_test.pl never return. it causes process to hang

Details of versions: perl version : v5.10 IPC::run version : 0.91. OS : GNU/Linux 2.6.32-358.11.1.el6.x86_64

[toddr]

IPC_run_test.pl

#!/bin/env perl

use IPC::Run qw( run timeout start harness  finish pump);  # IPC::Run version 0.91
use strict;
use warnings;
use IO::Pipe;

my $write = IO::Handle->new();;
my $read = IO::Handle->new();
$write->autoflush(1);
my $pipe = IO::Pipe->new($read, $write);

my @args  = ( [
    '/home/dhawal/perl_script/transform_sep.pl',
      '--in-seperator', '|',
    ],
    '<' , $read,
    '2>','/home/dhawal/log/transform_sep_err.log',
    '>', '/home/dhawal/log/transform_sep_out.log'
);

my $h = start (@args); 

open(LRGE_FH, '/home/dhawal/data/test_big_data.dat');
while (<LRGE_FH>) {
    print $write $_;
}

close ($write);
close ($read);

finish $h;
if ( defined $h->result && $h->result != 0 ) {
    print STDERR "Error in executing cmd transform_sep \n";
}
print " IPC::Run::finish completed successfully \n";
exit;

transform_sep.pl

#!/bin/env perl

use strict;
use Getopt::Long;

my $insep = '';
my $outsep = '';
my $result = GetOptions ("in-seperator=s" => \$insep,
                        "out-seperator=s"   => \$outsep,
);

if (!$insep) {
    die "Missing args : in-seperator \n";
}
if (!$outsep) {
    die "Missing args : out-seperator \n";
}
$insep =~ s/([^\w\\])/\\$1/g;
while (<>) {
    chomp();
    my @F = split ($insep, $_) ;
    print join( $outsep, @F ), "\n";
}