#!/usr/local/bin/perl -wT
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:

Be warned that this server doesn't speak telnet correctly, so
not all telnet clients will work.  Sorry!  If each character you type
appears on a separate line, log out and try a different client, and send
me email (bslesins-code\@hotwired.com) 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
I've had reports that Microsoft Telnet doesn't work.

Also, people might be logged in but doing something else, so they won't
see your message right away.  So type something, leave your telnet window
open, and come back later to see if anything happened.

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

__Brian__

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__

# and here's a chat server in 4 lines :-)

#!/usr/local/bin/perl -- minchat: run and telnet to port 5555 - bslesins
sub p{print@_}$SIG{CHLD}=sub{wait};socket S,2,2,6;bind S,pack(Snx12,2,5555);
listen S,5;while(accept C,S){if(!fork){open(STDOUT,">&C");p"name:";$n=substr
<C>,0,-2;$f=fork||exec"tail -f chatlog";open W,">>chatlog";select(W);$|=1;p
"[$n here]\r\n";while(<C>){p"$n> $_";}p"[$n gone]\r\n";kill 15,$f;exit}}