#!/c/bin/perl

#
# Capitalize Trading Game Server, $Revision: 1.68 $.
# Copyright (c) 2005 Teemu J. Takanen <ttakanen@iki.fi>
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#  
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#  For more details, please see the 'COPYING' file.
#

use strict;
use IO::Socket;
use IO::Select; 
use Net::hostent;
use POSIX;

my $port = 45680;
my $logfilename = "capitalize.log";
my $OUTEOL = "\015\012";

if($logfilename) {
	open(LOGFILE, ">>$logfilename")
		|| die "Cannot open log file $logfilename";
	#LOGFILE->autoflush(1);
}

sub logmsg {
	print STDERR "$0 $$: @_ at ", scalar localtime, "\n";
	if($logfilename) {
		print LOGFILE scalar localtime, " $0 $$: @_", "\n";
	}
}

my $server_socket = IO::Socket::INET->new( Proto     => 'tcp',
                                          LocalPort => $port,
                                          Listen    => SOMAXCONN,
                                          Reuse     => 1);
die "can't setup server socket for port $port" unless $server_socket;
logmsg "Accepting clients in port $port";

my %players;

my %settings = (
	"startmoney" => 2000,   # Number of credits players have on round 0
	"startim" => 15,        # Numberof ims players have on round 0
        "rawmaterials" => 5,    # Multiplier for a-d bank sales
        "randommaterials" => 0, # Multiplier for r bank sales
	"highermaterials" => 1, # Multiplier for E-F bank sales
        "victorypoints" => 1,   # Multiplier for vp bank sales
	"improvements" => 1,    # Multiplier for im bank sales
	"addmoney" => 25,       # Number of credits to add to each player/rnd
	"winlimit" => 2000,     # Number of vps needed to end the game
	"factoryimprice" => 10, # Number of ims needed to build a factory
	"factoryprice" => 400,  # Number of credits needed to build a factory
	"maximprove" => 50,     # Maximum number of ims per factory
	"processprice" => 50,   # Number of credits required by factory run
	"processbenefit" => 200,# Number of credits gained from EF factory
        "roundlength" => 60,    # Round length in seconds
        "lastround" => 0,       # Time in Unix standard time of the last rnd
	"newplayers" => 1,      # Boolean, are new players allowed in
	"roundnro" => 0,        # Current round number
        "running" => 0,         # Boolean, Initially the game is not running
	"gameover" => 0,        # Boolean, is game over
	"deallog" => 1,         # Boolean, log market deals
	"clientlog" => 0,       # Boolaen, log all client commands
	"maxautocommands" => 25 # Number of automatic command slots available
);

my %world_players;

my %world_sells;
my %world_buys;
my %world_dealstats;
my %world_matinc;
my %world_autocommands;

my $ranking_msg = "";

my %namemap = (
        "a" => "Metals",
        "b" => "Minerals",
        "c" => "Oil",
        "d" => "Water",
        "E" => "Components",
        "F" => "Plastics",
	"ab" => "a+b+cr=>E Factory",
	"cd" => "c+d+cr=>F Factory",
	"EF" => "E+F+cr=>cr Factory",
	"im" => "Improvement Modules",
	"vp" => "Victory Points",
	"credits" => "Money",
	"r" => "Unknown Resource (a-d)"
);

sub get_number_of_players {
	return scalar keys %world_players;
}

sub get_number_of_clients {
	return scalar keys %players;
}

sub say_to_client {
	my $socketname = shift;
	my $msg = shift;
	$msg = "* " . $msg . $OUTEOL;
	if(length $msg > $players{$socketname}{"maxout"}) {
		logmsg "Dropping output for $socketname";
		return;
	} else {
		$players{$socketname}{"outbuffer"} .= $msg;
		$players{$socketname}{"maxout"} -= length $msg;
	}
}

sub say_to_user {
	my $username = shift;
	my $msg = shift;
	$msg = "* " . $msg . $OUTEOL;

	my $socketname;
	foreach $socketname (keys %players) {
		unless($players{$socketname}{"name"} eq $username) {
			next;
		}
		if(length $msg > $players{$socketname}{"maxout"}) {
			logmsg "Dropping output for $socketname";
			return;
		} else {
			$players{$socketname}{"outbuffer"} .= $msg;
			$players{$socketname}{"maxout"} -= length $msg;
		}
	}
}

sub broadcast_to_clients {
	my $msg = shift;
	my $socketname;
	foreach $socketname (keys %players) {
		say_to_client($socketname, $msg);
	}
}	

sub create_player {
	my $socketname = shift;
	my $sock = shift;

        my $entry = {
		"name" => "",
                "inbuffer" => "",
                "outbuffer" => "",
		"maxin" => 512,
		"maxout" => 10240,
		"auth" => 0,
		"socket" => $sock,
		"kick" => 0,
		"interactive" => 1,
   		"prompt" => "[Capitalize Auth]> "
        };

        $players{$socketname}=$entry;
        return;
}

sub create_world_player {
	my $socketname = shift;
	my $name = shift;
	my $pass = shift;
	my $round = $settings{"roundnro"};
	my $money = $settings{"startmoney"}
		+ $round*$settings{"addmoney"};
	my $im=$settings{"startim"};
        
	my $entry = {
		"password" => $pass,
                "a" => 0,
                "b" => 0,
                "c" => 0,
                "d" => 0,
                "E" => 0,
                "F" => 0,
                "credits" => $money,
                "vp" => 0,
                "im" => $im,
                "ab" => 0,
                "cd" => 0,
                "EF" => 0
        };

	$players{$socketname}{"name"}=$name;
        $world_players{$name}=$entry;
        return;
}

sub getsocketname {
	my $sock = shift;
	return $sock->peerhost . "-" . $sock->peerport;
}

sub raw_say_to_client {
	my $socketname = shift;
	my $msg = shift;
	if(length $msg > $players{$socketname}{"maxout"}) {
		logmsg "Dropping output for $socketname";
		return;
	} else {
		$players{$socketname}{"outbuffer"} .= $msg;
		$players{$socketname}{"maxout"} -= length $msg;
	}
}

sub world_inventory {
	my $socketname = shift;
	my $username = shift;
	my $msg = "";
	my $statround = $settings{"roundnro"}-1;

	$msg .= "OK INVENTORY follows" . $OUTEOL;
	$msg .= "+      ID Name                      In Stock    New" . $OUTEOL;
	$msg .= "+ ======= ====                      ======== ======" . $OUTEOL;

	my $mat;
	foreach $mat ("a", "b", "c", "d", "E", "F",
                      "ab", "cd", "EF", "im", "vp", "credits") {
		$msg .= sprintf(
	        "+ %7s %-25s %8d %6d$OUTEOL", $mat, $namemap{$mat},
                                              $world_players{$username}{$mat},
					      $world_matinc{$statround}{$mat}{$username}); 
	}

	$msg .= "=";
}

