#!/afs/athena/contrib/perl/perl

require('/afs/athena/user/m/k/mkgray/perl/operl.pl');

$newthing = <<_RECEND_;
eval("\\\$dname=\$_[0]");
eval("\\\$description=\$_[1]");
eval("\\\$lock=\$_[2]");
eval("\\\$flags=\$_[3]");
eval("\\\$exits=\$_[4]");
eval("\\\$owner=\$_[5]");
eval("\\\$fail=\$_[6]");
eval("\\\$ofail=\$_[7]");
eval("\\\$succ=\$_[8]");
eval("\\\$osucc=\$_[9]");
eval("\\\$drop=\$_[10]");
eval("\\\$odrop=\$_[11]");
eval("\\\$contents=\$_[12]");
eval("\\\$location=\$_[13]");
_RECEND_

&defclass('connection', 'root');
&defclass('thing', 'root');

print($newthing);
&defmethod('thing', 'set', 'print("\$$_[0]=$_[1]");eval("\$$_[0]=$_[1]")');
&defmethod('thing', 'query', 'eval("\$$_[0]")');
&defmethod('thing', 'make', "$newthing");


&initialize();
print("Init complete\n");
$thing[++$thingid] = &newobject('thing');
&send($thing[$thingid], 'make', 'Wizard', 'You are filled with awe.', 'barfoo', 'WP', "", 0, 'You can\'t pick up a person', 'acts silly', 'Home sweet home...\n', 'goes home', '', '', '', 'operl_b');

$thing[++$thingid] = &newobject('thing');
&send($thing[$thingid], 'make', 'Room', 'This is a plain room.', '', 'JR', "", 0, '','','','','','','',$thing2);

$thing[++$thingid] = &newobject('thing');
&send($thing[$thingid], 'make', 'Simple Exit', 'This is your basic exit.  It comes back here.', '','','',0,'The exit is locked','wanders around','You go through the exit','steps out.','','steps in.','','operl_b');


print("Loading Database...\n");
&load_db();
print("...done\n");


print("Creating id's array\n");
for $nn (0..$#dname){
    $id{$dname[$nn]}=$nn;
}


