#####  XMLsocket-based chat server for Flash

#  TODO:
#     finish all action callbacks
#     implement can_write select on printing to handles

use strict;
 
###  chat support class (virtual)

package MPG::Chat;

my $debug = 1;

$^W = $debug;

sub debug ($) {
    my $message = shift;
    if ($debug) {
	warn $message."\n";
    }
}

my @default_channels = qw(
			  lobby_1,
			  lobby_2,
			  lobby_3,
			  lobby_4,
			  lobby_5,
			  );

sub default_channels {
    return @default_channels;
}

###  error and reply codes

my %errors = (
	      ERR_NOSUCHCHANNEL   => 403,
	      ERR_UNKNOWNCOMMAND  => 421,
	      ERR_NONICKNAMEGIVEN => 431,
	      ERR_NICKNAMEINUSE   => 433, 
	      ERR_NOTONCHANNEL    => 442,
	      ERR_PASSWDMISMATCH  => 464, 
	      );

my %error_message = (
		     ERR_NOSUCHCHANNEL   => "No such channel",
		     ERR_UNKNOWNCOMMAND  => "Unknown command",
		     ERR_NONICKNAMEGIVEN => "No nickname given",
		     ERR_NICKNAMEINUSE   => "Nickname is already in use",
		     ERR_NOTONCHANNEL    => "You're not on that channel",
		     ERR_PASSWDMISMATCH  => "Password incorrect",
		     );

my %replies = (
	       RPL_OK            => 200,
	       RPL_CHANOP        => 201,
	       RPL_CHANJOIN      => 202,
	       RPL_CHANKEY       => 203,
	       RPL_CHANBROADCAST => 204,
	       RPL_CHANMSG       => 205,
	       RPL_CHANACT       => 206,
	       RPL_MSGSENT       => 207,
	       RPL_USERMSG       => 208,
	       RPL_CHANUSERS     => 209,
	       RPL_LEFT          => 210,
	       RPL_NONE          => 300,
	       );



###  Main server class

package MPG::Chat::Server;

use IO::Socket;
use IO::Select;
use Class::Struct;

#  set up callback table

my %cmd = (
	   USER => 'log_in',
	   INFO => 'user_info',
	   JOIN => 'join_channel',
	   TALK => 'msg_channel',
	   ACT  => 'act_channel',
	   MSG  => 'msg_user',
	   PART => 'leave_channel',
	   KEY  => 'add_key',
	   KICK => 'kick_user',
	   BAN  => 'ban_user',
	   OPER => 'operator',
	   QUIT => 'quit',
	   KILL => 'kill_server',
	   LIST => 'list_channels',
	   WHO  => 'list_users',
	   );

#  create new() and initialization methods

struct (
	port      => '$',
	name      => '$',
	select    => 'IO::Select',
	user_id   => '@',   #  array of Chat::User objects, by fileno
	user_name => '%',   #  table of Chat::User objects, by username
	channels  => '%',   #  table of Chat::Channel objects
	);

sub start {

    #  Usage:
    #     $server->start;

    #  create server socket and set up listener

    my $self = shift;
    my $listen = new IO::Socket::INET(Listen => 1, 
				      LocalPort => $self->port,
				      Reuse     => 1,
				      Proto     => 'tcp' )
	or die ("Couldn't start ".$self->name.": $@");

    $self->select(new IO::Select($listen));
    close(STDIN); 
    close(STDOUT);

    MPG::Chat::debug($self->name . " ready.  Waiting for connections...");
    
    #  read from available sockets

    while (my @readable = $self->select->can_read) {

	my @commands;

	foreach my $f_handle (@readable) {
	    
	    if ($f_handle == $listen) {

		#  new connection
		
		my $new_handle = $listen->accept;
		$self->select->add($new_handle);
		
		#  add connection to user array
		
		my $user=MPG::Chat::User->new(
					      ip     => $new_handle->peerhost,
					      handle => $new_handle,
					      userid => fileno($new_handle),
					      );

		$self->user_id(fileno($new_handle),$user);
		#  $self->user_name not defined until user logged in

	      MPG::Chat::debug "Connection from ".$user->ip;

	    }
	    else {
		
		#  read and process input
		
		my $input;
		{ local $/ = "\0";
		  $input = <$f_handle>;
		  chomp $input; }
		
		if ($input =~ /^\s*$/) {
		    #  blank message - disconnect
		    $self->quit(fileno($f_handle), 'Disconnected');
		}
		else {
		    my $output = fileno($f_handle) . ": $input";
		    push(@commands, $output);
		}
	    }
	}
	
	#  parse and execute commands
	
	foreach my $line (@commands) {
	    my ($userid, $command, $args) = split(/:\s?/,$line,3);
	    $command = uc($command);
	  MPG::Chat::debug("Userid=$userid command=$command args=$args");
	    
	    if (exists $cmd{$command}) {
		my $c = $cmd{$command}; 
		$self->$c($userid,$args);
	    }
	    else {
	      $self->error($userid,'ERR_UNKNOWNCOMMAND');
	    }
	}
    }

  MPG::Chat::debug("Server ended.");
}