sub withdraw_sell_offer {
	my $socketname = shift;
	my $username = shift;
     	my $product_type = shift;
	my $round = $settings{"roundnro"};

	my $return_amount = $world_sells{$round}{$product_type}{$username}{"amount"};
	$world_players{$username}{$product_type} += $return_amount;
	delete($world_sells{$round}{$product_type}{$username});

	say_to_client($socketname, "OK Cancelled your previous sell offer on $product_type ($return_amount units)");
	logmsg "$socketname ($username) Cancelled sell on $product_type ($return_amount units)";
}

sub withdraw_buy_offer {
	my $socketname = shift;
	my $username = shift;
     	my $product_type = shift;
	my $round = $settings{"roundnro"};

	my $return_amount = $world_buys{$round}{$product_type}{$username}{"amount"};
	my $return_price  = $world_buys{$round}{$product_type}{$username}{"price"};
	my $total_price = $return_amount * $return_price;

	$world_players{$username}{"credits"} += $total_price;
	delete($world_buys{$round}{$product_type}{$username});

	say_to_client($socketname, "OK Cancelled your previous buy offer on $product_type ($return_amount units for ¤$return_price)");
	logmsg "$socketname ($username) Cancelled buy on $product_type ($return_amount units for ¤$return_price)";
}


sub create_sell_offer {
	my $socketname = shift;
	my $username = shift;
  	my $product_type = shift;
        my $amount = shift;
	my $round = $settings{"roundnro"};

	if($amount <= 0) {
		# Do nothing, this was a cancel command
		return "OK No sell offer on $product_type placed";
	}

	$world_sells{$round}{$product_type}{$username}{"amount"} = $amount;
	$world_sells{$round}{$product_type}{$username}{"random"} = rand();
	$world_sells{$round}{$product_type}{$username}{"seller"} = $username;
	unless($username eq "!Bank") {
		$world_players{$username}{$product_type} -= $amount;
	}

	logmsg "$socketname ($username) offers $amount units of $product_type";
	return "OK Now offering $amount units of $product_type on market";
}

sub create_buy_offer {
	my $socketname = shift;
	my $username = shift;
  	my $product_type = shift;
        my $amount = shift;
	my $price = shift;
	my $round = $settings{"roundnro"};

	if($amount <= 0) {
		# Do nothing, this was a cancel command
		return "OK No buy offer on $product_type placed";
	}

	$world_buys{$round}{$product_type}{$username}{"amount"} = $amount;
	$world_buys{$round}{$product_type}{$username}{"price"} = $price;
	$world_buys{$round}{$product_type}{$username}{"random"} = rand();
	$world_buys{$round}{$product_type}{$username}{"byer"} = $username;

	my $total_price = $amount * $price;
	$world_players{$username}{"credits"} -= $total_price;

	logmsg "$socketname ($username) offers to buy $amount units of $product_type for ¤$price";
	return "OK Now offering ¤$price/unit for $amount of $product_type";
}

sub get_product_on_market {
	my $product_type = shift;
	my $round = $settings{"roundnro"} - 1; # Previous round sell offers
	my $total = 0;

	my $seller;
	my $h = $world_sells{$round}{$product_type};
	foreach $seller (keys %$h) {
		$total += $world_sells{$round}{$product_type}{$seller}{"amount"};
	}

	return $total;
}

sub get_buys_on_market {
	my $product_type = shift;
	my $round = $settings{"roundnro"};
	my $total = 0;

	my $buyer;
	my $h = $world_buys{$round}{$product_type};
	foreach $buyer (keys %$h) {
		$total += $world_buys{$round}{$product_type}{$buyer}{"amount"};
	}

	return $total;
}

sub process_process {
        my $socketname = shift;
        my $username = shift;
	my $factory_type = shift;
	my $amount = shift;
	my $process_price = $settings{"processprice"};
	my $money = $world_players{$username}{"credits"};
	my $mat_1; my $mat_2; my $end_product;

	if($world_players{$username}{$factory_type} <= 0) {
		return "CANNOT You do not have that factory";
	}

	if($factory_type eq "EF") {
		$mat_1="E";
		$mat_2="F";
		$end_product="credits";
	} elsif($factory_type eq "ab") {
		$mat_1="a";
		$mat_2="b";
		$end_product="E";
	} elsif($factory_type eq "cd") {
		$mat_1="c";
		$mat_2="d";
		$end_product="F";
	} else {
		logmsg "Internal error in PROCESS";
		return "ERROR Internal server error";
	}

	my $unit_price = $process_price + 1
			 - $world_players{$username}{$factory_type};
	
	if($amount eq "MAX" || $amount eq "max") {
		$amount=$world_players{$username}{$mat_1};
		if($amount > $world_players{$username}{$mat_2}) {
			$amount=$world_players{$username}{$mat_2};
		}
		if($unit_price != 0) {
			if($amount > int($money/$unit_price)) {
				$amount=int($money/$unit_price);
			}
		}
		if($amount <= 0) {
			return "OK No processing in $factory_type done";
		}
	}

	my $total_price = $unit_price * $amount;

	if($amount > $world_players{$username}{$mat_1}) {
		return "CANNOT Not enough $mat_1 in stock";
	}
	if($amount > $world_players{$username}{$mat_2}) {
		return "CANNOT Not enough $mat_2 in stock";
	}
	if($total_price > $world_players{$username}{"credits"}) {
		return "CANNOT Not enough money";
	}

	$world_players{$username}{"credits"} -= $total_price;
	$world_players{$username}{$mat_1}    -= $amount;
	$world_players{$username}{$mat_2}    -= $amount;
	
	my $income = $amount;	
	if($end_product eq "credits") {
		$income = $amount * $settings{"processbenefit"};
	}
	$world_players{$username}{$end_product} += $income;

	logmsg "$socketname ($username) produced $amount in $factory_type";
	return "OK Processed $amount units into $income units in $factory_type factory";
}

