User Tools

Site Tools


crossfire:bot:seer

BOT Seer

The BOT Seer found on the metalforge .net server is working.
As a player, I use him occasionally.

This is what the client cmdline tell Seer help responds :

Seer tells you: 
I'm a bot, and I'm writing kill logs for all players and monsters.

You can ask me about:
 last <player>  to see when the player was here
 last           to see the last 10 logins/logouts

Seer tells you: 
 uptime         for the time the server's up (at least)
 tell <player> <something> to let me tell the player something when I see him
 maps           to see the most popular maps

Seer tells you: 
 kills <name>   to see what a player or monster has killed and how
 numkills <name>   to see how many times someone killed
 how killed <name> to see how someone prefers to kill

Seer tells you: 
 deaths <name>  to see who killed a player or monster and how
 numdeaths <name>  to see how many times someone died
 how died <name>   to see how someone prefers to die

Seer tells you: 
 what killed <name> to see what attack caused someone to die
 did <name> kill <name> to see if/how somebody killed somebody

 find <name>       to see all matching monsters or players

Seer tells you: 
Besides this, I'm afraid I'm not very intelligent. :)

Some years ago (Modification time tells me February 2013), I found a Perl script on the net, that contains the above lines.

This is Google's cache of http://www.suckfuell.net/jochen/cfbot/cfbot.
It is a snapshot of the page as it appeared on Feb 16, 2013 04:44:39
GMT. The current page <http://www.suckfuell.net/jochen/cfbot/cfbot>
could have changed in the meantime. Learn more
<http://support.google.com/websearch/bin/answer.py?hl=en&p=cached&answer=1687222>
Tip: To quickly find your search term on this page, press *Ctrl+F* or
*⌘-F* (Mac) and use the find bar.

Text-only version
<http://webcache.googleusercontent.com/search?q=cache:KLwoFyJLg7UJ:www.suckfuell.net/jochen/cfbot/cfbot+cfbot+crossfire&hl=en&gl=us&strip=1>
These search terms are highlighted: cfbot crossfire  

It is a GNU General Public License file by Copyright (C) 2003 Jochen Suckfuell <*crossfire* WHAT suckfuell.net> .

#!/usr/bin/perl -w
 
#
# -------------------------------------------------------------------------
#
#    Copyright (C) 2003 Jochen Suckfuell <*crossfire* WHAT suckfuell.net>
#
#    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.
#
# -----------------------------------------------------------------------
#
# TODO
#
#  - fix inventory logging
#  - check if event_wait and event_listen loops work
#
#
# Changelog:
# 
# 2005-05-28 0.9.9
#  - added the setup flag "bot 1" to tell the server that this is a bot
#
# 2004-03-11 0.9.8
#  - new commands: add_admin, rem_admin, admins
#  - added the admin commands to the help output
#  - removed the "host" command, since 'who doesn't show the IP any more
#  - fixed parsing changed 'who output format
#  - save the is_admin flag with the players
#  - allow several admin users
#  - implement numdeaths, numkills
#  - 'forget <script>' and 'stop <script>' commands implemented
#  - implemented storing more stats
#  - added events_stats callbacks
#  - we now log the players that enter a map whose name matches a pattern in
#    the predefined array @check_maps
# 
# 2003-02-13 Release 0.9.7
# 
#  - 'last <player>' now also shows the host name
#  - implemented the 'host <player>' command which tells the player's hostname
#  - Don't answer to "hi" if not addressed directly.
# 
# 2003-02-04 Release 0.9.6
#
#  - implemented script command "when hearing <whatever>"
#
#  
# 2003-02-03 Release 0.9.5
# 
#  - implemented simple scripting commands, conditions are still missing
#  - slowed down the decay of map scores
#  - output integer values for map scores
#  - use the 'ncom' protocol command instead of 'command'
#  - only reply to "hello|hi" to players that talked to me before
# 

I am not capable in the perl scripting language, and can not say anything about this script. 1900 lines :

#!/usr/bin/perl -w
 
#
# -------------------------------------------------------------------------
#
#    Copyright (C) 2003 Jochen Suckfuell <*crossfire*@suckfuell.net>
#
#    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.
#
# -----------------------------------------------------------------------
#
# TODO
#
#  - fix inventory logging
#  - check if event_wait and event_listen loops work
#
#
# Changelog:
# 
# 2005-05-28 0.9.9
#  - added the setup flag "bot 1" to tell the server that this is a bot
#
# 2004-03-11 0.9.8
#  - new commands: add_admin, rem_admin, admins
#  - added the admin commands to the help output
#  - removed the "host" command, since 'who doesn't show the IP any more
#  - fixed parsing changed 'who output format
#  - save the is_admin flag with the players
#  - allow several admin users
#  - implement numdeaths, numkills
#  - 'forget <script>' and 'stop <script>' commands implemented
#  - implemented storing more stats
#  - added events_stats callbacks
#  - we now log the players that enter a map whose name matches a pattern in
#    the predefined array @check_maps
# 
# 2003-02-13 Release 0.9.7
# 
#  - 'last <player>' now also shows the host name
#  - implemented the 'host <player>' command which tells the player's hostname
#  - Don't answer to "hi" if not addressed directly.
# 
# 2003-02-04 Release 0.9.6
#
#  - implemented script command "when hearing <whatever>"
#
#  
# 2003-02-03 Release 0.9.5
# 
#  - implemented simple scripting commands, conditions are still missing
#  - slowed down the decay of map scores
#  - output integer values for map scores
#  - use the 'ncom' protocol command instead of 'command'
#  - only reply to "hello|hi" to players that talked to me before
# 
# 
#
# 
#
#
#
 
# ======================  configuration section  ========================
 
use vars qw/$remote_host $player_name $player_password $retry_interval $admin $leave_cmd %players %kills %maps $socket $recvbuf $quit $upsince $getting_who_answer $last_maps_decay_time $version $pkg_sent $pkg_ackd @cmds_waiting $learning %scripts @events_wait @events_listen @events_stats %script_stack %stats %inv %checked_map @check_map/;
 
$remote_host = "127.0.0.1";
$player_name = "*cfbot*";
$player_password = "SeCrEt";
$retry_interval = 30; # time in seconds
$admin = " ";
$leave_cmd = "go home";
 
# We keep a player log for these maps:
@check_map = ( "^/guilds/" );
 
# ===================  no configuration below  ==========================
 
$version = "0.9.6";
 
use POSIX;
use IO::Socket;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
 
 
$events_stats{'maxhp'} = [];
$events_stats{'maxsp'} = [];
$events_stats{'maxgrace'} = [];
$events_stats{'lowfood'} = [];
 
