#!/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 $Elm:shared = ''; our $NoClient:shared = 0; our $EOL = "\r\n"; our $kill = 'my Socket broke'; $SIG{PIPE} = 'ignore'; sub ignore { ; } #We ignore SIGPIPEs generated by clients trying to work #with closed connections. SIGPIPEs, if not handled, cause death. my $server = IO::Socket::INET->new(LocalPort => 3333, Type => SOCK_STREAM, Reuse => 1, Listen => 10) or die $!; while (my $client = $server->accept()){ my $pAddr = $client->peerhost(); if ($pAddr!~/^127\.0\.0\./ && $pAddr!~/^10\.10\.10\.\d+/) { print $client 'Sorry not for you..',$EOL; print "Ooops, who was that? Addr: $pAddr\n"; close($client); next; } lock($NoClient); $NoClient++; cond_broadcast($NoClient); # create a uniqe ID from tmp-file: tmpnam() =~ /.+mp\/(.+)/; # initialize the number of lines the Writer for this Client lock($Elm); $Elm .= "$1:0;"; cond_broadcast($Elm); my $r = threads->new(\&Reader::run, client => $client, "ID","$1"); $r->detach(); my $w = threads->new( \&Writer::run, client => $client, "ID", "$1", "Addr" => "$pAddr" ); $w->detach(); } ##### package Reader; use threads; use threads::shared; sub new { my $pkg = shift; my $self = { @_ }; return bless($self, $pkg); } sub run { my $self = Reader->new(@_); my $socket = $self->{client}; my $l; while(defined ($l = <$socket>) ){ next if ($NoClient < 2); #print "$self->{ID}\t$1\n"; # skip empty lines $l =~ /(.+?)[\n\r]+/; if ($1) { lock(@chat); push @chat, "$self->{ID}\t$1"; cond_broadcast(@chat); } } # end while lock($NoClient); $NoClient--; cond_broadcast($NoClient); #lock(@chat); push @chat, "$self->{ID}\t$kill"; cond_signal(@chat); } ##### package Writer; use threads; use threads::shared; sub new { my $pkg = shift; my $self = { @_ }; return bless($self, $pkg); } sub run { my $self = Writer->new(@_); my $socket = $self->{client}; my $ID = $self->{ID}; my $Time = time; my %E = (); my ($start, $min, $i); printf "\t%12s has connected at %s\n", $self->{Addr}, scalar(localtime($Time)); while( "@chat" !~ /$ID\s$kill/ ) { lock(@chat); cond_wait(@chat); lock($Elm); %E = (map { $1 => $2; /(.+):(.+)/ } (split /;/, $Elm)); #$i =0; print "Writer: $ID\n\tstart at $E{$ID}, $Elm\n\@chat:\n", # (map {($i++)."\t$_\n"} @chat),"sending:\n"; for my $i ( $E{$ID} .. $#chat ) { $chat[$i] =~ /(.+?)\s(.+)[\n\r]+/; print $socket $2,$EOL if ( $1 ne $ID && $2 ne $kill); #print "> $i\t$1\t$2\n" if ( $1 ne $ID && $2 ne $kill); } # now delete from @chat what is not longer needed: $E{$ID} = @chat; $min = min(values %E); #$i = 0; print "\neliminating: $min\n", # (map { ($i++)."\t$_\n"} @chat[0..($min-1)]); #$i = 0; print "\nstill kept:\n", # (map {($i++)."\t$_\n"} @chat[$min..$#chat]); @chat = @chat[$min .. $#chat]; #print "\nold Elm: $ID\t$Elm"; $Elm =''; # to rewrite $E foreach ( keys %E) { $Elm .= "$_:".(($_ eq $ID) ? @chat : ($E{$_} - $min) ).';'; } #print "\nnew Elm: $ID\t$Elm\n#### done ####\n\n"; cond_broadcast($Elm); } # end while # now eliminate the Writer's ID from $E: lock($Elm); my @E = (split /;/, $Elm); $Elm =''; # to rewrite $E foreach ( @E ) { $Elm .= "$_;" unless ( $_ =~ /^$ID\:/); } cond_broadcast($Elm); #print "Writer $$: $ID will die, bye\n"; printf "\t%12s disconnected at %s after %s\n", $self->{Addr}, scalar(localtime(time)), s2T(time-$Time); } sub s2T { #: calcs sec into days h:m:s if ( $_[0] > 86400 ) { my $ti = ( ($_[0]%86400)/3600 )%100; my $t = ($_[0]%86400) - ($ti*3600); return sprintf(" %i d %3i:%02i:%02i",int($_[0] / 86400),$t +i,(($t/60)%60),($t-((($t/60)%60)*60))); } my $ti = ( $_[0]/3600 )%100; my $t = $_[0] - ($ti*3600); return sprintf("%3i:%02i:%02i",$ti,(($t/60)%60),($t-((($t/60)% +60)*60))); } sub min { #: min of value-list # @_ = #: LIST of values (int,float) my $m = $_[0]; foreach (@_) { $m = $_ if $m > $_ } return $m; ##: min of list }
In reply to Re: Re: thread:shared
by Anonymous Monk
in thread thread:shared
by Anonymous Monk
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |