Support double assessment, now that it's fast.

[foosball] / www / assess-double.pl

diff --git a/www/assess-double.pl b/www/assess-double.pl
new file mode 100755 (executable)
index 0000000..bc60069
--- /dev/null
+++ b/www/assess-double.pl
@@ -0,0 +1,85 @@
+#! /usr/bin/perl
+use strict;
+use warnings;
+use DBI;
+use CGI;
+use CGI::Carp qw(fatalsToBrowser);
+use lib qw(/srv/bzr.sesse.net/www/xml-template/perl/);
+use XML::Template;
+require '../foosball.pm';
+
+my $cgi = CGI->new;
+
+my $username1_1 = $cgi->param('team1_username1');
+$username1_1 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 1.1";
+$username1_1 = $1;
+
+my $username1_2 = $cgi->param('team1_username2');
+$username1_2 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 1.2";
+$username1_2 = $1;
+
+my $username2_1 = $cgi->param('team2_username1');
+$username2_1 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 2.1";
+$username2_1 = $1;
+
+my $username2_2 = $cgi->param('team2_username2');
+$username2_2 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 2.2";
+$username2_2 = $1;
+
+my $dbh = foosball::db_connect();
+
+# fetch the double ratings
+my ($rating1_1, $rd1_1) = foosball::find_double_rating($dbh, $username1_1);
+my ($rating1_2, $rd1_2) = foosball::find_double_rating($dbh, $username1_2);
+my ($rating2_1, $rd2_1) = foosball::find_double_rating($dbh, $username2_1);
+my ($rating2_2, $rd2_2) = foosball::find_double_rating($dbh, $username2_2);
+
+# 10-x table
+open ASSESS, "/srv/foosball.sesse.net/foosrank $rating1_1 $rd1_1 $rating1_2 $rd1_2 $rating2_1 $rd2_1 $rating2_2 $rd2_2 10 |"
+       or die "foosrank: $!";
+
+my @results10 = ();
+while (<ASSESS>) {
+       my ($score, $prob, $rdiff1, $rdiff2, $rdiff3, $rdiff4) = split /,/, $_;
+       push @results10, {
+               score => $score,
+               prob => (sprintf "%.3f", $prob),
+               rdiff1 => (sprintf "%+d", int($rdiff1+0.5)),
+               rdiff2 => (sprintf "%+d", int($rdiff2+0.5)),
+               rdiff3 => (sprintf "%+d", int($rdiff3+0.5)),
+               rdiff4 => (sprintf "%+d", int($rdiff4+0.5)),
+       };
+}
+
+# 7-x table
+open ASSESS, "/srv/foosball.sesse.net/foosrank $rating1_1 $rd1_1 $rating1_2 $rd1_2 $rating2_1 $rd2_1 $rating2_2 $rd2_2 7 |"
+       or die "foosrank: $!";
+
+my @results7 = ();
+while (<ASSESS>) {
+       my ($score, $prob, $rdiff1, $rdiff2, $rdiff3, $rdiff4) = split /,/, $_;
+       push @results7, {
+               score => $score,
+               prob => (sprintf "%.3f", $prob),
+               rdiff1 => (sprintf "%+d", int($rdiff1+0.5)),
+               rdiff2 => (sprintf "%+d", int($rdiff2+0.5)),
+               rdiff3 => (sprintf "%+d", int($rdiff3+0.3)),
+               rdiff4 => (sprintf "%+d", int($rdiff4+0.4)),
+       };
+}
+
+print CGI->header(-type=>'application/xhtml+xml');
+
+my $doc = XML::Template::process_file('assess-double.xml', {
+       'username1' => $username1_1,
+       'username2' => $username1_2,
+       'username3' => $username2_1,
+       'username4' => $username2_2,
+       'rating1' => int($rating1_1+0.5),
+       'rating2' => int($rating1_2+0.5),
+       'rating3' => int($rating2_1+0.5),
+       'rating4' => int($rating2_2+0.5),
+       '#results10' => \@results10,
+       '#results7' => \@results7,
+});
+print $doc->toString;