git.sesse.net Git - foosball/blob - www/assess-single.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 = $cgi->param('username1');
  14 $username1 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 1";
  15 $username1 = $1;
  16
  17 my $username2 = $cgi->param('username2');
  18 $username2 =~ /^([a-z][a-z0-9]*)$/ or die "Invalid user name 2";
  19 $username2 = $1;
  20
  21 my $dbh = foosball::db_connect();
  22
  23 # fetch the single ratings
  24 my ($rating1, $rd1) = foosball::find_single_rating($dbh, $username1);
  25 my ($rating2, $rd2) = foosball::find_single_rating($dbh, $username2);
  26
  27 open ASSESS, "/srv/foosball.sesse.net/foorank $rating1 $rd1 $rating2 $rd2 |"
  28         or die "foorank: $!";
  29
  30 my @results = ();
  31 while (<ASSESS>) {
  32         my ($score, $prob, $rdiff1, $rdiff2) = split /,/, $_;
  33         push @results, {
  34                 score => $score,
  35                 prob => (sprintf "%.3f", $prob),
  36                 rdiff1 => (sprintf "%+d", int($rdiff1+0.5)),
  37                 rdiff2 => (sprintf "%+d", int($rdiff2+0.5)),
  38         };
  39 }
  40
  41 print CGI->header(-type=>'application/xhtml+xml');
  42
  43 my $doc = XML::Template::process_file('assess.xml', {
  44         'username1' => $username1,
  45         'username2' => $username2,
  46         '#results' => \@results,
  47 });
  48 print $doc->toString;