====== CFLogBot ======

CFLogBot (aka Scribe on Metalforge server) is a modified version of LogBot (aka Seer). It is designed to collect communication on the in-game public channels such as shout and chat.

===== Source Code =====

<code>

#!/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/$buffer0 $logspool $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/;
$logspool = 'crossfirechatarchive.txt';
$remote_host = "XXXXXXXXXXXXXXXXXXX";
$player_name = "XXXXXXXXXXXXXXXXXXX";
$player_password = "XXXXXXXXXXXXXXX";
$retry_interval = 30; # time in seconds
$admin = "XXXXXXXXXXXXXXXXXXXXXXXXX";
$leave_cmd = "gohome";

# 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($info =~ /^(\S+) tells you: /)
                {
                        #handle_player_request($1, $2, "tell $1");
                        print"$info\n";
                        $buffer0 = $info;
                        databaseprint();
                        return;
                }
                if($info =~ /^(\S+) shouts: /)
                {
                        #handle_player_request($1, $2, "shout");
                        print"$info\n";
                        $buffer0 = $info;
                        databaseprint();
                        return;
                }
                if($info =~ /^(\S+) chats: /)
                {
                        #handle_player_request($1, $2, "shout");
                        print"$info\n";
                        $buffer0 = $info;
                        databaseprint();
                        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 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;
        }
        
}

sub databaseprint {
        chomp($buffer0);
        $buffer0 =~ s/[^a-zA-Z0-9_ \:\?\.\,\"\;\`\~\\\/\[\]\{\}\!\@\#\$\%\^\&\*\-\_\=\+\(\)]//g;
        stamptime();
        open FILE,">> $logspool" 
                or print"\nWARNING: Could Not Open $logspool \n";
        print FILE "$timestamp"."$buffer0<br>\n"
                or print"\nWARNING: Could Not Write To $logspool \n";       
        close FILE
                or print"\nWARNING: Could Not Even Close $logspool \n";

}
#END OF databaseprint();

sub stamptime {
        findtime();
        formattime();
}

sub findtime {
        ($Second, $Minute, $Hour, $Day, $Month, $Year, $WeekDay, $DayOfYear, $IsDST) = localtime(time);
}

sub formattime {
        $Month = $Month + 1;
        $Year = $Year + 1900;
        if ($Month <= 9) {
                $Month = "0$Month";
        }

        if ($Day <= 9) {
                $Day = "0$Day";
        }
        
        $timestamp = "[$Day/$Month/$Year $Hour:$Minute:$Second]";
}


</code>