Added an assessment function.

[foosball] / www / assess-single.pl

diff --git a/www/assess-single.pl b/www/assess-single.pl
new file mode 100644 (file)
index 0000000..0d24a58
--- /dev/null
+++ b/www/assess-single.pl
@@ -0,0 +1,48 @@
+#! /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 = $cgi->param('username1');
+$username1 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 1";
+$username1 = $1;
+
+my $username2 = $cgi->param('username2');
+$username2 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 2";
+$username2 = $1;
+
+my $dbh = foosball::db_connect();
+
+# fetch the single ratings
+my ($rating1, $rd1) = foosball::find_single_rating($dbh, $username1);
+my ($rating2, $rd2) = foosball::find_single_rating($dbh, $username2);
+
+open ASSESS, "/srv/foosball.sesse.net/foorank $rating1 $rd1 $rating2 $rd2 |"
+       or die "foorank: $!";
+
+my @results = ();
+while (<ASSESS>) {
+       my ($score, $prob, $rdiff1, $rdiff2) = split /,/, $_;
+       push @results, {
+               score => $score,
+               prob => (sprintf "%.3f", $prob),
+               rdiff1 => (sprintf "%+d", int($rdiff1+0.5)),
+               rdiff2 => (sprintf "%+d", int($rdiff2+0.5)),
+       };
+}
+
+print CGI->header(-type=>'application/xhtml+xml');
+
+my $doc = XML::Template::process_file('assess.xml', {
+       'username1' => $username1,
+       'username2' => $username2,
+       '#results' => \@results,
+});
+print $doc->toString;