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

#
#  Initialize everything and create a socket
#
($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");




#
#  Setup some variables
#
$con = 0;
$fh = 'AA';
$fhs = 'S ';
$bitn=1;
$fha[0]='S';
$debug = 0;
$maxid = 0;


#
#  Bootstrap in case there is no db
#
# Wizard
$idn = ($maxid++);
$dname[$idn]='Wizard';
$description[$idn]='You are filled with awe';
$lock[$idn]='barfoo';
$flags[$idn]='W';
$exits[$idn]="~home1$idn";
$owner[$idn]=0;
$fail[$idn]='You can\'t pick up a person';
$ofail[$idn]='acts silly';
$succ[$idn]='Home sweet home...\n';
$osucc[$idn]='goes home.';
$drop[$idn]='';
$odrop[$idn]='';
$contents[$idn]='';
$location[$idn]=1;

# First room
$here=($maxid++);
$dname[$here]='Room';
$description[$here]='This is a plain room.';
$lock[$here]='';
$flags[$here]='J';
$exits[$here]="~out;exit$here2";
$owner[$here]=0;
$fail[$here]='';
$ofail[$here]='';
$succ[$here]='';
$osucc[$here]='';
$drop[$here]='';
$odrop[$here]='';
$contents[$here]='';
$location[$here]=$here;

# The exit
$ex = ($maxid++);
$dname[$ex]='Simple Exit';
$description[$ex]='This is your basic exit.  It comes back here.';
$lock[$ex]='';
$flags[$ex]='';
$exits[$ex]='';
$owner[$ex]=0;
$fail[$ex]='The exit is locked.';
$ofail[$ex]='wanders around.';
$succ[$ex]='You go through the exit';
$osucc[$ex]='steps out.';
$drop[$ex]='';
$odrop[$ex]='steps in.';
$contents[$ex]='';
$location[$ex]=$here;


#
#  Hopefully, there will be a database
#
print("Loading Database...\n");
&load_db();
print("...done\n");


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


eval `cat /afs/sipb/user/mkgray/bin/perlmudi.subs`;

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

    $fhs .= ' ';
    $ein = $rin;


    $nfound = select($rin, undef, undef, 1);    # Anyone saying anything?


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

    while($nfound){
	&deal_with_pending_ports;
	&regular_command;
    }
}




#
#  Manage connections and annoying stuff like that
#
sub deal_with_pending_ports {
    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();
}


#
#  Duh, do nothing right now
#
sub regular_command{
}


#
#  Handy Dandy and stolen from the man page
#
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;
}


#
#  Cope with new connections
#
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);
}



#
#  Save the database
#
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]);
    }
}



#
# Deal with 'connect' and 'create'
#
sub parse_connect {
    local($text) = @_;

    print("Checking connect string [$text]\n");
    ($command, $name, $pword) = split(' ', $text);
    if($command eq 'connect'){
	next if(!defined($id{$name}));
	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";';
    }
}



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


#
#  Parse my database format
#
sub retrieve_object {
    local($id) = @_;
    $maxid = $id > $maxid ? $id:$maxid;
    chop($dname[$id]=substr((<DB>),1));
    print("Retrieved object {$dname[$id]}($id)\n");
    chop($description[$id]=substr((<DB>),1));
    chop($lock[$id]=substr((<DB>),1));
    chop($flags[$id]=substr((<DB>),1));
    chop($exits[$id]=substr((<DB>),1));
    chop($owner[$id]=substr((<DB>),1));
    chop($fail[$id]=substr((<DB>),1));
    chop($ofail[$id]=substr((<DB>),1));
    chop($succ[$id]=substr((<DB>),1));
    chop($osucc[$id]=substr((<DB>),1));
    chop($drop[$id]=substr((<DB>),1));
    chop($odrop[$id]=substr((<DB>),1));
    chop($contents[$id]=substr((<DB>),1));
    chop($location[$id]=substr((<DB>),1));
}

#
#  Create a new player
#
sub create_player {
    local($id) = @_;
    $description[$id] ='';
    $lock[$id]=$pword;
    $flags[$id]='P';
    $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;
}


#
# Create a room
#
sub create_room {
    local($name, $id) = @_;
    $dname[$id]=$name;
    $description[$id] ='';
    $lock[$id]='';
    $flags[$id]='R';
    $exits[$id]='';
    $owner[$id]=$me;
    $fail[$id]='';
    $ofail[$id]='';
    $succ[$id]='';
    $osucc[$id]='looks around.';
    $drop[$id]='';
    $odrop[$id]='';
    $location[$id]=$id;
}

#
#  Create an exit
#
sub create_exit {
    local($name, $whereto, $id) = @_;
    $dname[$id]=$name;
    $description[$id] ='';
    $lock[$id]='';
    $flags[$id]='E';
    $exits[$id]='';
    $owner[$id]=$me;
    $fail[$id]='';
    $ofail[$id]='';
    $succ[$id]='';
    $osucc[$id]='';
    $drop[$id]='';
    $odrop[$id]='';
    $location[$id]=$here;


    $exits[$here] .= "~$name$whereto$id";
}


#
#  Who else is in the room
#
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);
}


#
#  Say something to a user given by their FH
#
sub tell {
	local($message, @handles)=@_;
	for $h (@handles) {
	    select($h); $|=1;
	    print($message);
	    select(stdout);
	}
}

#
#  I don't remember what this is for really
#
sub myselect{
    chop($fhs);
    $rin = &fhbits($fhs);
    $orin = $rin;
    #Get bitmask

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


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


#
#  Kill dying connections
#
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)) if $name;
}


__END__