<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/env perl
#
# $Id: end_tourney.pl,v 1.2 2005/09/28 12:14:05 quozl Exp $
# 
# end_tourney.pl
#
# If this fails to work, change the first line of this file to point to
# a perl 5 (NOT perl 4) interpreter--"#!/usr/local/bin/perl5" for example.
#
# Generates PWstats and others from an ltd_stats file.
# Mails stats to statboys if REGISTER was used.

######################################################################
# NEW FEATURE: There is a central stats archive at
#              http://www.netrek.org/stats/
#
# By default, all stats are automatically archived there via the
# auto-archive.pl script.  YOU SHOULD EDIT auto-archive.pl to
# work under your environment.
#
# The auto-archiving is independent of the statboy email for
# registered games and the $dropdir features below.
######################################################################

#
# usage: end_tourney.pl [-register] [ID] 
# If "ID" exists, will open "ltd_stats.&lt;ID&gt;", else will open ltd_stats.
#
# The stats are saved in a hash of hashes, $stat{playername}-&gt;{stat}.  

$debug = 1;

$bgcolor="6699CC";
$th = "&lt;th bgcolor=$bgcolor&gt;";
$td = "&lt;td align=center&gt;";
$statboys = "netrek\@localhost";
$mailprog = "/usr/lib/sendmail";
$tickspersec = 10;

# Enter your local time zone here, standard time
$tz = "EST";
# Enter your local time zone here, daylight savings time (if applicable)
$tzdst = "EDT";

# Edit this to point to a valid key.html key file
$keyloc = "http://stats.psychosis.net/key.html";

# Uncomment this if you want pwstats to be automatically dropped in a
# directory.  This should be a FULL UNIX DIRECTORY PATHNAME, without
# a trailing slash.
# This is for keeping a local stats archive in addition to the stats
# that auto-archive.pl sends to http://www.netrek.org/stats/.
#
#$dropdir = "/home/netrek/www/stats";
#
# Uncomment this if $dropdir is defined and stats should be dumped
# into subdirectories within $dropdir.
#
$dropsub = 1;
#
# Uncomment this to use a more readable form for dropdir entries.
#
$newdrop = 1;
#
# Set this to call a directory indexing script after generating stats.
#
#$dirindex = "/home/netrek/bin/statsindex.py";
#

if ($keyloc) {
    $key = "&lt;font size=+1&gt;&lt;a href=$keyloc&gt;(View Key)&lt;/a&gt;&lt;/font&gt;";
}

foreach $argument ( @ARGV ) {
    if ( $argument eq "-register" ) {
	$register = 1;
    } else {
	$id = $argument;
    }
}

if ( $id ) {
    $inputfile = "ltd_dump.txt." . $id;
    $logfile = "INL_log." . $id;
    $outputfile = "pwstats." . $id . ".html";
    $cambotfile = "cambot.pkt." . $id;
    $endtime = $id;
} else { 
    $inputfile = "ltd_dump.txt";
    $logfile = "INL_log";
    $outputfile = "pwstats.html";
    $cambotfile = "cambot.pkt";
    $endtime = time;
}

@months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
@weekdays = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($endtime);
if ($hour &lt; 12) {
    $ampm = "AM";
} else {
    $hour = $hour - 12;
    $ampm = "PM";
}
if ($hour == 0) {
    $hour = 12;
}
if ($min &lt; 10) {
    $min = "0${min}";
}
if ($isdst) {
    $tz = $tzdst;
}
$endtimestr = "&lt;b&gt;$weekdays[$wday] $months[$mon] $mday ". ($year + 1900) .
    "&lt;/b&gt; at &lt;b&gt;$hour:$min $ampm $tz&lt;/b&gt;";

system("./tools/ltd_dump `./tools/getpath --localstatedir`/players." . $id . " &gt; $inputfile");

open (INPUT,"$inputfile");
open (OUTPUT,"&gt;$outputfile");

# make unbuffered I/O
select(OUTPUT); $| = 1;
select(STDERR); $| = 1;
select(STDOUT); $| = 1;

$homecurrentplanets=10;
$awaycurrentplanets=10;
$neuts=0;

&amp;parselog;
&amp;parsestats;
&amp;computescore;
&amp;printstdout;
&amp;printstats;

# Run the auto-archiver after pwstats have been generated.
# Stats are sent immediately while the cambot file is sent
# in the background.

