rounds.pl

A Perl-based statistics management system designed for academic competition tournaments. These tourn

#!/usr/bin/perl -w

# Livestat 1.2, by Jason Weill ([e-mail])
# Copyright (C) 2001-02 Jason Weill

# Livestat 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.
#
# Livestat 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 Livestat; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# Generates pages based on round-by-round results.

my %options;
my %teams;

if (not -e "activetourney") {
  die "No tournament is active.  Use set-active to set a tournament.";
}

# read the HTML header and footer
my $page_header = "";
my $page_footer = "";

if (not -e "common.head") {
  die "Header file not found";
}

if (not -e "common.foot") {
  die "Footer file not found";
}

open(HEADER, "< common.head") or die "Cannot open common header: $!";
foreach (<HEADER>) {
  $page_header .= $_;
}
close(HEADER) or die "Cannot close common header: $!";

open(FOOTER, "< common.foot") or die "Cannot open common footer: $!";
foreach (<FOOTER>) {
  $page_footer .= $_;
}
close(FOOTER) or die "Cannot close common footer: $!";

open ACTIVE, "activetourney" or die "Cannot open tournament file: $!";
chomp($dir = <ACTIVE>);
close ACTIVE or die "Cannot close tournament file: $!";

chdir($dir) or die "Cannot open directory $dir: $!";

open CONFIG, "global.cfg" or die "Cannot open configuration file: $!";

$_ = "";
until (/BEGIN TEAM/) {
  $_ = <CONFIG>;
  chomp;
  #s/\#.*//g;
  if (/=/ and not /^\#/) {
    ($option, $setting) = split(/=/, $_);
    $options{$option} = $setting;
  }
}

until (/END TEAM/) {
  $_ = <CONFIG>;
  chomp;
  if (/=/ and not /^\#/) {
    ($option, $setting) = split(/=/, $_);
    $teams{$option} = $setting;
  }
}

close CONFIG or die "Cannot close config file: $!";

open STATS, "scores" or die "Cannot open stats file: $!";
my %records;
my %games;
my $rounds = 0;

while(not eof(STATS)) {
  chomp($_ = <STATS>);
  if (/,/) {
    ($round, $team1, $team2, $score1, $score2) = split(/,/, $_);

    if ($round > $rounds) { $rounds = $round; }

    if (not $games{$round}) {
      $games{$round} = ();
    }
    #if (not $games{$team2}) {
    #  $games{$team2} = ();
    #}

    # print "Round $round: $team1 $score1 - $team2 $score2\n";

    my @tarray1 = ($team1, $team2, $score1, $score2);
    #my @tarray2 = ($round, $team1, $score2, $score1);

    push(@{$games{$round}}, @tarray1);
    #print join(", ", @{$games{$round}}) . "\n";
    #push(@{$games{$team2}}, @tarray2);
  }
}
close STATS;

open STATS, "indstats" or die "Cannot open individual stats file: $!";
while (not eof(STATS)) {
  chomp($_ = <STATS>);
  if (/,/) {
    @sets = split(/,/, $_);

    ($round, $team1, $team2, $name, $power, $tossup, $neg5) =
      @sets[0, 1, 2, 3, 6, 7, 8];

    $pname = "$round$team1$team2";
    # print $pname . "\n";

    if (not $records{$pname}) {
      $records{$pname} = ();
    }

    @tarray1 = ($name, $power, $tossup, $neg5);
    push(@{$records{$pname}}, @tarray1);
  }
}
close STATS;

sub by_points {
  # Defaults to PPG, then total points (i.e. games played), then fewest negs.
  $ppg_a = $records{$a}{"points"} / $records{$a}{"games"};  
  $ppg_b = $records{$b}{"points"} / $records{$b}{"games"};

  if ($ppg_a == $ppg_b) {
    if ($records{$a}{"points"} == $records{$b}{"points"}) {
      if ($records{$a}{"negs"} == $records{$b}{"negs"}) {
	return $a cmp $b; # sort by name, worst case
      } else {
	return $records{$a}{"negs"} <=> $records{$b}{"negs"};
      }
    } else {
      return $records{$a}{"points"} <=> $records{$b}{"points"};
    }
  } else {
    return $ppg_a <=> $ppg_b;
  }
}

sub by_value {
  # simple numeric sort
  return $a <=> $b;
}

@myrounds = sort by_value keys(%games);
# print join (", ", @myrounds) . "\n";

open STANDINGS, ">rounds.html" or die "Cannot open output file: $!";

$title = $options{"name"};
$page_header =~ s/TITLEHERE/$title Scoreboard/;
print STANDINGS $page_header;
print STANDINGS "<h1>$title</h1>\n";
print STANDINGS "<h2>Scoreboard after " . $rounds . " round" . 
  ($rounds == 1 ? "" : "s") . "</h2>\n";
  print STANDINGS 
