#!/usr/bin/perl
#----------------------------------------------------------------------
#
# Copyright (c) Craig Ferguson, 2000. All rights reserved.
#
# Note that this code implements Richard Bartle's "Waving Hands" game,
# which is itself copyright.
#
#----------------------------------------------------------------------
#
# The contents of this file are subject to the FM Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# ftp://ftp.gamerz.net/pub/fm/LICENSE
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is scores.pl.
#
# The Initial Developer of the Original Code is Craig Ferguson.
#
# Portions of the Original Code are based on users.pl, by Martin
# Gregory
#
#----------------------------------------------------------------------
#
# This code presents the output of a SCORES command as an HTML
# page.
#
#----------------------------------------------------------------------
$Revision .= ' L1.00';
# The description of an opponent's state in a Game Status report...
# (any states not in this hash will appear unchanged in the report)
sub Num
{
my $str = shift;
return $1 if ($str =~ /(-?\d+)/);
return 0;
}
sub ReportErrorAndExit
{
my $Error = shift;
print "Content-type: text/html\n\n";
print "
Error in scores.pl\n";
print "\n";
print "$Error\n";
print "\n";
exit;
}
sub BusyCode
{
local ($wiz) = @_;
if ($Wizard{$wiz}{'Busy'})
{
if ($Wizard{$wiz}{'Busy'} =~ m/^N/)
{
return 1;
}
return 2;
}
return 0;
}
sub wizard_by_score
{
if ($Wizard{$a}{$ScoreType.'Score'} != $Wizard{$b}{$ScoreType.'Score'})
{
return $Wizard{$b}{$ScoreType.'Score'} <=> $Wizard{$a}{$ScoreType.'Score'};
}
if(&BusyCode($a) != &BusyCode($b))
{
return &BusyCode($a) <=> &BusyCode($b);
}
if($Wizard{$a}{'User'} ne $Wizard{$b}{'User'})
{
return "\U$Wizard{$a}{'User'}" cmp "\U$Wizard{$b}{'User'}";
}
return "\U$a" cmp "\U$b";
}
sub dead_by_score
{
if ($DeadScores[$a] != $DeadScores[$b])
{
return $DeadScores[$b] <=> $DeadScores[$a];
}
if ($DeadUsers[$a] ne $DeadUsers[$b])
{
return "\U$DeadUsers[$a]" cmp "\U$DeadUsers[$b]";
}
return "\U$DeadNames[$a]" cmp "\U$DeadNames[$b]";
}
$version = "";
$version = "Test" if ($ENV{SCRIPT_FILENAME} =~ m#/Test/#);
$version = "Main" if ($ENV{SCRIPT_FILENAME} =~ m#/Main/#);
# Get type of score output requested based on filename
@types = ('Duel', 'Melee');
@types = ('Melee') if ($ENV{SCRIPT_FILENAME} =~ m/meleescores\.pl$/);
@types = ('Duel') if ($ENV{SCRIPT_FILENAME} =~ m/duelscores\.pl$/);
$gamedir = "/home/FM/fm/\L$version\E/saves";
open (WIZARDS, "<$gamedir/wizards.dat") || ReportErrorAndExit("Error opening wizards file ($gamedir/wizards.dat): " . $!);
@WizardInfo = ;
close WIZARDS;
eval "@WizardInfo";
@WizardNames = keys %Wizard;
print "Content-type: text/html\n\n";
print "Firetop Mountain Scores ($version Server)\n";
print "\n";
foreach $type (@types)
{
print "Honour Roll of the Mages of Firetop Mountain
\n";
print "Active List (Sorted by $type Scores):
\n";
print "Game | \n";
print "$type Score | \n";
my $othertype = "Melee" if ($type eq 'Duel');
$othertype = "Duel" if ($type eq 'Melee');
print "$othertype Score | \n";
print "Battles | \n";
print "Mage | \n";
print "User | \n";
print "
\n";
$ScoreType = $type;
foreach $wiz (sort wizard_by_score grep {!$Wizard{$_}{'Dead'} && !$Wizard{$_}{'Retired'}} @WizardNames)
{
print "";
if ($Wizard{$wiz}{'Busy'})
{
print "$Wizard{$wiz}{'Busy'}";
print "V" if ($Users{$Wizard{$wiz}{'User'}}{'Vacation'});
}
print " | \n";
print "$Wizard{$wiz}{$type.'Score'} | \n";
print "$Wizard{$wiz}{$othertype.'Score'} | \n";
print "$Wizard{$wiz}{'Battles'} | \n";
print "$wiz | \n";
print "$Wizard{$wiz}{'User'} | \n";
print "
\n";
}
print "
\n";
print "Successfully Retired ($type Scores):
\n";
print "Game | \n";
print "$type Score | \n";
my $othertype = "Melee" if ($type eq "Duel");
my $othertype = "Duel" if ($type eq "Melee");
print "$othertype Score | \n";
print "Battles | \n";
print "Mage | \n";
print "User | \n";
print "
\n";
$ScoreType = $type;
foreach $wiz (sort wizard_by_score grep {!$Wizard{$_}{'Dead'} && $Wizard{$_}{'Retired'}} @WizardNames)
{
print "";
if ($Wizard{$wiz}{'Busy'})
{
print "$Wizard{$wiz}{'Busy'}";
print "V" if ($Users{$Wizard{$wiz}{'User'}}{'Vacation'});
}
print " | \n";
print "$Wizard{$wiz}{$type.'Score'} | \n";
print "$Wizard{$wiz}{$othertype.'Score'} | \n";
print "$Wizard{$wiz}{'Battles'} | \n";
print "$wiz | \n";
print "$Wizard{$wiz}{'User'} | \n";
print "
\n";
}
print "
\n";
if (!open(HISTORY, "<$gamedir/$type.history.dat"))
{
print "\n";
exit;
}
@DeadNames = ();
@DeadScores = ();
@DeadUsers = ();
%BestScore = ();
while()
{
chomp;
($Name, $Score, $DeadUser) = split(/[ ]+/, $_, 3);
if ($Name && (!$BestScore{$Name} || ($BestScore{$Name} < $Score)))
{
push(@DeadNames, $Name);
push(@DeadScores, $Score);
push(@DeadUsers, $DeadUser);
$BestScore{$Name} = $Score;
}
}
close HISTORY;
#if (!open(HISTORY, ">$gamedir/$type.history.dat"))
#{
# print "