From 66615c316074968c4c39fd3962ba2e7eacedd44c Mon Sep 17 00:00:00 2001
From: Shiar <shiar@shiar.org>
Date: Sun, 11 Nov 2007 23:50:51 +0000
Subject: [PATCH] pvpgn report file parser

Reads a game report file (mixed formatting of formatted text and xml),
and inserts basic game information into the database.
---
 pvpgnreport | 110 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 110 insertions(+)
 create mode 100755 pvpgnreport

diff --git a/pvpgnreport b/pvpgnreport
new file mode 100755
index 0000000..1a91ddf
--- /dev/null
+++ b/pvpgnreport
@@ -0,0 +1,110 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+our $DBG = 0;
+our $TEST = 0;
+
+sub reporthead {
+	my ($reportfile) = @_;
+	my %report;
+	while (defined ($_ = readline $reportfile)) {
+		# empty line = end of head
+		/\S/ or last;
+		# strip first key=val pair
+		s{
+			^\s* ([a-zA-Z]+) = ("(?: [^"\\] | \\. )*" | \S*)
+		}{}x or chomp, warn("Unknown pvpgn report header line: $_\n"), next;
+		my ($key, $val) = ($1, $2);
+		$val =~ s/^"(.*)"$/$1/ and $val =~ s/\\(.)/$1/g;  # unquote
+		$report{$key} = $val;
+		redo if /\S/;  # other pairs on this line
+	}
+	return \%report;
+}
+
+sub reportplayers {
+	my ($reportfile) = @_;
+	my @player;
+
+	while (defined ($_ = readline $reportfile)) {
+		# ignore leading empty lines; stop if trailing
+		/\S/ or @player ? last : next;
+		my ($name, $result) = /^ (.*?) \s+ ([A-Z]+) \s*$/x
+			or chomp, warn("Unknown pvpgn report player line: $_\n");
+		push @player, {name => $name, result => $result};
+	}
+
+	my $i = -1;
+	while (defined ($_ = readline $reportfile)) {
+		m{<race>([^<]+)</race>} or next;
+		while (1) {
+			defined $player[++$i]
+				or die("More <race> entries than $i found players\n");
+			last unless $player[$i]->{result} eq "DISCONNECT";
+		}
+		$player[$i]->{race}= $1;
+	}
+
+	return \@player;
+}
+
+my $name = $ARGV[0] or die "Usage: $0 FILE\n";
+open my $reportfile, '<', "$name.txt" or die "No report file: $!\n";
+my $report = reporthead($reportfile);
+print Dumper $report if $DBG;
+
+my $players = reportplayers($reportfile);
+my %resultdelta = qw(WIN 1  DISCONNECT 0  DRAW 0  LOSS -1);
+for (@$players) {
+	defined $resultdelta{ $_->{result} }
+		or die "Invalid player result '$_->{result}' for $_->{name}\n";
+	$_->{delta} = $resultdelta{ $_->{result} };
+}
+print Dumper $players if $DBG;
+
+my %placetxt = (
+	bn => "bnet",
+	gr => "groningen",
+	md => "mdhq",
+);
+my ($placeid) = $name =~ /.*([a-z]{2})/;
+my $place = $placetxt{$placeid} or die "Unknown place id: $placeid\n";
+print "Resolved place '$placeid' to $place\n" if $DBG;
+
+use DBIx::Simple;
+my @dbinfo = do "dbinfo.inc.pl";
+my $Db = DBIx::Simple->connect(@dbinfo, {pg_enable_utf8 => 1})
+	or die "No database: $DBI::errstr\n";
+
+$TEST and exit;
+
+$Db->begin;
+
+use Date::Parse;
+my ($start, $end) = map str2time($report->{$_}), qw(started ended);
+use Date::Format;
+$Db->insert("game", {
+	name => $name,
+	place => $place,
+	map => $report->{mapfile},
+	type => $report->{type},
+	start => time2str('%Y-%m-%d %X', $start),
+	duration => sprintf('%d seconds', $end - $start),
+})->rows or die "Game insert failed: ".$Db->error."\n";
+my $gameid = $Db->last_insert_id((undef) x 4, {sequence => "game_id_seq"});
+
+$Db->insert("play", {
+	game => $gameid,
+	slot => $_,
+	name => $players->[$_]->{name},
+	account => $players->[$_]->{name},
+	result => $players->[$_]->{delta},
+	race => substr($players->[$_]->{race}, 0, 1),
+})->rows or die "Player insert failed: ".$Db->error."\n"
+	for 0 .. $#$players;
+
+$Db->commit;
+
-- 
2.30.0