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.
#!/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]";
}