As always, comments and better ways to do it are appreciated. This is not finished, obviously, but could certainly be molded into something useful with a little initiative.

#!/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 = <<END;

Welcome to my chat server.

IMPORTANT DIRECTIONS FOR TELNET USERS:

If each character you type appears on a separate line, log out and try
+ a different client, and send me email (tekniko\@elektrasystems.net) 
+about which clients work for you.

I've tried these clients and they seem to work:
  - "telnet" on Solaris
  - "telnet" on IRIX
  - CRT on Windows 95

To quit, close your telnet window.  Or if you're running telnet from t
+he Unix command line, hit Control-] and then type "close" at the prom
+pt.

END
    $welcome =~ s:\n:\r\n:g;
    $self->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__
[download]