Mercurial > hg > batmud > misc
changeset 104:fb5a3f75cfa3 misc
Added script for generating 'weekly' exp plaques from icesus top player plaque logs, made for Nuane by request.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Wed, 18 Aug 2010 17:28:44 +0000 |
parents | e33194a36089 |
children | 6d6aebcdc0e3 |
files | icesusplaque.pl |
diffstat | 1 files changed, 184 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/icesusplaque.pl Wed Aug 18 17:28:44 2010 +0000 @@ -0,0 +1,184 @@ +#!/usr/bin/perl -w +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 150 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 =~ 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 =~ 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"; +}