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";
+}