What I really need to be able to do is to check the background program to see if it's stalled waiting for input

Based on the idea that an attached strace would typically show the line

read(0,
[download]

(and wait there) in case the respective program is waiting for user input, you could check if you get nothing but this within a certain period of time (3 secs in the sample):

#!/usr/bin/perl -w
use strict;
$SIG{CHLD} = 'IGNORE';

my $pid = fork(); die $! unless defined $pid;
unless ($pid) {
    # run background program to watch
    exec q(exec perl -E 'for (1..10) {say "...working"; sleep 1} <>');
    exit;
}

sub check {
    my $pid = shift;
    my $pid2 = open my $strace, "-|", "strace -qp $pid 2>&1" or die $!
+;

    local $SIG{ALRM} = sub { kill INT => $pid2 };
    print "checking...\n";
    alarm 3;
    my $trace;
    $trace.=$_ while <$strace>;
    alarm 0;
    close $strace;

    if ($trace =~ /^read\(.*$/) {   # check strace output
        print "=> hanging\n";
        kill TERM => $pid;    # (optional)
        return 0;
    } else {
        print "=> still running\n";
        return 1;
    }
}

0 while check($pid);

__END__
$ ./964971.pl
checking...
...working
...working
...working
=> still running
checking...
...working
...working
...working
=> still running
checking...
...working
...working
...working
=> still running
checking...
...working
=> still running
checking...
=> hanging
[download]

Of course, that would require a platform that has strace or similar...

I'd thought of strace, and was hoping to use a pure perl solution, but I can't think of one, so maybe that's what I'm stuck with. Not the end of the world I suppose.

A little convoluted, but I finally found a good use for the return value from print:

#! perl -slw
use strict;
use threads;
use threads::shared;

our $N //= 12;
our $I //= 0;

my $cmd = qq[$^X -E"\$|++; sleep $N; <STDIN> if $I; sleep 2;say 'Kid d
+one'"];

my $timeout = time() + 10;
my $inInputState :shared = 0;

my $pid :shared = open CMD, '|-', $cmd or die $!;
my $old = select CMD; $|++; select $old;

async {
    $inInputState = 1 if printf CMD " \b"x2048;
}->detach;

my $timedOut = 0;
Win32::Sleep 10 until !kill 0, $pid
    or $timedOut = time() > $timeout
    or $inInputState
;

if( $timedOut ) {
    print "Command timed out";
    kill 3, $pid;
}
if( $inInputState ) {
    print "Child waiting for input";
}
else {
    print "Kid never entered input state";
}

print 'Parent done';

__END__
C:\test>detectChildInputState -I=0 -N=2
Kid done
Kid never entered input state
Parent done

C:\test>detectChildInputState -I=1 -N=2
Child waiting for input
Parent done
Kid done

C:\test>detectChildInputState -I=1 -N=12
Command timed out
Kid never entered input state
Parent done

C:\test>detectChildInputState -I=1 -N=10
Child waiting for input
Parent done
Kid done

C:\test>detectChildInputState -I=0 -N=10
Command timed out
Kid never entered input state
Parent done
[download]

Thanks. This looks like exactly what I'm looking for, though I've got to do some man page reading to fully understand this. I've never used any of the thread modules before. So this is a good opportunity to explore them.

though I've got to do some man page reading to fully understand this. I've never used any of the thread modules

A little explanation might help.

The core of the mechanism is here:

## Start the command connecting our output to its input
## (You might need to use open2/3() if you want to capture the output)
my $pid = open CMD, '|-', $cmd or die $!;

## A shared var that captures whether the print succeeds
## If it does, the process went into an input state
## if it doesn't it ended (or was terminated) without entering an inpu
+t state
my $inInputState :shared = 0;

## Attempt to write to the process
## in a thread so we can do other things while it blocks.
## No newline so the process doesn't see it
## a series of spaces followed by backspaces 
## which should be "cancelled out" by the line edit API
## 4096 chars to ensure it gets through pipe buffering
async {
    $inInputState = 1 if printf CMD " \b"x2048;
}->detach;

## A microsleep to ensure responsiveness whilst avoiding cpu burn
## until the process self terminates
## or we reach the timeout period
## or the print succeeds -- entered input state
Win32::Sleep 10 until !kill 0, $pid
    or $timedOut = time() > $timeout
    or $inInputState
[download]

The rest is just mechanics.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?

Just for the record, a "unixish" implementation of BrowserUk's idea could look something like this:

#!/usr/bin/perl -slw
use strict;

our $N //= 12;
our $I //= 0;

my $cmd = qq[exec $^X -E'sleep $N; \$_=<STDIN> if $I; sleep 2; printf 
+"Kid done (read %d bytes)\\n", length'];

my $inInputState = 1;
my $timedOut = 0;
$SIG{PIPE} = sub { $inInputState = 0; };
$SIG{ALRM} = sub { $inInputState = 0; $timedOut = 1; die };
$SIG{CHLD} = 'IGNORE';

my $pid = open CMD, '|-', $cmd or die $!;

alarm 10;
eval { syswrite CMD, " \b"x(2**15+1) };
alarm 0;
    
if( $timedOut ) {
    print "Command timed out";
    kill 15, $pid;
}
if( $inInputState ) {
    print "Child waiting for input";
}
else {
    print "Kid never entered input state";
}
print 'Parent done';


__END__
$ ./detectChildInputState -I=0 -N=2
Kid done (read 0 bytes)
Kid never entered input state
Parent done

$ ./detectChildInputState -I=1 -N=2
Child waiting for input
Parent done
$ Kid done (read 65538 bytes)

$ ./detectChildInputState -I=1 -N=12
Command timed out
Kid never entered input state
Parent done

$ ./detectChildInputState -I=1 -N=9
Child waiting for input
Parent done
$ Kid done (read 65538 bytes)

$ ./detectChildInputState -I=0 -N=9
Command timed out
Kid never entered input state
Parent done
[download]

The main difference revolves around the SIGPIPE signal which on Unix would be delivered to a process if it attempts to write to a broken pipe (this is the case when the child terminates before having read anything).

By default, this signal would terminate the writing process, so it would have to be handled one way or another, anyway (e.g. $SIG{PIPE} = 'IGNORE'). OTOH, we can take advantage of this error notification, in which case we don't need an extra thread (or process) doing the blocking write.  The logic is kind of reversed now: we assume things went ok, unless we know otherwise, which is when

• the child terminated before it went into an input state (in which case we get a SIGPIPE)
• a timeout occurred before the child went into an input state

in those cases, $inInputState is set to zero in the respective signal handler.

A couple of more notes:

• the timeout is implemented via the usual alarm mechanism (instead of status polling in a loop)
• I'm using syswrite to circumvent Perl's own buffering without having to fiddle with autoflush
• Unix pipes typically use a rather large buffer (64k in my case), so the chunk written needs to be significantly larger than on Windows, in order to get the write operation to block
• the backspace cancellation trick would only work under rare circumstances (AFAICT) — simply reading from stdin would, for example, not treat the backspaces in any special way.
• last but not least, as a consequnce of the above, the tested program should be able to handle 64k of junk in case it puts up an innocent prompt (whether this is in fact an issue, of course depends on the type of program...)

#!/usr/bin/perl
use warnings;
use strict;
use IPC::Open3;
use IO::Select;

#interface to "bc" calculator
my $pid = open3(\*WRITE, \*READ,\*ERROR,"bc");
            #if \*ERROR is false, STDERR is sent to STDOUT 

my $selread = new IO::Select();
my $selerror = new IO::Select();
$selread->add(\*READ);
$selerror->add(\*ERROR);
# may not be best use of IO::Select, but it works :-)

my($error,$answer)=('','');

while(1){

print "Enter expression for bc, i.e. 2 + 2\n";
chomp(my $query = <STDIN>);

#send query to bc
print WRITE "$query\n";

#timing delay needed tp let bc output
select(undef,undef,undef,.01); 

#see which filehandles have output
if($selread->can_read(0)){print "ready->read\n"}
if($selerror->can_read(0)){print "ready->error\n"}
 
#get any error from bc
sysread(ERROR,$error,4096) if $selerror->can_read(0);
if($error){print "\e[1;31m ERROR-> $error \e[0m \n"}

#get the answer from bc
sysread(READ,$answer,4096) if $selread->can_read(0);
if($answer){print "$query = $answer\n"}

($error,$answer)=('','');
}

waitpid($pid, 1);
# It is important to waitpid on your child process,  
# otherwise zombies could be created.
[download]

This depends on knowing what the prompt will be, which I don't in this case. If I know what the prompt would be, of course I can just wait until I see it, but in this case I don't know what it'll be.

I actually know what to do IF the program is waiting for input. What I need to be able to do is distinguish whether the background program is running (and just taking a while to complete) or if it's stalled waiting for input.

In this situation, it's actually not critical that I be able to interact with the program... I just need to know what state it's in. That's why it's not absolutely critical that I use IPC::Open3 or RPC::Run... if I can have access to STDIN/STDOUT, that would be nice, but I'll do without if I have to.

One more detail... the program will be sending stuff to STDOUT/STDERR, so the presense of output from the program doesn't signal that it's prompting for input.