Mercurial > hg > batmud > misc

comparison icesusplaque.pl @ 350:14b3b8dfc797 misc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Cleanups.
author Matti Hamalainen <ccr@tnsp.org>
date Fri, 20 Oct 2017 23:05:27 +0300
parents c79dd30a368f
children
comparison
equal deleted inserted replaced
349:6687ac83bb48 350:14b3b8dfc797
6 # 6 #
7 # Inputs a logfile with multiple Icesus top player plaque listings 7 # Inputs a logfile with multiple Icesus top player plaque listings
8 # and outputs a plaque with changed positions etc. 8 # and outputs a plaque with changed positions etc.
9 # 9 #
10 use strict; 10 use strict;
11 use warnings;
11 use Date::Parse; 12 use Date::Parse;
13
12 14
13 ### Settings 15 ### Settings
14 my $opt_sep = 0; 16 my $opt_sep = 0;
15 my $opt_topexp = 0; 17 my $opt_topexp = 0;
16 my $opt_plaque = 0; 18 my $opt_plaque = 0;
17 my $opt_filename = shift or die("Usage: [perl] $0 <logfilename> [-p] [-s] [-t]\n"); 19 my $opt_filename = shift or die("Usage: [perl] $0 <logfilename> [-p] [-s] [-t]\n");
18 20
19 while (defined(my $opt = shift)) { 21
20 if ($opt eq "-s") { 22 ### Helper functions
21 $opt_sep = 1;
22 } elsif ($opt eq "-t") {
23 $opt_topexp = 1;
24 } elsif ($opt eq "-p") {
25 $opt_plaque = 1;
26 }
27 }
28
29 ### Initialize common global variables
30 my $cplaque = {};
31 my @plaques = ();
32 my $state = 0;
33 my $stamp = undef;
34 my $stamps = 0;
35
36 ### Parse input logfile for plaque data
37 open(INFILE, "<", $opt_filename) or die("Could not open '".$opt_filename."'!\n");
38 while (defined(my $line = <INFILE>)) {
39 $line =~ s/[\r\n]+$//;
40 if ($line =~ /^Server time: (.+)/) {
41 $stamp = str2time($1);
42 } elsif ($state == 0 && $line =~ /^\| +The top \d+ players of Icesus +lvl +Exp +\|/) {
43 $state = 1;
44 } elsif ($state == 1 && $line =~ /^\| +(\d+) +([A-Z][a-z]+) +(\d+) +([0-9][0-9,]+) +\|/) {
45 my ($pos, $name, $level, $exp) = ($1, $2, $3, $4);
46 $exp =~ s/,//g;
47 $$cplaque{$name} = { "pos" => $pos, "level" => $level, "exp" => int($exp) };
48 } elsif ($state == 1 && $line =~ /\`---------------------------------------------------------\'/) {
49 # Save plaque data to array
50 $state = 0;
51 $$cplaque{0} = $stamp;
52 $stamp = undef;
53
54 # We keep maximum of 100 plaques in memory
55 shift(@plaques) if (scalar(@plaques) > 100);
56 push(@plaques, $cplaque);
57 undef($cplaque);
58 $cplaque = {};
59 }
60 }
61 close(INFILE);
62
63 die("Not enough plaque data in input.\n") unless (scalar(@plaques) >= 2);
64
65
66 ### Find plaques with time difference of a week
67 my $p0 = undef;
68 my $p1 = pop(@plaques);
69 die("No timestamp found for primary comparision plaque.\n") unless defined($$p1{0});
70
71 foreach my $plaque (@plaques) {
72 if (defined($$plaque{0}) && $$plaque{0} <= $$p1{0} - (7*24*60*60)) {
73 $p0 = $plaque;
74 }
75 }
76
77 die("Could not find old enough plaque to make a weekly comparision.\n") unless defined($p0);
78
79
80 ### Compute results
81 my @paskat = (30*24*60*60, 7*24*60*60, 24*60*60, 60*60, 60);
82 my @opaskat = ("months", "weeks", "days", "hours", "minutes");
83 my @upaskat = ("month", "week", "day", "hour", "minute");
84
85 sub get_period($) 23 sub get_period($)
86 { 24 {
25 my @paskat = (30*24*60*60, 7*24*60*60, 24*60*60, 60*60, 60);
26 my @opaskat = ("months", "weeks", "days", "hours", "minutes");
27 my @upaskat = ("month", "week", "day", "hour", "minute");
87 my $cur = $_[0]; 28 my $cur = $_[0];
88 if ($cur >= 0) { 29 if ($cur >= 0)
30 {
89 my $str = ""; 31 my $str = "";
90 my ($r, $k, $p, $n); 32 my ($r, $k, $p, $n);
91 $n = 0; 33 $n = 0;
92 foreach my $div (@paskat) { 34 foreach my $div (@paskat)
35 {
93 $r = int($cur / $div); 36 $r = int($cur / $div);
94 $k = ($cur % $div); 37 $k = ($cur % $div);
95 if ($r > 0) { 38 if ($r > 0)
39 {
96 $p = ($r > 1) ? $opaskat[$n] : $upaskat[$n]; 40 $p = ($r > 1) ? $opaskat[$n] : $upaskat[$n];
97 $str .= ", " if ($str ne ""); 41 $str .= ", " if ($str ne "");
98 $str .= sprintf("%d %s", $r, $p); 42 $str .= sprintf("%d %s", $r, $p);
99 } 43 }
100 $cur = $k; 44 $cur = $k;
101 $n++; 45 $n++;
102 } 46 }
103 return $str; 47 return $str;
104 } else { 48 }
49 else
50 {
105 return "?"; 51 return "?";
106 } 52 }
107 } 53 }
54
108 55
109 sub fmt_num($) 56 sub fmt_num($)
110 { 57 {
111 my $s = sprintf("%1.0f", $_[0]); 58 my $s = sprintf("%1.0f", $_[0]);
112 $s =~ s/\d{1,3}(?=(\d{3})+(?!\d))/$&,/g if ($opt_sep); 59 $s =~ s/\d{1,3}(?=(\d{3})+(?!\d))/$&,/g if ($opt_sep);
113 return $s; 60 return $s;
114 } 61 }
62
115 63
116 sub fmt_value($$$) 64 sub fmt_value($$$)
117 { 65 {
118 if ($_[0] == $_[1]) { 66 if ($_[0] == $_[1]) {
119 return sprintf("%".$_[2]."s", fmt_num($_[0])); 67 return sprintf("%".$_[2]."s", fmt_num($_[0]));
122 return sprintf("%".$_[2]."s (%s%.0f)", 70 return sprintf("%".$_[2]."s (%s%.0f)",
123 fmt_num($_[0]), $val < 0 ? "" : "+", $val); 71 fmt_num($_[0]), $val < 0 ? "" : "+", $val);
124 } 72 }
125 } 73 }
126 74
75
76 ###
77 ### Parse commandline arguments
78 ###
79 while (defined(my $opt = shift))
80 {
81 if ($opt eq "-s")
82 {
83 $opt_sep = 1;
84 }
85 elsif ($opt eq "-t")
86 {
87 $opt_topexp = 1;
88 }
89 elsif ($opt eq "-p")
90 {
91 $opt_plaque = 1;
92 }
93 }
94
95
96 ### Initialize common global variables
97 my $cplaque = {};
98 my @plaques = ();
99 my $state = 0;
100 my $stamp = undef;
101 my $stamps = 0;
102
103
104 ### Parse input logfile for plaque data
105 open(INFILE, "<", $opt_filename) or die("Could not open '".$opt_filename."'!\n");
106
107 while (defined(my $line = <INFILE>))
108 {
109 $line =~ s/[\r\n]+$//;
110 if ($line =~ /^Server time: (.+)/)
111 {
112 $stamp = str2time($1);
113 }
114 elsif ($state == 0 && $line =~ /^\| +The top \d+ players of Icesus +lvl +Exp +\|/)
115 {
116 $state = 1;
117 }
118 elsif ($state == 1 && $line =~ /^\| +(\d+) +([A-Z][a-z]+) +(\d+) +([0-9][0-9,]+) +\|/)
119 {
120 my ($pos, $name, $level, $exp) = ($1, $2, $3, $4);
121 $exp =~ s/,//g;
122 $$cplaque{$name} = { "pos" => $pos, "level" => $level, "exp" => int($exp) };
123 }
124 elsif ($state == 1 && $line =~ /\`---------------------------------------------------------\'/)
125 {
126 # Save plaque data to array
127 $state = 0;
128 $$cplaque{0} = $stamp;
129 $stamp = undef;
130
131 # We keep maximum of 100 plaques in memory
132 shift(@plaques) if (scalar(@plaques) > 100);
133 push(@plaques, $cplaque);
134 undef($cplaque);
135 $cplaque = {};
136 }
137 }
138
139 close(INFILE);
140
141 die("Not enough plaque data in input.\n") unless (scalar(@plaques) >= 2);
142
143
144 ### Find plaques with time difference of a week
145 my $p0 = undef;
146 my $p1 = pop(@plaques);
147 die("No timestamp found for primary comparision plaque.\n") unless defined($$p1{0});
148
149 foreach my $plaque (@plaques)
150 {
151 if (defined($$plaque{0}) && $$plaque{0} <= $$p1{0} - (7*24*60*60))
152 {
153 $p0 = $plaque;
154 }
155 }
156
157 die("Could not find old enough plaque to make a weekly comparision.\n") unless defined($p0);
158
159
160 ### Compute results
127 my %final = (); 161 my %final = ();
128 my %expers = (); 162 my %expers = ();
129 163
130 foreach my $name (keys %{$p1}) { 164 foreach my $name (keys %{$p1}) {
131 my $entry1 = $$p1{$name}; 165 my $entry1 = $$p1{$name};
157 191
158 192
159 ### Print output 193 ### Print output
160 my ($shead, $sbar); 194 my ($shead, $sbar);
161 195
162 if ($opt_plaque) { 196 if ($opt_plaque)
163 $sbar = $shead = sprintf "| %-10s | %-12s | %-10s | %-30s |", 197 {
164 "Pos", "Name", "Lvl", "Exp"; 198 $sbar = $shead = sprintf(
199 "| %-10s | %-12s | %-10s | %-30s |",
200 "Pos", "Name", "Lvl", "Exp");
201
165 $sbar =~ tr/\|/+/; 202 $sbar =~ tr/\|/+/;
166 $sbar =~ s/[^\+]/-/g; 203 $sbar =~ s/[^\+]/-/g;
167 204
168 print "" . scalar localtime($$p0{0})." to ".scalar localtime($$p1{0})." (".get_period($$p1{0} - $$p0{0}).")\n". 205 print
169 "$sbar\n$shead\n$sbar\n"; 206 "" . scalar localtime($$p0{0})." to ".scalar localtime($$p1{0})." (".get_period($$p1{0} - $$p0{0}).")\n".
170 foreach my $place (sort { $a <=> $b } keys %final) { 207 "$sbar\n$shead\n$sbar\n";
208
209 foreach my $place (sort { $a <=> $b } keys %final)
210 {
171 print $final{$place}; 211 print $final{$place};
172 } 212 }
213
173 print "$sbar\n"; 214 print "$sbar\n";
174 } 215 }
175 216
176 217
177 ### Bestestest expmakers 218 ### Bestestest expmakers
178 if ($opt_topexp) { 219 if ($opt_topexp)
179 $sbar = $shead = sprintf "| %-15s | %7s | %-15s | %-15s |", 220 {
180 "Exp gain", "% (*)", "Total exp", "Name"; 221 $sbar = $shead = sprintf(
222 "| %-15s | %7s | %-15s | %-15s |",
223 "Exp gain", "% (*)", "Total exp", "Name");
224
181 $sbar =~ tr/\|/+/; 225 $sbar =~ tr/\|/+/;
182 $sbar =~ s/[^\+]/-/g; 226 $sbar =~ s/[^\+]/-/g;
183 227
184 print "" . scalar localtime($$p0{0})." to ".scalar localtime($$p1{0}). 228 print
185 " (".get_period($$p1{0} - $$p0{0}).")\n" unless ($opt_plaque); 229 "" . scalar localtime($$p0{0})." to ".scalar localtime($$p1{0}).
230 " (".get_period($$p1{0} - $$p0{0}).")\n" unless ($opt_plaque);
186 231
187 print "\nTop exp gainers:\n$sbar\n$shead\n$sbar\n"; 232 print "\nTop exp gainers:\n$sbar\n$shead\n$sbar\n";
188 foreach my $exp (sort { $b <=> $a } keys %expers) { 233 foreach my $exp (sort { $b <=> $a } keys %expers)
234 {
189 my $s = sprintf("%4.2f%%", ($exp * 100.0) / $expers{$exp}{"total"}); 235 my $s = sprintf("%4.2f%%", ($exp * 100.0) / $expers{$exp}{"total"});
190 printf "| %15s | %7s | %15s | %-15s |\n", 236 printf("| %15s | %7s | %15s | %-15s |\n",
191 fmt_num($exp), $s, fmt_num($expers{$exp}{"total"}), $expers{$exp}{"name"}; 237 fmt_num($exp), $s, fmt_num($expers{$exp}{"total"}), $expers{$exp}{"name"});
192 } 238 }
239
193 print "$sbar\n(*) = Gain % of total experience.\n"; 240 print "$sbar\n(*) = Gain % of total experience.\n";
194 } 241 }