system("./auto-archive.pl $id");

$hometeam =~ s/[\`\"\']//g;
$awayteam =~ s/[\`\"\']//g;

if ( $dropdir ) {
    if ( -d $dropdir ) {
	if ( $dropsub ) {
	    if ($newdrop) {
		if ($neuts == 0) {
    	    	    $dirpath = "$dropdir/$hometeam -vs- $awayteam ($homecurrentplanets-$awaycurrentplanets)";
    	    	} else {
    	    	    $dirpath = "$dropdir/$hometeam -vs- $awayteam ($homecurrentplanets-$awaycurrentplanets-$neuts)";
	    	}
		if ( -d $dirpath ) {
	    	    $dirnum = 2;
		    while ( -d "$dirpath [$dirnum]" ) {
		    	$dirnum++;
		    }
		    $dirpath = "$dirpath [$dirnum]";
	    	}
	    } else {
	    	$dirpath = "$dropdir/$id";
	    }
	    umask 022;
	    system("mkdir \"$dirpath\"");
	    system("cp $outputfile \"$dirpath/pwstats.html\"");
	    system("ln -s \"$dirpath/pwstats.html\" \"$dirpath/index.html\"");
	    system("cp $logfile \"$dirpath/INL_log.txt\"");
	    system("cp $inputfile \"$dirpath/ltd_dump.txt\"");
	    if ( -f $cambotfile ) {
	    	system("gzip -9c $cambotfile &gt; \"$dirpath/cambot.pkt.gz\"");
	    }
	    system("chmod 755 \"$dirpath\"");
	    system("chmod 644 \"$dirpath\"/*");
	    if ($dirindex) {
		system("$dirindex $dropdir &gt; $dropdir/index.html");
	    }
	} else {
	    system("cp -f $outputfile $dropdir/$outputfile");
	}
    } else {
	print STDERR "Dropdir " , $dropdir , " is not a directory!\n";
    }
}

if ( $register ) {
    &amp;maillog;
}


sub computescore { 
    # After parsing stats, add up taken and destroyed planets for each
    # team to figure out the score.
    
    foreach $player ( sort keys %stat ) {

	if ( $debug &gt; 1 ) {
	    print "$player\n";
	}

	my $tpt = $stat{$player}-&gt;{ptt};
	my $tpd = $stat{$player}-&gt;{pdt};

	if ( $debug &gt; 1 ) {
	    print "${player} ($stat{$player}-&gt;{team}): $stat{$player}-&gt;{ptt}, $stat{$player}-&gt;{pdt}\n";
	}

	if ( $stat{$player}-&gt;{team} eq $homerace ) {
	    $homescore += $tpt + $tpd;
	    $homecurrentplanets += $tpt;
	    $awaycurrentplanets -= $tpd;
	} else {
	    $awayscore += $tpt + $tpd;
	    $awaycurrentplanets += $tpt;
	    $homecurrentplanets -= $tpd;
	}
	$neuts = 20 - $homecurrentplanets - $awaycurrentplanets;
	if ( $debug &gt; 1 ) {
	    print "Score: $homescore, $awayscore, $neuts\n";
	}
    }

} ### end sub computescore

sub parselog {
    # Go through the INL_log to find the team names (possibly other stuff)

    open ( LOG,"$logfile") || die ("Could not open $logfile; $!");

    while ( $line = &lt;LOG&gt; ) {

	last if $line =~ /^\s*\d+: INL-&gt;ALL  Teams chosen/;

	next if $line !~ /^\s*\d+: INL-&gt;ALL\s+.*team is/;

	$line =~ /^\s*\d+: INL-&gt;ALL  (....) team is   (.*) \((.*)\):/;

	if ( $1 eq "Home" ) {
	    $hometeam = $2;
	    $homerace = $3;
	} else {
	    $awayteam = $2;
	    $awayrace = $3;
	}

	if ( $debug &gt; 1 ) {
	    print "$hometeam vs. $awayteam, $homerace vs. $awayrace\n";
	}

    }

} ### end sub parselog

sub parsestats {
    # Go through the ltd_stats and get the data we need.  This is the main
    # loop of the program.

    $player = 0;

while ( $line = &lt;INPUT&gt; ) {

    study $line;

    if ( ! $player ) {
	# $player is set to the name of the player we're currently reading
	# stats for; if it's false, we're not in a player, look for the
	# beginning line
	next if $line !~ /^\+\+ LTD statistics for player \[(.*)\] \((...)\)$/;

	$player = $1;
	$team = $2;


	if ( $stat{$player}-&gt;{team} &amp;&amp; $stat{$player}-&gt;{team} ne $team ) {
	    # This is a horrible hack for players who played on both teams

	    $player .= $team;
	}

    }

    if ( $line =~ /^\+\+ LTD statistics for player \[(.*)\] \((...)\)$/ ) {
	$player = $1;
	$team = $2;

	if ( $stat{$player}-&gt;{team} &amp;&amp; $stat{$player}-&gt;{team} ne $team ) {
	    # This is a horrible hack for players who played on both teams

	    $player .= $team;
	}

    }

    if ( $debug &gt; 1 ) {
	print $player , "\n";
    }

    $stat{$player}-&gt;{team} = $team;
    $stat{$player}-&gt;{name} = $player;

    if ( $line =~ /^\((.*)\).*:(.*):(.*):(.*):(.*):(.*):(.*):(.*):(.*):$/ ) {
	# $1 is the stat abbreviation; store the stats in 
	# $stat{$player}-&gt;{$abbr}, one for each ship type.

	if ( $debug &gt; 5 ) {
	    print $line;
	}

	$stat1 = $1 . "sc";
	$stat2 = $1 . "dd";
	$stat3 = $1 . "ca";
	$stat4 = $1 . "bb";
	$stat5 = $1 . "as";
	$stat6 = $1 . "sb";
	$stat7 = $1 . "ga";
	$stat8 = $1;

	$stat{$player}-&gt;{$stat1}=$2;
	$stat{$player}-&gt;{$stat2}=$3;
	$stat{$player}-&gt;{$stat3}=$4;
	$stat{$player}-&gt;{$stat4}=$5;
	$stat{$player}-&gt;{$stat5}=$6;
	$stat{$player}-&gt;{$stat6}=$7;
	$stat{$player}-&gt;{$stat7}=$8;
	$stat{$player}-&gt;{$stat8}=$9;

	if ( $debug &gt; 1 ) {
	    print "$player, $stat1, $stat{$player}-&gt;{$stat1}\n";
	    print "$player, $stat3, $stat{$player}-&gt;{$stat3}\n";
	}

    }

} ### end while ( $line = &lt;INPUT&gt; ) 

close INPUT;

} ### end sub parsestats


sub printstdout {
    # Prints a plain text summary of stats so the server can pipe it to
    # stdout on the clients
    # This is deprecated due to most clients being run without visible stdout

format STDOUT =
@&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt;&lt; @&gt;&gt;&gt; @&gt;&gt;&gt; @&gt;&gt;&gt; @&gt;&gt;&gt; @&gt;&gt;&gt; @&gt;&gt;&gt;
$name, $tpt, $tpd, $tab, $tek, $def, $acc
.

    if ($neuts) {
        print "FINAL SCORE: $hometeam -vs- $awayteam, ${homecurrentplanets}-${awaycurrentplanets}-${neuts}\n\n";
    } else {
        print "FINAL SCORE: $hometeam -vs- $awayteam, ${homecurrentplanets}-${awaycurrentplanets}\n\n";
    }

    print "\nPLAYER STATS for $hometeam\n";

    ( $name, $tpt, $tpd, $tab, $tek, $def, $acc ) =
    ( "Name" , "tpt" , "tpd" , "tab", "tek" , "def" , "acc" );

    write STDOUT;

    foreach $player ( sort keys %stat ) {

	next if $stat{$player}-&gt;{team} ne $homerace;

	( $name, $tpt, $tpd, $tab, $tek, $def, $acc ) =
	    ( $stat{$player}-&gt;{name} ,
	      $stat{$player}-&gt;{ptt} , $stat{$player}-&gt;{pdt} ,
	      $stat{$player}-&gt;{bat} ,
	      $stat{$player}-&gt;{kt} , $stat{$player}-&gt;{dt} ,
	      $stat{$player}-&gt;{acc} );

	write STDOUT;
    }

    print "\nPLAYER STATS for $awayteam\n";

    ( $name, $tpt, $tpd, $tab, $tek, $def, $acc ) =
    ( "Name" , "tpt" , "tpd" , "tab", "tek" , "def" , "acc" );

    write STDOUT;

    foreach $player ( sort keys %stat ) {

	next if $stat{$player}-&gt;{team} ne $awayrace;

	( $name, $tpt, $tpd, $tab, $tek, $def, $acc ) =
	    ( $stat{$player}-&gt;{name} ,
	      $stat{$player}-&gt;{ptt} , $stat{$player}-&gt;{pdt} ,
	      $stat{$player}-&gt;{bat} ,
	      $stat{$player}-&gt;{kt} , $stat{$player}-&gt;{dt} ,
	      $stat{$player}-&gt;{acc} );

	write STDOUT;
    }

} ### end sub printstdout


sub printstats {

    # After the log has been wholly parsed, get the information
    # (mostly from the %stat hash) and print it.

if ($neuts) {
    $planetscore = "${homecurrentplanets}-${awaycurrentplanets}-${neuts}";
} else {
    $planetscore = "${homecurrentplanets}-${awaycurrentplanets}";
}
print OUTPUT  &lt;&lt;END;
&lt;BODY BGCOLOR="#FFFFFF" TEXT="#111100" LINK="#112299" ALINK="AA0000"
VLINK="#BB7711"&gt;

&lt;title&gt;PWStats: $hometeam ($homerace) -vs- $awaytem ($awayrace)&lt;/title&gt;

&lt;center&gt;
&lt;font size=+1&gt;Game Ended: $endtimestr&lt;/font&gt;
&lt;br&gt;&lt;br&gt;Warning: The stats code is currently buggy. Planet counts and the winning team may be incorrect.
&lt;br&gt;&lt;br&gt;
&lt;table border cellpadding=2&gt;
&lt;tr&gt;${th}&lt;font size=+2&gt;Home Team&lt;/font&gt;&lt;/th&gt;${th}&lt;font size=+2&gt;Away Team&lt;/font&gt;&lt;/th&gt;&lt;/tr&gt;
&lt;tr&gt;&lt;td&gt;&lt;font size=+1&gt;&lt;b&gt;$hometeam&lt;/b&gt;&lt;/font&gt; &lt;font color=#444444 size=+1&gt;($homerace)&lt;/font&gt;&lt;/td&gt;&lt;td&gt;&lt;font size=+1&gt;&lt;b&gt;$awayteam&lt;/b&gt;&lt;/font&gt; &lt;font color=#444444 size=+1&gt;($awayrace)&lt;/font&gt;&lt;/td&gt;&lt;/tr&gt;
&lt;/table&gt;
&lt;br&gt;
    &lt;table&gt;&lt;tr&gt;&lt;th&gt;&lt;font size=+3&gt;FINAL SCORE:&amp;nbsp;&lt;/font&gt;&lt;/th&gt;$th&lt;font size=+3&gt;$planetscore&lt;/font&gt;&lt;/th&gt;&lt;/tr&gt;&lt;/table&gt;
&lt;table&gt;&lt;tr&gt;&lt;td&gt;Scoring Mode: &lt;b&gt;Planet Count&lt;/b&gt; (11-8-1 or 8-11-1 required for victory)&lt;/td&gt;&lt;/tr&gt;&lt;/table&gt;
END

if ($homecurrentplanets &lt;= 8) {
    print OUTPUT "&lt;h2&gt;$awayteam (Away) &lt;u&gt;-defeats-&lt;/u&gt; $hometeam (Home)!&lt;/h2&gt;";
} elsif ($awaycurrentplanets &lt;= 8) {
    print OUTPUT "&lt;h2&gt;$hometeam (Home) &lt;u&gt;-defeats-&lt;/u&gt; $awayteam (Away)!&lt;/h2&gt;";
} else {
    print OUTPUT "&lt;h2&gt;$hometeam (Home) &lt;u&gt;-ties-&lt;/u&gt; $awayteam (Away).&lt;/h2&gt;";
}
print OUTPUT "&lt;/center&gt;";

# Change all undef values to 0's for printing

    @stats = ("name","playerslot","tpd","tpt","tpb","tab","tad","tac",
	      "cak","eao","eck","pck","tek","def","acc",
	      "sbtek","sbdef","sbtac","sbtad","sbcak","sbeao","sbeck","sbpck",
	      "kbp","kbt","kbe","kbd","kbs","dbp","dbt","dbe","dbd","dbs",
	      "dbpf","sbkbp","sbkbt","sbkbe","sbkbd","sbkbs","sbdbp",
	      "sbdbt","sbdbe","sbdbd","sbdbs");


foreach $value ( @stats ) {

    foreach $player ( sort keys %stat ) {
	if ( ! $stat{$player}-&gt;{$value} ) {
	    $stat{$player}-&gt;{$value} = 0;
	}
    }
}


# Go through printing the home team first, then their totals, then 
# the away team and their totals, then SB stats.

$count=1;

print OUTPUT  &lt;&lt;END;

&lt;p&gt;
&lt;font size=+1&gt;Download:&lt;/font&gt; &lt;a href=ltd_dump.txt&gt;LTD Stats&lt;/a&gt;&amp;nbsp;|&amp;nbsp;
&lt;a href=INL_log.txt&gt;INL Log&lt;/a&gt;&amp;nbsp;|&amp;nbsp;&lt;a href=cambot.pkt.gz&gt;Game Recording (Cambot)&lt;/a&gt;
&lt;p&gt;
&lt;font size=+2&gt;Player Stats&lt;/font&gt; $key

&lt;h4&gt;Home Team&lt;/h4&gt;

&lt;table border cellpadding=4&gt;
    &lt;tr&gt;${th}Name${th}Minutes${th}tpd${th}tpt${th}tpb${th}tab
    ${th}tad/tac/pad${th}cak${th}eao${th}eck${th}pck${th}tek${th}def${th}acc

&lt;tr&gt;

END

foreach $player ( sort keys %stat ) {

    next if $stat{$player}-&gt;{team} ne $homerace;

printrecord($player);

$home{tpd}+=$stat{$player}-&gt;{pdt};
$home{tpt}+=$stat{$player}-&gt;{ptt};
$home{tpb}+=$stat{$player}-&gt;{bpt};
$home{tab}+=$stat{$player}-&gt;{bat};
$home{tac}+=$stat{$player}-&gt;{at};
#
# Add armies used to attack, armies used to reinforce, and armies ferried 
# for tad
$home{tad}+=$stat{$player}-&gt;{aa} + $stat{$player}-&gt;{ar} + $stat{$player}-&gt;{af};
$home{cak}+=$stat{$player}-&gt;{ak};
$home{eao}+=$stat{$player}-&gt;{oat};
$home{eck}+=$stat{$player}-&gt;{odc};
$home{pck}+=$stat{$player}-&gt;{opc};
$home{tek}+=$stat{$player}-&gt;{kt};
$home{def}+=$stat{$player}-&gt;{dt};
$home{acc}+=$stat{$player}-&gt;{acc};

}

print OUTPUT  &lt;&lt;END;
&lt;tr&gt;&lt;td&gt;
    ${th}Home Total
    ${th}$home{tpd}
${th}$home{tpt}
${th}$home{tpb}
${th}$home{tab}
${th}$home{tad}/$home{tac},
END

    if ( $home{tac} ) {
	$home{pad} = ($home{tad}/$home{tac})*100;
    } else {
	$home{pad} = 0;
    }
    printf OUTPUT ("%2.1f",$home{pad});

print OUTPUT  &lt;&lt;END;
%
${th}$home{cak}
${th}$home{eao}
${th}$home{eck}
${th}$home{pck}
${th}$home{tek}
${th}$home{def}
${th}$home{acc}

&lt;/table&gt;
&lt;p&gt;
&lt;h4&gt;Away Team&lt;/h4&gt;

&lt;table border cellpadding=4&gt;
    &lt;tr&gt;${th}Name${th}Minutes${th}tpd${th}tpt${th}tpb${th}tab
    ${th}tad/tac/pad${th}cak${th}eao${th}eck${th}pck${th}tek${th}def${th}acc

END

foreach $player ( sort keys %stat ) {

    next if $stat{$player}-&gt;{team} ne $awayrace;

printrecord($player);

$away{tpd}+=$stat{$player}-&gt;{pdt};
$away{tpt}+=$stat{$player}-&gt;{ptt};
$away{tpb}+=$stat{$player}-&gt;{bpt};
$away{tab}+=$stat{$player}-&gt;{bat};
$away{tac}+=$stat{$player}-&gt;{at};
#
# Add armies used to attack, armies used to reinforce, and armies ferried 
# for tad
$away{tad}+=$stat{$player}-&gt;{aa} + $stat{$player}-&gt;{ar} + $stat{$player}-&gt;{af};
$away{cak}+=$stat{$player}-&gt;{ak};
$away{eao}+=$stat{$player}-&gt;{oat};
$away{eck}+=$stat{$player}-&gt;{odc};
$away{pck}+=$stat{$player}-&gt;{opc};
$away{tek}+=$stat{$player}-&gt;{kt};
$away{def}+=$stat{$player}-&gt;{dt};
$away{acc}+=$stat{$player}-&gt;{acc};

}


print OUTPUT  &lt;&lt;END;
&lt;tr&gt;&lt;td&gt;
${th}Away Total
${th}$away{tpd}
${th}$away{tpt}
${th}$away{tpb}
${th}$away{tab}
${th}$away{tad}/$away{tac},
END

    if ( $away{tac} ) {
	$away{pad} = ($away{tad}/$away{tac})*100;
    } else {
	$away{pad} = 0;
    }
    printf OUTPUT ("%2.1f",$away{pad});

print OUTPUT  &lt;&lt;END;
%
${th}$away{cak}
${th}$away{eao}
${th}$away{eck}
${th}$away{pck}
${th}$away{tek}
${th}$away{def}
${th}$away{acc}
END

print OUTPUT  &lt;&lt;END;
&lt;/table&gt;
&lt;p&gt;
&lt;h3&gt;Normalized Player Stats&lt;/h3&gt;
&lt;i&gt;(Statistics normalized to game length)&lt;/i&gt;

&lt;h4&gt;Home Team&lt;/h4&gt;

&lt;table border cellpadding=4&gt;
    &lt;tr&gt;${th}Name${th}Minutes${th}tpd${th}tpt${th}tpb${th}tab
    ${th}tad/tac/pad${th}cak${th}eao${th}eck${th}pck${th}tek${th}def${th}acc

&lt;tr&gt;
END

    foreach $player ( sort keys %stat ) {
	next if $stat{$player}-&gt;{team} ne $homerace;
	printnormalizedrecord($player);
    }

print OUTPUT &lt;&lt;END;
&lt;/table&gt;
&lt;p&gt;
&lt;h4&gt;Away Team&lt;/h4&gt;

&lt;table border cellpadding=4&gt;
    &lt;tr&gt;${th}Name${th}Min ${th}tpd${th}tpt${th}tpb${th}tab
    ${th}tad/tac/pad${th}cak${th}eao${th}eck${th}pck${th}tek${th}def${th}acc

END

    foreach $player ( sort keys %stat ) {
	next if $stat{$player}-&gt;{team} ne $awayrace;
	printnormalizedrecord($player);
    }

print OUTPUT &lt;&lt;END;
&lt;/table&gt;
&lt;p&gt;

&lt;h3&gt;Starbase Stats&lt;/h3&gt;
&lt;table border cellpadding=4&gt;
    &lt;tr&gt;${th}Name ${th}Min ${th}tek ${th}def ${th}tad/tac/pad ${th}cak
END

    foreach $player (sort keys %stat) {
	next if $stat{$player}-&gt;{ttsb} &lt; 2;
	my $sbmin = int($stat{$player}-&gt;{ttsb}/($tickspersec*60))+1;
	my $sbtad = $stat{$player}-&gt;{atsb} - $stat{$player}-&gt;{aksb};

	if ( $stat{$player}-&gt;{atsb} &gt; 0 ) {
	    my $sbpad = ($sbtac/$stat{$player}-&gt;{atsb}-$stat{$player}-&gt;{aksb}) * 100;
	} else {
	    my $sbpad = 0;
	}

	print OUTPUT &lt;&lt;END;
	&lt;tr&gt;	${td} $player ${td} $sbmin ${td} $stat{$player}-&gt;{ktsb}
${td} $stat{$player}-&gt;{dtsb} ${td} $sbtad/$stat{$player}-&gt;{atsb}
END

        printf OUTPUT ("%2.1f",$sbpad);
        print OUTPUT ${td} , $stat{$player}-&gt;{aksb};

    }


print OUTPUT &lt;&lt;END;

&lt;/table&gt;
&lt;p&gt;

&lt;h3&gt;Kill Stats&lt;/h3&gt;

&lt;table border cellpadding=4&gt;
&lt;tr&gt;${th}Name ${th}kbp ${th}kbt ${th}kbs
    ${th}dbp ${th}dbt ${th}dbs
END

foreach $player ( sort keys %stat ) {

print OUTPUT  &lt;&lt;END;
&lt;tr&gt;
    $td $stat{$player}-&gt;{name}
$td $stat{$player}-&gt;{kbp}
$td $stat{$player}-&gt;{kbt}
$td $stat{$player}-&gt;{kbs}
$td $stat{$player}-&gt;{dbp}
$td $stat{$player}-&gt;{dbt}
$td $stat{$player}-&gt;{dbs}
END
}

print OUTPUT &lt;&lt;END;
&lt;/table&gt;
&lt;p&gt;
&lt;h3&gt;Starbase Kill Stats&lt;/h3&gt;

&lt;table border cellpadding=4&gt;
&lt;tr&gt;${th}Name ${th}kbp ${th}kbt ${th}kbs
    ${th}dbp ${th}dbt ${th}dbs
END

    foreach $player ( sort keys %stat ) {

	next if $stat{$player}-&gt;{ktsb} &lt; 1;

print OUTPUT  &lt;&lt;END;
&lt;tr&gt;
    $td $stat{$player}-&gt;{name}
$td $stat{$player}-&gt;{kbpsb}
$td $stat{$player}-&gt;{kbtsb}
$td $stat{$player}-&gt;{kbssb}
$td $stat{$player}-&gt;{dbpsb}
$td $stat{$player}-&gt;{dbtsb}
$td $stat{$player}-&gt;{dbssb}
END
	
    }

print OUTPUT "&lt;/table&gt;\n";

} ### end sub printstats


sub printrecord {
    # Takes one argument, a player name, and prints the information in
    # tabular form.

    my $player=$_[0];

    $td = "&lt;td align=right&gt;";

#    my $minutes = int(($stat{$player}-&gt;{tt}-$stat{$player}-&gt;{ttsb})
    my $minutes = int(($stat{$player}-&gt;{tt})
		      /($tickspersec*60))+1;
    my $tad = $stat{$player}-&gt;{aa} + $stat{$player}-&gt;{ar} + $stat{$player}-&gt;{af};

print OUTPUT  &lt;&lt;END;
&lt;tr&gt;
    $td $stat{$player}-&gt;{name}
    $td $minutes
    $td $stat{$player}-&gt;{pdt}
    $td $stat{$player}-&gt;{ptt}
    $td $stat{$player}-&gt;{bpt}
    $td $stat{$player}-&gt;{bat}
    $td $tad/$stat{$player}-&gt;{at}
END

    if ( $stat{$player}-&gt;{at} &gt; 0 ) {
	my $pad = $tad/$stat{$player}-&gt;{at}*100;
	printf OUTPUT ("%2.1f",$pad);
	print OUTPUT  "%";
    } else {
	print OUTPUT  "0.0%";
    }

print OUTPUT  &lt;&lt;END;

    $td $stat{$player}-&gt;{ak}
    $td $stat{$player}-&gt;{oat}
    $td $stat{$player}-&gt;{odc}
    $td $stat{$player}-&gt;{opc}
    $td $stat{$player}-&gt;{kt}
    $td $stat{$player}-&gt;{dt}
    $td $stat{$player}-&gt;{acc}
END

} ### end sub printrecord

sub printnormalizedrecord {
    # Takes one argument, a player name, and prints the information in
    # tabular form, normalized to the game length (actually the same number
    # of ticks as the highest player.

    my $player=$_[0];

    if ( ! $gamelength ) {
	# First time through, figure out the gamelength by looking at the
	# greatest number of ticks 

	foreach $player1 ( sort keys %stat ) {
	    if ( $stat{$player1}-&gt;{tt} &gt; $gamelength ) {
		$gamelength = $stat{$player1}-&gt;{tt};
	    }
	}
    }

    $td = "&lt;td align=right&gt;";

#    my $minutes = int(($stat{$player}-&gt;{tt}-$stat{$player}-&gt;{ttsb})
    my $minutes = int(($stat{$player}-&gt;{tt})
		      /($tickspersec*60))+1;

    my $ticks = $stat{$player}-&gt;{tt};
    my %normal;
    $normal{tad} = normalize (($stat{$player}-&gt;{at}-$stat{$player}-&gt;{ak})
			      , $ticks);

    $normal{pdt} = normalize($stat{$player}-&gt;{pdt}, $ticks);
    $normal{ptt} = normalize($stat{$player}-&gt;{pdt}, $ticks);
    $normal{bpt} = normalize($stat{$player}-&gt;{bpt}, $ticks);
    $normal{bat} = normalize($stat{$player}-&gt;{bat}, $ticks);
    $normal{at} = normalize($stat{$player}-&gt;{at}, $ticks);
    $normal{ak} = normalize($stat{$player}-&gt;{ak}, $ticks);
    $normal{oat} = normalize($stat{$player}-&gt;{oat}, $ticks);
    $normal{odc} = normalize($stat{$player}-&gt;{odc}, $ticks);
    $normal{opc} = normalize($stat{$player}-&gt;{opc}, $ticks);
    $normal{kt} = normalize($stat{$player}-&gt;{kt}, $ticks);
    $normal{dt} = normalize($stat{$player}-&gt;{dt}, $ticks);
    $normal{acc} = normalize($stat{$player}-&gt;{acc}, $ticks);

print OUTPUT  &lt;&lt;END;
&lt;tr&gt;
    $td $stat{$player}-&gt;{name}
    $td $minutes
    $td $normal{pdt}
    $td $normal{ptt}
    $td $normal{bpt}
    $td $normal{bat}
    $td $normal{tad}/$normal{at}
END

    if ( $normal{at} &gt; 0 ) {
	my $pad = $tad/$normal{at}*100;
	printf OUTPUT ("%2.1f",$pad);
	print OUTPUT  "%";
    } else {
	print OUTPUT  "0.0%";
    }

print OUTPUT  &lt;&lt;END;

    $td $normal{ak}
    $td $normal{oat}
    $td $normal{odc}
    $td $normal{opc}
    $td $normal{kt}
    $td $normal{dt}
    $td $normal{acc}
END

} ### end sub printnormalizedrecord


sub normalize {
    # Given a number and a number of ticks, returns 
    # number * (gamelength / ticks), for normalized stats.

    my ( $number, $ticks ) = @_;

    if ( $ticks == 0 ) {
	return 0;
    } else {
	my $value = int($number * ( $gamelength / $ticks )+0.5);
    }

} ### end sub normalize

sub getteam {
    # Given a single character, returns the team associated with it (in caps)

    my $character = $_[0];

    if ( $character eq "R" ) {
	return ("ROM");
    } elsif ( $character eq "F" ) {
	return ("FED");
    } elsif ( $character eq "K" ) {
	return ("KLI");
    } elsif ( $character eq "O" ) {
	return ("ORI");
    }
} ### end sub getteam


sub maillog {
    # Takes a completed log and mails it to statboys, along with the
    # INL log.

    if ( ! -e $mailprog ) {
	# they don't have /usr/lib/sendmail?  What the heck are they
	# using?  Let's try random shit:
	#
	if ( -e "/usr/sbin/sendmail" ) {
	    $mailprog = "/usr/sbin/sendmail";
	} elsif ( -e "/usr/bin/sendmail" ) {
	    $mailprog = "/usr/bin/sendmail";
	} elsif ( -e "/usr/bin/mailx" ) {
	    $mailprog = "/usr/bin/mailx"; 
	} elsif ( -e "/usr/bin/mail" ) {
	    $mailprog = "/usr/bin/mail"; 
	} elsif ( -e "/bin/mail" ) {
	    $mailprog = "/bin/mail";
	} else {
	    die "I give up, I can't find a mail program";
	}
    }

    open (MAIL,"|$mailprog -t");
    print MAIL "Subject: INL RESULTS: $awayteam at $hometeam\n";
    print MAIL "To: " , $statboys , "\n\n";

    open (PWSTATS,"$outputfile");
    while ( $line = &lt;PWSTATS&gt; ) {
	print MAIL $line;
    }
    print MAIL "--- end PWstats ---\n";
    close PWSTATS;

    open (LTDSTATS,"$inputfile");
    while ( $line = &lt;LTDSTATS&gt; ) {
	print MAIL $line;
    }
    print MAIL "--- end INL log ---\n";
    close LTDSTATS;

    open (INLLOG,"$logfile");
    while ( $line = &lt;INLLOG&gt; ) {
	print MAIL $line;
    }
    print MAIL "--- end INL log ---\n";
    close INLLOG;
    close MAIL;

}



</pre></body></html>