#!/usr/bin/perl
use warnings;
use strict;
use Thread::Queue;
use threads::shared;
use Time::HiRes qw(usleep gettimeofday tv_interval);

my %tids    = ();
my $t_count = 0;
my $done    = 0;
my @results = ();

my $run_alive = 0;
my $die : shared;
$die = 0;
my $go : shared;
$go = 0;
my $Q = new Thread::Queue;

#This is my worker
sub pipeCommand ($$$$$;@) {
    my $tid   = shift;
    my $uut   = shift;
    my $test  = shift;
    my $cmd   = shift;
    my @input = @_ ? @_ : ();

    my $err = 0;
    my ( $out, $in );
    my $pid;
    
    while (1) {
        if ($go) {
            eval {
                $pid = open2( $out, $in, $cmd );    # die "$!\n";
            };
            if ($@) {
                if ( $@ =~ /^open2/ ) {
                    warn "open2 failed: $!\n$@\n";
                    $err = 1;
                    goto CLOSE;
                }
                die "something else happened: $!\n$@\n";
            }
            print $in "$_\n" foreach (@input);
            close $in or warn "close of input: $! $?\n";
            goto START;
        }
        else {
            select( undef, undef, undef, 0.25 );
        }
    }
  START:
    while (<$out>) {
        last if ($die);
        chomp;
        $err = 1 if (/^thread failed/);
        $Q->enqueue("$tid:$uut:$test:$_");
        last if ($err);
    }
  CLOSE:
    kill( 2, $pid ) if ( $err or $die );
    $Q->enqueue("$tid:$uut:$test:error test exited abnormally")
      if ( $err or $die );
    close $out or warn "close of output: $! $?\n";
    my $kpid = waitpid( $pid, 0 );
    $Q->enqueue("$tid:$uut:$test:ENDEND");

    my $retval = ( $err or $die ) ? 1 : 0;
    return ($retval);
}

#this guy runs in the main thread 
#thread 0 that is, texas tea...
#basically pulls all of the IO from the queue
sub recv_results {

    my $td = time();
    my $err_count = 0;

    while (1) {
        if ( $Q->pending ) {
            my $line = $Q->dequeue;
            $_ = $line;
            chomp;
            if (/ENDEND$/) {
                $done++;
                my ( $tid, $fru, $test, $text ) = split(/:/);
                $results[ $tids{$tid} ]->{done} = 1;
            }
            last if ( $done == $t_count );
            last if (/^DIEDIE$/);
            next if (/ENDEND$/);
            next if (/^\s*[Ss]econds?/);
            if ( /some_error_match/) {
                $err_count++;
                my ( $tid, $fru, $test, $text ) = split(/:/);
                $results[ $tids{$tid} ]->{err_count}++;
                push @{ $results[ $tids{$tid} ]->{results} }, $text;
            }
            elsif ( /some_pass_text/ ) {
                my ( $tid, $fru, $test, $text ) = split(/:/);
            }
            else {
                            #some other text. do something or not
            }
        }
        else {
            usleep 5000;
                        #this sleep is key. 
                        #otherwise you will thrash your cpu
                        #and it won't have time to do anything else.
        }
    }

 print "Final Status: $done/$t_count Done.  $err_count errors...\n";

    return $err_count;
}
#A couple of notable sig handlers...
sub ALRM_handler {
    alarm 0;
    $Q->enqueue("DIEDIE");
    $die = 1;
}

sub INT_handler {
    $Q->enqueue("DIEDIE");
    $done = 1;
}

#set up all the threads.
#note, go is not yet set to zero so, they'll sleep until told to go
sub launch_tests {

    foreach my $cur_test (@tests) {
        foreach my $uut (@targets) {
            my $run_test = 0;
            my $cmd      = "";
            my %result   = (
                thread    => '',
                test      => "",
                fru       => "",
                results   => [],
                err_count => 0,
                done      => 0,
            );

            if ( $cur_test =~ /test1/ ) {
                next unless is_das($uut);
                $cmd = "cd "
                  . $test{$cur_test}{wd} . "; "
                  . $test{$cur_test}{handler}[0]( $uut, $time, undef )
+;
                $run_test = 1;
            }
            elsif ( $cur_test =~ /test2/ ) {
                my $hnum = ( $uut =~ /bc1-01/ ) ? 1 : 0;
                $cmd = "cd "
                  . $test{$cur_test}{wd}[$hnum] . "; "
                  . $test{$cur_test}{handler}[$hnum]( $uut, $time, "co
+ld" );
                $run_test = 1;
            }
#add other elseifs to your heart's content
            if ($run_test) {
                $t_count++;
                $tids{$t_count}   = $t_count-1;
                $result{fru}      = $uut;
                $result{test}     = $cur_test;
                $result{'thread'} =
                  threads->new( \&pipeCommand, $t_count, $t_uut, $cur_
+test,
                    $cmd, @targets );
                push @results, \%result;
            }
        }
        print "Queued $cur_test...\n";
    }
}

#main chunk of code.
print "Preparing Tests for execution....\n";
launch_tests();

#let loose the dogs of war 
#or the test threads. whatever you have at hand
$go = 1;

#Install the hadlers.
$SIG{INT}  = 'INT_handler';
$SIG{ALRM} = 'ALRM_handler';

#Setup the alarm leave a little bloat.
my $alrm = $time + 35;    #seem to be around 22s.

#set the alarm.
alarm $alrm;

my $err_count = recv_results();

#this will force any threads that are still stuck in the while loop to
+ exit
#of course they already should have finished, but
#murphy is always around.
$die = 1; 

#This is a blocking call that will join all threads
#back to the main thread.
foreach my $k (sort keys %tids) {
    $results[$k-1]->{'thread'}->join;
}

exit;

__END__
[download]