modelscore.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use ASR;
   6 use POSIX qw/strftime/;
   7 use Carp qw/cluck/;
   8 $SIG{__WARN__} = sub { cluck $_[0] };
   9
  10 my $ctx = ASR::Ladder->new;
  11
  12 $ctx->header('Score Change Projection');
  13
  14 my $p1rec = $ctx->db_selectrow("SELECT * FROM player WHERE nick = ?", {}, $ctx->param('p1'));
  15 my $p2rec = $ctx->db_selectrow("SELECT * FROM player WHERE nick = ?", {}, $ctx->param('p2'));
  16
  17 my $err = 0;
  18 if (not $p1rec) {
  19         print $ctx->p("Player '".$ctx->param('p1')."' not found.");
  20         $err++;
  21 }
  22 if (not $p2rec) {
  23         print $ctx->p("Player '".$ctx->param('p2')."' not found.");
  24         $err++;
  25 }
  26 if ($err) {
  27         $ctx->footer;
  28         exit;
  29 }
  30
  31 my $p1proj = $ctx->recompute_score($p1rec->{score}, $p2rec->{score});
  32 my $p2proj = $ctx->recompute_score($p2rec->{score}, $p1rec->{score});
  33
  34 my $p1l = $ctx->plink($p1rec->{id}, $p1rec->{nick});
  35 my $p2l = $ctx->plink($p2rec->{id}, $p2rec->{nick});
  36
  37 print $ctx->p("Assuming game $p1l ($p1rec->{score}) vs $p2l ($p2rec->{score}):");
  38 print <<EOT;
  39 <table id="scoreprojection">
  40 <tr><th>Winner</th><th>$p1rec->{nick}</th><th>$p2rec->{nick}</th></tr>
  41 <tr><td>$p1rec->{nick}</td><td>$p1proj</td><td>$p2rec->{score}</td></tr>
  42 <tr><td>$p2rec->{nick}</td><td>$p1rec->{score}</td><td>$p2proj</td></tr>
  43 </table>
  44 EOT
  45
  46 $ctx->footer;