load();
 
$socket = '';
init_connection();
 
$recvbuf = '';
$quit = 0;
my $save_minutes = 10; # This will be counted down and reset to 10, below.
 
my $last_time = time;
$getting_who_answer = 0;
$last_maps_decay_time = time;
 
$SIG{INT} = sub { $quit = 1; print STDERR "SIGINT\n"; };
 
# main event loop
while(! $quit)
{
	my $r_in = '';
	vec($r_in, $socket->fileno, 1) = 1;
 
	my $rv = select($r_in, undef, undef, 1);
	if(!defined($rv) || $rv < 0)
	{
		unless($! == EINTR) { die "select failed: $!"; }
		last;
	}
 
	if($rv && vec($r_in, $socket->fileno, 1) == 1)
	{
		my $rv = $socket->recv($buf, POSIX::BUFSIZ, 0);
		unless (defined($rv))
		{
			print STDERR "recv failed: $!\n";
			init_connection();
			$recvbuf = '';
			next;
		}
 
		if(length($buf) == 0)
		{
			print STDERR "Connection closed.\n";
			init_connection();
			$recvbuf = '';
			next;
		}
		$recvbuf .= $buf;
		while(length($recvbuf) >= 2)
		{
			my $len = unpack("n", $recvbuf);
			#print "DEBUG len $len , recvbuf length is ".length($recvbuf)."\n";
 
			if(length($recvbuf) < 2 + $len) { last; }
 
			#print unpack("H*", $recvbuf)."\n";
			my $data = substr($recvbuf, 2, $len);
			handle($data);
			$recvbuf = substr($recvbuf, $len + 2);
		} # len info
	} # $socket is readable
 
	my $now = time;
	next if $last_time == $now;
 
	if($now - $last_time > 60)
	{
		# This is processed once per minute.
 
		$last_time = $now;
 
		$save_minutes--;
		if($save_minutes == 0)
		{
			save();
			$save_minutes = 10;
		}
 
		if($now - $last_maps_decay_time > 24*60*60)
		{
			# once per day
 
			# We halve the map score values once per day:
			foreach my $map (keys %maps)
			{
				$maps{$map} *= 0.25;
				if($maps{$map} == 0) { delete $maps{$map}; }
			}
			$last_maps_decay_time = $now;
		}
 
		cf_send_cmd("who"); # update maps' popularity
	}
 
	for(my $i = 0; $i < scalar @events_wait; $i++)
	{
		my $event_ref = $events_wait[$i];
		if($event_ref->{"continue_at"} <= $now)
		{
			splice @events_wait, $i, 1; # remove the event from the list
			do_execute($event_ref->{"script"}, $event_ref->{"pc"});
		}
	}
 
}
 
save();
 
exit 0;
 
# ===============================================================
 
sub init_connection
{
	if($socket) { $socket->close(); }
	while(!($socket = IO::Socket::INET->new(PeerAddr => $remote_host, PeerPort => 13327, Proto => "tcp", Type => SOCK_STREAM)))
	{
		print STDERR "Couldn't connect to $remote_host:13327 : $@\n";
		print STDERR "Retrying in $retry_interval seconds.\n";
		sleep $retry_interval;
	}
 
	my $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: $!\n";
 
	$pkg_sent = 0;
	$pkg_ackd = 0;
	cf_send("version 1027 1027 Perl Bot");
	cf_send("setup map1cmd 1 map1acmd 1 sound 0 sexp 0 darkness 0 newmapcmd 0 faceset 0 facecache 1 itemcmd 1 bot 1");
	cf_send("addme");
	$upsince = time;
	print "Login at ".localtime($upsince)."\n";
}
 
