my $childThread = threads->new( \&Your::Package::childThreadWrite, $self, $l_cqrdMessage);

##</code><code>##

    lock $self->{waitFlag};

##</code><code>##

print do{ no strict 'refs'; \*( $self->{ inst } } }, $l_cqrdMessage;

##</code><code>##

#! perl -slw
use strict;
package test;
use threads qw[ yield ];
use threads::shared;
use IPC::Open2;

use constant TIMEOUT => 10; # seconds

sub new {
    my( $class, $inst ) = @_;
    my $pid = open2( '>&STDOUT', do{ no strict 'refs'; \*{ $inst } },
        'perl58', '-e" print q[etx:],  scalar <> for 1 .. 5; sleep 60; print q[Dying]; "' )
        or die "Opening pipe failed: $!";

    my %self : shared = (
        inst    => $inst,
        procID  => $pid,
    );

    return bless \%self, shift;
}

sub write {
    my( $self, $msg ) = @_;
    my $flag : shared = 1;

    warn 'Setting timeout';
    my $timeout = time + TIMEOUT;

    my $thread = threads->create(
        \&tWrite,
        $self,
        \$flag,
        do{ no strict 'refs'; \*{ $self->{ inst } } },
        $msg
    );

    warn 'Waiting for flg to clear or timeout';
    yield while do{ lock( $flag ); $flag }
            and time < $timeout;

    if( $flag ) {
        warn "Timeout; killing process:$self->{ procID }";
        kill 9, $self->{ procID } or warn $!;
        warn 'Closing pipe';
        close do{ no strict 'refs'; \*{ $self->{ inst } } }
            or warn "Close pipe failed: $!";
        @{ $self }{ qw[ procID timeout ] } = ( undef, 0 );
        warn 'Waiting for thread to notice';
        $thread->join;
        warn 'Returning failure';
        return 0;
    }
    warn 'Wrote successfully; waiting for thread to join';
    $thread->join;
    warn 'joined';
    return 1;
}

sub tWrite {
    my( $self, $flagref, $GLOB, $msg ) = @_;

    warn 'Writing';
    print { $GLOB } $msg or warn "pipe: $!";
    warn 'Written; clearing flag';
    { lock( $$flagref ); $$flagref = 0; }
    warn 'Ending';
}

sub done {
    my( $self ) = @_;
    close do{ no strict 'refs'; \*{ $self->{ inst } } }
        or warn $!;
    kill 9, $self->{ ProcID };
    undef $self;
}

1;
package main;

select do{ local $_ = select( STDERR ); $|++; $_ };

# Pass in a name to be used symbolically
# for this instance pipe handle.
my $test = test->new( 'PIPE' );

for (1 .. 10) {
    printf 'Enter to print a line of data'; <STDIN>;
    warn 'Calling write';
    unless( $test->write( 'X' x 1024 ) ) {
        warn 'Restarting external process';
        $test->done;
        # Use the same name when we recreate the instance.
        $test = test->new( 'PIPE' );
    }
    else {
        warn "Successfully wrote line $_";
    }
}

warn 'Done';
exit;