--- /dev/null
+package Data::StarCraft::PvPGN::Report;
+
+use strict;
+use warnings;
+use Carp;
+
+our $VERSION = "1.00";
+
+sub open {
+ my $package = shift;
+ my ($path) = @_;
+ open my $file, '<', $path or carp("No report file: $!\n"), return undef;
+ bless $file, $package;
+}
+
+sub head {
+ my $file = shift;
+ my %report;
+ while (defined ($_ = readline $file)) {
+ # 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 players {
+ my $file = shift;
+ my @player;
+
+ while (defined ($_ = readline $file)) {
+ # ignore leading empty lines; stop if trailing
+ /\S/ or @player ? last : next;
+ my ($name, $result, $ladder) = /^ (\S+) \s+ ([A-Z]+) \s* (.*)/x
+ or chomp, warn("Unknown pvpgn report player line: $_\n");
+ push @player, {name => $name, result => $result};
+ if ($ladder) {
+ my @ladderdata = $ladder =~ m{
+ ^ \s* rating=(\d+) \s+ \[\#\d+\]
+ \s+ prob=([\d.]+)% \s+ K=(\d+) \s+ adj=([+-]\d+) \s* $
+ }x ? $player[-1]{ladder} = {
+ rating => $1,
+ prob => $2,
+ K => $3,
+ adj => $4,
+ } : warn("Unknown ladder details for player $name: $ladder\n");
+ }
+ }
+
+ my $i = -1;
+ while (defined ($_ = readline $file)) {
+ 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;
+}
+
+1;
+
use strict;
use warnings;
+use Data::StarCraft::PvPGN::Report;
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, $ladder) = /^ (\S+) \s+ ([A-Z]+) \s* (.*)/x
- or chomp, warn("Unknown pvpgn report player line: $_\n");
- push @player, {name => $name, result => $result};
- if ($ladder) {
- my @ladderdata = $ladder =~ m{
- ^ \s* rating=(\d+) \s+ \[\#\d+\]
- \s+ prob=([\d.]+)% \s+ K=(\d+) \s+ adj=([+-]\d+) \s* $
- }x ? $player[-1]{ladder} = {
- rating => $1,
- prob => $2,
- K => $3,
- adj => $4,
- } : warn("Unknown ladder details for player $name: $ladder\n");
- }
- }
-
- 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 $path = $ARGV[0] or die "Usage: $0 FILE\n";
my ($name) = $path =~ m{([^/]+)$};
-open my $reportfile, '<', "$path.txt" or die "No report file: $!\n";
-my $report = reporthead($reportfile);
-print Dumper $report if $DBG;
+my $report = Data::StarCraft::PvPGN::Report->open("$path.txt")
+ or die "No report file: $!\n";
+my $data = $report->head;
+print Dumper $data if $DBG;
-my $players = reportplayers($reportfile);
+my $players = $report->players;
my %resultdelta = qw(WIN 1 DISCONNECT 0 DRAW 0 LOSS -1);
for (@$players) {
defined $resultdelta{ $_->{result} }
$Db->begin;
use Date::Parse;
-my ($start, $end) = map str2time($report->{$_}), qw(started ended);
+my ($start, $end) = map str2time($data->{$_}), qw(started ended);
use Date::Format;
$Db->insert("game", {
name => $name,
place => $place,
- map => $report->{mapfile},
- type => $report->{type},
+ map => $data->{mapfile},
+ type => $data->{type},
start => time2str('%Y-%m-%d %X', $start),
duration => sprintf('%d seconds', $end - $start),
})->rows or die "Game insert failed: ".$Db->error."\n";