sub handle
{
	my $line = shift;
	$line =~ /^(\S+)\s*(.*)$/s or die "Cannot match '$line'";
	my $cmd = $1;
	my $args = $2;
 
	if($cmd =~ /^drawinfo$/)
	{
		$args =~ /^(\S+)\s*(.*)$/s;
		my $color = $1;
		my $info = $2;
 
		if($getting_who_answer)
		{
			$getting_who_answer = parse_who($info);
 
			# Return if we got another WHO line, else process the new line as
			# normal.
			return if $getting_who_answer;
		}
 
		if($info =~ /^((?:(?! killed) ?[a-zA-Z0-9'_-]+)+) killed /)
		{
			if(defined $kills{$info})
			{
				$kills{$info}++;
			}
			else
			{
				$kills{$info} = 1;
			}
			return;
		}
 
		if($info =~/^Players:$/)
		{
			$getting_who_answer = 1;
			return;
		}
 
		if($info =~ /^(\S+) has entered the game.$/)
		{
			my $name = $1;
			$player_ref = $players{$name};
			unless(defined $player_ref)
			{
				$player_ref = { asked_me => 0, message => "", is_admin => 0 };
				$players{$name} = $player_ref;
			}
			elsif($player_ref->{"message"})
			{
				my $msg = $player_ref->{"message"};
				$msg =~ s/_-/\n/g;
				sleep 3;
				cf_send_info("tell $name", "Hi $name!$msg");
				$player_ref->{"message"} = "";
			}
 
			$player_ref->{"last_seen"} = time;
			$player_ref->{"is_here"} = 1;
 
 
			print ">$info\n";
			return;
		}
 
		if($info =~ /^(\S+) (leaves|left) the game.$/)
		{
			my $name = $1;
			$player_ref = $players{$name};
			unless(defined $player_ref)
			{
				$player_ref = { asked_me => 0, message => "" };
				$players{$name} = $player_ref;
			}
			$player_ref->{"last_seen"} = time;
			$player_ref->{"is_here"} = 0;
 
			return;
		}
 
		if($info =~ /^(\S+) tells you: (.*)\??$/)
		{
			handle_player_request($1, $2, "tell $1");
			return;
		}
 
		if($info =~ /^(\S+) shouts: $player_name[:,!]? *(.*)\??$/)
		{
			handle_player_request($1, $2, "shout");
			return;
		}
 
		if($info =~ /^(\S+) shouts: (hi\b|hello|morning)\s+$player_name!?/i)
		{
			my $pl = $1;
			return if $pl eq $player_name;
			my $pl_ref = $players{$pl};
			return unless (defined $pl_ref && $pl_ref->{"asked_me"});
			sleep 3;
			cf_send_cmd("shout $2 $1");
			return;
		}
 
		if($info =~ /^Welcome Back!$/)
		{
			cf_send_cmd("listen 15");
			cf_send_cmd("who");
			if(defined $scripts{"autorun"})
			{
				$script_stack{"autorun"} = [];
				do_execute("autorun");
			}
			return;
		}
 
		# Blue color text (in cfclient at least) is for NPC speech and other
		# messages from the map.
		if($color == 2)
		{
			for(my $i = 0; $i < scalar @events_listen; $i++)
			{
				my $event_ref = $events_listen[$i];
				if($info =~ /$event_ref->{"listen_text"}/ms)
				{
					splice @events_listen, $i, 1; # remove the event from the list
					do_execute($event_ref->{"script"}, $event_ref->{"pc"});
				}
			}
		}
 
		#print "INFO: $color $info\n";
 
		return;
	}
 
	if($cmd =~ /^query$/)
	{
		print "$args ";
		if($args =~ /What is your name/)
		{
			cf_send("reply $player_name");
			return;
		}
 
		if($args =~ /What is your password/)
		{
			cf_send("reply $player_password");
			return;
		}
 
		if($args =~ /Do you want to play again/)
		{
			cf_send("reply a");
			return;
		}
 
		my $answer = <STDIN>;
		chomp $answer;
		cf_send("reply $answer");
		return;
	}
 
	if($cmd =~ /^comc$/)
	{
		($pkg_ackd) = unpack("n", $args);
		if(scalar @cmds_waiting)
		{
			$pkg_sent++;
			if($pkg_sent == 256) { $pkg_sent = 0; }
			cf_send("ncom ".pack("n", $pkg_sent)."\0\0\0\1".(shift @cmds_waiting));
		}
 
		return;
	}
 
	if($cmd =~ /^stats$/)
	{
		while($args)
		{
			my $s;
			($s, $args) = unpack ('C a*', $args);
			last if $s > 26;
			if($s == 18) # food
			{
				($stats{'food'}, $args) = unpack('n a*', $args);
				#print "food: $stats{food}\n";
				if($stats{'food'} < 80)
				{
					foreach my $event_ref (@{$events_stats{'lowfood'}})
					{
						do_execute($event_ref->{"script"}, $event_ref->{"pc"});
					}
					$events_stats{ 'lowfood'} = [];
				}
			}
			elsif($s == 1) # HP
			{
				($stats{'hp'}, $args) = unpack('n a*', $args);
				#print "hp: $stats{hp}\n";
				if(defined $stats{'maxhp'} && $stats{'hp'} ==  $stats{'maxhp'})
				{
					@events = @{$events_stats{'maxhp'}};
					$events_stats{ 'maxhp'} = [];
					foreach my $event_ref (@events)
					{
						do_execute($event_ref->{"script"}, $event_ref->{"pc"});
					}
					$events_stats{ 'maxhp'} = [];
				}
			}
			elsif($s == 2) # max HP
			{
				($stats{'maxhp'}, $args) = unpack('n a*', $args);
				#print "maxhp: $stats{maxhp}\n";
			}
			elsif($s == 3) # SP
			{
				($stats{'sp'}, $args) = unpack('n a*', $args);
				#print "sp: $stats{sp}\n";
				if(defined $stats{'maxsp'} && $stats{'sp'} ==  $stats{'maxsp'})
				{
					@events = @{$events_stats{'maxsp'}};
					$events_stats{ 'maxsp'} = [];
					foreach my $event_ref (@events)
					{
						do_execute($event_ref->{"script"}, $event_ref->{"pc"});
					}
				}
			}
			elsif($s == 4) # max SP
			{
				($stats{'maxsp'}, $args) = unpack('n a*', $args);
				#print "maxsp: $stats{maxsp}\n";
			}
			elsif($s == 23) # grace
			{
				($stats{'grace'}, $args) = unpack('n a*', $args);
				#print "grace: $stats{grace}\n";
				if(defined $stats{'maxgrace'} && $stats{'grace'} ==  $stats{'maxgrace'})
				{
					@events = @{$events_stats{'grace'}};
					$events_stats{ 'grace'} = [];
					foreach my $event_ref (@events)
					{
						do_execute($event_ref->{"script"}, $event_ref->{"pc"});
					}
					$events_stats{ 'maxgrace'} = [];
				}
			}
			elsif($s == 24) # max SP
			{
				($stats{'maxgrace'}, $args) = unpack('n a*', $args);
				#print "maxgrace: $stats{maxgrace}\n";
			}
			elsif($s == 11) # exp
			{
				($stats{'exp'}, $args) = unpack('N a*', $args);
				#print "exp: $stats{exp}\n";
			}
			elsif($s == 12) # level
			{
				($stats{'level'}, $args) = unpack('n a*', $args);
				print "level: $stats{level}\n";
			}
			elsif($s == 13) # WC
			{
				my $wc;
				($wc, $args) = unpack('n a*', $args);
				$stats{'wc'} = ($wc > 32767 ? $wc - 65536 : $wc);
				print "wc: $stats{wc}\n";
			}
			elsif($s == 14) # AC
			{
				my $ac;
				($ac, $args) = unpack('n a*', $args);
				$stats{'ac'} = ($ac > 32767 ? $ac - 65536 : $ac);
				print "ac: $stats{ac}\n";
			}
			elsif($s == 17 || $s == 19 || $s == 26)
			{
				(undef, $args) = unpack('N a*', $args);
			}
			else
			{
				(undef, $args) = unpack('n a*', $args);
			}
		}
		return;
	}
 
	if($cmd =~ /^item1$/)
	{
		my ($location, $tag, $flags, $weight, $name, $nrof);
		%inv = ();
		($location, $args) = unpack ('N a*', $args);
		return unless $location;
		while($args)
		{
			($tag, $flags, $weight, undef, $name, undef, undef, $nrof, $args) = unpack ('N N N N C/A n C N a*', $args);
			($name, undef) = split /\0/, $name;
			$inv{$tag} = { name => $name, flags => $flags, weight => $weight, nrof => $nrof };
			#print "INV1: $nrof $name ($weight)\n";
		}
		return;
	}
 
	if($cmd =~ /^item2$/)
	{
		my ($location, $tag, $flags, $weight, $name, $nrof);
		%inv = ();
		($location, $args) = unpack ('N a*', $args);
		return unless $location;
		while($args)
		{
			($tag, $flags, $weight, undef, $name, undef, undef, $nrof, undef, $args) = unpack ('N N N N C/A n C N n a*', $args);
			$inv{$tag} = { name => $name, flags => $flags, weight => $weight, nrof => $nrof };
			#print "INV2: $nrof $name ($weight)\n";
		}
		return;
	}
 
	if($cmd =~ /^map|^face2$|^delinv$|^anim$|^player$/)
	{
		return;
	}
 
	print ">$cmd";
 
	if(
			$cmd =~ /^setup$/
		)
	{
		print " $args";
	}
	print "\n";
}
 
 
sub handle_player_request
{
	my $player = shift;
	my $request = shift;
	my $answer_command = shift;
 
	$player_ref = $players{$player};
	unless(defined $player_ref)
	{
		$player_ref = { asked_me => 0, last_seen => time, is_here => 1, message => "" };
		$players{$player} = $player_ref;
	}
 
	$player_ref->{"asked_me"}++;
 
	if($learning && $admin =~ / $player /)
	{
		# This continues a script.
		if($request eq "end $learning")
		{
			cf_send_cmd("$answer_command Ok, I learnt $learning.");
			$learning = "";
			return;
		}
 
		push @{$scripts{$learning}}, $request;
		return;
	}
 
	#cf_send_cmd("tell $admin PL_REQ $player $request");
	if($request =~ /^(hi|hello)/i)
	{
		sleep 2;
		cf_send_cmd("$answer_command $1 $player!");
		return;
	}
 
	if($request =~ /^(help|what do you do|what can you do|how can you help|who are you|yes)/i)
	{
		cf_send_info($answer_command, <<HELP);
I'm a bot, and I'm writing kill logs for all players and monsters.
 
You can ask me about:
 
 last <player>  to see when the player was here
 last           to see the last 10 logins/logouts
 uptime         for the time the server's up (at least)
 tell <player> <something> to let me tell the player something when I see him
 maps           to see the most popular maps
 
 kills <name>   to see what a player or monster has killed and how
 numkills <name>   to see how many times someone killed
 how killed <name> to see how someone prefers to kill
 
 deaths <name>  to see who killed a player or monster and how
 numdeaths <name>  to see how many times someone died
 who killed <name> to see who killed someone
 what killed <name> to see what attack caused someone to die
 
Besides this, I'm afraid I'm not very intelligent. :)
 
HELP
		if($players{$player}{is_admin} == 1)
		{
			cf_send_info($answer_command, <<ADMIN_HELP);
Special admin commands are:
 
 do <command>        sends the command to the server
 learn <scriptname>  starts recording server commands to a script
 end <scriptname>    ends learning a script [don't recurse!]
 execute <scriptname> execute a script
 running             shows all currently running scripts
 scripts             shows the names of all known scripts
 stop <scriptname>   stops a running script
 forget <scriptname> deletes a script
 
 stats               to see my character statistics
 add_admin <player>  to add a player to my admin list
 rem_admin <player>  to remove a player from my admin list
 admins              to see who is on my admin lists
 
 For my scripting abilities please check the document at:
 http://www.suckfuell.net/*cfbot*/cfbot_script.txt
 
ADMIN_HELP
		}
		return;
	}
 
	if($request =~ /^tell\s+(\S+)\s+(.*)$/)
	{
		my $other = $1;
		my $other_ref = $players{$other};
		unless(defined $other_ref)
		{
			cf_send_cmd("$answer_command Sorry, I don't know $other yet.");
			return;
		}
		my $msg = "\n$player wants me to tell you:\n\"$2\"";
 
		if($other_ref->{"is_here"})
		{
			cf_send_info("command tell $other", $msg);
			sleep 2;
			cf_send_cmd("$answer_command I told him what you said.");
			return;
		}
 
		$msg =~ s#\n#_-#g;
		$other_ref->{"message"} .= $msg;
		sleep 2;
		cf_send_cmd("$answer_command I will tell him when I see him.");
		return;
	}
 
	if($request =~ /^last\s+(\S+)$/)
	{
		my $other = $1;
 
		unless(defined $players{$other})
		{
			cf_send_cmd("$answer_command I haven't seen $other.");
			return;
		}
 
		sleep 2;
		cf_send_cmd("$answer_command $other was here at ".gmtime($players{$other}{"last_seen"})." GMT");
		return;
	}
 
	if($request =~ /^last$/i)
	{
		my @last_seen = sort { $players{$b}{last_seen} <=> $players{$a}{last_seen} } keys %players;
		my $i = 0;
		my $out = "";
		foreach my $pl (@last_seen)
		{
			next if $players{$pl}{"is_here"};
			$out .= "\n$pl was here at ".gmtime($players{$pl}{"last_seen"})." GMT.";
			$i++;
			last if $i == 10;
		}
		cf_send_info($answer_command, $out);
		return;
	}
 
	if($request =~ /uptime/i)
	{
		sleep 2;
		cf_send_cmd("$answer_command The server has been up at least since ".gmtime($upsince)." (GMT).");
		return;
	}
 
	if($request =~ /^kills\s+(.*)$/)
	{
		my $name = $1;
		chomp $name;
		my $info = "";
		my $total = 0;
		foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills)
		{
			if($kill =~ /^$name killed /i)
			{
				$info .= $kills{$kill}." times ".$kill."\n";
				$total += $kills{$kill};
			}
		}
 
		if(!$info)
		{
			cf_send_cmd("$answer_command $name hasn't killed anything yet.");
			return;
		}
 
		$info .= "\nThat's a total of $total kills.";
 
 
		cf_send_info($answer_command, "\n$info");
		return;
	} 
 
	if($request =~ /^numkills\s+(.*)$/)
	{
		my $name = $1;
		chomp $name;
		my $total = 0;
		foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills)
		{
			if($kill =~ /^$name killed /i)
			{
				$total += $kills{$kill};
			}
		}
 
		cf_send_cmd("$answer_command $name has killed $total times.");
		return;
	} 
 
	if($request =~ /^numdeaths\s+([^?]*)$/i)
	{
		my $name = $1;
		chomp $name;
		my $total = 0;
		foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills)
		{
			if($kill =~ / killed $name(\.| with )/i)
			{
				$total += $kills{$kill};
			}
		}
 
		cf_send_cmd("$answer_command $name died $total times.");
		return;
	} 
 
	if($request =~ /^(?:deaths|who killed)\s+([^?]*)$/i)
	{
		my $name = $1;
		chomp $name;
		my $info = "";
		my $total = 0;
		foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills)
		{
			if($kill =~ / killed $name(\.| with )/i)
			{
				$info .= "\n".$kills{$kill}." times ".$kill;
				$total += $kills{$kill};
			}
		}
 
		if(!$info)
		{
			cf_send_cmd("$answer_command $name hasn't been killed yet.");
			return;
		}
 
		$info .= "\nThat's a total of $total.";
 
		cf_send_info($answer_command, $info);
		return;
	} 
 
	if($request =~ /find\s+(.*)$/i)
	{
		my $who = $1;
		if(length($who) < 3)
		{
			cf_send_cmd("$answer_command The query must be at least two characters long.");
			return;
		}
 
		my %matches = ();
		my $info = "";
		foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills)
		{
			unless($kill =~ /^(\S+(?:(?! killed ) \S*)*) killed ([^\s\.]+(?:\s(?!with )[^\s\.]*)*)/)
			{
				#print STDERR "find regexp failed, '$kill' => '$1' killed '$2'\n";
				next;
			}
 
			my $name1 = $1;
			my $name2 = $2;
			next if defined $matches{$name1};
			next if defined $matches{$name2};
			#print STDERR "match: '$name1' '$name2'\n";
			if($name1 =~ /$who/i)
			{
				$matches{$name1} = 1;
				$info .= "\n$name1";
			}
			if($name2 =~ /$who/i)
			{
				$matches{$name2} = 1;
				$info .= "\n$name2";
			}
		}
 
		if(!$info)
		{
			cf_send_cmd("$answer_command I haven't found a match for '$who'.");
			return;
		}
 
		$info = "Matching '$who' I found:".$info;
 
		cf_send_info($answer_command, $info);
		return;
	}
 
	if($request =~ /did\s+((?! kill ).+) kill ([^?]+)$/i)
	{
		my $name = $1;
		my $killed = $2;
 
		my $info = "";
		foreach my $kill (sort { $kills{$b} <=> $kills{$a} } keys %kills)
		{
			if($kill =~ /$name killed $killed(\.| with )/i)
			{
				$info .= "\n".$kills{$kill}." times ".$kill;
			}
		}
 
		if(!$info)
		{
			cf_send_cmd("$answer_command $name hasn't killed $killed yet.");
			return;
		}
 
		cf_send_info($answer_command, $info);
		return;
	}
 
	if($request =~ /^how killed\s+([^?]*)$/i)
	{
		my $name = $1;
		chomp $name;
		my %count;
		foreach my $kill (keys %kills)
		{
			if($kill =~ /^($name) killed (?:(?!with )[^.])*([^.]*)\.$/i)
			{
				my $type = $2;
				if(! $type) { $type = "with melee"; }
				if(defined $count{$type})
				{
					$count{$type} += $kills{$kill};
				}
				else
				{
					$count{$type} = $kills{$kill};
				}
			}
		}
 
		if(scalar keys %count == 0)
		{
			cf_send_cmd("$answer_command $name hasn't killed yet.");
			return;
		}
 
		my $info = "$1 killed";
		foreach my $c (sort { $count{$a} <=> $count{$b} } keys %count)
		{
			$info .= "\n".$count{$c}." times ".$c;
		}
 
		cf_send_info($answer_command, $info);
		return;
	} 
 
	if($request =~ /^how died\s+([^?]*)$/i)
	{
		my $name = $1;
		chomp $name;
		my %count;
		foreach my $kill (keys %kills)
		{
			if($kill =~ / killed $name(?: with ([^.]+))?\.$/)
			{
				my $type = $1;
				if(! $type) { $type = "melee"; }
 
				if(defined $count{$type})
				{
					$count{$type} += $kills{$kill};
				}
				else
				{
					$count{$type} = $kills{$kill};
				}
			}
		}
 
		if(scalar keys %count == 0)
		{
			cf_send_cmd("$answer_command $name didn't die yet.");
			return;
		}
 
		my $info = "$name died";
		foreach my $c (sort { $count{$a} <=> $count{$b} } keys %count)
		{
			$info .= "\n".$count{$c}." times by $c";
		}
 
		cf_send_info($answer_command, $info);
		return;
	} 
 
	if($request =~ /^what killed\s+([^?]*)$/i)
	{
		my $name = $1;
		chomp $name;
		my %count;
		foreach my $kill (keys %kills)
		{
			if($kill =~ /killed $name\s*(with[^.]*)?\.$/i)
			{
				my $type = $1;
				if(! $type) { $type = "with melee"; }
				if(defined $count{$type})
				{
					$count{$type} += $kills{$kill};
				}
				else
				{
					$count{$type} = $kills{$kill};
				}
			}
		}
 
		if(scalar keys %count == 0)
		{
			cf_send_cmd("$answer_command $name hasn't been killed yet.");
			return;
		}
 
		my $info = "$name was killed";
		foreach my $c (sort { $count{$a} <=> $count{$b} } keys %count)
		{
			$info .= "\n".$count{$c}." times ".$c;
		}
 
		cf_send_info($answer_command, $info);
		return;
	} 
 
	if($request =~ /^$leave_cmd!?$/)
	{
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command Hey, you're not allowed to send me home!");
			admin_msg("$player tried to send me home.\n");
			return;
		}
 
		cf_send_cmd("$answer_command bye");
		$quit = 1;
		return;
	}
 
	if($request =~ /thanks|thank you|thx/i)
	{
		sleep 2;
		cf_send_cmd("$answer_command Any time.");
		return;
	}
 
	if($request =~ /^maps$/i)
	{
		sleep 2;
		my $show = 0;
 
		my $info = "The most popular maps are:";
 
		foreach my $map (sort { $maps{$b} <=> $maps{$a} } keys %maps)
		{
			#print "MAPS $maps{$map} $map\n";
			last if $maps{$map} < 5;
			$info .= "\n".int($maps{$map})." $map";
			$show++;
			last if $show == 30;
		}
 
		cf_send_info($answer_command, $info);
		return;
	}
 
	if($request =~ /^learn\s+(.*)$/)
	{
		$learning = $1;
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command You're not my teacher!");
			admin_msg("$player wanted me to learn '$learning'.");
			$learning = "";
			return;
		}
 
		if(defined $scripts{$learning})
		{
			cf_send_cmd("$answer_command I know this already.");
			$learning = "";
			return;
		}
 
		$scripts{$learning} = [];
		cf_send_cmd("$answer_command How do I do this?");
 
		return;
	}
 
	if($request =~ /^forget\s+(.*)$/)
	{
		my $forget = $1;
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command You're not my teacher!");
			admin_msg("$player wanted me to forget '$forget'.");
			return;
		}
 
		unless(defined $scripts{$forget})
		{
			cf_send_cmd("$answer_command I don't know this anyway.");
			return;
		}
 
		delete $scripts{$forget};
		cf_send_cmd("$answer_command Funny, I forgot how $forget goes.");
 
		return;
	}
 
	if($request =~ /^do\s+(.*)$/)
	{
		my $command = $1;
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command You're not allowed to request this!");
			admin_msg("$player wanted me to do '$command'.");
			return;
		}
 
		cf_send_cmd("$answer_command Ok, I'll do $command.");
		do_command($command);
 
		return;
	}
 
	if($request =~ /^execute\s+(.*)$/)
	{
		my $execute = $1;
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command You're not allowed to request this!");
			admin_msg("$player wanted me to execute '$execute'.");
			return;
		}
 
		if(!defined $scripts{$execute})
		{
			cf_send_cmd("$answer_command I don't know how to do this.");
			return;
		}
 
		if(defined $script_stack{$execute})
		{
			cf_send_cmd("$answer_command $execute is already running.");
			return;
		}
 
		$script_stack{$execute} = [];
 
		cf_send_cmd("$answer_command Ok, I'll execute $execute.");
		do_execute($execute);
 
		return;
	}
 
	if($request =~ /^stop\s+(.*)$/)
	{
		my $stop = $1;
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command You're not allowed to request this!");
			admin_msg("$player wanted me to stop '$stop'.");
			return;
		}
 
		unless(defined $script_stack{$stop})
		{
			cf_send_cmd("$answer_command $stop isn't running at all.");
			return;
		}
 
		stop_script($stop);
 
		cf_send_cmd("$answer_command I stopped $stop.");
		return;
	}
 
	if($request =~ /^running$/)
	{
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command You're not allowed to request this!");
			return;
		}
 
		my $info = "Running scripts are:";
		foreach my $script (keys %script_stack)
		{
			$info .= "\n$script";
		}
		cf_send_info($answer_command, $info);
		return;
	}
 
	if($request =~ /^scripts$/)
	{
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command You're not allowed to request this!");
			return;
		}
 
		my $info = "Known scripts are:";
		foreach my $script (keys %scripts)
		{
			$info .= "\n$script";
		}
		cf_send_info($answer_command, $info);
		return;
	}
 
	if($request =~ /^inv/)
	{
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command You're not allowed to request this!");
			admin_msg("$player wanted to see my inventory.");
			return;
		}
 
		my $info = "My inventory is:";
		foreach my $item (keys %inv)
		{
			$info .= "\n$inv{$item}{nrof}: $inv{$item}{name} ($inv{$item}{weight}g)";
		}
 
		cf_send_info($answer_command, $info);
		return;
	}
 
	if($request =~ /^checked maps$/)
	{
		#if($admin !~ / $player /)
		#{
		#		cf_send_cmd("$answer_command You're not allowed to request this!");
		#		admin_msg("$player wanted to see the checked maps.");
		#		return;
		#}
 
		my $info = "Checked maps are:";
		foreach my $map (keys %checked_map)
		{
			$info .= "\n$map:";
			foreach my $pl (keys %{$checked_map{$map}})
			{
				$info .= "\n$pl $checked_map{$map}{$pl}";
			}
		}
 
		cf_send_info($answer_command, $info);
		return;
	}
 
	if($request =~ /^stats$/)
	{
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command You're not allowed to request this!");
			admin_msg("$player wanted to see my stats.");
			return;
		}
 
		my $info = "My stats are:";
		foreach my $stat (keys %stats)
		{
			$info .= "\n$stat: $stats{$stat}";
		}
 
		cf_send_info($answer_command, $info);
		return;
	}
 
	if($request =~ /^add_admin\s+(\S+)$/)
	{
		my $newadm = $1;
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command Hey, you're not allowed to add admins!");
			admin_msg("$player tried to add $1 to the admin list.\n");
			return;
		}
 
		my $newadm_ref = $players{$newadm};
		unless(defined $newadm_ref)
		{
			cf_send_cmd("$answer_command Sorry, I don't know $newadm yet.");
			return;
		}
 
		if($newadm_ref->{"is_admin"} == 1)
		{
			cf_send_cmd("$answer_command $newadm is already admin.");
			return;
		}
 
		$admin .= "$newadm ";
		$newadm_ref->{"is_admin"} = 1;
 
		if($newadm_ref->{"is_here"})
		{
			cf_send_info("command tell $newadm", "$player said you're a really nice gui. I trust you and will do what you suggest.");
		}
		else
		{
			$newadm_ref->{"message"} .= "$player said you're a really nice gui. I trust you and will do what you suggest.";
		}
		cf_send_cmd("$answer_command $newadm is now one of my very close friends.");
		return;
	}
 
	if($request =~ /^rem_admin\s+(\S+)$/)
	{
		my $remadm = $1;
		if($admin !~ / $player /)
		{
			cf_send_cmd("$answer_command Hey, you're not allowed to remove admins!");
			admin_msg("$player tried to remove $1 from the admin list.\n");
			return;
		}
 
		my $remadm_ref = $players{$remadm};
		unless(defined $remadm_ref)
		{
			cf_send_cmd("$answer_command Sorry, I don't know $remadm.");
			return;
		}
 
		if($remadm_ref->{"is_admin"} == 0)
		{
			cf_send_cmd("$answer_command $remadm is not an admin.");
			return;
		}
 
		if($remadm eq $player)
		{
			cf_send_cmd("$answer_command You don't want to remove yourself from the admin list, do you?");
			return;
		}
 
		$admin =~ s/ $remadm / /;
		$remadm_ref->{"is_admin"} = 0;
 
		if($remadm_ref->{"is_here"})
		{
			cf_send_info("command tell $remadm", "$player removed you from my admin list.");
		}
		else
		{
			$remadm_ref->{"message"} .= "$player removed you from my admin list.";
		}
		cf_send_cmd("$answer_command $remadm is no longer in my admin list.");
		return;
	}
 
	if($request =~ /^admins$/)
	{
		sleep 2;
		cf_send_cmd("$answer_command My admin friends are:$admin");
		return;
	}
 
	sleep 2;
	cf_send_cmd("$answer_command I don't know what you mean. Do you need help?");
}
 
