$self->{rw} = 1;


##</code><code>##

	    ${$self->{rw}} = 1;


##</code><code>##

#!/usr/bin/perl -w
use strict;
use threads;

sub threadA {
    for(my $i = 1; $i <= 100; $i++) {
        warn "Thread A: Print $i";
	print FILE "A: $i\n";
    }
}

sub threadB {
    for(my $i = 1; $i <= 100; $i++) {
        warn "Thread B: Print $i";
	print FILE "B: $i\n";
    }
}

tie *FILE, 'FHShare';
open FILE, '>fhshare.out';
autoflush FILE;
my $a = threads->create('threadA');
threadB();
$a->join;
close FILE;

package FHShare;

# A package to share filehandles between threads via tie()

use strict;
use threads;
use threads::shared;
use FileHandle;

# Subroutine to start thread that accesses filehandle
sub start_thread {
    my $self = shift;
    $self->cmdloop();
}

sub TIEHANDLE {
    my $class = shift;

    my $sem : shared;
    my $cw : shared = 0;
    my $rw : shared = 0;
    my @cmd : shared;
    my @rv : shared;
    my $err : shared;

    my $self = {
	cmd => \@cmd,		# Command
	rv => \@rv,		# Return value
	err => \$err,		# Error from calling filehandle method
	# A semaphore to lock access to send commands to the command
	# thread:
	sem => \$sem,
	# A semaphore for the command thread to notify it that it has
	# a command waiting:
	cw => \$cw,	# 1 for command waiting
	# A semaphore for the command thread to notify other threads
	# that return values are waiting:
	rw => \$rw };	# 1 for values waiting
    bless $self, $class;

    # Create thread attached to this handle
    threads->create('start_thread', $self)->detach();
    return $self;
}

sub DESTROY {
    my $self = shift;
    lock $self->{sem};
    ${$self->{cmd}} = ();	# Empty list to quit
    {
	lock $self->{cw};
	${$self->{cw}} = 1;
	cond_signal $self->{cw};
    }
    {
	lock $self->{rw};
	while (!${$self->{rw}}) {
	    cond_wait $self->{rw};
	}
    }
}

# Autoload section -- convert uppercase method names called to
# lowercase method names for the underlying filehandle.

our $AUTOLOAD;

sub AUTOLOAD {
    my $self = shift;
    warn "Autoloaded $AUTOLOAD";
    my $method = lc($AUTOLOAD);	# Convert method to lc.
    $method =~ s/^.*:://;	# Remove prefix.

    FileHandle->can($method) or
	die "Error: filehandles have no '$method' method";

    my @ret;			# Return value

    {
	lock $self->{sem};	# Lock access
	# Send command:
        warn "$AUTOLOAD: Sent $method(@_)";
	@{$self->{cmd}} = ($method, @_);
	# Tell command thread that it is waiting:
	{
	    lock $self->{cw};
	    ${$self->{cw}} = 1;
	    cond_signal $self->{cw};
	}
	# Wait for return values
        warn "$AUTOLOAD: waiting";
	{
	    lock $self->{rw};
	    while (!${$self->{rw}}) {
                warn "$AUTOLOAD: waiting for data";
		cond_wait $self->{rw};
                warn "$AUTOLOAD: done waiting";
	    }
	    ${$self->{rw}} = 0;	# Reset
	}
	# Handle errors
	if (my $err = ${$self->{err}}) {
	    chomp $err;
	    my($filename, $line) = (caller)[2,3];
	    die "$err at $filename line $line\n";
	}
	@ret = @{$self->{rv}};	# Get return values
    }
    return @ret;		# Return w/ return vals
}

# Method for thread that accesses underlying filehandle to loop
# through commands

sub cmdloop {
    my $self = shift;
    warn "Entered command loop";
    my $fh = new FileHandle;

    while (1) {
	# Wait for and get command
	{
	    warn "Waiting for command ready";
	    lock $self->{cw};
	    while (!${$self->{cw}}) {
		cond_wait $self->{cw};
	    }
	    $self->{cw} = 0;	# Reset
	}
	
	# Get the method and arguments
	my @cmd = @{$self->{cmd}} or last; # Quit on empty list
	my $method = shift @cmd;
	my @args = @cmd;

	# Call the method, enqueue the return value(s)
	my $mcall = "\$fh->$method(\@args)";
	warn "sending \$fh->$method(@args)";
	@{$self->{rv}} = eval $mcall;
	#@{$self->{rv}} = $fh->$method(@args);

	# Record errors
	${$self->{err}} = $@;
    } continue {
	# Signal that values are waiting
	{
	    warn "Signaling data available";
	    lock $self->{rw};
	    warn "locked 'rw' flag";
	    warn "'rw' flag is $self->{rw}";
	    ${$self->{rw}} = 1;
	    warn "'rw' flag is $self->{rw}";
	    cond_signal $self->{rw};
	    warn "signalled 'rw' flag";
	}
    }
}

1;