sub reply {

    #  Usage:  $self->reply($userid, $reply_code, $message);
    #
    #     Sends a reply back to the user, with the specified reply
    #     code, and an optional message.

    my $self = shift;
    my ($userid, $reply, $message) = @_;
    return unless (defined $userid);
    $reply = 'RPL_NONE' unless ($reply);
    
    my $user_handle = $self->userid_handle($userid);
    print $user_handle "$replies{$reply} $message\0";

    MPG::Chat::debug("REPLY:  Userid $userid == $reply: $message");
}

sub error {

    #  Usage:  $self->error($userid, $error_code);
    #
    #     Sends an error message back to the user, with the specified 
    #     error code.

    my $self = shift;
    my ($userid, $error) = @_;
    return unless (defined $userid);
    $error = 'ERR_UNKNOWNCOMMAND' unless ($error);
    
    my $user_handle = $self->userid_handle($userid);
    print $user_handle "$errors{$error} $error_message{$error}\0";
    MPG::Chat::debug("* ERROR:  Userid $userid == $error");
}


sub userid_handle {
    
    #  Usage:  my $handle = $self->userid_handle($userid);
    #
    #    Returns open handle for reading from/writing to user socket

    my $self   = shift;
    my $userid = shift;
    return unless (defined $userid);

    return $self->user_id($userid)->handle;
}

sub logged_in {

    #  Usage:  do_something() if ($self->logged_in($username));
    #     
    #     Returns true if the given username is logged into the server.
 
    my $self     = shift;
    my $username = shift || return;

    return defined($self->user_name($username));
}

sub remove_user {
    
    #  Usage:  $self->remove_user($userid);
    #
    #     Removes the user with the given userid from the server, and
    #     removes them from any channel they're on.

    my $self   = shift;
    my $userid = shift;
    return unless (defined $userid);
    my $message = shift;

    #  remove user from current channel, too, and broadcast

    #  delete directly from hash/array, since Class::Struct 
    #  can't handle undef values.

    my $hr_user_name = $self->user_name;
    my $ar_user_id   = $self->user_id;
    delete $$hr_user_name{$self->user_id($userid)->name};
    delete $$ar_user_id[$userid];    
}

sub broadcast_channel {
    
    #  Usage:  $self->broadcast_channel($channel_name, $message);
    #
    #     Sends a server message to all users on the given channel.

    my $self = shift;
    my $channel_name = shift || return;
    my $message      = shift || return;
    my $channel      = $self->channels($channel_name);

    for my $userid (keys %{$channel->users}) {
	$self->reply($userid, 'RPL_CHANBROADCAST', $message);
    }
}


###  callback subs

sub kill_server {
    my $self = shift;
    my ($userid, $args) = @_;
    my $user = $self->user_id($userid);
    
    if ($user->name eq "majcher") {
	#  change to oper when implemented
	exit; 
    }
}