sub process_sell {
	my $socketname = shift;
	my $username = shift;
	my $product_type = shift;
	my $amount = shift;
        my $round = $settings{"roundnro"};

	if(defined $world_sells{$round}{$product_type}) {
		# There is at least one previous offer by someone
		if(defined $world_sells{$round}{$product_type}{$username}) {
			# By us, so lets get rid of it
			withdraw_sell_offer($socketname,
					    $username,
					    $product_type);
		}
	}

	if($amount eq "MAX" || $amount eq "max") {
		$amount = $world_players{$username}{$product_type};
		if($amount <= 0) {
			return "OK No $product_type sold to the market";
		}
	}

	if($amount > $world_players{$username}{$product_type}) {
		return "CANNOT You do not have that much of $product_type";
	}

	return create_sell_offer($socketname, $username,
				 $product_type, $amount);
}

sub process_buy {
	my $socketname = shift;
	my $username = shift;
	my $product_type = shift;
	my $amount = shift;
	my $price = shift;
        my $round = $settings{"roundnro"};
	my $on_market = get_product_on_market($product_type);

	if(defined $world_buys{$round}{$product_type}) {
		# There is at least one previous offer by someone
		if(defined $world_buys{$round}{$product_type}{$username}) {
			# By us, so lets get rid of it
			withdraw_buy_offer($socketname,
					   $username,
					   $product_type);
		}
	}
	my $money = $world_players{$username}{"credits"};

	if((not ($price eq "max" || $price eq "MAX")) && $price <= 0) {
		return "CANNOT Price must be at least 1";
	}

	if($amount eq "MAX" || $amount eq "max") {
		$amount = $on_market;
		if($amount > $money) {
			$amount = $money; # Min unit price is 1
		}

		if(not ($price eq "MAX" || $price eq "max")) {
			if($amount*$price > $money) {
				$amount = int($money/$price);
			}
		}

		if($amount <= 0) {
			return "OK No offer on product $product_type done";
		}
	}

	if($price eq "MAX" || $price eq "max") {
		if($amount <= 0) {
			$price = 0;
		} else {
			$price = int($money/$amount);
		}

		if($price <= 0) {
			return "OK No offer on product $product_type done";
		}
	}
	
	if($amount > $on_market) {
		return "CANNOT There is not so much of $product_type available on market";
	}

	if($amount*$price > $money) {
		return "CANNOT You do not have that much money";
	}

	return create_buy_offer($socketname, $username,
				$product_type, $amount, $price);
}

sub process_quotes {
        my $socketname = shift;
        my $username = shift;
        my $product_type = shift;
        my $start_round = shift;
        my $last_round = shift;
        my $round = $settings{"roundnro"};
        my $statround = $round - 1;

        if($last_round > $statround) {
                $last_round = $statround;
        }

        my $msg = "OK QUOTES For $product_type follows ($start_round - $last_round)" . $OUTEOL;
        $msg .= "+ Round   Amount   Price" . $OUTEOL;
        $msg .= "+ =====   ======   =====" . $OUTEOL;

        my $r;
	my $tot_amount;
	my $tot_price;
	my $n=0;
        for($r=$start_round; $r<=$last_round; $r++) {
		$n++;
		my $amount = $world_dealstats{$r}{$product_type}{"amount"};
		my $price  = $world_dealstats{$r}{$product_type}{"price"};
		$tot_amount += $amount;
		$tot_price  += $amount*$price;

                $msg .= sprintf("+ %5d  %7d  %6d$OUTEOL",
                                $r,
				$amount,
				$price
                                );
        }

	if($n > 0) {
		my $avg_amount = $tot_amount/$n;
		my $avg_price = 0;
		if($tot_amount != 0) {
			$avg_price=$tot_price/$tot_amount;
		}

		$msg .= sprintf("+  AVG   %7.2f  %6.2f$OUTEOL",
			$avg_amount, $avg_price);
	}
        
        $msg .= "=";
        return $msg;
}

sub process_help {
	my $topic = shift;

	if($topic) {
		return "ERROR Not implemented yet";
	} else {
		return "HELP List of available commands follows" . $OUTEOL .
		"(I)   INVENTORY                Show your stock" . $OUTEOL .
		"(M)   MARKET                   Show market status" . $OUTEOL .
		"(Q)   QUOTES <mat> [r]         Print market history for mat from round r" . $OUTEOL .
		"(B)   BUY <mat> <n> <p>        Buy n units of mat for p per unit" . $OUTEOL .
		"(S)   SELL <mat> <n>           Sell n units of mat" . $OUTEOL .
		"(BLD) BUILD ab|cd|EF           Build factory" . $OUTEOL .
		"(IMP) IMPROVE ab|cd|EF <n>     Improve factory n times" . $OUTEOL .
		"(P)   PROCESS ab|cd|EF <n>     Process n times in a factory" . $OUTEOL .
		"(R)   RANK                     Show player rankings" . $OUTEOL .
		"(A)   AUTO                     List autocommand slots" . $OUTEOL .
		"(A)   AUTO [n] <cmd>           Set cmd in autoslot n" . $OUTEOL .
		"      LTE <mat> <n> <cmd>      Do cmd if |mat| <= n " . $OUTEOL .
		"      GTE <mat> <n> <cmd>      Do cmd if |mat| >= n " . $OUTEOL .
		"      RND <n> <cmd>            Do cmd if round == n " . $OUTEOL .
		"      RLE <n> <cmd>            Do cmd if round <= n " . $OUTEOL .
		"      RGE <n> <cmd>            Do cmd if round >= n " . $OUTEOL .
		"(H)   HELP                     This help" . $OUTEOL .
		"      ENV                      Print host settings" . $OUTEOL .
		"      USERS                    Show number of players" . $OUTEOL .
		"      QUIT                     Quit the game" . $OUTEOL .
		"      INTERACTIVE ON|OFF       Select interactive mode" . $OUTEOL .
		"=";
	}
}

sub process_player_resign {
	my $username = shift;
	my $socketname;
	my $n_clients=0;

	for $socketname (keys %players) {
		if($players{$socketname}{"name"} eq $username) {
			say_to_client($socketname,
				"RESIGN Removing your player entry. Rejoin is not possible. Bye!");
			$players{$socketname}{"auth"}=0;
			$players{$socketname}{"name"}="";
			$players{$socketname}{"kick"}=1;
			$n_clients++;
		}
	}

	# XXX: TODO remove sells and buys for this round
	delete($world_autocommands{$username});
	delete($world_players{$username});

	logmsg "Removed player $username and dropped $n_clients clients";
}

sub list_auto {
	my $socketname = shift;
	my $username = shift;
	my $maxslots = $settings{"maxautocommands"};
	my $msg = "OK List of automatic command slots follows" . $OUTEOL;

	my $slot;
	for($slot=0; $slot<$maxslots; $slot++) {
		$msg .= "+ [". $slot . "] " .
		$world_autocommands{$username}[$slot] . $OUTEOL;
	}
	$msg .= "=";
	return $msg;
}

