Updated end_tourney.pl

To: vanilla-list@us.netrek.org
Subject: Updated end_tourney.pl
From: Tom Holub <doosh@best.com>
Date: Wed, 21 Jul 1999 22:46:31 -0700
I updated end_tourney.pl to work with the new team selection code,
and fixed a few minor bugs.  here 'tis.

--- begin end_tourney.pl
#!/usr/bin/env perl
# 
# 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.
#
# usage: end_tourney.pl [-register] [ID] 
# If "ID" exists, will open "ltd_stats.<ID>", else will open ltd_stats.
#
# The stats are saved in a hash of hashes, $stat{playername}->{stat}.  

$debug = 1;

$bgcolor="6699CC";
$th = "<th bgcolor=$bgcolor>";
$td = "<td align=center>";
$statboys = "statboys\@csua.berkeley.edu";
$mailprog = "/usr/lib/sendmail";
$tickspersec = 10;

# 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.
#
#$dropdir = "/ls/home/tom/public_html/results";

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";
} else { 
    $inputfile = "ltd_dump.txt";
    $logfile = "INL_log";
    $outputfile = "pwstats.html";
}

    open (INPUT,"$inputfile");
    open (OUTPUT,">$outputfile");

$homecurrentplanets=10;
$awaycurrentplanets=10;

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

if ( $dropdir ) {
    if ( -d $dropdir ) {
	system("cp -f $outputfile $dropdir/$outputfile");
    } else {
	print STDERR "Dropdir " , $dropdir , " is not a directory!\n";
    }
}

if ( $register ) {
    &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 > 1 ) {
	    print "$player\n";
	}

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

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

	if ( $stat{$player}->{team} eq $homerace ) {
	    $homescore += $tpt + $tpd;
	} else {
	    $awayscore += $tpt + $tpd;
	}
	if ( $debug > 1 ) {
	    print "Score: $homescore, $awayscore\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 = <LOG> ) {

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

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

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

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

	if ( $debug > 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 = <INPUT> ) {

    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}->{team} && $stat{$player}->{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}->{team} && $stat{$player}->{team} ne $team ) {
	    # This is a horrible hack for players who played on both teams

	    $player .= $team;
	}

    }

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

    $stat{$player}->{team} = $team;
    $stat{$player}->{name} = $player;

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

	if ( $debug > 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}->{$stat1}=$2;
	$stat{$player}->{$stat2}=$3;
	$stat{$player}->{$stat3}=$4;
	$stat{$player}->{$stat4}=$5;
	$stat{$player}->{$stat5}=$6;
	$stat{$player}->{$stat6}=$7;
	$stat{$player}->{$stat7}=$8;
	$stat{$player}->{$stat8}=$9;

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

    }

} ### end while ( $line = <INPUT> ) 

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

