#!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 $!;

warn "started on $port\n";
my $select = IO::Select->new($listen);
my @chatters;

# comment out this line on win32
$SIG{'PIPE'} = 'IGNORE';

while(my @ready = $select->can_read) {
#    print "going: ".join(', ',map {$_->fileno} @ready) . "\n";
    for my $socket (@ready) {
	print "$socket ready\n";
	if($socket == $listen) {
	    my $new_socket = $listen->accept;
	    Chatter->new($new_socket, $select, \@chatters);
	} # if
	else {
	    my $chatter = $chatters[$socket->fileno];
	    if(defined $chatter) {
		&{$chatter->nextsub}();
	    } 
	    else {
		print "unknown chatter\n";
	    }
	} # else
    } # for
} # while
# ************************************************************
package Chatter;
use strict;

# create new chatter
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;
} # new
# ------------------------------------------------------------
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:

This server doesn\'t speak telnet correctly, so not all telnet clients 
will work. If each character you type appears on a separate line, log out 
and try a different client. I\'ve tried these clients and they are ok:
  - "telnet" on Solaris, Linux, IRIX
  - CRT on Windows 95/NT
Microsoft Telnet and Tera Term Pro don\'t work.

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

You can get help with "/help"

END
    ;
    $welcome =~ s:\n:\r\n:g;
    $self->write($welcome);

    $self->write("choose a handle> ");

    $self->{'nextsub'} = sub { $self->get_handle };
} # ask_for_handle
# ------------------------------------------------------------
sub get_handle {
    my($self) = @_;

    # if no nick entered, don't block but return
    my $handle = $self->read or return;
    $handle =~ tr/ -~//cd;

    # check if handle is still available
    my $handleFree = 1;
    for my $socket ($self->select->handles){
	my $chatter = $self->chatters->[$socket->fileno];
	if (lc($handle) eq lc($chatter->{handle})){
	    $handleFree = 0;
	} # if
    } # for
    
    # selected handle is available
    if ($handleFree){
	$self->{'handle'} = $handle;
	$self->broadcast("*** $handle has connected");
	$self->log("handle: $handle");
	$self->{'nextsub'} = sub { $self->chat };
    } # if

    # selected handle is not available any more
    else {
	$self->write("ERROR: handle $handle is already in use");
	$self->write("choose a handle> ");
	$self->{'nextsub'} = sub { $self->get_handle };
    } # else

} # get_handle
# ------------------------------------------------------------
sub read {
    my($self) = @_;

    my $buf="";
    $self->socket->recv($buf,80);
    $self->leave if($buf eq "");

    return $buf;
} # read
# ------------------------------------------------------------
sub write {
    my($self,$buf) = @_;

    $self->socket->send($buf."\r\n") or $self->leave;
} # write
# ------------------------------------------------------------
sub log {
    my($self,$msg) = @_;
    my ($logfile) = "chat.log";
    my $fileno = $self->socket->fileno;

#    print "$fileno: $msg\n";
    open (LOG, ">>$logfile") or die ("ERROR: could not open LOG $logfile\n");
    print (LOG "$fileno: ".($self->{handle} || "").": $msg\n");
    close(LOG);

} # log
# ------------------------------------------------------------
sub broadcast {
    my($self,$msg) = @_;

    for my $socket ($self->select->handles) {
	my $chatter = $self->chatters->[$socket->fileno];
	$chatter->write("$msg") if(defined $chatter);
    } # for

} # broadcast
# ------------------------------------------------------------
sub chat {
    my($self) = @_;

    my $line = $self->read;
    return if ($line eq "");
    return if ($line eq "\r\n");
    $line =~ tr/ -~//cd;
    $self->ParseLine($line);

} # chat
# ------------------------------------------------------------
sub ParseLine {
    my ($self, $line) = @_;

    my $handle = $self->handle;
    my ($cmd, @args) = split(/ +/, $line);
    $cmd = lc($cmd);
    if ($cmd =~ /^\#/){
	my (@args) = ($cmd, @args);	$self->msg (\@args);
	return;
    } # if
    
    if ($cmd !~ s|^/||){
	$self->write("** Unknown command. Type /help for help");
#	$self->broadcast("$self->{handle}> $line");
	return;
    } # if
    if ($cmd eq "help"){
	$self->printHelp(\@args);
    }
    elsif ($cmd eq "nick"){
	$self->changeNick($self->handle, $args[0] || $self->handle);
    } # if
    elsif (($cmd eq "me") || ($cmd eq "act")){
	$self->act($self->handle, join (" ", @args)); 
    } # elsif
    elsif ($cmd eq "who"){
	$self->who( join (" ", @args));
    } # elsif
    elsif ($cmd eq "msg"){
	$self->msg(\@args);
    } # elsif
    elsif ($cmd eq "exit"){
	$self->leave;
    } # elsif
    elsif ($cmd eq "join"){
	$self->joinChannel($args[0]);
    } # elsif
    elsif ($cmd eq "part"){
	$self->leaveChannel($args[0]);
    } # elsif
    elsif ($cmd eq "list"){
	$self->listChannels;
    } # elsif

    else {
	$self->write("ERROR: unknown command: /$cmd");
    } # else

} # ParseLine
# ------------------------------------------------------------
sub printHelp {
    my ($self, $argsRef) = @_;
    
    my ($helpLine) = <<"EOH";
Available commands:
- /help                   displays this help

- /exit                   leaves the chat
- /join \#channel          joins channel with name \#channel
- /list                   list all existing channels
- /me message             ->*** nickname message
- /msg nick message       private message to nick
- /msg \#channel message   sends a message to all people on a channel
- /nick newnick           changes your handle: /nick newnick
- /part \#channel          leaves channel with name \#channel
- /who                    lists all users in chat
- /who \#channel           lists all users on channel \#channel
EOH
    ;
    $helpLine =~ s:\n:\r\n:g;
    $self->write($helpLine);
    
} # printHelp
# ------------------------------------------------------------
sub act {
    my ($self, $handle, $line) = @_;

    unless ($line){
	$self->write("** Usage: /me message");
	return;
    } # unless
    $self->log("act");
    $self->broadcast("*** $handle $line");
} # act
# ------------------------------------------------------------
sub changeNick {
    my ($self, $nick, $newNick) = @_;
    
    # if no nick specified
    unless ($newNick){
	$self->write("** Usage: /nick newnick");
	return;
    } # unless
    
    # check if handle is available
    my $handleIsFree = 1;
    for my $socket ($self->select->handles){
	my $chatter = $self->chatters->[$socket->fileno];
	if (lc($newNick) eq lc($chatter->{handle})){
	    $handleIsFree = 0;
	} # if
    } # for
    
    # if yes
    if ($handleIsFree){
	$self->{'handle'} = $newNick;
	$self->broadcast("** $nick is now known as $newNick");
	$self->log("/nick $nick $newNick");
    } # if
    
    # if not
    else {
	$self->write("** ERROR: $newNick already in use");
    } # else
} # changeNick
# ------------------------------------------------------------
sub joinChannel {
    my ($self, $channel) = @_;
    
    if ((! defined($channel)) || ($channel !~ /^\#/)){
        $self->write("** Usage: /join \#channelname");
	return;
    } # if
    
    my (@users) = ();
    if (defined $main::channels{$channel}){
	(@users) = @{ $main::channels{$channel} };
    } # if

    if (grep(/^$self->{handle}$/, @users)){
	$self->write("** You are already on channel $channel");
	return;
    } # if
    push (@users, $self->{handle});
    $main::channels{$channel} = \@users;
    $self->who($channel);
    
} # joinChannel
# ------------------------------------------------------------
sub leave {
    my($self) = @_;
    
    print "leave called\n";
    my $handle = $self->handle;

    # leave all channels
    foreach (keys %main::channels){
	$self->leaveChannel($_);
    } # foreach

    $self->chatters->[$self->socket->fileno] = undef;
    $self->select->remove($self->socket);
    $self->broadcast("[$handle left]") if(defined $handle);
    $self->log("disconnected");
    $self->socket->close;
} # leave
# ------------------------------------------------------------
sub leaveChannel {
    my ($self, $channel) = @_;

    return unless $channel;
    my @users = @{ $main::channels{$channel} };
    if (grep (s/^$self->{handle}$//i, @users)){
	@users = sort(@users);
	shift(@users) if $users[0] eq "";
	$main::channels{$channel} = \@users;
	$self->broadcast("*** $self->{handle} has left channel $channel");
    } # if    
} # leaveChannel
# ------------------------------------------------------------
sub listChannels {
    my ($self) = @_;

    $self->write(join(" ", keys %main::channels));

} # listchannels
# ------------------------------------------------------------
sub msg {
    my ($self, $wordsRef) = @_;
    my ($target, @words) = @$wordsRef;
    my $err = 1;
    my $targetChatter;

    unless ($target && $words[0]){
	$self->write("** Usage: /msg nick message");
	return;
    } # unless
    $self->log("msg");

    # message to a channel
    if ($target =~ /^\#/){
	unless (defined $main::channels{$target}){
	    $self->write("** ERROR: no such channel");
	    return;
	} # unless    
	my @users = @{ $main::channels{$target} };
	foreach (@users){
	    for my $socket ($self->select->handles){
		my $chatter = $self->chatters->[$socket->fileno];
		if (lc($chatter->{handle}) eq lc($_)){
		    $chatter->write("$target/$self->{handle}> ".join(" ", @words));
		} # if
	    } # for	
	} # foreach
    } # if

    # private message
    else {
	for my $socket ($self->select->handles){
	    my $chatter = $self->chatters->[$socket->fileno];
	    if (lc($target) eq lc($chatter->{handle})){
		$err = 0;
		$targetChatter = $chatter;
	    } # if
	} # for
	
	if ($err){
	    $self->write("*** no such nick: $target");
	} # if
	else {
	    $self->log("msg from $self->{handle} to $targetChatter->{handle}: ".join(" ", @words));
	    $targetChatter->write("Msg/$self->{handle}: ".join(" ", @words));
	} # else
    } # else
} # msg
# ------------------------------------------------------------
sub who {
    my ($self, $channel) = @_;
    $self->log("who");

    # if no channel given
    unless ($channel){
	for my $socket ($self->select->handles){
	    my $chatter = $self->chatters->[$socket->fileno];
	    $self->write($chatter->{handle}) if defined $chatter->{handle};
	} # for
	return;
    } # for

    # if invalid channel given
    if ($channel !~ /^\#/){
	$self->write("** Usage: /who  or /who \#channelname");
	return;
    } # if

    # if non-existing channel given
    unless (defined $main::channels{$channel}){
	$self->write("** No such channel $channel found");
    } # unless

    # channel must be valid
    else {
	my @users = @{ $main::channels{$channel} };
	if (@users){
	    $self->write("Users on channel $channel:");
	    $self->write(join(" ", sort (@users)));
	} # if
    } # else
} # who
# ------------------------------------------------------------