sub set_auto {
	my $socketname = shift;
	my $username = shift;
	my $slot = shift;
	my $command = shift;

	my $maxslots = $settings{"maxautocommands"};

	if($slot <0 || $slot>=$maxslots) {
		return "ERROR Available slots are 0-" . ($maxslots-1);
	}

	$world_autocommands{$username}[$slot] = $command;
	logmsg "$socketname ($username) Set auto command slot $slot to '$command'";
	return "OK Slot $slot set";
}

sub process_auto {
	my $socketname = shift;
	my $username = shift;
	my $slot = shift;
	my $command = shift;
}	

sub process_authed_input {
	my $socketname = shift;
	my $username = shift;
	my $command = shift;
	my $round = $settings{"roundnro"};

	if($command =~ /^(i|in|inv|inventory|I|INV|INVENTORY|stock|stk|st|status)$/i) {
		return world_inventory($socketname, $username);
	}

	elsif($command =~ /^(bld|build|BLD|BUILD)\s+(ab|cd|EF)$/) {
		my $factory_type = $2;
		my $fact_price = $settings{"factoryprice"};
		my $im_price = $settings{"factoryimprice"};
		my $money = $world_players{$username}{"credits"};
		my $im = $world_players{$username}{"im"};

		if($world_players{$username}{$factory_type} > 0)  {
			return "CANNOT You already have $factory_type factory";
		}
		if($money < $fact_price) {
			return "CANNOT A new factory costs $fact_price but you only have $money";
		}
		if($im < $im_price) {
			return "CANNOT A new factory needs $im_price Improvement Modules, you have $im";
		}
		
		$world_players{$username}{$factory_type} = 1;
		$world_players{$username}{"credits"} -= $fact_price;
		$world_players{$username}{"im"} -= $im_price;
		logmsg "$socketname ($username) built factory $factory_type";
		return "OK Built $factory_type factory";
	}

	elsif($command =~ /^(quit|exit|QUIT|EXIT)$/i) {
		if(defined $players{$socketname}) {
			logmsg "$socketname ($username) gave quit command";
			$players{$socketname}{"kick"}=1;
			return "OK Bye";
		} else {
			return "ERROR Cannot QUIT with autocommand";
		}
	}

	elsif($command =~ /^(improve|imp|IMPROVE|IMP)\s+(ab|cd|EF)\s+(\d{1,2}|max|MAX)$/) {
		my $factory_type = $2;
		my $amount = $3;
		my $maximprove = $settings{"maximprove"};

		if($world_players{$username}{$factory_type} == 0) {
			return "CANNOT You do not have this type of factory";
		}
		
		if($amount eq "MAX" || $amount eq "max") {
			$amount=$maximprove-
			        ($world_players{$username}{$factory_type}-1);
			if($amount > $world_players{$username}{"im"}) {
				$amount = $world_players{$username}{"im"};
			}
			if($amount <= 0) {
				return "OK No improvement for $factory_type done";	
			}
		}

		if($amount > $world_players{$username}{"im"}) {
			return "CANNOT Not enough Factory Improvements";
		}
		if($amount > (50-($world_players{$username}{$factory_type}-1))) {
			return "CANNOT Max improve per factory exceeded";
		}

		$world_players{$username}{"im"} -= $amount;
		$world_players{$username}{$factory_type} += $amount;
		logmsg "$socketname ($username) Improved $factory_type by $amount (now $world_players{$username}{$factory_type})";
		return "OK Improved $factory_type by $amount to $world_players{$username}{$factory_type}";
	}

	elsif($command =~ /^(p|P|PROCESS|process|pro|PRO|pr|PR)\s+(ab|cd|EF)\s+(max|MAX|\d{1,4})$/) {
		my $factory_type = $2;
		my $amount = $3;

		return process_process($socketname, $username,
				$factory_type, $amount);
	}

	elsif($command =~ /^(p|P|PROCESS|process|pro|PRO|pr|PR)\s+(ab|cd|EF)$/) {
		my $factory_type = $2;

		return process_process($socketname, $username,
		        		$factory_type, 1);
	}

	elsif($command =~ /^(p|P|PROCESS|process|pro|PRO|pr|PR)$/) {
		if($world_players{$username}{"EF"} >= 1 &&
		   $world_players{$username}{"E"}  >= 1 &&
		   $world_players{$username}{"F"}  >= 1) {
			return process_process($socketname, $username,
		        		"EF", 1);
		} elsif($world_players{$username}{"ab"} >= 1 &&
			$world_players{$username}{"cd"} >= 1 &&
			$world_players{$username}{"E"} >=
			$world_players{$username}{"F"}) {
			return process_process($socketname, $username,
					"cd", 1);
		} elsif($world_players{$username}{"ab"} >= 1 &&
			$world_players{$username}{"cd"} >= 1 &&
			$world_players{$username}{"E"} < 
			$world_players{$username}{"F"}) {
			return process_process($socketname, $username,
					"ab", 1);
		} elsif($world_players{$username}{"ab"} >= 1 &&
			$world_players{$username}{"a"} >= 1 &&
			$world_players{$username}{"b"} >= 1) {
			return process_process($socketname, $username,
					"ab", 1);
		} elsif($world_players{$username}{"cd"} >= 1 &&
			$world_players{$username}{"c"} >= 1 &&
			$world_players{$username}{"d"} >= 1) {
			return process_process($socketname, $username,
					"cd", 1);
		} else {
			return "CANNOT I cannot decide what to produce";
		}
	}

	elsif($command =~ /^(sell|s|SELL|S)\s+(a|b|c|d|E|F|im)\s+(max|MAX|\d{1,3})$/) {
		my $product_type = $2;
		my $amount = $3;
	
		return process_sell($socketname, $username,
				$product_type, $amount);
	}

	elsif($command =~ /^(sell|s|SELL|S)\s+(a|b|c|d|E|F|im)$/) {
		my $product_type = $2;
	
		return process_sell($socketname, $username,
				$product_type, 0);
	}
	
	elsif($command =~ /^(buy|BUY|b|B)\s+(a|b|c|d|E|F|im|vp|r)\s+(\d{1,4}|max|MAX)\s+(\d{1,4}|max|MAX)$/) {
		my $product_type = $2;
		my $amount = $3;
		my $price = $4;
		
		return process_buy($socketname, $username,
				$product_type, $amount, $price);
	}

	elsif($command =~ /^(buy|BUY|b|B)\s+(a|b|c|d|E|F|im|vp|r)$/) {
		my $product_type = $2;
		
		return process_buy($socketname, $username,
				$product_type, 0, 1);
	}

	elsif($command =~ /^(market|MARKET|M|m)$/) {
		my $product_type;
		my $msg = "";

		$msg .= "OK MARKET Report follows" . $OUTEOL;
 		$msg .= "+      ID Name                      Avail Sales Quote  Have ToSell  ToBuy" . $OUTEOL;
		$msg .= "+ ======= ========================= ===== ===== ===== ===== ====== ======" . $OUTEOL;

		my $statround = $round-1;
		foreach $product_type ("r","a","b","c","d","E","F","im","vp" ) {
			my ($amount, $price, $have, $to_sell, $to_buy);

			$amount=$world_dealstats{$statround}{$product_type}{"amount"};
			$price=$world_dealstats{$statround}{$product_type}{"price"};
			$have=$world_players{$username}{$product_type};

			$to_buy=0; $to_sell=0;
			if(defined $world_sells{$round}{$product_type}{$username}) {
				$to_sell=$world_sells{$round}{$product_type}{$username}{"amount"};
			}
			if(defined $world_buys{$round}{$product_type}{$username}) {
				$to_buy=$world_buys{$round}{$product_type}{$username}{"amount"};
			}

			$msg .= sprintf(
			"+ %7s %-25s %5d %5d %5d %5d %6d %6d$OUTEOL", $product_type,
			$namemap{$product_type},
			get_product_on_market($product_type),
			$amount, $price, $have, $to_sell, $to_buy);
		}
	
		$msg .= "=";
		return $msg;
	}
	
	elsif($command =~ /^(users|USERS|who|WHO)$/) {
		my $num_pl = get_number_of_players();
		my $num_cl = get_number_of_clients();
		return "OK $num_pl players, $num_cl connected clients";
	}

	elsif($command =~ /^(env|ENV)$/) {
		my $key;
		my $msg = "OK ENVIRONMENT Dump follows" . $OUTEOL;
		
		foreach $key (keys %settings) {
			$msg.=sprintf "+ %-20s == %s\n", $key, $settings{$key};
		}
		$msg .= "=";
		return $msg;
	}

	elsif($command =~ /^(quotes|QUOTES|quote|QUOTE|q|Q)\s+(r|a|b|c|d|E|F|im|vp)$/) {
		my $product_type=$2;
		my $first_round=$round-10;
		if($first_round<0) {
			$first_round=0;
		}
		return process_quotes($socketname, $username,
			$product_type, $first_round, $round);
	}
        
	elsif($command =~ /^(quotes|QUOTES|quote|QUOTE|q|Q)\s+(r|a|b|c|d|E|F|im|vp)\s+(\d{1,5})$/) {
		my $product_type=$2;
		my $first_round=$3;
		my $last_round=$first_round+10;

		if($first_round>$round-1) {
			$first_round=$round-1;
		}
		return process_quotes($socketname, $username,
			$product_type, $first_round, $last_round);
	}
	
	elsif($command =~ /^(quotes|QUOTES|quote|QUOTE|q|Q)\s+(r|a|b|c|d|E|F|im|vp)\s+(max|MAX)$/) {
		my $product_type=$2;
		my $first_round=0;
		my $last_round=$round-1;

		return process_quotes($socketname, $username,
			$product_type, $first_round, $last_round);
	}


	elsif($command =~ /^(r|R|RANK|rank|RANKING|ranking|RANKINGS|rankings)$/) {

		if($settings{"gameover"}) {
			return $ranking_msg;
		} else {
			return "ERROR Cannot show rankings until the game is over";
		}
	}

	elsif($command =~ /^(A|a|AUTO|auto)$/) {
		return list_auto($socketname, $username);
	}

	elsif($command =~ /^(A|a|AUTO|auto)\s+(\d+)$/) {
		my $slot = $2;
		return set_auto($socketname, $username, $slot, "");
	}

	elsif($command =~ /^(A|a|AUTO|auto)\s+(\d+)\s+([\w\ ]*)$/) {
		my $slot = $2;
		my $acommand = $3;
		return set_auto($socketname, $username, $slot, $acommand);
	}

	elsif($command =~ /^(LTE|lte)\s+(a|b|c|d|E|F|im|vp|credits)\s+(\d{1,5})\s+([\w\ ]+)$/) {
		my $product_type = $2;
		my $limit = $3;
		my $subcommand = $4;

		if($world_players{$username}{$product_type} <= $limit) {
			return process_authed_input($socketname,
						$username,
						$subcommand);
		} else {
			return "NOCOND Not done, LTE limit not met";	
		}
	}

	elsif($command =~ /^(GTE|gte)\s+(a|b|c|d|E|F|im|vp|credits)\s+(\d{1,5})\s+([\w\ ]+)$/) {
		my $product_type = $2;
		my $limit = $3;
		my $subcommand = $4;

		if($world_players{$username}{$product_type} >= $limit) {
			return process_authed_input($socketname,
						$username,
						$subcommand);
		} else {
			return "NOCOND Not done, GTE limit not met";	
		}
	}

	elsif($command =~ /^(RND|rnd)\s+(\d{1,5})\s+([\w\ ]+)$/) {
		my $limit = $2;
		my $subcommand = $3;

		if($round == $limit) {
			return process_authed_input($socketname,
						$username,
						$subcommand);
		} else {
			return "NOCOND Not done, RND limit not met";	
		}
	}

	elsif($command =~ /^(RLE|rle)\s+(\d{1,5})\s+([\w\ ]+)$/) {
		my $limit = $2;
		my $subcommand = $3;

		if($round <= $limit) {
			return process_authed_input($socketname,
						$username,
						$subcommand);
		} else {
			return "NOCOND Not done, RLE limit not met";	
		}
	}

	elsif($command =~ /^(RGE|rge)\s+(\d{1,5})\s+([\w\ ]+)$/) {
		my $limit = $2;
		my $subcommand = $3;

		if($round >= $limit) {
			return process_authed_input($socketname,
						$username,
						$subcommand);
		} else {
			return "NOCOND Not done, RGE limit not met";	
		}
	}

	#elsif($command =~ /^(RESIGN|resign)$/) {
	#	process_player_resign($username);
	#	return "OK You are gone";
	#}

	elsif($command =~ /^(h|H|HELP|help)$/) {
		return process_help(0);
	}

	elsif($command =~ /^(interactive|INTERACTIVE)\s+(on|ON)$/) {
		$players{$socketname}{"interactive"} = 1;
		return "OK Interactive mode enabled";
	}

	elsif($command =~ /^(interactive|INTERACTIVE)\s+(off|OFF)$/) {
		$players{$socketname}{"interactive"} = 0;
		return "OK Interactive mode disabled";
	}

	else {
		return "ERROR Invalid command";
	}

	# AUTO
	# HELP
}