format STDOUT =
@<<<<<<<<<<<<<<< @>>> @>>> @>>> @>>> @>>> @>>>
$name, $tpt, $tpd, $tab, $tek, $def, $acc
.

    $winner = 0;

    if ( $awayscore > $homescore ) {
	if ( $awayscore - $homescore > 2 ) {
	    print "FINAL SCORE: $awayteam defeats $hometeam, ${awayscore}-$homescore\n\n";
	    $winner = 1;
	}
    } else {
	if ( $homescore - $awayscore > 2 ) {
	    print "FINAL SCORE: $hometeam defeats $awayteam, ${homescore}-$awayscore\n\n";
	    $winner = 1;
	}
    }

    if ( ! $winner ) {
	print "FINAL SCORE: $hometeam draws $awayteam, ${homescore}-$awayscore\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}->{team} ne $homerace;

	( $name, $tpt, $tpd, $tab, $tek, $def, $acc ) =
	    ( $stat{$player}->{name} ,
	      $stat{$player}->{ptt} , $stat{$player}->{pdt} ,
	      $stat{$player}->{bat} ,
	      $stat{$player}->{kt} , $stat{$player}->{dt} ,
	      $stat{$player}->{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}->{team} ne $awayrace;

	( $name, $tpt, $tpd, $tab, $tek, $def, $acc ) =
	    ( $stat{$player}->{name} ,
	      $stat{$player}->{ptt} , $stat{$player}->{pdt} ,
	      $stat{$player}->{bat} ,
	      $stat{$player}->{kt} , $stat{$player}->{dt} ,
	      $stat{$player}->{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.

print OUTPUT  <<END;
<BODY BGCOLOR="#FFFFFF" TEXT="#111100" LINK="#112299" ALINK="AA0000"
VLINK="#BB7711">

<title>PWstats: $awayteam ($awayrace) at $hometeam ($homerace)</title>

<center>
<h2>PWstats: $awayteam ($awayrace) at $hometeam ($homerace)</h2>

<table>
<tr><th valign=center rowspan=2><font size=+3>FINAL SCORE: 
END

if ( $awayscore > $homescore ) {
    print OUTPUT  <<END;
<td><font size=+2>$awayteam ($awayrace) ${th}<font size=+2>$awayscore
<tr><td><font size=+2>$hometeam ($homerace) ${th}<font size=+2>$homescore
</table>
</center>
END

} else {
    print OUTPUT  <<END;
<td><font size=+2>$hometeam ($homerace) ${th}<font size=+2>$homescore
<tr><td><font size=+2>$awayteam ($awayrace) ${th}<font size=+2>$awayscore
</table>
</center>
END
}

# 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}->{$value} ) {
	    $stat{$player}->{$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  <<END;

<h3>Player Stats</h3>

<h4>Home Team</h4>

<table border cellpadding=4>
    <tr>${th}Name${th}Minutes${th}tpd${th}tpt${th}tpb${th}tab
    ${th}tad/tac/%ad${th}cak${th}eao${th}eck${th}pck${th}tek${th}def${th}acc

<tr>

END

foreach $player ( sort keys %stat ) {

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

printrecord($player);

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

}

print OUTPUT  <<END;
<tr><td>
    ${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  <<END;
%
${th}$home{cak}
${th}$home{eao}
${th}$home{eck}
${th}$home{pck}
${th}$home{tek}
${th}$home{def}
${th}$home{acc}

</table>
<p>
<h4>Away Team</h4>

<table border cellpadding=4>
    <tr>${th}Name${th}Minutes${th}tpd${th}tpt${th}tpb${th}tab
    ${th}tad/tac/%ad${th}cak${th}eao${th}eck${th}pck${th}tek${th}def${th}acc

END

foreach $player ( sort keys %stat ) {

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

printrecord($player);

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

}


print OUTPUT  <<END;
<tr><td>
${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  <<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  <<END;
</table>
<p>
<h3>Normalized Player Stats</h3>
<i>(Statistics normalized to game length)</i>

<h4>Home Team</h4>

<table border cellpadding=4>
    <tr>${th}Name${th}Minutes${th}tpd${th}tpt${th}tpb${th}tab
    ${th}tad/tac/%ad${th}cak${th}eao${th}eck${th}pck${th}tek${th}def${th}acc

<tr>
END

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

print OUTPUT <<END;
</table>
<p>
<h4>Away Team</h4>

<table border cellpadding=4>
    <tr>${th}Name${th}Min ${th}tpd${th}tpt${th}tpb${th}tab
    ${th}tad/tac/%ad${th}cak${th}eao${th}eck${th}pck${th}tek${th}def${th}acc

END

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

print OUTPUT <<END;
</table>
<p>

<h3>Starbase Stats</h3>
<table border cellpadding=4>
    <tr>${th}Name ${th}Min ${th}tek ${th}def ${th}tad/tac/%ad ${th}cak
END

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

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

	print OUTPUT <<END;
	<tr>	${td} $player ${td} $sbmin ${td} $stat{$player}->{ktsb}
${td} $stat{$player}->{dtsb} ${td} $sbtad/$stat{$player}->{atsb}
END

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

    }


print OUTPUT <<END;

</table>
<p>

<h3>Kill Stats</h3>

<table border cellpadding=4>
<tr>${th}Name ${th}kbp ${th}kbt ${th}kbs
    ${th}dbp ${th}dbt ${th}dbs
END

foreach $player ( sort keys %stat ) {

print OUTPUT  <<END;
<tr>
    $td $stat{$player}->{name}
$td $stat{$player}->{kbp}
$td $stat{$player}->{kbt}
$td $stat{$player}->{kbs}
$td $stat{$player}->{dbp}
$td $stat{$player}->{dbt}
$td $stat{$player}->{dbs}
END
}

print OUTPUT <<END;
</table>
<p>
<h3>Starbase Kill Stats</h3>

<table border cellpadding=4>
<tr>${th}Name ${th}kbp ${th}kbt ${th}kbs
    ${th}dbp ${th}dbt ${th}dbs
END

    foreach $player ( sort keys %stat ) {

	next if $stat{$player}->{ktsb} < 1;

print OUTPUT  <<END;
<tr>
    $td $stat{$player}->{name}
$td $stat{$player}->{kbpsb}
$td $stat{$player}->{kbtsb}
$td $stat{$player}->{kbssb}
$td $stat{$player}->{dbpsb}
$td $stat{$player}->{dbtsb}
$td $stat{$player}->{dbssb}
END
	
    }

print OUTPUT "</table>\n";

} ### end sub printstats


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

    my $player=$_[0];

    $td = "<td align=center>";

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

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

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

print OUTPUT  <<END;

    $td $stat{$player}->{ak}
    $td $stat{$player}->{oat}
    $td $stat{$player}->{odc}
    $td $stat{$player}->{opc}
    $td $stat{$player}->{kt}
    $td $stat{$player}->{dt}
    $td $stat{$player}->{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}->{tt} > $gamelength ) {
		$gamelength = $stat{$player1}->{tt};
	    }
	}
    }

    $td = "<td align=center>";

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

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

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

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

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

print OUTPUT  <<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 = <PWSTATS> ) {
	print MAIL $line;
    }
    print MAIL "--- end PWstats ---\n";
    close PWSTATS;

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

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

}
end_tourney.pl
Follow-Ups:
- Re: [VANILLA-LIST:2555] Updated end_tourney.pl
  - From: Dave Ahn <ahn@vec.wfubmc.edu>
Prev by Date: Re: [VANILLA-LIST:2552] Package Naming Credibility
Next by Date: Re: [VANILLA-LIST:2555] Updated end_tourney.pl
Prev by thread: Re: [VANILLA-LIST:2552] Package Naming Credibility
Next by thread: Re: [VANILLA-LIST:2555] Updated end_tourney.pl
Index(es):
- Date
- Thread