#!/usr/bin/perl -w

use strict;
use IO::Socket;
use Socket;

# Mapping from fileno to client data
my %clients;

# Input/output handle vectors
my $rvec = my $wvec = '';

sub cmd_nick;
sub cmd_who;
sub cmd_quit;
sub cmd_say;
sub cmd_unknown;

sub welcome;
sub kill_client;
sub write_to;
sub write_to_all;
sub write_to_all_except;
sub read_from;

sub cmd_nick {
	my ($client, $name) = @_;
	my $old = $client->{name};

	write_to_all "* $old is now known as $name\n";
	$client->{name} = $name;
}

sub cmd_who {
	my $client = shift;

	write_to $client, "* Currently online: " . 
		join(' ', sort map $_->{name}, values %clients) . "\n";
}

sub cmd_quit {
	my $client = shift;
	my $name = $client->{name};

	write_to $client, "* Goodbye, $name!\n";
	kill_client $client;
}

sub cmd_say {
	my ($client, $line) = @_;
	my $name = $client->{name};

	write_to_all_except $client, "$name: $line\n";
}

sub cmd_unknown {
	my ($client, $cmd) = @_;

	write_to $client, "* Unknown command: $cmd\n";
}

sub welcome {
	my $client = shift;
	my $name = $client->{name};

	write_to_all_except $client, "* New connection from $name\n";
	write_to $client, "* Welcome, $name!\n";
	cmd_who $client;
}

sub kill_client {
	my ($client, $reason) = @_;
	my $fh = $client->{fh};
	my $fd = $fh->fileno;
	my $name = $client->{name};

	my $msg = "* $name has disconnected" . ($reason ? " ($reason)\n" : "\n");
	write_to_all_except $client, $msg;
	close $fh;
	delete $clients{$fd};
	vec($rvec, $fd, 1) = vec($wvec, $fd, 1) = 0;
}

sub write_to {
	my ($client, $data) = @_;
	my $fh = $client->{fh};
	my $fd = $fh->fileno;

	$client->{out} .= $data;
	if (length $client->{out}) {
		my $n = syswrite $fh, $client->{out};
		unless (defined $n) {
			kill_client $fd, "$!";
			return;
		}
		substr $client->{out}, 0, $n, '';
		vec($wvec, $fd, 1) = !! length $client->{out};
	}
}

sub write_to_all {
	my $data = shift;
	write_to $_, $data foreach values %clients;
}

sub write_to_all_except {
	my ($client, $data) = @_;
	my $fd = $client->{fh}->fileno;
	foreach (keys %clients) {
		write_to $clients{$_}, $data if $_ != $fd;
	}
}

sub read_from {
	my $client = shift;
	my $fh = $client->{fh};
	my $fd = $fh->fileno;

	my $data = '';
	my $n = sysread $fh, $data, 1024;
	unless (defined $n) {
		kill_client $client, "$!";
		return;
	}
	if ($n == 0) {
		kill_client $client;
		return;
	}
	$client->{in} .= $data;

	while (
		length $client->{in} and
		(my $line, $client->{in}) = $client->{in} =~ /^(.*?)[\r\n]+(.*)/
	) {
		if (my ($new) = $line =~ m(^/nick\s+(.*))) {
			cmd_nick $client, $new;
		} elsif ($line =~ m(^/who\b)) {
			cmd_who $client;
		} elsif ($line =~ m(^/(?:exit|quit)\b)) {
			cmd_quit $client;
			return;
		} elsif (my ($rest) = $line =~ m(^/say\s+(.*))) {
			cmd_say $client, $rest;
		} elsif (my ($cmd) = $line =~ m(^(/\S*))) {
			cmd_unknown $client, $cmd;
		} else {
			cmd_say $client, $line;
		}
	}
}

# Listen on any IP, port 5555
my $sock = new IO::Socket::INET(
	Listen    => 1,
	LocalPort => 5555,
	# Blocking  => 0,
	ReuseAddr => 1,
);
vec($rvec, $sock->fileno, 1) = 1;

while (my $n = select((my $r = $rvec), (my $w = $wvec), undef, undef)) {
	if (vec($r, $sock->fileno, 1)) {
		my $fh     = $sock->accept;
		my $peer   = $fh->peerhost . ':' . $fh->peerport;
		my $fd     = $fh->fileno;
		my $client = $clients{$fd} = {
			fh   => $fh,
			name => $peer,
			in   => '',
			out  => '',
		};
		welcome $client;
		vec($rvec, $fd, 1) = 1;
	}

	foreach (keys %clients) {
		read_from $clients{$_}    if vec $r, $_, 1;
		write_to $clients{$_}, "" if vec $w, $_, 1;
	}
}