Mercurial > hg > batmud > misc
view icesusplaque.pl @ 322:1f3fd2d0831b misc
Adjust threshold values for alloy tests.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Wed, 30 Dec 2015 23:17:46 +0200 |
parents | c79dd30a368f |
children | 14b3b8dfc797 |
line wrap: on
line source
#!/usr/bin/perl -w # # Icesus top player plaque parser # Developed by Matti Hämäläinen (Ggr Pupunen) <ccr@tnsp.org> # (C) Copyright 2010 Tecnic Software productions (TNSP) # # Inputs a logfile with multiple Icesus top player plaque listings # and outputs a plaque with changed positions etc. # use strict; use Date::Parse; ### Settings my $opt_sep = 0; my $opt_topexp = 0; my $opt_plaque = 0; my $opt_filename = shift or die("Usage: [perl] $0 <logfilename> [-p] [-s] [-t]\n"); while (defined(my $opt = shift)) { if ($opt eq "-s") { $opt_sep = 1; } elsif ($opt eq "-t") { $opt_topexp = 1; } elsif ($opt eq "-p") { $opt_plaque = 1; } } ### Initialize common global variables my $cplaque = {}; my @plaques = (); my $state = 0; my $stamp = undef; my $stamps = 0; ### Parse input logfile for plaque data open(INFILE, "<", $opt_filename) or die("Could not open '".$opt_filename."'!\n"); while (defined(my $line = <INFILE>)) { $line =~ s/[\r\n]+$//; if ($line =~ /^Server time: (.+)/) { $stamp = str2time($1); } elsif ($state == 0 && $line =~ /^\| +The top \d+ players of Icesus +lvl +Exp +\|/) { $state = 1; } elsif ($state == 1 && $line =~ /^\| +(\d+) +([A-Z][a-z]+) +(\d+) +([0-9][0-9,]+) +\|/) { my ($pos, $name, $level, $exp) = ($1, $2, $3, $4); $exp =~ s/,//g; $$cplaque{$name} = { "pos" => $pos, "level" => $level, "exp" => int($exp) }; } elsif ($state == 1 && $line =~ /\`---------------------------------------------------------\'/) { # Save plaque data to array $state = 0; $$cplaque{0} = $stamp; $stamp = undef; # We keep maximum of 100 plaques in memory shift(@plaques) if (scalar(@plaques) > 100); push(@plaques, $cplaque); undef($cplaque); $cplaque = {}; } } close(INFILE); die("Not enough plaque data in input.\n") unless (scalar(@plaques) >= 2); ### Find plaques with time difference of a week my $p0 = undef; my $p1 = pop(@plaques); die("No timestamp found for primary comparision plaque.\n") unless defined($$p1{0}); foreach my $plaque (@plaques) { if (defined($$plaque{0}) && $$plaque{0} <= $$p1{0} - (7*24*60*60)) { $p0 = $plaque; } } die("Could not find old enough plaque to make a weekly comparision.\n") unless defined($p0); ### Compute results my @paskat = (30*24*60*60, 7*24*60*60, 24*60*60, 60*60, 60); my @opaskat = ("months", "weeks", "days", "hours", "minutes"); my @upaskat = ("month", "week", "day", "hour", "minute"); sub get_period($) { my $cur = $_[0]; if ($cur >= 0) { my $str = ""; my ($r, $k, $p, $n); $n = 0; foreach my $div (@paskat) { $r = int($cur / $div); $k = ($cur % $div); if ($r > 0) { $p = ($r > 1) ? $opaskat[$n] : $upaskat[$n]; $str .= ", " if ($str ne ""); $str .= sprintf("%d %s", $r, $p); } $cur = $k; $n++; } return $str; } else { return "?"; } } sub fmt_num($) { my $s = sprintf("%1.0f", $_[0]); $s =~ s/\d{1,3}(?=(\d{3})+(?!\d))/$&,/g if ($opt_sep); return $s; } sub fmt_value($$$) { if ($_[0] == $_[1]) { return sprintf("%".$_[2]."s", fmt_num($_[0])); } else { my $val = $_[0] - $_[1]; return sprintf("%".$_[2]."s (%s%.0f)", fmt_num($_[0]), $val < 0 ? "" : "+", $val); } } my %final = (); my %expers = (); foreach my $name (keys %{$p1}) { my $entry1 = $$p1{$name}; next if ($name eq 0); # Check if player is on the previous plaque if (defined($$p0{$name})) { my $entry0 = $$p0{$name}; # Yes, print a "diff" line $final{$$entry1{"pos"}} = sprintf( "| %-10s | %-12s | %-10s | %-30s |\n", fmt_value($$entry1{"pos"}, $$entry0{"pos"}, 3), $name, fmt_value($$entry1{"level"}, $$entry0{"level"}, 3), fmt_value($$entry1{"exp"}, $$entry0{"exp"}, 15) ); my $exp = $$entry1{"exp"} - $$entry0{"exp"}; if ($exp > 0) { $expers{$exp}{"name"} = $name; $expers{$exp}{"total"} = $$entry1{"exp"}; } } else { # No, print a normal line $final{$$entry1{"pos"}} = sprintf( "| %-10s | %-12s | %-10s | %-30s |\n", $$entry1{"pos"}, $name, $$entry1{"level"}, $$entry1{"exp"} ); } } ### Print output my ($shead, $sbar); if ($opt_plaque) { $sbar = $shead = sprintf "| %-10s | %-12s | %-10s | %-30s |", "Pos", "Name", "Lvl", "Exp"; $sbar =~ tr/\|/+/; $sbar =~ s/[^\+]/-/g; print "" . scalar localtime($$p0{0})." to ".scalar localtime($$p1{0})." (".get_period($$p1{0} - $$p0{0}).")\n". "$sbar\n$shead\n$sbar\n"; foreach my $place (sort { $a <=> $b } keys %final) { print $final{$place}; } print "$sbar\n"; } ### Bestestest expmakers if ($opt_topexp) { $sbar = $shead = sprintf "| %-15s | %7s | %-15s | %-15s |", "Exp gain", "% (*)", "Total exp", "Name"; $sbar =~ tr/\|/+/; $sbar =~ s/[^\+]/-/g; print "" . scalar localtime($$p0{0})." to ".scalar localtime($$p1{0}). " (".get_period($$p1{0} - $$p0{0}).")\n" unless ($opt_plaque); print "\nTop exp gainers:\n$sbar\n$shead\n$sbar\n"; foreach my $exp (sort { $b <=> $a } keys %expers) { my $s = sprintf("%4.2f%%", ($exp * 100.0) / $expers{$exp}{"total"}); printf "| %15s | %7s | %15s | %-15s |\n", fmt_num($exp), $s, fmt_num($expers{$exp}{"total"}), $expers{$exp}{"name"}; } print "$sbar\n(*) = Gain % of total experience.\n"; }