Sorry about that, I just wanted to post my current status to show that I am not just waiting around for someone to do the work for me. I will be better about it.

Versions: threads::shared version 1.12 threads version 1.63

Incidentally I am using use strict; and use warnings; and I am not seeing anything about $fh->close(), not sure why it isn't

Versions: threads::shared version 1.12 threads version 1.63

Okay. That could explain some of the anomolies. I strongly recommend that you upgrade to the latest CPAN versions of both. There have been so many changes recently that it is impossible to keep track of what worked and what didn't with down-level versions.

However, would you try this both before and after the upgrade and tell me how you get on (the stuff after the __END_ token is examples of it running on my system):

#! perl -slw
use strict;
use threads qw[ yield ];
use threads::shared;

$|++;

my $cmd = $ARGV[ 0 ] || 'diskpart';
my $timeout = 10;

my @results = timedCommand( $cmd, $timeout );

if( $results[0] ne '**TIMEOUT**' ) {
    print "Command returned\n", join '', @results;
}
else {
    print "Command timed out after $timeout seconds and returned\n", 
        join '', @results;
}

sub timedCommand {
    my( $cmd, $timeout ) = @_;

    my $pid :shared;
    my( $thr ) = threads->create( \&pipedCmd, $cmd, $timeout, \$pid );
    yield until $pid;
    sleep 1 while $pid and $timeout--;
    return $thr->join unless $pid;
    kill 3, $pid if $pid and $timeout;
    return '**TIMEOUT**', $thr->join;
}

sub pipedCmd {
    my( $cmd, $timeout, $pidref ) = @_;
    my @results;
    $$pidref = open my $fh, "$cmd |" or die "$!, $^E";
    yield;
    push @results, $_ while defined( $_ = <$fh> );
    undef $$pidref;
    return @results;
}

__END__
c:\test>timedCommand.pl
Command timed out after 10 seconds and returned
**TIMEOUT**
Microsoft DiskPart version 5.1.3565
Copyright (C) 1999-2003 Microsoft Corporation.
DISKPART>

c:\test>timedCommand.pl
exit
Command returned
Microsoft DiskPart version 5.1.3565
Copyright (C) 1999-2003 Microsoft Corporation.
DISKPART>
Leaving DiskPart...

c:\test>timedCommand.pl cd
Command returned
c:\test
[download]

---

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.

"Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."

Here is the output with no upgrade

C:\Sandbox\AutoPilot\src>perl timedCommand.pl
Command timed out after 10 seconds and returned
**TIMEOUT**
Microsoft DiskPart version 5.1.3565

Copyright (C) 1999-2003 Microsoft Corporation.
On computer: USITPAPADGD1C

DISKPART>

C:\Sandbox\AutoPilot\src>perl timedCommand.pl
exit
Command returned

Microsoft DiskPart version 5.1.3565

Copyright (C) 1999-2003 Microsoft Corporation.
On computer: USITPAPADGD1C

DISKPART>
Leaving DiskPart...


C:\Sandbox\AutoPilot\src>perl cd
Can't open perl script "cd": No such file or directory

C:\Sandbox\AutoPilot\src>perl timedCommand.pl cd
Command returned
C:\Sandbox\AutoPilot\src
[download]

Seems like it is the same as on your system, which is good because upgrading to the newer thread would not be a suitable solution for other people.

I have a question on your implementation, lets say I wanted to every 5 seconds check the entries in @results, to see if the last entry matches a certain regex, and that the size of @results hasn't changed. How would you do this? I was able to figure out how using the queue

That being said I have been playing around with the code I was working on and seem to have a solution that works using queues.

Here is how I did it:

my $queue = new Thread::Queue;

my $command = 'diskpart';

    my $status = _timedCommand($command, 90);
    if ($status eq 'TIMEOUT') {
        print "\n=======TIMEOUT==========\n";
    }

    my @ans;
    while (my $ref = $queue->dequeue_nb()) {
        if (ref($ref) =~ m/ARRAY/i) {
            push(@ans, @$ref);
        }
        else {
            push(@ans, $ref);
        }
    }
    print "@ans\n";

sub _timedCommand
{
    my ($command, $time) = @_;
    my $pid :shared;

    my $thr = async {
        $pid = open my $fh, "$command |" or die "$!";
        while (<$fh>) {
            $queue->enqueue($_);
        }
        close($fh);
    };

    while ($thr->is_running() and $time > 0) {
        sleep(1);
        $time--;
        #Special Case Checking, if we get to 30 seconds
        #check to see if we might be waiting on user input
        if ($time == 30) { #only check once give it time
            my $num = $queue->pending();
            if ($num > 100) {
                #if we have a lot of entries, then its
                #most likely not an input hang
                next;
            }
            print "Num Pending $num\n";
            for (my $i=0; $i < $num; $i++) {
                my $line = $queue->[$i];
                #Check DiskPart:
                if ($line =~ m/^Microsoft DiskPart/i) {
                    #If we are hung up waiting for user input
                    #the second to last line in the queue will
                    #be On Computer: check for it
                    if ($queue->[$num-2] =~ m/^On Computer:/i) {
                        $time = 0;
                        last;
                    }
                }
                #End DiskPart Check
            }
        }
    }

    if ($thr->is_joinable()) {
        $thr->join();
        return 'OK';
    }
    else {
        kill 3, $pid;
        $thr->join();
        return 'TIMEOUT';
    }
}
[download]