#!/usr/bin/perl -w
#the Northlands a perl based mud. Please enjoy and share this great software with
#anyone who wants it. 
#Copyright (C) 2000  Peter Smith creator@operamail.com
#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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
$|=1;
use POSIX;
use IO::Socket;
use IO::Select;
use Socket; 
use Fcntl;
use Tie::RefHash;
use Term::ANSIColor;
use Time::HiRes ("usleep");
require ("commands.pm");
require ("init.pm");
require("update.pm");
require("roomcommands.pm");
require("monster.pm");
require("combat.pm");
#use strict;
use vars qw(@node @elements $monstertotal $room $longupdate %inbuffer %outbuffer %ready $prompt %type @room %item %command);
$SIG{HUP}="ignore";
srand;
#$last=time;
$port=4005;
$server=IO::Socket::INET->new(LocalPort =>$port, Listen=> 10, Reuse=>1) or die "Can't make server socket: $@\n";
$prompt=color("blue").": ".color("reset");
%inbuffer = ();
%outbuffer = ();
%ready = ();
tie %ready, 'Tie::RefHash';
$node[0]={monsters=>[0],prob=>10,room=>1,max=>10,maxused=>0};
nonblock($server);
$select= IO::Select->new($server);
@elements=("Earth", "Air", "Water", "Fire", "Life");
$longupdate=0;
$lastupdate=time;
$monstertotal=0;
loaditems();
loadmuddata();
loadrealitems();
loadmonster();
loadroom();
loadcommands();	
print "Entering main loop\n";
while (1){
	my $client;
	my $rv;
	my $data;
	if (-e "killmud"){
		print "Closing down\n";
		exit;
		}
	
	#check for new information
	foreach $client ($select->can_read(0)) {
		$last{$client}=time;
		if ($client == $server) {
			#new connection
			print "A\n";
			$client= $server->accept();
			$select->add($client);
			nonblock($client);
			$outbuffer{$client}.="Welcome to the Northlands\r\n";
			$outbuffer{$client}.="Please tell me who you are:";
			$type{$client}="login";
			print "new connection\r\n";
		}else {
			#get data
			$data='';
			$rv = $client->recv($data, POSIX::BUFSIZ, 0);
			

			unless (defined($rv) && length $data) {
				#hang up
				&delete($client);
				next;
				}
			
		$inbuffer{$client}.=$data;
		while($inbuffer{$client} =~s/(.*\n)//) {
			push( @{$ready{$client}}, $1);}
		}
	}
	foreach $client ( keys %ready) {
		handle($client);
		}
	foreach $client ($select->can_write(1)) {
		next unless exists $outbuffer{$client};
		$rv=$client->send($outbuffer{$client}, 0);
		unless (defined($rv)){
			warn "I was told I could write but I can't";
			next;}
	
		if (($rv == length $outbuffer{$client}) || ($!== POSIX::EWOULDBLOCK)){
			substr($outbuffer{$client}, 0,$rv)="";
			delete $outbuffer{$client} unless length $outbuffer{$client};
			}		
		else{
			warn "hello. $! $outbuffer{$client} \r\n$rv\r\n";
			delete $inbuffer{$client};
			delete $outbuffer{$client};
			delete $ready{$client};
			delete $user{$client};
			delete $last{$client};
			$select ->remove($client);
			close($client);
			next;}
		}
	if (time-$lastupdate>1){
		update();
		$lastupdate=time;
		}
	else{
		usleep(0.0001);}
}
sub handle {
local $client= shift;
main: foreach $request (@{$ready{$client}}) {
	$request=~s/[\a|\r|\n]//g;
	$request=~s/\s*$//i;
	if ($request eq "."){
		$request=$lastrequest{$client};
		}
	if ($request){
		$lastrequest{$client}="$request";
		}
	$request=~s/^'/say /i;
	#';
	local @input=split(/ /,$request);	
	unless ($input[0]=~/^([-\@\w.]+$)/){
		$outbuffer{$client}.="possibly insecure data detected.\r\n$prompt";
		next;
		}
	if ($request){
	if ($user{$client}{room}){
		if (defined($room[$user{$client}{room}]{commands}{$input[0]})){
			unless (defined(&{$commandtype{$type{$client}}{$input[0]}})){
				$outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt";
				next;
				}
			
			&{$commandtype{$type{$client}}{$input[0]}};
			next;	
		}
	}
	
		if (defined($commandtype{$type{$client}}{input})){
			unless (defined(&{$commandtype{$type{$client}}{input}})){
				$outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt";
				next;
				}
			
			&{$commandtype{$type{$client}}{input}};
			next;
			}
		if (defined($commands{$type{$client}}{$input[0]})){
			unless (defined(&{$commands{$type{$client}}{$input[0]}})){
				$outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt";
				next;
				}
			
			&{$commands{$type{$client}}{$input[0]}};
			}
		elsif(defined($commands{basic}{$input[0]})){
			unless (defined(&{$commands{basic}{$input[0]}})){
				$outbuffer{$client}.="That sub doesn't exists, this is a serious error.\r\n$prompt";
				next;
				}
			&{$commands{basic}{$input[0]}};
			}
		
		else {
			$outbuffer{$client}.="$commandtype{$type{$client}}{failed}\r\n$prompt";
			}
		}
	else{
		$outbuffer{$client}.="\r\n$prompt";
		}
	}
delete $ready{$client};
}

sub nonblock {
my $socket= shift;
my $flags;
$flags= fcntl($socket, F_GETFL, 0) or die "can't get flags for socket $!\n";
fcntl($socket, F_SETFL, $flags | O_NONBLOCK) or die "can't make socket nonblocking";
}
sub roundcheck {
if ($user{$client}{round}){
	$outbuffer{$client}.="Please wait $user{$client}{round} more seconds.\r\n$prompt";
	return 1;
	}

}