git.pond.sub.org Git - empserver/blob - tests/normalize.pl

   1 #!/usr/bin/perl
   2
   3 # TODO Don't hardcode xdump columns, get them from xdump meta
   4
   5 use warnings;
   6 use strict;
   7 use Getopt::Std;
   8
   9 $Getopt::Std::STANDARD_HELP_VERSION = 1;
  10 our ($opt_j, $opt_s);
  11 getopts('js')
  12     or die "$0: invalid options\n";
  13 die "$0: either -j or -s, not both\n"
  14     if $opt_j && $opt_s;
  15
  16 my $dow_re = qr/(Sun|Mon|Tue|Wed|Thu|Fri|Sat)/;
  17 my $mon_re = qr/(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)/;
  18 my $tod_re = qr/[0-2][0-9]:[0-5][0-9]:[0-6][0-9]/;
  19 my $year_re = qr/[0-9][0-9][0-9][0-9]/;
  20 my $ctime19_re = qr/$dow_re $mon_re [ 123][0-9] $tod_re/;
  21 my $ctime_re = qr/$dow_re $mon_re [ 123][0-9] $tod_re $year_re/;
  22 my $fmttime2822_re = qr/$dow_re, [0123][0-9] $mon_re $year_re $tod_re [-+][0-9][0-9][0-9][0-9]/;
  23 my $xdfld_re = qr/\([^)]*\)|[^ (][^ ]*/;
  24
  25 # Current dump, if any
  26 # Either zero or the name of the dump we're currently processing.
  27 # Legacy dump names start with an uppercase letter, and xdump names
  28 # start with a lowercase letter.
  29 my $dump = "";
  30
  31 sub norm_ctime {
  32     my ($s) = @_;
  33     $s =~ s/$ctime_re/Thu Jan  1 00:00:00 1970/g;
  34     $s =~ s/$ctime19_re/Thu Jan  1 00:00:00/g;
  35     $s =~ s/$fmttime2822_re/Thu, 01 Jan 1970 00:00:00 +0000/g;
  36     return $s;
  37 }
  38
  39 while (<>) {
  40     chomp;
  41
  42     # Strip log timestamp
  43     if ($opt_j || $opt_s) {
  44         die "$0: malformed line" unless /^$ctime_re /;
  45         $_ = substr($_, 25);
  46     }
  47
  48     # Strip trailing white space
  49     # We don't really care for it in test output, and git's pre-commit
  50     # hook flags it, which is annoying.
  51     s/\s+$//;
  52
  53     # Split off prefix that is not to be normalized
  54     my $pfx = '';
  55     if ($opt_j) {
  56         die "$0: malformed line" unless substr($_, 10, 1) eq ' ';
  57         $pfx .= substr($_, 0, 11);
  58         # Normalize only player output
  59         $_ = substr($_, 11);
  60         if (/(^output [^ ]* 1 )(.*)/) {
  61             $pfx .= $1;
  62             $_ = $2;
  63         } else {
  64             $pfx .= $_;
  65             $_ = '';
  66         }
  67     }
  68
  69     if ($opt_s) {
  70         $_ = norm_ctime($_);
  71         ### Host environment in logs
  72         # getrusage() results in server.log
  73         s/(End update|done assembling paths) .* user .* system/$1 0.0 user 0.0 system/;
  74         # PID in server.log
  75         s/(Empire server \(pid) [0-9]+(\) started)/$1 42$2/;
  76         ### Harmless races
  77         # shutdown wins race with logout
  78         next if /Waiting for player threads to terminate/;
  79         print "$pfx$_\n";
  80         next;
  81     }
  82
  83     $dump = ""
  84         if ($dump =~ /^[a-z]/
  85             and /^\//)
  86         or ($dump =~ /^[A-Z]/
  87             and (/\: No (sector|ship|plane|unit|nuke)\(s\)|\: Nothing lost/
  88                  or /^[0-9]+ (sector|ship|plane|unit|nuke|lost item)/));
  89
  90     ### Formatted time
  91     # nat_timeused in prompt
  92     s/^\[[0-9]+(:[0-9]+\] Command \:)/[0$1/;
  93     $pfx =~ s/( output [^ ]* 6) [0-9]+ ([0-9]+$)/$1 0 $2/
  94         if $opt_j;
  95     # TODO command play column time
  96     # result of ctime() in many commands
  97     $_ = norm_ctime($_)
  98         unless $dump;
  99     ### Time values in legacy dumps
 100     s/(DUMP (SECTOR|SHIPS|PLANES|LAND UNITS|NUKES|LOST ITEMS)) [0-9]+$/$1 0/;
 101     s/ [0-9]+$/ 0/
 102         if $dump eq 'LOST ITEMS';
 103     ### Time values in xdump
 104     s/(XDUMP (meta )?[-a-z0-9]+) [0-9]+$/$1 0/
 105         unless $dump;
 106     # HACK: assume any integer with more than 10 digits is time
 107     # TODO don't do that, use xdump meta instead
 108     s/(^| )[0-9]{10,}/${1}0/g
 109         if $dump =~ /^[a-z]/;
 110     # timeused in xdump country timeused (column 10)
 111     s/^(($xdfld_re ){10})([0-9]+) /${1}255 /
 112         if $dump eq 'country';
 113     # timeused in xdump nat (column 15)
 114     s/^(($xdfld_re ){15})([0-9]+) /${1}255 /
 115         if $dump eq 'nat';
 116     # duration in xdump news (column 4)
 117     s/^(($xdfld_re ){4})([0-9]+) /${1}0 /
 118         if $dump eq 'news';
 119     ### nrndx values in xdump
 120     # Encoding depends on the host, see resources[].  Too clever by half;
 121     # perhaps we should change it.
 122     # nrndx in xdump product (column 12)
 123     s/^(($xdfld_re ){12})([0-9]+) /${1}0 /
 124         if $dump eq 'product';
 125     # value in xdump resources (column 0)
 126     s/^[0-9]+ /0 /
 127         if $dump eq 'resources';
 128     ### Floating-point zero in xdump
 129     # Windows %#g prints it with seven significant digits instead of six
 130     s/ 0\.000000/ 0.00000/g
 131         if $dump =~ /^[a-z]/;
 132
 133     print "$pfx$_\n";
 134
 135     if (/(XDUMP|^config) (meta )?([-a-z0-9]+)/) {
 136         $dump = $3;
 137         die unless $dump =~ /^[a-z]/;
 138     } elsif (/DUMP (SECTOR|SHIPS|PLANES|LAND UNITS|NUKES|LOST ITEMS) /) {
 139         $dump = $1;
 140     }
 141 }