sub do_command
{
	my $cmd = shift;
	if($cmd =~ /^save$|^north$|^south$|^east$|^west$|^northwest$|^northeast$|^southwest$|^southeast$|^say |^tell |^shout |^get\b|^take\b|^drop\b|^cast |^invoke |^apply\b|^pickup \d+$|^title |^ready_skill |^use_skill |^fire/)
	{
		# We just pass this through.
		cf_send_cmd($cmd);
	}
}
 
sub stop_script
{
	my $scr = shift;
	return unless defined $scripts{$scr};
	return unless defined $script_stack{$scr};
 
	foreach my $events_array_ref (\@events_listen, \@events_wait, \@events_stats)
	{
		for(my $i = 0; $i < scalar @$events_array_ref; $i++)
		{
			my $event_ref = $events_array_ref->[$i];
			if($scr eq $event_ref->{"script"})
			{
				splice @$events_array_ref, $i, 1; # remove the event from the list
			}
		}
	}
	delete $script_stack{$scr};
}
 
sub do_execute
{
	my $scriptname = shift;
	my $pc = shift || 0;
 
	for(; $pc < scalar @{$scripts{$scriptname}}; $pc++)
	{
		$cmd = $scripts{$scriptname}[$pc];
		print "executing: $cmd (stack size: ".(scalar @{$script_stack{$scriptname}}).")\n";
		if($cmd =~ /^save$|^north$|^south$|^east$|^west$|^northwest$|^northeast$|^southwest$|^southeast$|^say |^tell |^shout |^get\b|^take\b|^drop\b|^cast |^invoke |^apply\b|^pickup \d+$|^title |^ready_skill |^use_skill |^fire/)
		{
			# We just pass this through.
			cf_send_cmd($cmd);
			next;
		}
 
		if($cmd =~ /^execute (\S+)$/)
		{
			my $scr = $1;
			next unless defined $scripts{$scr};
			next if defined $script_stack{$scr};
 
			$script_stack{$scr} = [];
			do_execute($scr);
			next;
		}
 
		if($cmd =~ /^stop (\S+)$/)
		{
			stop_script($1);
			last;
		}
 
		if($cmd =~ /^wait (\d+)$/)
		{
			push @events_wait, { script => $scriptname, pc => ($pc+1), continue_at => time + $1 };
			last;
		}
 
		if($cmd =~ /^for (\d+) times$/)
		{
			push @{$script_stack{$scriptname}}, { context => 'for', pc => $pc, count => $1 };
			next;
		}
 
		if($cmd =~ /^end_for$/)
		{
			if(scalar @{$script_stack{$scriptname}} == 0)
			{
				print "Stack underflow in end_for!\n";
				stop_script($scriptname);
				last;
			}
 
			$stack_last = $script_stack{$scriptname}[0];
			unless($stack_last->{"context"} eq 'for')
			{
				print "Script error: end_for found, but no for on stack.\n";
				stop_script($scriptname);
				return;
			}
			$stack_last->{"count"}--;
			if($stack_last->{"count"} == 0)
			{
				shift @{$script_stack{$scriptname}};
				next;
			}
 
			$pc = $stack_last->{"pc"};
			next;
		}
 
		if($cmd =~ /^forever$/)
		{
			push @{$script_stack{$scriptname}}, { context => 'forever', pc => $pc };
			next;
		}
 
		if($cmd =~ /^end_forever$/)
		{
			if(scalar @{$script_stack{$scriptname}} == 0)
			{
				print "Stack underflow in end_forever!\n";
				stop_script($scriptname);
				return;
			}
 
			$stack_last = $script_stack{$scriptname}[0];
			unless($stack_last->{"context"} eq 'forever')
			{
				print "Script error: end_forever found, but no forever on stack.\n";
				stop_script($scriptname);
				return;
			}
 
			$pc = $stack_last->{"pc"};
			next;
		}
 
		if($cmd =~ /^when hearing\s+(\S.+)$/)
		{
			push @events_listen, { script => $scriptname, pc => ($pc+1), listen_text => "$1" };
			last;
		}
 
		if($cmd =~ /^when stats_event\s+(maxhp|maxsp|maxgrace|lowfood)$/)
		{
			push @{$events_stats{$1}}, { script => $scriptname, pc => ($pc+1) };
			last;
		}
 
		if($cmd eq "end")
		{
			stop_script($scriptname);
			last;
		}
 
		if($cmd =~ /^assert (.*)$/)
		{
			last unless script_condition($1);
			next;
		}
 
		cf_send_cmd("tell Zorag Script error: unknown command '$cmd'");
		last;
	}
 
	if($pc == scalar @{$scripts{$scriptname}})
	{
		stop_script($scriptname);
	}
 
}
 
