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