print "Listening for connection 1....\n";
$/ = "\n";
for(;;) {
    chop($fhs);
    $rin = &fhbits($fhs);
    #Get bitmask

    $fhs .= ' ';
    $ein = $rin;
    $nfound = select($rin, undef, undef, 1);
    #Do select


#   That line above needs to be fixed.
#   Disconections change it.

    if(vec($rin, fileno(S), 1)){
	&new_connection();
    }

    while($nfound){


	print("There are $nfound pending ports.Bitmask: ($rin)\n") if $debug;


	for $f (reverse(1..$#fha)){

	    print("Checking port $f in bitmask $rin\n") if $debug;

	    if(vec($rin,fileno($fha[$f]),1)){
		$foo = $fha[$f];
		print("Reading from $f,$foo...\n") if $debug;
		$nbread = sysread($foo, $output, 128);
		$fhs = join(' ', @fha);
		$fhs .=' ';
		chop($output);    #chop linefeed
		if(substr($output, length($output)-1, 1) eq "\r"){
		    chop($output);} #chop CR
		print("Read from $f,$foo: [$output] (cleaned up)\n") if $debug;
		#say hello
		if(!$name[$f]){
		    print("Port $f does not have a name. Granting name $output\n") if $debug;
		    eval(&parse_connect($output));
		    }
		if(!$nbread){
		    #Dead connection
		    $ofh = splice(@fha, $f,1);
		    $fhs = join(' ', @fha);
		    $fhs .=' ';
		    print("Connection port $f dead.  Removing name and fh entry.\n") if $debug;
		    $name = splice(@name, $f, 1);
		    $me = $id{$name};
		    &tell("$name has disconnected\n", &others_in_room($here));
		    $output = 'bluh';
		}
		&user_input($f, $name[$f], $output);

		print("\n") if $debug;
	    }
	}
	print("Done.  Doing select again.\n") if $debug;
	&myselect();
    }

	&regular_command();

}

sub regular_command{
}

sub fhbits {
    local(@fhlist) = split(' ',$_[0]);
    local($bits);
    for (@fhlist) {
	vec($bits,fileno($_),1) = 1;
	$obits = ord($bits);
	$fno = fileno($_);
	print(",$_($bits)($obits)($fno),") if $debug;
    }
    print("\n") if $debug;
    $bits;
}

sub new_connection {
    ($addr = accept($fh,S)) || die $!;
    push(@fha, $fh);
    $fhs =join(' ', @fha).' ';
    $fh++;
    ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
    $date = time;
    ($hostname,$aliases,$addrtype,$length,@addrs) = gethostbyaddr($inetaddr, 2);
    $fn = fileno($fha[$#fha]);
    $hostname[fileno($fha[$#fha])] = $hostname;
    print("Connection made from $hostname($fn) at $date. ($fhs)\n") if $debug;
    select(@fha[$#fha]); $|=1;
    print("Connect please\n");
    select(stdout);
}

sub user_input {
    local($num, $name, $text)=@_;


    $me = $id{$name[$f]};
    $here = $location[$me];
    
    $text =~ s/[\e\b\cg\ch\ci\cj\ck\cl\cm\cn\co]//g;
    print("$name//$text//\n");
    $lasttime[$id{$name}]=time;
    if($name){
	if(substr($text, 0, 1) eq ':'){
	    $rest = substr($text, 1);
	    $tell = "$name $rest\n";
	    &tell($tell, &others_in_room($here));
	    &tell($tell, $port[$me]);
	}
	elsif(substr($text, 0, 1) eq '"'){
	    print("$name is saying something\n") if $debug;
	    $rest = substr($text, 1);
	    $tell = "$name says, \"$rest\"\n";
	    @foo = &others_in_room($here);
	    &tell($tell, @foo);
	    $tell = "You say, \"$rest\"\n";
	    &tell($tell, $port[$me]);
	}
	else{
	    &parse_command($name, $text);
	}
    }
    else
    {
	$tell = $text;
    } 
}

sub tstring{
    local($time)=@_;
    local($sec, $min, $hour, $day, @rest, $diff, $ret);

    $diff = time-$time;
    ($sec, $min, $hour, $day, @rest)= gmtime($diff);
    $day -=1;
    if($day){
	$ret = $day.'d '.$hour.':'.$min;
    }
    elsif($hour){
	$ret = $hour.':'.$min;
    }
    elsif($min){
	$ret = $min.'m '.$sec.'s';
    }
    else{
	$ret = $sec.'s';
    }
    return $ret;
}

sub parse_command{
    local($name, $command) = @_;

    if($command eq 'who'){
	&tell("Name\t\t\tLogin time\tIdle\tWhere\n", $port[$me]);
	$i=1;
	for $w (1..$#name){
	    if($who=$name[$w]){
	    $hname = $hostname[fileno($fha[$i])];
	    $ltime = &tstring($logintime[$id{$who}]);
	    $itime = &tstring($lasttime[$id{$who}]);
	    if(($l=length($who))<10){$who .= ' 'x(10-$l);}
	    &tell("$who\t\t$ltime\t\t$itime\t$hname\n", $port[$me]);
	    $i++;
	}
	}
    }
    elsif($command eq 'ids'){
	&tell("Id numbers of stuff\n", $port[$me]);
	for $idn (0..$maxid-1){
	    &tell("#$idn:\t$dname[$idn]\n", $port[$me]);
	}
    }
    elsif($command eq 'hello'){
	&tell("You are now connected.\n", $port[$me]);
    }
    elsif($command eq 'QUIT'){
	close($fha[$f]);
	splice(@fha, $f,1);
	$fhs = join(' ', @fha);
	$fhs .=' ';
	print("Connection port $f dead.  Removing name and fh entry.\n") if $debug;
	$name = splice(@name, $f, 1);
#	$contents[$here] =~ s/$id{$name}//;
	&tell("$name has disconnected\n", &others_in_room($here));
    }
    elsif($command eq 'bluh'){
    }
    elsif($command =~ /(^l\b|^look)/){
	if(($ind = index($command, ' ')) ==-1){
	    print("In $here.  $dname[$here], $description[$here]\n");
	    &tell("$dname[$here]\n", $port[$me]);
	    if($description[$here]){
		&tell("$description[$here]\n", $port[$me]);
	    }
	    &tell("Contents:\n", $port[$me]);
	    &tell(&list_contents($here), $port[$me]);
	}
	else{
	$opts = substr($command, $ind+1);
	&tell(&get_descrip($opts), $port[$me]);
    }
    }
    elsif($command eq 'save'){
	&save_db();
    }
    elsif($command =~ /^boot /){

	if($flags[$me] =~ /W/){
	    $who = substr($command, 5);
	    foreach $hand (0..$#fha){
		print("Comparing ($who) to ($name[$hand])\n");
		if($who eq $name[$hand]){
		    &tell("You are being booted.\n", $fha[$hand]);
		    &disconnect($hand);
		}
	    }
	}
	else{
	    &tell("You can't do that.\n", $port[$me]);
	}
    }
    elsif($command eq 'help'){
	&tell("None available yet\n", $port[$me]);
    }
    else{
	if(!&exit_somewhere($command)){
	    &tell("Huh?\n", $port[$me]);
	}
    }
    
}
sub exit_somewhere {
    local($exit) = @_;


    return(0);
}



sub get_descrip{
    local($string) = @_;
    @others = split('', $contents[$room]);
    $match = 0;
    for $n (1..$#others){
	print("Checking $string against $dname[$others[$n]]\n");
	if($dname[$others[$n]] =~ /$string/i){
	    $ret = $description[$others[$n]];
	    $match = 1;
	}
    }
    if(!$match){$ret='You don\'t see that here.';}
    elsif(!$ret){$ret='You see nothing remarkable.';}
    $ret."\n";

}

sub load_db{
    open(DB, "perlmud-db");
    while(<DB>){
	if(substr($_,0,1) eq '#'){
	    &retrieve_object(int(substr($_,1)));
	}
    }
    close(DB);
}

sub retrieve_object {
    local($id) = @_;

    &send($id, 'set', 'dname', (substr((<DB>),1)));
    print("Retrieved object {$dname}($id)\n");
    &send($id, 'set', 'description', (substr((<DB>),1)));
    &send($id, 'set', 'lock', (substr((<DB>),1)));
    &send($id, 'set', 'flags', (substr((<DB>),1)));
    &send($id, 'set', 'exits', (substr((<DB>),1)));
    &send($id, 'set', 'owner', (substr((<DB>),1)));
    &send($id, 'set', 'fail', (substr((<DB>),1)));
    &send($id, 'set', 'ofail', (substr((<DB>),1)));
    &send($id, 'set', 'succ', (substr((<DB>),1)));
    &send($id, 'set', 'osucc', (substr((<DB>),1)));
    &send($id, 'set', 'drop', (substr((<DB>),1)));
    &send($id, 'set', 'odrop', (substr((<DB>),1)));
    &send($id, 'set', 'contents', (substr((<DB>),1)));
    &send($id, 'set', 'location', (substr((<DB>),1)));
}


sub save_db{

    if($flags[$me] =~ /W/){
	open(DB, ">>perlmud-db");
	select(DB);
	for $idnum (0..$maxid-1){
	    print("#$idnum\n");
	    print(";$dname[$idnum]\n");
	    print(";$description[$idnum]\n");
	    print(";$lock[$idnum]\n");
	    print(";$flags[$idnum]\n");
	    print(";$exits[$idnum]\n"); 
	    print(";$owner[$idnum]\n");
	    print(";$fail[$idnum]\n");
	    print(";$ofail[$idnum]\n");
	    print(";$succ[$idnum]\n");
	    print(";$osucc[$idnum]\n");
	    print(";$drop[$idnum]\n");
	    print(";$odrop[$idnum]\n");
	    print(";$contents[$idnum]\n");
	    print(";$location[$idnum]\n");
	    print("\n");
	}	
	select(stdout);
	close(DB);
	&tell("Done\n", $port[$me]);
    }
    else{
	&tell("You can't do that\n", $port[$me]);
    }
}
    
sub list_contents{
    ($room) = @_;
    local(@ret);
    @others = split('', $contents[$room]);
    print("Contentlist: $contents[$room]\n");

    for $n (1..$#others){
	    push(@ret, $dname[$others[$n]]);
	}
    $ret = join("\n", @ret)."\n";
    return $ret;
}

sub parse_connect {
    local($text) = @_;

    print("Checking connect string [$text]\n");
    ($command, $name, $pword) = split(' ', $text);
    if($command eq 'connect'){
	if(($p=$lock[$id{$name}]) && (!grep(/$name/,@name))){
	    if($p eq $pword){
		print("Connecting player $name($id{$name})\n");
# Not anymore	$contents[$location[$id{$name}]] .= "$id{$name}";
		$port[$id{$name}]=$fha[$f];
		$logintime[$id{$name}]=time;
		$lasttime[$id{$name}]=time;
		$me=$id{$name};
		&tell("$name has connected.\n", &others_in_room($location[$me]));
		return '$name[$f]="$name";$output="hello";';
	    }
	}
	else{
	    &tell("I can't find that charachter with that password\n", $fha[$f]);
	    if(grep(/$name/,@name)){&tell("Already connected\n", $fha[$f]);}
	}
    }
    elsif($command eq 'create'){
	if(!$lock[$id{$name}] || !defined($id{$name})){
	    $id{$name}=($maxid++);
	    print("Connecting and creating player $name($id{$name})\n");
	    $dname[$id{$name}]= $name;
	    $contents[1] .= "$id{$name}";
	    $port[$id{$name}]=$fha[$f];
	    &create_player($id{$name});
	    $output = "hello";
	    $logintime[$id{$name}]=time;
	    $lasttime[$id{$name}]=time;
	    $lock[$id{$name}]=$pword;
	    $me=$id{$name};
	    &tell("$name has connected.\n", &others_in_room($location[$me]));
	    return '$lock[$id{$name}]=$pword;$name[$f]="$name";';
	    }
	else{
	    &tell("That name already exists, try again\n", $fha[$f]);
	    return '$output = "";';
	}
    }
    else{
	&tell("Please connect to an existing charachter or create a new one\nconnect name password\ncreate name password\n", $fha[$f]);
	return '$output = "hello";';
    }
}

sub create_player {
    local($id) = @_;
    $description[$id] ='';
    $lock[$id]=$pword;
    $flags[$id]='';
    $exits[$id]="~home1$id";
    $owner[$id]=0;
    $fail[$id]='You can\'t pick up a person';
    $ofail[$id]='acts silly';
    $succ[$id]='Home sweet home...\n';
    $osucc[$id]='goes home.';
    $drop[$id]='';
    $odrop[$id]='';
    $location[$id]=1;
}

sub others_in_room {
    ($room) = @_;
    local(@ret);
    @others = split('', $contents[$room]);
    for $n (1..$#others){
	if(defined($port[$others[$n]]) && $others[$n] ne $me){
	    push(@ret, $port[$others[$n]]);
	}
    }
    return(@ret);

}


sub tell {
	local($message, @handles)=@_;
	for $h (@handles) {
	    select($h); $|=1;
	    print($message);
	    select(stdout);
	}
}

sub myselect{

    chop($fhs);
    $rin = &fhbits($fhs);
    #Get bitmask

    $fhs .= ' ';
    $ein = $rin;
    $nfound = select($rin, undef, undef, 1);
    #Do select


    if(vec($rin, fileno(S), 1)){
	&new_connection();
    }


}

sub disconnect {
    local($f) = @_;
    
	close($fha[$f]);
	splice(@fha, $f,1);
	$fhs = join(' ', @fha);
	$fhs .=' ';
	print("Connection port $f dead.  Removing name and fh entry.\n") if $debug;
	$name = splice(@name, $f, 1);
#	$contents[$here] =~ s/$id{$name}//;
	&tell("$name has disconnected\n", &others_in_room($here));
}

sub initialize{
($port) = @ARGV;
$port = 2345 unless $port;

$AF_INET = 2;
$SOCK_STREAM = 1;

$sockaddr = 'S n a4 x8';
($name, $aliases, $proto) = getprotobyname('tcp');
if ($port !~ /^\d+$/) {
    ($name, $aliases, $port) = getservbyport($port, 'tcp');
}

print "Port = $port\n";
$this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");

select(NS); $| = 1; select(stdout);

socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
bind(S,$this) || die "bind: $!";
listen(S,5) || die "connect: $!";
select(S); $| = 1; select(stdout);

$fn = fileno(S);
print("Base socket fileno: $fn\n");
$con = 0;
$fh = 'AA';
$fhs = 'S ';
$bitn=1;
$fha[0]='S';
$debug = 0;
$maxid = 0;
}



__END__