changeset 169:863c9d955d71 misc

Improve mage staff wear/remove detection.
author Matti Hamalainen <ccr@tnsp.org>
date Thu, 06 Jan 2011 17:35:31 +0000
parents 59bac2a71517
children d5b260fae82a
files magestats.pl
diffstat 1 files changed, 67 insertions(+), 22 deletions(-) [+]
line wrap: on
line diff
--- a/magestats.pl	Sun Jan 02 14:18:49 2011 +0000
+++ b/magestats.pl	Thu Jan 06 17:35:31 2011 +0000
@@ -2,7 +2,7 @@
 #
 # Magestats - BatMUD Mage guild statistics generator
 # Developed by Matti Hämäläinen (Ggr Pupunen) <ccr@tnsp.org>
-# (C) Copyright 2010 Tecnic Software productions (TNSP)
+# (C) Copyright 2010-2011 Tecnic Software productions (TNSP)
 #
 # Requires Perl 5.8 and following modules:
 # In Debian / Ubuntu, apt-get install libgd-graph-perl
@@ -27,7 +27,7 @@
 
 # Settings and defaults
 my $prog_name = "Magestats";
-my $prog_version = "0.6.5";
+my $prog_version = "0.7.0";
 my $prog_file = $0;
 
 my $opt_cachefile;
@@ -38,6 +38,7 @@
 my $opt_width = 500;
 my $opt_height = 250;
 my $opt_ggrtf = 0;
+my $opt_ignore = 0;
 
 my @crit_types = ("Unseen", "ENERGY", "POWER", "power");
 
