]> git.pond.sub.org Git - empserver/blob - tests/normalize.pl
tests: Cut off log file timestamp instead of normalizing it
[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 $ctime_re = qr/(Sun|Mon|Tue|Wed|Thu|Fri|Sat) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) [ 123][0-9] [0-2][0-9]:[0-5][0-9]:[0-6][0-9] [0-9][0-9][0-9][0-9]/;
17 my $xdfld_re = qr/\([^)]*\)|[^ (][^ ]*/;
18
19 # Current dump, if any
20 # Either zero or the name of the dump we're currently processing.
21 # Legacy dump names start with an uppercase letter, and xdump names
22 # start with a lowercase letter.
23 my $dump = "";
24
25 sub norm_ctime {
26     my ($s) = @_;
27     $s =~ s/$ctime_re/Thu Jan  1 00:00:00 1970/g;
28     return $s;
29 }
30
31 while (<>) {
32     chomp;
33
34     my $pfx = '';
35
36     if ($opt_j || $opt_s) {
37         die "$0: malformed line" unless /^$ctime_re /;
38         $_ = substr($_, 25);
39     }
40
41     if ($opt_j) {
42         die "$0: malformed line" unless substr($_, 10, 1) eq ' ';
43         $pfx .= substr($_, 0, 11);
44         $_ = substr($_, 11);
45         if (/(^output [^ ]* 1 )(.*)/) {
46             $pfx .= $1;
47             $_ = $2;
48         } else {
49             $pfx .= $_;
50             $_ = '';
51         }
52     }
53
54     if ($opt_s) {
55         $_ = norm_ctime($_);
56         ### Host environment in logs
57         # getrusage() results in server.log
58         s/(End update|done assembling paths) .* user .* system/$1 0.0 user 0.0 system/g;
59         # PID in server.log
60         s/(Empire server \(pid) [0-9]+(\) started)/$1 42$2/g;
61         ### Harmless races
62         # shutdown wins race with logout
63         next if /Waiting for player threads to terminate/;
64         print "$pfx$_\n";
65         next;
66     }
67
68     $dump = ""
69         if ($dump =~ /^[a-z]/
70             and /^\//)
71         or ($dump =~ /^[A-Z]/
72             and (/\: No (sector|ship|plane|unit|nuke)\(s\)|\: Nothing lost/
73                  or /^[0-9]+ (sector|ship|plane|unit|nuke|lost item)/));
74
75     ### Formatted time
76     # nat_timeused in prompt
77     s/^\[[0-9]+(:[0-9]+\] Command \:)/[0$1/g;
78     # TODO command play column time
79     # result of ctime() in many commands
80     $_ = norm_ctime($_)
81         unless $dump;
82     ### Time values in legacy dumps
83     s/(DUMP (SECTOR|SHIPS|PLANES|LAND UNITS|NUKES|LOST ITEMS)) [0-9]+$/$1 0/g;
84     s/ [0-9]+$/ 0/
85         if $dump eq 'LOST ITEMS';
86     ### Time values in xdump
87     s/(XDUMP (meta )?[-a-z0-9]+) [0-9]+$/$1 0/
88         unless $dump;
89     # HACK: assume any integer with more than 10 digits is time
90     # TODO don't do that, use xdump meta instead
91     s/(^| )[0-9]{10,}/${1}0/g
92         if $dump =~ /^[a-z]/;
93     # timeused in xdump country timeused (column 10)
94     s/^(($xdfld_re ){10})([0-9]+) /${1}255 /
95         if $dump eq 'country';
96     # timeused in xdump nat (column 15)
97     s/^(($xdfld_re ){15})([0-9]+) /${1}255 /
98         if $dump eq 'nat';
99     # duration in xdump news (column 4)
100     s/^(($xdfld_re ){4})([0-9]+) /${1}0 /
101         if $dump eq 'news';
102     ### nsc_type values in xdump
103     # Can vary between systems, because the width of enumeration types
104     # is implementation-defined.
105     # TODO type in xdump meta
106     ### nrndx values in xdump
107     # Encoding depends on the host, see resources[].  Too clever by half;
108     # perhaps we should change it.
109     # nrndx in xdump product (column 12)
110     s/^(($xdfld_re ){12})([0-9]+) /${1}0 /
111         if $dump eq 'product';
112     # value in xdump resources (column 0)
113     s/^[0-9]+ /0 /
114         if $dump eq 'resources';
115     ### Floating-point zero in xdump
116     # Windows %#g prints it with seven significant digits instead of six
117     s/ 0\.000000/ 0.00000/g
118         if $dump =~ /^[a-z]/;
119
120     print "$pfx$_\n";
121
122     if (/(XDUMP|^config) (meta )?([-a-z0-9]+)/) {
123         $dump = $3;
124         die unless $dump =~ /^[a-z]/;
125     } elsif (/DUMP (SECTOR|SHIPS|PLANES|LAND UNITS|NUKES|LOST ITEMS) /) {
126         $dump = $1;
127     }
128 }