'<p>Standings: <a href="stats.html">By Team</a> - 
<a href="personal.html">By Individual</a> - 
<strong>By Round</strong></p>';
#foreach $key(keys(%records)) {
#my $gm = 0;
foreach $key(@myrounds) {
  #$rank++;
  print STANDINGS "<h3>Round $key</h3>\n";

  while (@{$games{$key}}) {
    $t1 = shift(@{$games{$key}});
    $t2 = shift(@{$games{$key}});
    $s1 = shift(@{$games{$key}});
    $s2 = shift(@{$games{$key}});

    print STANDINGS "<table class=\"round\">\n";

    print STANDINGS "<tr>\n";
    if ($s1 > $s2) {
      print STANDINGS "<td width='25%' class='winteam1'>" .
	"<a href='stats.$t1.html'>" 
	. $teams{$t1} . "</a></td>\n";
      print STANDINGS "<td width='5%' class='winscr1'>$s1</td>\n";
    } else {
      print STANDINGS "<td width='25%' class='team1'>" .
	"<a href='stats.$t1.html'>" 
	. $teams{$t1} . "</a></td>\n";
      print STANDINGS "<td width='5%' class='scr1'>$s1</td>\n";
    }

    # leading scorer
    my ($lsname, $lspt, $ls15, $ls10, $ls5);
    $lsname = "N/A";
    $lspt = $ls15 = $ls10 = $ls5 = 0;
    $tag = $key . $t1 . $t2;
    # print "Checking $tag\n";
    while (@{$records{$tag}}) {
      $mname = shift(@{$records{$tag}});
      $m15 = shift(@{$records{$tag}});
      $m10 = shift(@{$records{$tag}});
      $m5 = shift(@{$records{$tag}});
      $mpts = $m15 * 15 + $m10 * 10 - $m5 * 5;

      if ($mpts > $lspt) {
	($lsname, $lspt, $ls15, $ls10, $ls5) = 
	  ($mname, $mpts, $m15, $m10, $m5);
      }
    }
    $lstring = $lsname . ": " . 
      ($options{"power"} eq "y" ? 
       ($ls15 == 0 ? "" : $ls15 . " power toss-up" . 
	($ls15 == 1 ? "" : "s") . ", ") : "") .
	  ($ls10 == 0 ? "" : 
	   $ls10 . " toss-up" . ($ls10 == 1 ? "" : "s") . ", ") . 
	     ($ls5 == 0 ? "" : $ls5 . " neg-5" . ($ls5 == 1 ? "" : "s"));

    $lstring =~ s/, $//;

    # print nothing if nobody has a positive score
    if ($lstring eq "N/A: ") { 
      $lstring = "&nbsp;" # will not print anything
    } 

    print STANDINGS "<td width='70%'>$lstring</td>\n";
    print STANDINGS "</tr><tr>\n";

    if ($s2 > $s1) {
      print STANDINGS "<td width='25%' class='winteam2'>" . 
	"<a href='stats.$t2.html'>" 
	. $teams{$t2} . "</a></td>\n";
      print STANDINGS "<td width='5%' class='winscr2'>$s2</td>\n";
    } else {
      print STANDINGS "<td width='25%' class='team2'>" .
	"<a href='stats.$t2.html'>" 
	  . $teams{$t2} . "</a></td>\n";
      print STANDINGS "<td width='5%' class='scr2'>$s2</td>\n";
    }

    # leading scorer
    # my ($lsname, $lspt, $ls15, $ls10, $ls5);
    $lsname = "N/A";
    $lspt = $ls15 = $ls10 = $ls5 = 0;
    $tag = $key . $t2 . $t1;
    # print "Checking $tag\n";
    while (@{$records{$tag}}) {
      $mname = shift(@{$records{$tag}});
      $m15 = shift(@{$records{$tag}});
      $m10 = shift(@{$records{$tag}});
      $m5 = shift(@{$records{$tag}});
      $mpts = $m15 * 15 + $m10 * 10 - $m5 * 5;

      if ($mpts > $lspt) {
	($lsname, $lspt, $ls15, $ls10, $ls5) = 
	  ($mname, $mpts, $m15, $m10, $m5);
      }
    }
    $lstring = $lsname . ": " . 
      ($options{"power"} eq "y" ? 
       ($ls15 == 0 ? "" : $ls15 . " power toss-up" . 
	($ls15 == 1 ? "" : "s") . ", ") : "") .
	  ($ls10 == 0 ? "" : 
	   $ls10 . " toss-up" . ($ls10 == 1 ? "" : "s") . ", ") . 
	     ($ls5 == 0 ? "" : $ls5 . " neg-5" . ($ls5 == 1 ? "" : "s"));

    $lstring =~ s/, $//;

    print STANDINGS "<td width='70%'>$lstring</td>\n";
    print STANDINGS "</tr>\n</table>\n";
  }
}
  
# print STANDINGS "</table>";

print STANDINGS $page_footer;
close STANDINGS or die "Cannot close output file: $!";