Script background (Long, can skip if not interested): This module is designed as a proxy for a anonymous pipe to an external process (terminal style program). However, the external process occasionally hangs, meaning that eventually the anonymous pipe blocks when attempting to perform a write. As the process has hung, the thread attempting the write will never return, eventually hanging up the entire script. As Windows doesn't implement alarms, and because forking is too expensive, I am trying to use threads to timeout the write to the anonymous pipe. Although I cannot forcefully kill the hung thread, I can forcefully kill the process at the other end, which allows the thread to recover and be joined/eval'ed properly. The terminal process can then be restarted.

One thread is spawned to actually perform the write, while the other busy loops (on yields, so it's not *quite* so bad) until a timeout has passed. If the timout occurs, the original thread kills the associated process and attempts to harvest the thread.

sub write
{
    # get class reference
    my $self = shift;

    my $l_cqrdMessage = shift;

    # set synchronisation flag
    $self->{waitFlag} = 0;

    # take note of the time the call was supposed 
    # to start
    $self->{callTime} = time();

    # create child thread to perform actual write
    my $childThread = threads->new(\&$self->childThreadWrite, $l_cqrdM
+essage);

    # wait until child thread has started properly
    my $tempFlag = 0;

    while (1)
    {
        {
            lock $self->{waitFlag};
            $tempFlag = $self->{waitFlag};
        }
        if($tempFlag == 0)
        {
            yield();
        }
        else
        {
            last;
        }
    }

    # Wait for either the child thread to 
    # indicate a successful write by setting 
    # the waitFlag value in the instance, or
    # to timeout.  Yield until one of the 
    # conditions comes up - pretty busy, but
    # gives other threads a chance to run.

    while (1)
    {
        {
            lock $self->{waitFlag};
            $tempFlag = $self->{waitFlag};
        }
        if(($tempFlag == 1) && (($self->{callTime} + $self->{timeout})
+ > time() ))
        {
            yield();
        }
        else
        {
            last;
        }
    }

    if ($tempFlag == 1)
    {
        # TODO put out log file message.

        # Thread has not returned from blocking 
        # write call so trash the CQRD process
        # to force the thread to return.
        kill( 9, $self->{procID}) or warn $!;           

        # Clean the CQRDProxy up as the CQRD is
        # (hopefully) dead, therefore the rest of 
        # the CQRDProxy state is invalid.
        close ($self->{processFH});
        $self->{procID}   = undef;
        $self->{waitFlag} = 0;
        $self->{callTime} = 0;

        # eval the child thread rather than join 
        # to trap the inevitable errors.
        $childThread->eval();

        return 0;

    }
    else
    {
        # Blocking call completed successfully
        $childThread->join();

        return 1;
    }

}

# The childThreadWriter method is supplied to the 
# child thread to perform the (potentially) blocking
# IO call to the IPC channel.
sub childThreadWriter
{
    my $self = shift;
    my $l_cqrdMessage = shift;

    # Anonymous blocks are to limit the lock 
    # scope, as there is no unlock facility and
    # locks are dynamically scoped.
    {
        lock $self->{waitFlag};
        $self->{waitFlag} = 1;
    }

    print $self->{processFH}, $l_cqrdMessage;

    {
        lock $self->{waitFlag};
        $self->{waitFlag} = 0;
    }
}
[download]