sub rebuild_prompt {
	my $socketname = shift;
	my $timeleft = $settings{"lastround"}+$settings{"roundlength"}-time();
	if($timeleft<0) {
		$timeleft = 0;
	}

	if($players{$socketname}{"auth"}) {
		my $username = $players{$socketname}{"name"};
		$players{$socketname}{"prompt"} =
		  "[" . $username . " R" .
		  $settings{"roundnro"} . " " .
		  $timeleft . "s ¤" .
		  $world_players{$username}{"credits"} . "]> ";
		if(!$players{$socketname}{"interactive"}) {
			$players{$socketname}{"prompt"} .= "\n";
		}
	}
}

sub auth_client {
	my $socketname = shift;
	my $username = shift;
	my $password = shift;

	if(defined $world_players{$username}) {
		# Rejoin attempt
		if($password eq $world_players{$username}{"password"}) {
			$players{$socketname}{"name"} = $username;
			$players{$socketname}{"auth"} = 1;
			logmsg "$socketname rejoined as ($username) with correct auth";
			rebuild_prompt $socketname;
			say_to_client($socketname, "OK REJOIN Welcome back");
		} else {
			logmsg "$socketname tried to rejoin as ($username) with incorrect password";
			say_to_client($socketname, "ERROR AUTH Failed");
		}
	} else {
		# New player
		if($settings{"newplayers"}) {
			$players{$socketname}{"name"} = $username;
			$players{$socketname}{"auth"} = 1;
			create_world_player($socketname, $username, $password);
			logmsg "$socketname joined as player ($username)";
			say_to_client($socketname, "OK JOIN Welcome");
			rebuild_prompt $socketname;
		} else {
			logmsg "$socketname tried to join, but joins are not all owed by settings";
			say_to_client($socketname, "ERROR No new players accepted");
			$players{$socketname}{"kick"} = 1;
		}
	}
}