sub script_condition
{
	my $cond = shift;
	my @words = split (/\s+/, $cond);
	my @stack = ( );
	while (my $word = shift(@words))
	{
		if($word eq "not")
		{
			return 0 if scalar @stack < 1;
			$stack[$#stack] = !$stack[$#stack];
			next;
		}
 
		if($word eq "and")
		{
			return 0 if scalar @stack < 2;
			splice @stack, $#stack-1, 2, ($stack[$#stack] && $stack[$#stack-1]);
			next;
		}
 
		if($word eq "or")
		{
			return 0 if scalar @stack < 2;
			splice @stack, $#stack-1, 2, ($stack[$#stack] || $stack[$#stack-1]);
			next;
		}
 
		if($word eq "xor")
		{
			return 0 if scalar @stack < 2;
			splice @stack, $#stack-1, 2, ($stack[$#stack] ^ $stack[$#stack-1]);
			next;
		}
 
		# implement some conditions here XXX
	}
	return pop @stack;
}
 
sub parse_who
{
	my $line = shift;
	unless ($line =~ /^(\S+) the ([^\]]+)\[([^\]]+)\]/)
	{
		#print "WHO next line: $line\n";
		return 0;
	}
	my $pl = $1;
	return 1 if $pl eq $player_name; # Don't log ourselves.
	my $title = $2;
	my $map = $3;
	$title =~ s/ $//;
 
	#print ">WHO Player: $pl the $title on map $map\n";
 
	# Set this player's is_here:
	my $player_ref = $players{$pl};
	if(defined $player_ref)
	{
		if(! $player_ref->{"is_here"})
		{
			$player_ref->{"is_here"} = 1;
			if($player_ref->{"message"})
			{
				my $msg = $player_ref->{"message"};
				$msg =~ s/_-/\n/g;
				cf_send_info("command tell $pl", "Hi $pl!$msg");
				$player_ref->{"message"} = "";
			}
		}
	}
	else
	{
		$player_ref = { asked_me => 0, is_here => 1, message => "", is_admin => 0 };
		$players{$pl} = $player_ref;
	}
	$player_ref->{"last_seen"} = time;
 
	# Do we log this map's usage?
	foreach my $map_pat (@check_map)
	{
		if($map =~ m#$map_pat#)
		{
			if(defined $checked_map{$map}{$pl})
			{
				$checked_map{$map}{$pl}++;
			}
			else
			{
				$checked_map{$map}{$pl} = 1;
			}
		}
	}
 
	if($map =~ m#/_city_apartment_[Aa]partments.?$|/_santo_dominion_sdomino_appartment$|^/guilds/|^/city/city$|^/world/world_..$|^/dragonisland/housebrxzl$#)
	{
		# We don't log these maps.
		return 1;
	}
 
	# remove number from random maps:
	if($map =~ m#^/random/#)
	{
		$map =~ s/\d\d\d\d$//;
	}
 
	# Add to the map popularity:
	if(defined $maps{$map})
	{
		$maps{$map}++;
	}
	else
	{
		$maps{$map} = 1;
	}
 
	return 1;
}
 
sub admin_msg
{
	for my $adm (split /\s+/, $admin)
	{
		next unless $adm;
		my $admin_ref = $players{$adm};
		return unless defined $admin_ref;
 
		my $msg = shift;
 
		if($admin_ref->{"is_here"})
		{
			cf_send_cmd("tell $adm $msg");
			return;
		}
 
		$msg =~ s#\n#_-#g;
		$admin_ref->{"message"} .= $msg;
	}
}
 
 
sub cf_send_info
{
	my $answer_command = shift;
	my $info = shift;
	my @lines = split(/\n/, $info);
 
	if(! @lines) { return; }
 
	my $chunk = shift @lines;
	foreach $line (@lines)
	{
		if(length($chunk) + length($line) < 220)
		{
			$chunk .= "\n".$line;
		}
		else
		{
			if(! $chunk)
			{
				die "Text chunk is too large (".length($chunk)." bytes)";
			}
			cf_send_cmd("$answer_command $chunk");
			$chunk = "\n$line";
		}
	}
	if($chunk)
	{
		cf_send_cmd("$answer_command $chunk");
	}
}
 
sub cf_send_cmd
{
	push @cmds_waiting, shift;
 
	my $pending = $pkg_sent - $pkg_ackd;
	if($pending < 0) { $pending += 256; }
	while($pending < 3)
	{
		my $msg = shift @cmds_waiting;
 
		# send this command immediately
		$pkg_sent++;
		if($pkg_sent == 256) { $pkg_sent = 0; }
		cf_send("ncom ".pack("n", $pkg_sent)."\0\0\0\1$msg");
 
		last unless scalar @cmds_waiting;
 
		$pending++;
	}
 
}
 
sub cf_send
{
	my $msg = shift;
	#print "<$msg\n";
	my $out = pack("n/a*", $msg);
	#print unpack("H*", $out)."\n";
	print $socket $out;
	$socket->flush();
}
 
 
sub save
{
	open(KILLS, "> cf_kills") or die "Can't write file 'cf_kills': $!";
	foreach my $key (keys %kills)
	{
		print KILLS $key.":".$kills{$key}."\n";
	}
	close KILLS;
 
	open(SCRIPTS, "> cf_scripts") or die "Can't write file 'cf_scripts': $!";
	foreach my $scriptname (keys %scripts)
	{
		#print "Saving script '$scriptname'.\n";
		print SCRIPTS "$scriptname\n";
		foreach my $line (@{$scripts{$scriptname}})
		{
			print SCRIPTS "$line\n";
		}
		print SCRIPTS "\n";
	}
	close SCRIPTS;
 
	open(PLS, ">cf_players") or die "Can't write file 'cf_players': $!";
	foreach my $key (keys %players)
	{
		#print "Saving player '$key'.\n";
		print PLS "$key\n";
		foreach my $plkey (keys %{$players{$key}})
		{
			print PLS "$plkey:$players{$key}{$plkey}\n";
		}
	}
	close PLS;
 
	open(MAPS, ">cf_maps") or die "Can't write file 'cf_maps': $!";
	print MAPS "$last_maps_decay_time\n";
	foreach my $map (keys %maps)
	{
		#print "Saving map info '$map'.\n";
		print MAPS "$map $maps{$map}\n";
	}
	print MAPS "\n";
	foreach my $map (keys %checked_map)
	{
		print MAPS "$map\n";
		foreach my $pl (keys %{$checked_map{$map}})
		{
			print MAPS "$pl:$checked_map{$map}{$pl}\n";
		}
	}
	close MAPS;
 
	print STDERR "Data saved.\n";
}
 
 
sub load
{
	%kills = ();
	unless(open(KILLS, "< cf_kills"))
	{
		print STDERR "Can't read file 'cf_kills': $!\n";
	}
	else
	{
		print "Loading kills.\n";
		while(<KILLS>)
		{
			chomp;
			my ($key, $value) = split(/:/, $_);
			$kills{$key} = $value;
		}
		close KILLS;
	}
 
	%scripts = ();
	unless(open(SCRIPTS, "< cf_scripts"))
	{
		print STDERR "Can't read file 'cf_scripts': $!\n";
	}
	else
	{
		print "Loading scripts.\n";
		while(<SCRIPTS>)
		{
			chomp;
			my $scriptname = $_;
			print "Loading script '$scriptname'.\n";
			$scripts{$scriptname} = [];
			for(;;)
			{
				my $line = <SCRIPTS>;
				chomp $line;
				last unless $line;
				print ":$line\n";
 
				push @{$scripts{$scriptname}}, $line;
			}
		}
		close SCRIPTS;
	}
 
	%players = ();
	unless(open(PLS, "< cf_players"))
	{
		print STDERR "Can't read file 'cf_players': $!\n";
	}
	else
	{
		$current_name = "";
		print "Loading players.\n";
		while(<PLS>)
		{
			chomp;
			if(/^([^:]+):(.*)$/)
			{
				my $key = $1;
				my $val = $2;
				if($key eq "is_admin" && $val == 1)
				{
					$admin .= "$current_name ";
				}
				if($key eq "is_here")
				{
					# We get the current users from the 'who command.
					$val = 0;
				}
				$players{$current_name}{$key} = $val;
			}
			else
			{
				$current_name = $_;
			}
		}
	}
 
	%maps = ();
	unless(open(MAPS, "< cf_maps"))
	{
		print STDERR "Can't read file 'cf_maps': $!\n";
	}
	else
	{
		print "Loading maps.\n";
		my $last_maps_decay_time = <MAPS>;
		chomp $last_maps_decay_time;
		while(<MAPS>)
		{
			chomp;
			last unless $_;
			my ($key, $value) = split(/ /, $_);
			$maps{$key} = $value;
		}
		$current_name = "";
		while(<MAPS>)
		{
			chomp;
			if(/^([^:]+):(.*)$/)
			{
				$checked_map{$current_name}{$1} = $2;
			}
			else
			{
				$current_name = $_;
			}
		}
		close MAPS;
	}
 
}
crossfire/bot/seer.txt · Last modified: 2018/02/21 21:52 by karl