#!/usr/bin/perl

use strict;
use warnings;
use threads;           # pull in threading routines
use threads::shared;   # and variable sharing routines
use IO::Socket::INET;  # and rock the sock et
use File::Temp qw/ :POSIX /;


our @chat:shared = ();
our $EOL = "\r\n";
# signal for the writer to die:
our $kill = 'my Socket broke';
$SIG{PIPE} = 'ignore';   sub ignore { ; }

    my $server = IO::Socket::INET->new(
        LocalPort => 1234, 
        Type => SOCK_STREAM,
        Reuse => 1, 
        Listen => 10
    ) or die $!;

    while (my $client = $server->accept()){
        tmpnam() =~ /tmp\/(.+)/; # use tmp-file name for the IDs
        my $r = threads->new(\&Reader::run, 
                    client => $client, "ID","$1");
        $r->detach();
        my $w = threads->new( \&Writer::run, 
                    client => $client, "ID", "$1" );
        $w->detach();
    }

#####
package Reader;
use threads;
use threads::shared;

sub new {..}
sub run {
    my $self = Reader->new(@_);
    my $socket = $self->{client};
    my $l;

    while(defined ($l = <$socket>) ){
        lock(@chat);
        push @chat, "$self->{ID}\t$1";
        cond_broadcast(@chat);
    }
    # this is the only way that I've found to make th Writer die ..
    # Now let the Writer know to stopservice and die:
    # AND HERE is MY PROBLEM:
    # with lock(@chat) before push the Writer won't get it, won't die!
    # but cond_broadcast(@chat) causes the warning..
    push @chat, "$self->{ID}\t$kill";
    cond_broadcast(@chat);
    print "Reader $$: $self->{ID} will die, bye\n";
}

#####
package Writer;
use threads;
use threads::shared;

sub new { .. }
sub run {
    my $self = Writer->new(@_);
    my $socket = $self->{client};
    my $ID = $self->{ID}; # easier to use in regExpr.

    while( "@chat" !~ /$ID$kill/ ) { # to leave the loop to die
        lock(@chat);
        cond_wait(@chat);
        foreach (@chat) {
            $_ =~ /(.+?)\s(.+)$/;
            print $socket $2,$EOL if ( $1 ne $ID && $2 ne $kill);
            # this does not work:
            print $socket $2, $EOL or die;
        }
    }
    print "Writer $$: $ID will die, bye\n";
}
[download]