sub process_unauthed_input {
	my $socketname = shift;
	my $command = shift;

	if($command =~ /^([a-zA-Z][a-zA-Z0-9]{1,9})\s+(\w{0,20})/) {
		# AUTH
		my $username = $1;
		my $password = $2;
		auth_client($socketname, $username, $password);
	} else {
		say_to_client($socketname, "ERROR Invalid AUTH");
	}
	# TODO: QUIT
}


sub process_client_input {
	my $socketname = shift;
	my $inline = shift;

	if($inline =~ /^\r?\n/) {
		rebuild_prompt $socketname;
		# empty line
	} elsif($inline =~ /([\w\ ]+)/) {
		my $okline = $1;

		if($settings{"clientlog"}) {
			logmsg "Client $socketname said: '$okline'";
		}

		if($players{$socketname}{"auth"}) {
			my $username = $players{$socketname}{"name"};
			say_to_client($socketname,
				process_authed_input($socketname,
						     $username, $okline));
			rebuild_prompt $socketname;
		} else {
			process_unauthed_input($socketname, $okline);
		}

	} else {
		logmsg "Invalid input from client $socketname";
		say_to_client($socketname, 
				"* ERROR Invalid characters on input line");
	}
	raw_say_to_client($socketname, $players{$socketname}{"prompt"});
}

sub is_user_online {
	my $username = shift;
	my $socketname;

        foreach $socketname (keys %players) {
		if($players{$socketname}{"name"} eq $username) {
			return $socketname;
		}
        }

	return 0;
}

sub dump_player_list {
	my $username;
	foreach $username (keys %world_players) {
		if(is_user_online($username)) {
			printf "* %12s ONLINE\n", $username;
		} else {
			printf "* %12s OFFLINE\n", $username;
		}
	}
}

sub dump_user_list {
	my $socketname;
	foreach $socketname (keys %players) {
		printf "* %12s %30s %2d\n",
			$players{$socketname}{"name"},
			$socketname,
			$players{$socketname}{"auth"};
	}
}

sub kick_user {
	my $user = shift;

	if(defined $players{$user}) {
		$players{$user}{"kick"}=1;
		logmsg "Console kicked $user";
	} else {
		print "* ERROR No such user\n";
	}
}

sub dump_env {
	my $key;

	foreach $key (keys %settings) {
		printf "* %-20s == %s\n", $key, $settings{$key};
	}
}

sub set_env {
	my $key = shift;
	my $value = shift;
	my $oldvalue;
	
	if(defined $settings{$key}) {
		$oldvalue = $settings{$key};
		$settings{$key}=$value;
		logmsg "Console set $key: $oldvalue => $value";
		broadcast_to_clients("ENVSET Server conf changed for '$key': $oldvalue => $value");
	} else {
		print "* ERROR Invalid key for set operation\n";
	}
}

sub process_console_input {
	my $inline = shift;

	if($inline =~ /^([\w\ ]+)/) {
		my $okline = $1;

		for($inline) {
			/^quit$/i	&& do {
				logmsg "Quit --- Console request";
				close(LOGFILE);
				exit(0);
				};

			/^players$/i	&& do {
				dump_player_list();
				last;
				};

			/^users$/i	&& do {
				dump_user_list();
				last;
				};

			/^kick ([\w\-\.\d]+)$/i	&& do {
				kick_user($1);
				last;
				};

			/^env$/i && do {
				dump_env();
				last;
				};

			/^set\s+(\w+)\s+(\w+)$/i && do {
				set_env($1, $2);
				last;
				};

			logmsg "Unknown command from Console";
			return;
		}

	} else {
		logmsg "Invalid input from Console";
	}
}

sub place_random_sells {
	my $amount = shift;
	my @mats   = @_;
	my $n_mats = scalar @mats;
	my $n;
	my %sell_amounts;
	
	for($n=0;$n<$amount;$n++) {
		my $r=int(rand()*$n_mats);
		if($r>=$n_mats) { $r = $n_mats-1; }
		
		$sell_amounts{$mats[$r]} += 1;
	}

	my $mat;
	foreach $mat (@mats) {
		my $a = 0;
		if(defined $sell_amounts{$mat}) {
			$a=$sell_amounts{$mat};
		}
		create_sell_offer("!Bank", "!Bank", $mat, $a);
	}
}

