pvpgnreport

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use Data::Dumper;
   6
   7 our $DBG = 0;
   8 our $TEST = 0;
   9
  10 sub reporthead {
  11         my ($reportfile) = @_;
  12         my %report;
  13         while (defined ($_ = readline $reportfile)) {
  14                 # empty line = end of head
  15                 /\S/ or last;
  16                 # strip first key=val pair
  17                 s{
  18                         ^\s* ([a-zA-Z]+) = ("(?: [^"\\] | \\. )*" | \S*)
  19                 }{}x or chomp, warn("Unknown pvpgn report header line: $_\n"), next;
  20                 my ($key, $val) = ($1, $2);
  21                 $val =~ s/^"(.*)"$/$1/ and $val =~ s/\\(.)/$1/g;  # unquote
  22                 $report{$key} = $val;
  23                 redo if /\S/;  # other pairs on this line
  24         }
  25         return \%report;
  26 }
  27
  28 sub reportplayers {
  29         my ($reportfile) = @_;
  30         my @player;
  31
  32         while (defined ($_ = readline $reportfile)) {
  33                 # ignore leading empty lines; stop if trailing
  34                 /\S/ or @player ? last : next;
  35                 my ($name, $result, $ladder) = /^ (\S+) \s+ ([A-Z]+) \s* (.*)/x
  36                         or chomp, warn("Unknown pvpgn report player line: $_\n");
  37                 push @player, {name => $name, result => $result};
  38                 if ($ladder) {
  39                         my @ladderdata = $ladder =~ m{
  40                                 ^ \s* rating=(\d+) \s+ \[\#\d+\]
  41                                 \s+ prob=([\d.]+)% \s+ K=(\d+) \s+ adj=([+-]\d+) \s* $
  42                         }x ? $player[-1]{ladder} = {
  43                                 rating => $1,
  44                                 prob => $2,
  45                                 K => $3,
  46                                 adj => $4,
  47                         } : warn("Unknown ladder details for player $name: $ladder\n");
  48                 }
  49         }
  50
  51         my $i = -1;
  52         while (defined ($_ = readline $reportfile)) {
  53                 m{<race>([^<]+)</race>} or next;
  54                 while (1) {
  55                         defined $player[++$i]
  56                                 or die("More <race> entries than $i found players\n");
  57                         last unless $player[$i]->{result} eq "DISCONNECT";
  58                 }
  59                 $player[$i]->{race}= $1;
  60         }
  61
  62         return \@player;
  63 }
  64
  65 my $path = $ARGV[0] or die "Usage: $0 FILE\n";
  66 my ($name) = $path =~ m{([^/]+)$};
  67 open my $reportfile, '<', "$path.txt" or die "No report file: $!\n";
  68 my $report = reporthead($reportfile);
  69 print Dumper $report if $DBG;
  70
  71 my $players = reportplayers($reportfile);
  72 my %resultdelta = qw(WIN 1  DISCONNECT 0  DRAW 0  LOSS -1);
  73 for (@$players) {
  74         defined $resultdelta{ $_->{result} }
  75                 or die "Invalid player result '$_->{result}' for $_->{name}\n";
  76         $_->{delta} = $resultdelta{ $_->{result} };
  77 }
  78 print Dumper $players if $DBG;
  79
  80 my %placetxt = (
  81         bn => "bnet",
  82         gr => "groningen",
  83         md => "mdhq",
  84 );
  85 my ($placeid) = $name =~ /.*([a-z]{2})/;
  86 my $place = $placetxt{$placeid} or die "Unknown place id: $placeid\n";
  87 print "Resolved place '$placeid' to $place\n" if $DBG;
  88
  89 use DBIx::Simple;
  90 my @dbinfo = do "dbinfo.inc.pl";
  91 my $Db = DBIx::Simple->connect(@dbinfo, {pg_enable_utf8 => 1})
  92         or die "No database: $DBI::errstr\n";
  93
  94 $TEST and exit;
  95
  96 $Db->begin;
  97
  98 use Date::Parse;
  99 my ($start, $end) = map str2time($report->{$_}), qw(started ended);
 100 use Date::Format;
 101 $Db->insert("game", {
 102         name => $name,
 103         place => $place,
 104         map => $report->{mapfile},
 105         type => $report->{type},
 106         start => time2str('%Y-%m-%d %X', $start),
 107         duration => sprintf('%d seconds', $end - $start),
 108 })->rows or die "Game insert failed: ".$Db->error."\n";
 109 my $gameid = $Db->last_insert_id((undef) x 4, {sequence => "game_id_seq"})
 110         or die "Couldn't find our game insertion: ".$Db->error."\n";
 111 print "Game inserted as # $gameid\n";
 112
 113 $Db->insert("play", {
 114         game => $gameid,
 115         slot => $_,
 116         name => $players->[$_]->{name},
 117         account => $players->[$_]->{name},
 118         result => $players->[$_]->{delta},
 119         race => substr($players->[$_]->{race}, 0, 1),
 120 })->rows or die "Player insert failed: ".$Db->error."\n"
 121         for 0 .. $#$players;
 122
 123 $Db->commit;
 124