Mercurial > hg > batmud > misc
annotate icesusplaque.pl @ 350:14b3b8dfc797 misc
Cleanups.
| author | Matti Hamalainen <ccr@tnsp.org> |
|---|---|
| date | Fri, 20 Oct 2017 23:05:27 +0300 |
| parents | c79dd30a368f |
| children |
| rev | line source |
|---|---|
| 350 | 1 #!/usr/bin/perl -w |
| 2 # | |
| 3 # Icesus top player plaque parser | |
|
134
b2685ec16e67
Update copyrights, add comments.
Matti Hamalainen <ccr@tnsp.org>
parents:
104
diff
changeset
|
4 # Developed by Matti Hämäläinen (Ggr Pupunen) <ccr@tnsp.org> |
|
b2685ec16e67
Update copyrights, add comments.
Matti Hamalainen <ccr@tnsp.org>
parents:
104
diff
changeset
|
5 # (C) Copyright 2010 Tecnic Software productions (TNSP) |
| 350 | 6 # |
| 7 # Inputs a logfile with multiple Icesus top player plaque listings | |
| 8 # and outputs a plaque with changed positions etc. | |
|
134
b2685ec16e67
Update copyrights, add comments.
Matti Hamalainen <ccr@tnsp.org>
parents:
104
diff
changeset
|
9 # |
| 350 | 10 use strict; |
| 11 use warnings; | |
| 12 use Date::Parse; | |
| 13 | |
|
104
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
14 |
| 350 | 15 ### Settings |
| 16 my $opt_sep = 0; | |
| 17 my $opt_topexp = 0; | |
| 18 my $opt_plaque = 0; | |
| 19 my $opt_filename = shift or die("Usage: [perl] $0 <logfilename> [-p] [-s] [-t]\n"); | |
| 20 | |
| 21 | |
| 22 ### Helper functions | |
|
104
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
23 sub get_period($) |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
24 { |
| 350 | 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"); | |
|
104
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
28 my $cur = $_[0]; |
| 350 | 29 if ($cur >= 0) |
| 30 { | |
|
104
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
31 my $str = ""; |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
32 my ($r, $k, $p, $n); |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
33 $n = 0; |
| 350 | 34 foreach my $div (@paskat) |
| 35 { | |
|
104
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
36 $r = int($cur / $div); |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
37 $k = ($cur % $div); |
| 350 | 38 if ($r > 0) |
| 39 { | |
|
104
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
40 $p = ($r > 1) ? $opaskat[$n] : $upaskat[$n]; |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
41 $str .= ", " if ($str ne ""); |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
42 $str .= sprintf("%d %s", $r, $p); |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
43 } |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
44 $cur = $k; |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
45 $n++; |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
46 } |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
47 return $str; |
| 350 | 48 } |
| 49 else | |
| 50 { | |
|
104
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
51 return "?"; |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
52 } |
|
fb5a3f75cfa3
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff
changeset
|
53 } |
| 350 | 54 |
| 55 | |
| 56 sub fmt_num($) | |
| 57 { | |
| 58 my $s = sprintf("%1.0f", $_[0]); | |
| 59 $s =~ s/\d{1,3}(?=(\d{3})+(?!\d))/$&,/g if ($opt_sep); | |
| 60 return $s; | |
| 61 } | |
| 62 | |
| 63 | |
| 64 sub fmt_value($$$) | |
| 65 { | |
| 66 if ($_[0] == $_[1]) { | |
| 67 return sprintf("%".$_[2]."s", fmt_num($_[0])); | |
| 68 } else { | |
| 69 my $val = $_[0] - $_[1]; | |
| 70 return sprintf("%".$_[2]."s (%s%.0f)", | |
| 71 fmt_num($_[0]), $val < 0 ? "" : "+", $val); | |
| 72 } | |
| 73 } | |
| 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 | |
| 161 my %final = (); | |
| 162 my %expers = (); | |
| 163 | |
| 164 foreach my $name (keys %{$p1}) { | |
| 165 my $entry1 = $$p1{$name}; | |
| 166 next if ($name eq 0); | |
| 167 # Check if player is on the previous plaque | |
| 168 if (defined($$p0{$name})) { | |
| 169 my $entry0 = $$p0{$name}; | |
| 170 # Yes, print a "diff" line | |
| 171 $final{$$entry1{"pos"}} = sprintf( | |
| 172 "| %-10s | %-12s | %-10s | %-30s |\n", | |
| 173 fmt_value($$entry1{"pos"}, $$entry0{"pos"}, 3), | |
| 174 $name, | |
| 175 fmt_value($$entry1{"level"}, $$entry0{"level"}, 3), | |
| 176 fmt_value($$entry1{"exp"}, $$entry0{"exp"}, 15) | |
| 177 ); | |
| 178 my $exp = $$entry1{"exp"} - $$entry0{"exp"}; | |
| 179 if ($exp > 0) { | |
| 180 $expers{$exp}{"name"} = $name; | |
| 181 $expers{$exp}{"total"} = $$entry1{"exp"}; | |
| 182 } | |
| 183 } else { | |
| 184 # No, print a normal line | |
| 185 $final{$$entry1{"pos"}} = sprintf( | |
| 186 "| %-10s | %-12s | %-10s | %-30s |\n", | |
| 187 $$entry1{"pos"}, $name, $$entry1{"level"}, $$entry1{"exp"} | |
| 188 ); | |
| 189 } | |
| 190 } | |
| 191 | |
| 192 | |
| 193 ### Print output | |
| 194 my ($shead, $sbar); | |
| 195 | |
| 196 if ($opt_plaque) | |
| 197 { | |
| 198 $sbar = $shead = sprintf( | |
| 199 "| %-10s | %-12s | %-10s | %-30s |", | |
| 200 "Pos", "Name", "Lvl", "Exp"); | |
| 201 | |
| 202 $sbar =~ tr/\|/+/; | |
| 203 $sbar =~ s/[^\+]/-/g; | |
| 204 | |
| 205 print | |
| 206 "" . scalar localtime($$p0{0})." to ".scalar localtime($$p1{0})." (".get_period($$p1{0} - $$p0{0}).")\n". | |
| 207 "$sbar\n$shead\n$sbar\n"; | |
| 208 | |
| 209 foreach my $place (sort { $a <=> $b } keys %final) | |
| 210 { | |
| 211 print $final{$place}; | |
| 212 } | |
| 213 | |
| 214 print "$sbar\n"; | |
| 215 } | |
| 216 | |
| 217 | |
| 218 ### Bestestest expmakers | |
| 219 if ($opt_topexp) | |
| 220 { | |
| 221 $sbar = $shead = sprintf( | |
| 222 "| %-15s | %7s | %-15s | %-15s |", | |
| 223 "Exp gain", "% (*)", "Total exp", "Name"); | |
| 224 | |
| 225 $sbar =~ tr/\|/+/; | |
| 226 $sbar =~ s/[^\+]/-/g; | |
| 227 | |
| 228 print | |
| 229 "" . scalar localtime($$p0{0})." to ".scalar localtime($$p1{0}). | |
| 230 " (".get_period($$p1{0} - $$p0{0}).")\n" unless ($opt_plaque); | |
| 231 | |
| 232 print "\nTop exp gainers:\n$sbar\n$shead\n$sbar\n"; | |
| 233 foreach my $exp (sort { $b <=> $a } keys %expers) | |
| 234 { | |
| 235 my $s = sprintf("%4.2f%%", ($exp * 100.0) / $expers{$exp}{"total"}); | |
| 236 printf("| %15s | %7s | %15s | %-15s |\n", | |
| 237 fmt_num($exp), $s, fmt_num($expers{$exp}{"total"}), $expers{$exp}{"name"}); | |
| 238 } | |
| 239 | |
| 240 print "$sbar\n(*) = Gain % of total experience.\n"; | |
| 241 } |