sub place_bank_sells {
	logmsg "World: Placing bank sales for this round";

	my $round = $settings{"roundnro"};
	my $vp_mult = $settings{"victorypoints"};
	my $im_mult = $settings{"improvements"};
	my $r_mult = $settings{"rawmaterials"};
	my $ran_mult = $settings{"randommaterials"};
	my $hi_mult = $settings{"highermaterials"};
	my $num_players = get_number_of_players();

	my $vp_amount = int($vp_mult * $num_players * $round);
	my $im_amount = int($im_mult * $num_players);
	my $r_amount  = int($ran_mult * $num_players);

	create_sell_offer("!Bank", "!Bank", "vp", $vp_amount);
	create_sell_offer("!Bank", "!Bank", "im", $im_amount);
	create_sell_offer("!Bank", "!Bank", "r", $r_amount);

	place_random_sells($r_mult*$num_players, "a", "b", "c", "d");
	place_random_sells($hi_mult*$num_players, "E", "F");
}

sub sort_func_sell {
	if($$a{"amount"} > $$b{"amount"}) {
		return -1;
	}
	if($$a{"amount"} < $$b{"amount"}) {
		return 1;
	}
	if($$a{"random"} > $$b{"random"}) {
		return -1;
	}
	
	return 1;
}

sub sort_func_buy {
	if($$a{"price"} > $$b{"price"}) {
		return -1;
	}
	if($$a{"price"} < $$b{"price"}) {
		return 1;
	}
	if($$a{"amount"} > $$b{"amount"}) {
		return -1;
	}
	if($$a{"amount"} < $$b{"amount"}) {
		return 1;
	}
	if($$a{"random"} > $$b{"random"}) {
		return -1;
	}
	
	return 1;
}
sub add_random_res {
	my $username = shift;
	my $amount = shift;
	my $type;
	my $round = $settings{"roundnro"};
	my $r = rand();

	if($r<=0.25) {
		$type="a";
	} elsif($r>0.25 && $r<=0.5) {
		$type="b";
	} elsif($r>0.5 && $r<=0.75) {
		$type="c";
	} else {
		$type="d";
	}

	$world_players{$username}{$type} += $amount;
	$world_matinc{$round}{$type}{$username} += $amount;
}

sub one_auction {
	my $product_type = shift;
	my $round = $settings{"roundnro"};
	my $sellround = $round - 1;
	#logmsg "World: Running auction for $product_type";

	my $on_market = get_product_on_market($product_type);
	my $to_buy = get_buys_on_market($product_type);

	my $h = $world_sells{$sellround}{$product_type};
	my @sells = sort sort_func_sell values %$h;

	my $h2 = $world_buys{$round}{$product_type};
	my @buys  = sort sort_func_buy values %$h2;

	my $price = 0;
	my $sell; my $buy;
	my $left = $on_market;
	my $total_sale = $on_market;
	if($total_sale > $to_buy) {
		$total_sale=$to_buy;
	}

	foreach $buy (@buys) {
		$price = $$buy{"price"};
		if($$buy{"amount"} >= $left) {
			$left=0;
			last;
		} else {
			$left -= $$buy{"amount"};
		}
	}

	$left = $total_sale;
	foreach $sell (@sells) {
		my $thisdeal;
		my $miss=0;
		my $seller = $$sell{"seller"};
		if($$sell{"amount"} <= $left) {
			$thisdeal = $$sell{"amount"};
		} else {
			$miss     = $$sell{"amount"}-$left;
			$thisdeal = $left;
		}
		$left -= $thisdeal;
		
		if(not $seller eq "!Bank") {
			$world_players{$seller}{"credits"} +=
				$thisdeal * $price;
			$world_matinc{$round}{"credits"}{$seller} += $thisdeal*$price;
			$world_players{$seller}{$product_type} += 
				$miss;
		}
	}

	$left = $total_sale;
	foreach $buy (@buys) {
		my $thisdeal;
		my $miss=0;
		my $byer = $$buy{"byer"};
		if($$buy{"amount"} <= $left) {
			$thisdeal = $$buy{"amount"};
		} else {
			$miss     = $$buy{"amount"}-$left;
			$thisdeal = $left;
		}
		$left -= $thisdeal;
		
		if(not $byer eq "!Bank") {
			if($product_type eq "r") {
				add_random_res($byer, $thisdeal);
			} else {
				$world_players{$byer}{$product_type} += $thisdeal;
				$world_matinc{$round}{$product_type}{$byer} += $thisdeal;
			}
			$world_players{$byer}{"credits"} +=
				$miss*$$buy{"price"};
			$world_players{$byer}{"credits"} +=
				$thisdeal*
				($$buy{"price"}-$price);
		}
	}

	if($round != 0 && $total_sale==0) {
		my $prevround = $round-1;
		$price = $world_dealstats{$prevround}{$product_type}{"price"};
	}

	$world_dealstats{$round}{$product_type}{"amount"} = $total_sale;
	$world_dealstats{$round}{$product_type}{"price"} = $price;

	if($settings{"deallog"}) {
		logmsg "Round $round Deals for $product_type: $total_sale units, ¤$price/unit";
		logmsg "Round $round Exchange of $product_type: sales: $on_market buys: $to_buy";
	}
}

sub dutch_auction {
	my $product_type;
        foreach $product_type ("r","a","b","c","d","E","F","im","vp" ) {
		one_auction $product_type;
        }
}

sub sort_func_winner {
	if($world_players{$a}{"vp"}>$world_players{$b}{"vp"}) {
		return -1;
	} elsif($world_players{$a}{"vp"}<$world_players{$b}{"vp"}) {
		return 1;
	} else {
		return 0;
	}
}

sub determine_winner {
	my $username;
	my $gameend=0;
	my $winlimit=$settings{"winlimit"};

	foreach $username (keys %world_players) {
		if($world_players{$username}{"vp"} >= $winlimit) {
			$gameend=1;
		}
	}

	if($gameend) {
		$settings{"running"}=0;
		$settings{"gameover"}=1;
		logmsg "Game ended, at least one player is at or above $winlimit vps.";

		my @pl_order = sort sort_func_winner keys %world_players;
		my $msg;
		$msg = "END Game Over! Rankings follow." . $OUTEOL;
		$msg .= "+ Rank  Player      Points" . $OUTEOL;
		$msg .= "+ ====  ======      ======" . $OUTEOL;

		my $rank=0;
                foreach $username (@pl_order) {
			$rank++;
			my $vp = $world_players{$username}{"vp"};
			$msg .= sprintf "+ %4d. %-10s  %6d$OUTEOL",
				$rank,
				$username,
				$vp;
			logmsg "Rank $rank, Player $username, VP $vp";
                }
		$msg .= "=";
	
		$ranking_msg = $msg;

		my $socketname;
		foreach $socketname (keys %players) {
			say_to_client($socketname, $msg);
		}
	}
}

