#!/usr/local/bin/perl -w require 5.002; use strict; use IO::Socket; use IO::Select; my $port = scalar(@ARGV)>0 ? $ARGV[0] : 2323; $| = 1; my $listen = IO::Socket::INET->new(Proto => 'tcp', LocalPort => $port, Listen => 1, Reuse => 1) or die $!; $ENV{'PATH'} = "/usr/bin"; my $date = `date`; warn "started on $port on $date"; my $select = IO::Select->new($listen); my @chatters; # comment out this line on win32 $SIG{'PIPE'} = 'IGNORE'; my @ready; while(@ready = $select->can_read) { print "going: ".join(', ',map {$_->fileno} @ready) . "\n"; my $socket; for $socket (@ready) { if($socket == $listen) { my $new_socket = $listen->accept; Chatter->new($new_socket, $select, \@chatters); } else { my $chatter = $chatters[$socket->fileno]; if(defined $chatter) { &{$chatter->nextsub}(); } else { print "unknown chatter\n"; } } } } package Chatter; use strict; sub new { my($class,$socket,$select,$chatters) = @_; my $self = { 'socket' => $socket, 'select' => $select, 'chatters' => $chatters }; bless $self,$class; $chatters->[$socket->fileno] = $self; $self->select->add($socket); $self->log("connected"); $self->ask_for_handle; return $self; } sub socket { $_[0]->{'socket'} } sub select { $_[0]->{'select'} } sub chatters { $_[0]->{'chatters'} } sub handle { $_[0]->{'handle'} } sub nextsub { $_[0]->{'nextsub'} } sub ask_for_handle { my($self) = @_; my $welcome = <write($welcome); $self->write("choose a handle> "); $self->{'nextsub'} = sub { $self->get_handle }; } sub get_handle { my($self) = @_; my $handle = $self->read or return; $handle =~ tr/ -~//cd; $self->{'handle'} = $handle; $self->broadcast("[$handle is here]"); $self->log("handle: $handle"); $self->{'nextsub'} = sub { $self->chat }; } sub chat { my($self) = @_; my $line = $self->read; return if($line eq ""); $line =~ tr/ -~//cd; my $handle = $self->handle; $self->broadcast("$handle> $line"); } sub broadcast { my($self,$msg) = @_; my $socket; for $socket ($self->select->handles) { my $chatter = $self->chatters->[$socket->fileno]; $chatter->write("$msg\r\n") if(defined $chatter); } } sub read { my($self) = @_; my $buf=""; $self->socket->recv($buf,80); $self->leave if($buf eq ""); return $buf; } sub write { my($self,$buf) = @_; $self->socket->send($buf) or $self->leave; } sub leave { my($self) = @_; print "leave called\n"; $self->chatters->[$self->socket->fileno] = undef; $self->select->remove($self->socket); my $handle = $self->handle; $self->broadcast("[$handle left]") if(defined $handle); $self->log("disconnected"); $self->socket->close; } sub log { my($self,$msg) = @_; my $fileno = $self->socket->fileno; print "$fileno: $msg\n"; } __END__