@@ -55,7 +56,7 @@
 my $opt_mode = shift or die(
 "$prog_name v$prog_version - BatMUD Mage guild statistics generator
 Developed by Matti Hamalainen (Ggr \@ bat), <ccr\@tnsp.org>
-(C) Copyright 2010 Tecnic Software productions (TNSP)
+(C) Copyright 2010-2011 Tecnic Software productions (TNSP)
 
 Usage: $prog_file dump [options] < logfile
        $prog_file stats [options] < logfile
@@ -75,6 +76,13 @@
  -s <WxH>          Graph dimensions in pixels ($opt_width x $opt_height)
  -n                No input (only handle cache, if specified)
  -g                Assume GgrTF mangled logfiles
+".
+
+# -i                Try to ignore blasts for staff counters that occured
+#                   when staff was not being worn. WARNING! This is a very
+#                   fragile and EXPERIMENTAL feature!
+
+"
 
 NOTICE! The input log data is assumed to be in CHRONOLOGICAL ORDER!
 Things will go bonkers if that is not the case. Thus, make sure you
@@ -98,6 +106,8 @@
     $opt_noinput = 1;
   } elsif ($opt eq "-g") {
     $opt_ggrtf = 1;
+  } elsif ($opt eq "-i") {
+    $opt_ignore = 1;
   } elsif ($opt eq "-s") {
     my $tmp = shift or die("-s option requires an argument.\n");
     if ($tmp =~ /^(\d+)[x:](\d+)$/) {
@@ -148,6 +158,7 @@
 $spells->{"staff"}{"desc"} = "";
 $spells->{"staff"}{"data"} = [];
 
+
 ### Convert special characters to HTML/XML entities
 my %entities = (
   "<" => "lt",
@@ -162,6 +173,7 @@
   return $value;
 }
 
+
 ### Get damage type of given mage spell, die if not known spell.
 sub get_spell_type($)
 {
@@ -170,6 +182,7 @@
   return $spells->{$spell}{"type"};
 }
 
+
 ### Trap warnings to inform the user that the cache might be stale
 my $has_warned = 0;
 $SIG{__WARN__} = sub {
@@ -184,6 +197,7 @@
   $has_warned = 1;
 };
 
+
 ###
 ### Read cache
 ###
@@ -208,19 +222,13 @@
 my $crit_flag = 0;
 my $crit_type;
 my $last_spell = "";
+my $staff_worn = 0;
 
-sub staff_update($$$)
+
+sub staff_update($$)
 {
-  my $desc = $_[0];
-  my $postfix = $_[1];
-  my $line = $_[2];
+  my ($desc, $line) = @_;
   
-  if ($postfix =~ / glow>/) {
-    $desc .= " <red glow>";
-  } else {
-    $desc .= $postfix;
-  }
-      
   if ($spells->{"staff"}{"desc"} ne $desc) {
     mlog(2, "Staff change '".$spells->{"staff"}{"desc"}."' -> '$desc'\n# $line\n");
     my %blasts = ();
@@ -246,6 +254,7 @@
   }
 }
 
+
 sub spell_update($)
 {
   $last_spell = $_[0];
@@ -285,6 +294,45 @@
 }
 
 
+sub staff_match($$$)
+{
+  my ($str, $wear, $line) = @_;
+  my ($result, $postfix) = ("", "");
+  
+  if ($str =~ /(\S+ the (Shimmering|Radiating|Glowing) (white|grey|dark|black) mage staff)(.*)$/i) {
+    $result = $1;
+    $postfix = $4;
+  } elsif ($str =~ /(\S+ the (white|grey|dark|black) mage staff)(.*)$/i) {
+    $result = $1;
+    $postfix = $3;
+  } elsif ($str =~ /((Shimmering|Radiating|Glowing) (white|grey|dark|black) mage staff)(.*)$/i) {
+    $result = $1;
+    $postfix = $4;
+  } elsif ($str =~ /((white|grey|dark|black) mage staff)(.*)$/i) {
+    $result = $1;
+    $postfix = $3;
+  }
+
+  if ($postfix ne "") {
+    if ($postfix =~ /^ \(glowing\) <.+? glow>/) {
+      $postfix = " <red glow>";
+    } elsif ($postfix =~ /^( <.+? glow>| of Power)/) {
+      $postfix = $1;
+    } else {
+      $postfix = "";
+    }
+  }
+  
+  if ($result ne "") {
+    if ($wear) {
+#      print STDERR "'$result' :: '$postfix'\n";
+      staff_update($result.$postfix, $line);
+    }
+    $staff_worn = $wear;
+  }
+}
+
+
 if ($opt_noinput) {
   mlog(1, "Skipping input parsing.");
 } else {
@@ -292,22 +340,19 @@
   mlog(1, "Using GgrTF format only!") if ($opt_ggrtf);
   mlog(2, "Matching regexp '$match'\n");
   mlog(1, "Parsing log from stdin...");
+
   while (defined(my $s = <STDIN>)) {
-    if ($s =~ /^You wear.*? (\S+ the (Shimmering|Radiating|Glowing) ([Ww]hite|[Gg]rey|[Dd]ark|[Bb]lack) mage staff)( <.+? glow>| of Power)/) {
-      staff_update($1, $4, $s);
-    } elsif ($s =~ /^You wear.*? (\S+ the ([Ww]hite|[Gg]rey|[Dd]ark|[Bb]lack) mage staff)( <.+? glow>| of Power)/) {
-      staff_update($1, $4, $s);
-    } elsif ($s =~ /^You wear.*? ((Shimmering|Radiating|Glowing) ([Ww]hite|[Gg]rey|[Dd]ark|[Bb]lack) mage staff)( <.+? glow>| of Power)/) {
-      staff_update($1, $4, $s);
-    } elsif ($s =~ /^You wear.*? (([Ww]hite|[Gg]rey|[Dd]ark|[Bb]lack) mage staff)( <.+? glow>| of Power)/) {
-      staff_update($1, $3, $s);
+    if ($s =~ /^You wear (.+?)\.$/) {
+      staff_match($1, 1, $s);
+    } elsif ($s =~ /^You remove (.+?)\.$/) {
+      staff_match($1, 0, $s);
     } elsif ($s =~ /^Time to choose your reincarnation method./) {
       # Set reinc flags for each type that has essence
       foreach my $type (keys %spell_data) {
         $spells->{$type}{"reinc"} = 1 if ($spells->{$type}{"essence"}{"increase"} > 0);
       }
     } elsif ($s =~ /^You watch with selfpride as your ($match) hits / || $s =~ /^You hit .+? with your ($match)\.$/) {
-      spell_update($1) if $gflag == 0;
+      spell_update($1) if ($gflag == 0);
       $gflag = 0;
     } elsif ($s =~ /^Your .($match). hits / || $s =~ /^Your ($match) hits /) {
       if ($opt_ggrtf) {