sub run_auto_commands {
	my $username;
	my $slot;
	my $maxslots = $settings{"maxautocommands"};

	foreach $username (keys %world_players) {
		for($slot=0; $slot<$maxslots; $slot++) {
			my $cmd = $world_autocommands{$username}[$slot];
			if($cmd) {
				say_to_user($username,
				  process_authed_input("Autocommand", 
						       $username,
                                                       $cmd));
			}
		}
	}
}

sub world_run {
	my $autorun = shift;

	if($settings{"running"} &&
   	   $settings{"lastround"}+$settings{"roundlength"} <= time()) {
		my $thisround = $settings{"roundnro"};
		my $nextround = $thisround+1;

		logmsg "World: Running round $thisround => $nextround";
		place_bank_sells();
		dutch_auction();

		my $username;
		foreach $username (keys %world_players) {
			my $addmoney=$settings{"addmoney"};
			$world_players{$username}{"credits"} += $addmoney;
			$world_matinc{$thisround}{"credits"}{$username} +=
				$addmoney;
		}

		my $socketname;
		foreach $socketname (keys %players) {
			rebuild_prompt $socketname;
		}

		broadcast_to_clients("ROUND $thisround Run (Now in round $nextround)");
		
		logmsg "World: Run round completed, now in $nextround";
		$settings{"lastround"}=time();
		$settings{"roundnro"}=$nextround;

		determine_winner();
		run_auto_commands();
	}
}

sub print_welcome {
	my $socketname = shift;
	my $status = "halted";
	my $round = $settings{"roundnro"};
	my $n_players = get_number_of_players();

	if($settings{"running"}) {
		$status="running";
	} elsif($settings{"gameover"}) {
		$status="over";
	}
	
	say_to_client($socketname,
	"CAPITALIZE 1.0 AUTH Follows" . $OUTEOL .
	"+ ===========================" . $OUTEOL .
	"+ Welcome to Capitalize Game"  . $OUTEOL .
	"+" . $OUTEOL .
	"+ This game is currently $status on round $round." . $OUTEOL .
	"+ There are $n_players players in the game." . $OUTEOL .
	"+" . $OUTEOL .
	"+ Please authenticate yourself with <username> <password>" . $OUTEOL .
	"+" . $OUTEOL .
	"=" . $OUTEOL .
	"[username password]> ");
}

my $read_set = new IO::Select();
my $write_set = new IO::Select();
my $error_set = new IO::Select();
my $timeout = 1.0; # seconds
$read_set->add($server_socket);
$read_set->add(\*STDIN);

sub raw_read {
	my $sock = shift;
	my $socketname = getsocketname($sock);
	
	while($players{$socketname}{"maxin"}) {
		my $buf="";
		my $bytes_read = sysread($sock,
			$buf,
			$players{$socketname}{"maxin"});

		if (defined($bytes_read)) {
			if ($bytes_read == 0) {
				# Remote socket closed connection
				$players{getsocketname($sock)}{"kick"}=1;
				last;
			} else { 
				$players{$socketname}{"inbuffer"} .= $buf;
				$players{$socketname}{"maxin"} -= $bytes_read;
			}
		} else {
			if ($! == EAGAIN()) {
				last; # Return to select
			} else {
				last;
			}
		}
	}
}

sub raw_write {
	my $sock = shift;
	my $socketname = getsocketname($sock);
	
	while(length $players{$socketname}{"outbuffer"}) {
		my $bytes_written = syswrite($sock,
			$players{$socketname}{"outbuffer"});

		if (defined($bytes_written)) {
			if ($bytes_written == 0) {
				# Remote socket closed connection
				$players{getsocketname($sock)}{"kick"}=1;
				last;
			} else { 
				$players{$socketname}{"outbuffer"}=
				  substr $players{$socketname}{"outbuffer"},
				       $bytes_written;
				$players{$socketname}{"maxout"} += $bytes_written;
			}
		} else {
			if ($! == EAGAIN()) {
				last; # Return to select
			} else {
				last;
			}
		}
	}
}

while(1) {
	my ($r_ready, $w_ready, $error) = 
		IO::Select->select($read_set, $write_set, $error_set, $timeout);
	
	my $sock;
	foreach $sock (@$r_ready) {
		if($sock == $server_socket) {
			my $new_sock = $sock->accept();
                	my $hostinfo = gethostbyaddr($new_sock->peeraddr);
                	my $clientname="";
			if(defined $hostinfo) {
				$clientname=$hostinfo->name;
			} else {
				$clientname=$new_sock->peerhost;

			}
			my $socketname = getsocketname($new_sock);
                	logmsg "[Connect from $socketname $clientname]";
			fcntl($new_sock, F_SETFL(), O_NONBLOCK());
			$read_set->add($new_sock);
			create_player($socketname, $new_sock);
			print_welcome($socketname);
		} elsif($sock == \*STDIN) {
			my $console_input = <STDIN>;
			chop $console_input;
			process_console_input($console_input);
		} else {
			my $socketname = getsocketname($sock);
			raw_read($sock);
			while($players{$socketname}{"inbuffer"} =~ 
				s/^([^\n]*\r?\n)//) {
				my $buf = $1;
				$players{$socketname}{"maxin"} += length $buf;
				process_client_input($socketname, $buf);
			}
			if($players{$socketname}{"maxin"} <= 0) {
				# Input buffer is full, no end of line in sight
				$players{$socketname}{"kick"} = 1;
				logmsg "Dropping $socketname, too long input line";
			}
        	}
	}

	foreach $sock (@$w_ready) {
		raw_write($sock);
	}

	$write_set = new IO::Select();
	my $player;
	foreach $player (keys %players) {
		if(length $players{$player}{"outbuffer"}) {
			$write_set->add($players{$player}{"socket"});
		}
	}
	
	# XXX: Handle Errors

	world_run();

	foreach $player (keys %players) {
		if($players{$player}{"kick"}) {
			my $psock = $players{$player}{"socket"};
			$read_set->remove($psock);
			delete($players{$player});
			$psock->close();
			logmsg "Server drop $player";
		}
	}
}

#TODO HELP <topic>
#TODO show client, show player in console
#TODO delete / RESIGN
#TODO STAT
#TODO Console help
#TODO Object model rewrite
