Data/StarCraft/PvPGN/Report.pm

   1 package Data::StarCraft::PvPGN::Report;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6
   7 our $VERSION = "1.00";
   8
   9 sub open {
  10         my $package = shift;
  11         my ($path) = @_;
  12         open my $file, '<', $path or carp("No report file: $!\n"), return undef;
  13         bless $file, $package;
  14 }
  15
  16 sub head {
  17         my $file = shift;
  18         my %report;
  19         while (defined ($_ = readline $file)) {
  20                 # empty line = end of head
  21                 /\S/ or last;
  22                 # strip first key=val pair
  23                 s{
  24                         ^\s* ([a-zA-Z]+) = ("(?: [^"\\] | \\. )*" | \S*)
  25                 }{}x or chomp, warn("Unknown pvpgn report header line: $_\n"), next;
  26                 my ($key, $val) = ($1, $2);
  27                 $val =~ s/^"(.*)"$/$1/ and $val =~ s/\\(.)/$1/g;  # unquote
  28                 $report{$key} = $val;
  29                 redo if /\S/;  # other pairs on this line
  30         }
  31         return \%report;
  32 }
  33
  34 sub players {
  35         my $file = shift;
  36         my @player;
  37
  38         while (defined ($_ = readline $file)) {
  39                 # ignore leading empty lines; stop if trailing
  40                 /\S/ or @player ? last : next;
  41                 my ($name, $result, $ladder) = /^ (\S+) \s+ ([A-Z]+) \s* (.*)/x
  42                         or chomp, warn("Unknown pvpgn report player line: $_\n");
  43                 push @player, {name => $name, result => $result};
  44                 if ($ladder) {
  45                         my @ladderdata = $ladder =~ m{
  46                                 ^ \s* rating=(\d+) \s+ \[\#\d+\]
  47                                 \s+ prob=([\d.]+)% \s+ K=(\d+) \s+ adj=([+-]\d+) \s* $
  48                         }x ? $player[-1]{ladder} = {
  49                                 rating => $1,
  50                                 prob => $2,
  51                                 K => $3,
  52                                 adj => $4,
  53                         } : warn("Unknown ladder details for player $name: $ladder\n");
  54                 }
  55         }
  56
  57         my $i = -1;
  58         while (defined ($_ = readline $file)) {
  59                 m{<race>([^<]+)</race>} or next;
  60                 while (1) {
  61                         defined $player[++$i]
  62                                 or die("More <race> entries than $i found players\n");
  63                         last unless $player[$i]->{result} eq "DISCONNECT";
  64                 }
  65                 $player[$i]->{race}= $1;
  66         }
  67
  68         return \@player;
  69 }
  70
  71 1;
  72