git.sesse.net Git - foosball/blob - www/assess-double.pl

   1 #! /usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use DBI;
   5 use CGI;
   6 use CGI::Carp qw(fatalsToBrowser);
   7 use lib qw(/srv/bzr.sesse.net/www/xml-template/perl/);
   8 use XML::Template;
   9 require '../foosball.pm';
  10
  11 my $cgi = CGI->new;
  12
  13 my $username1_1 = $cgi->param('team1_username1');
  14 $username1_1 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 1.1";
  15 $username1_1 = $1;
  16
  17 my $username1_2 = $cgi->param('team1_username2');
  18 $username1_2 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 1.2";
  19 $username1_2 = $1;
  20
  21 my $username2_1 = $cgi->param('team2_username1');
  22 $username2_1 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 2.1";
  23 $username2_1 = $1;
  24
  25 my $username2_2 = $cgi->param('team2_username2');
  26 $username2_2 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 2.2";
  27 $username2_2 = $1;
  28
  29 my $dbh = foosball::db_connect();
  30
  31 # fetch the double ratings
  32 my ($rating1_1, $rd1_1) = foosball::find_double_rating($dbh, $username1_1);
  33 my ($rating1_2, $rd1_2) = foosball::find_double_rating($dbh, $username1_2);
  34 my ($rating2_1, $rd2_1) = foosball::find_double_rating($dbh, $username2_1);
  35 my ($rating2_2, $rd2_2) = foosball::find_double_rating($dbh, $username2_2);
  36
  37 # 10-x table
  38 open ASSESS, "/srv/foosball.sesse.net/foosrank $rating1_1 $rd1_1 $rating1_2 $rd1_2 $rating2_1 $rd2_1 $rating2_2 $rd2_2 10 |"
  39         or die "foosrank: $!";
  40
  41 my @results10 = ();
  42 while (<ASSESS>) {
  43         my ($score, $prob, $rdiff1, $rdiff2, $rdiff3, $rdiff4) = split /,/, $_;
  44         push @results10, {
  45                 score => $score,
  46                 prob => (sprintf "%.3f", $prob),
  47                 rdiff1 => (sprintf "%+d", int($rdiff1+0.5)),
  48                 rdiff2 => (sprintf "%+d", int($rdiff2+0.5)),
  49                 rdiff3 => (sprintf "%+d", int($rdiff3+0.5)),
  50                 rdiff4 => (sprintf "%+d", int($rdiff4+0.5)),
  51         };
  52 }
  53
  54 # 7-x table
  55 open ASSESS, "/srv/foosball.sesse.net/foosrank $rating1_1 $rd1_1 $rating1_2 $rd1_2 $rating2_1 $rd2_1 $rating2_2 $rd2_2 7 |"
  56         or die "foosrank: $!";
  57
  58 my @results7 = ();
  59 while (<ASSESS>) {
  60         my ($score, $prob, $rdiff1, $rdiff2, $rdiff3, $rdiff4) = split /,/, $_;
  61         push @results7, {
  62                 score => $score,
  63                 prob => (sprintf "%.3f", $prob),
  64                 rdiff1 => (sprintf "%+d", int($rdiff1+0.5)),
  65                 rdiff2 => (sprintf "%+d", int($rdiff2+0.5)),
  66                 rdiff3 => (sprintf "%+d", int($rdiff3+0.3)),
  67                 rdiff4 => (sprintf "%+d", int($rdiff4+0.4)),
  68         };
  69 }
  70
  71 print CGI->header(-type=>'application/xhtml+xml');
  72
  73 my $doc = XML::Template::process_file('assess-double.xml', {
  74         'username1' => $username1_1,
  75         'username2' => $username1_2,
  76         'username3' => $username2_1,
  77         'username4' => $username2_2,
  78         'rating1' => int($rating1_1+0.5),
  79         'rating2' => int($rating1_2+0.5),
  80         'rating3' => int($rating2_1+0.5),
  81         'rating4' => int($rating2_2+0.5),
  82         '#results10' => XML::Template::alternate('tr/class', \@results10, 'odd', 'even'),
  83         '#results7' => XML::Template::alternate('tr/class', \@results7, 'odd', 'even'),
  84 });
  85 print $doc->toString;