sub log_in {

    #  Takes username and password as arguments, returns an error
    #  if either argument is bad, otherwise registers user with the
    #  server, and tells the client to join a random lobby channel.

    my $self = shift;
    my ($userid, $args) = @_;
    my ($username, $password) = split(" ",$args,2);
    
    #  add userdb based login later
    if (! $username) {
	$self->error($userid,'ERR_NONICKNAMEGIVEN');
    }
    elsif (! $password) {
	$self->error($userid,'ERR_PASSWDMISMATCH');
    }
    elsif ($self->logged_in($username)) {
	$self->error($userid,'ERR_NICKNAMEINUSE');
    }
    else {
	#  initialize user
	$self->user_name($username, $self->user_id($userid));
	$self->user_id($userid)->name($username);
	$self->user_id($userid)->logged_in(1);

	$self->reply($userid, 'RPL_OK', "JOIN: " . 
		   MPG::Chat::Channel::get_random_channel());
    }
	    
}

sub join_channel {

    #  Takes channel name as argument, with an optional key.  User
    #  joins channel if possible, and leaves old channel if necessary.
    #  If new channel doesn't exist, create the channel, make the 
    #  user operator on the channel, and add the key, if given.
    #  User will not join channel if they are already on it.

    my $self = shift;
    my ($userid, $args) = @_;
    return unless (defined $userid);

    my ($channel_name, $key) = split(/\s/,$args);

    my $user = $self->user_id($userid);
    return unless ($user->logged_in);

    my ($channel, $op);

    #  don't do anything if user already on channel

    return if ($channel_name eq $user->channel);

    #  create new channel if it doesn't already exist, op user

    if (! defined $self->channels($channel_name)) {
	MPG::Chat::debug(
		 "creating channel: name=$channel_name op=>".$user->name);

	$channel = MPG::Chat::Channel->new(
					   name => $channel_name,
					   op   => $user->name,
					   );
	$channel->key($key) if ($key !~ /^\s*$/);
	
	$self->channels($channel_name, $channel);
	$op = 1;
    }
    else {
	$channel = $self->channels($channel_name);
    }
    
    ### todo:  check for ban, key, etc

    #  leave current channel, if on one

    if (my $old_channel = $user->channel) {
	$self->leave_channel($userid, $user->channel);
    }

    $channel->users($userid, $user);
    $user->channel($channel_name);

    $self->reply($userid, 'RPL_CHANJOIN', $channel->name);
    $self->reply($userid, 'RPL_CHANOP', $channel->name) if $op;
    $self->reply($userid, 'RPL_CHANKEY', $key) if $key;

    ### broadcast user join to channel

    $self->broadcast_channel($channel_name, 
			     $user->name." has joined channel ".$channel_name);
}


sub leave_channel {

    #  Takes channel name, and optional message.  Removes user from
    #  channel, and broadcasts message.

    my $self = shift;
    my ($userid, $args) = @_;
    return unless (defined $userid);
    my ($channel_name, $message) = split(/\s/,$args);

    if (defined $self->channels($channel_name)) {
	my $channel = $self->channels($channel_name);
	my $user    = $self->user_id($userid);

	if ($channel_name ne $user->channel) {
	    $self->error($userid, 'ERR_NOTONCHANNEL');
	    return;
	}

	my $hr_users = $channel->users;
	delete $$hr_users{$userid};
	$user->channel('');

	#  remove channel if nobody left

	if ($channel->user_count < 1) {
	    my $hr_channels = $self->channels;
	    delete $$hr_channels{$channel_name};
	} 
	else {
	    #  tell everyone that they left
	    my $bcast = $user->name . " has left channel " . $channel_name;
	    $bcast .= " ($message)" if $message;
	    $self->broadcast_channel($channel_name, $bcast);
	}

	$self->reply($userid, 'RPL_LEFT');
    }
    else {
	$self->error($userid, 'ERR_NOSUCHCHANNEL');
    }
}

sub list_users {

    #  Takes channel name as optional argument.  Replies with list 
    #  of usernames on that channel, or on the user's current channel
    #  if no argument is specified.

    my $self = shift;
    my ($userid, $channel_name) = @_;
    return unless (defined $userid);
    my $user = $self->user_id($userid);

    $channel_name = $user->channel unless ($channel_name);

    my $channel;
    if (defined $self->channels($channel_name)) {
	$channel = $self->channels($channel_name);

	my @userids = $channel->user_list;

	my $usernames = join(" ",map {$self->user_id($_)->name} @userids);
	$self->reply($userid, 'RPL_CHANUSERS', $usernames);
    }
    else {
	$self->error($userid, 'ERR_NOSUCHCHANNEL');
    }

}

sub list_channels {

    #  Replies with list of active channels


}

sub msg_channel {

    #  Takes a string to broadcast as argument.

    my $self = shift;
    my ($userid, $message) = @_;
    return unless (defined $userid);
    my $user = $self->user_id($userid);
    
    return unless (defined $message);
    return unless (my $channel_name = $user->channel);
    return unless (my $channel = $self->channels($channel_name));

    #  todo: error checking

    for my $ch_userid (keys %{$channel->users}) {
	$self->reply($ch_userid, 'RPL_CHANMSG', $user->name." ".$message);
    }
}

sub act_channel {

    #  Takes a string to broadcast as argument.

    my $self = shift;
    my ($userid, $message) = @_;
    return unless (defined $userid);
    my $user = $self->user_id($userid);
    
    return unless (defined $message);
    return unless (my $channel_name = $user->channel);
    return unless (my $channel = $self->channels($channel_name));

    #  todo: error checking

    for my $ch_userid (keys %{$channel->users}) {
	$self->reply($ch_userid, 'RPL_CHANACT', $user->name." ".$message);
    }

}

sub msg_user {

    #  Takes a username and message to send to that user as arguments.

    my $self = shift;
    my ($userid, $args) = @_;
    my ($msg_username, $message) = split(/\s/,$args,2);
    return unless (defined $userid);
    return unless ($msg_username && defined($message));

    #  todo: error checking

    $self->reply($userid, 'RPL_MSGSENT', $args);
    $self->reply($self->user_name($msg_username)->userid, 
		 'RPL_USERMSG', $self->user_id($userid)->name." ".$message);
}


sub user_info {
    my $self = shift;
    my ($userid, $username) = @_;
    return unless (defined $userid);

    #  todo:  error checking

    
}


sub add_key {
    my $self = shift;
    my ($userid, $args) = @_;
    return unless (defined $userid);

    #  todo:  error checking

}

sub kick_user {
    my $self = shift;
    my ($userid, $args) = @_;
    return unless (defined $userid);

    #  todo:  error checking

}

sub ban_user {
    my $self = shift;
    my ($userid, $args) = @_;
    return unless (defined $userid);

    #  todo:  error checking

}


sub operator {
    my $self = shift;
    my ($userid, $args) = @_;
    return unless (defined $userid);

    #  todo:  error checking

}


sub quit {
    my $self = shift;
    my ($userid, $args) = @_;
    return unless (defined $userid);

    my $f_handle = $self->user_id($userid)->handle;
    $self->remove_user($userid);

    MPG::Chat::debug "Disconnection from " . $f_handle->peerhost; 
    $self->select->remove($f_handle);
    $f_handle->close;
}




###  Channel class

package MPG::Chat::Channel;

my $num_start = 5;         #  Number of initial channels
my $prefix    = "lobby";   #  Default channel prefix

use Class::Struct;

struct (
	 name  => '$',
         key   => '$',    #  key required to join channel
	 op    => '$',    #  userid of channel op
	 users => '%',    #  table of Chat::User objects, by userid
	);


sub user_count {

    #  Usage:  $foo = $channel->user_count;
    #
    #     Returns the number of users currently on the channel.

    my $self = shift;
    return scalar keys %{$self->users};
}

sub user_list {

    #  Usage:  my @userids = $channel->user_list;
    #
    #     Returns an array of userids currently on the channel.

    my $self = shift;
    return keys %{$self->users};
}

sub get_random_channel {

    #  Usage:  $chan_name = MPG::Chat::Channel::get_random_channel;
    #
    #     Returns a random starting channel name
    
    return "lobby";  #  for now
    return $prefix."_".int(rand($num_start)+1);
}



###  User class

package MPG::Chat::User;

use Class::Struct;

struct ( name      => '$',
         logged_in => '$',
         channel   => '$',
         oper      => '$',
         chan_op   => '$',
         ip        => '$',
         handle    => '$',
         userid    => '$',
);



1;

#	    foreach my $f_handle ($select->can_write(0)) {
#		MPG::Chat::debug Dumper $f_handle;
#		print $f_handle "$command\0";
#	    }