--- a/log2npctemplate.pl	Mon Jan 24 18:45:09 2011 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,679 +0,0 @@
-#!/usr/bin/perl -w
-#
-# log2npctemplate - Log parser for BatWiki NPC templates
-# Developed by Matti Hämäläinen (Ggr Pupunen) <ccr@tnsp.org>
-# (C) Copyright 2010-2011 Tecnic Software productions (TNSP)
-#
-# Requires Perl 5.8.
-#
-# Usage
-# =====
-# 1) command qla say -- $* --;prod $*;whereami;say -??-;blook at $*;say -==-;look at $*;say ====
-# 2) rip_action set party kills (or spam party kills every once in a while to collect expvalue data)
-# 3) qla monster
-# 4) Cast detect race, detect alignment, whatnot at monster (if you wish/can/have those).
-# 5) Fight and kill monster.
-# 6) run log2npctemplate.pl < logfile.log > output.txt
-#
-# 7) command id 
-#
-# Notes
-# =====
-# - You must have spellname translator, preferably one with format:
-#   Xxxx claps its hands and says (cure critical wounds)
-#
-# - There is some flexibility in the parser, it can filter out ANSI from the
-#   input log, etc. but you may have to customize it. And that requires Perl
-#   knowledge.
-#
-use strict;
-
-# Options
-my $opt_ansi = 1;	# 1 = strip ANSI, 0 = don't (is faster)
-my $opt_debug = 0;	# 1 = enable debug output
-my $opt_pkills_crop = 60;
-my $opt_outfile;
-my $opt_identify = 1;
-my $opt_npc = 1;
-
-
-# Define the regular expression to match any outputs of "say"
-# as this is somewhat race-dependant.
-my $sayregex = "(quack|say)";
-
-
-# Define the various spell chant prefixes here, we need them
-# for matching the spell cast lines themselves.
-my @spellchants = (
-"claps its hands and says",
-"claps his hands and whispers",
-"fills up his cheeks with air and exhales",
-"booms in sinister voice",
-"throws a pinch of magic dust in air and chants",
-"rolls her eyes wildly and exclaims",
-"rolls its eyes frantically and states",
-"utters the magic words",
-"spreads her fingers and whispers",
-"waves its index finger while uttering",
-"points an accusing finger and cries",
-"gets an evil gleam in its eyes and chants",
-"flaps arms and utters the magic words",
-"flaps his arms and utters the magic words",
-"taps its foot three times and utters the words",
-"is surrounded by blue waves as you hear the words:",
-"closes his eyes and with a dry, dark voice entones",
-"shakes with firey rage and yells",
-"traces fiery demonic night runes in the air",
-"weaves a mystic matrix with glowing red lines in arcane ways and chants",
-#"",
-);
-
-
-# Stat name translations
-my @statTransTable = (
-  sub { return $_[0] =~ s/^ability at the (skill|spell) (.+)$/$2/ },
-  sub { return $_[0] =~ s/^mental regeneration$/spr/g },
-  sub { return $_[0] =~ s/^physical regeneration$/hpr/g },
-#  sub { return $_[0] =~ s///g },
-);
-
-
-### Options
-while (defined(my $arg = shift)) {
-  if ($arg eq "-d") {
-    $opt_debug++;
-  }
-  elsif ($arg eq "-i") {
-    $opt_identify = 0;
-  }
-  elsif ($arg eq "-n") {
-    $opt_npc = 0;
-  }
-  elsif ($arg eq "-o") {
-    $opt_outfile = shift or die("Output file option -o requires an argument.\n");
-  }
-  else {
-    die("Invalid option '$arg'.
-Usage: $0 [options] < input.log > output.txt
-
-    -o <filename>         Output filename.
-    -d                    Enable debug mode.
-    -i                    Disable identify parser.
-    -n                    Disable NPC parser.
-
-");
-  }
-}
-
-print STDERR "Debug mode enabled, level=".$opt_debug.".\n" if ($opt_debug);
-
-if (defined($opt_outfile)) {
-  open(STDOUT, '>', $opt_outfile) or die("Could not open output file '$opt_outfile'.\n");
-}
-
-
-### Translate stats
-sub trans_stat($)
-{
-  my ($s) = @_;
-  foreach my $pat (@statTransTable) {
-    return $s if ($pat->($s));
-  }  
-  return $s;
-}
-
-
-### Globals
-my %monsters = ();
-my %aligns = ();
-my %spells = ();
-my %races = ();
-my %areas = ();
-my %ids = ();
-
-my $line = 0;
-
-my $mob_sdesc;
-my $mob = { };
-my $state = 0;
-
-my $id_tale;
-my $id_tale2;
-my $id = {};
-
-
-### Convert spellchants array to regexp
-my $spellregexps = join("|", map { s/ (his|its|her) / ... /g; $_ } @spellchants);
-
-
-### Change parsing state
-sub set_state($$)
-{
-  return unless ($_[0] != $state);
-  print STDERR "STATE = $_[0], old = $state\n" if ($opt_debug > 1);
-  $state = $_[0];
-  if ($state < 0) {
-    print STDERR "ERROR($line): $_[1]\n";
-    $state = 0;
-  }
-}
-
-
-sub parse_npc($)
-{
-  my ($s) = @_;
-  
-  if ($state == 1) {
-    if ($s =~ /^You prod (.+?) like a stray cow\.$/o) {
-      # Get 'short name'
-      $$mob{"sname"} = $1;
-    } elsif ($s =~ /^You are in '.*?' in (.+?) on the continent of ([A-Z][a-z]+). \(Coordinates: (\d+)x, (\d+)y\)$/o) {
-      # Area, continent
-      $$mob{"area"} = $1;
-      $$mob{"cont"} = $2;
-
-      $areas{$1}{"cont"} = $2;
-      $areas{$1}{"x"} = $3;
-      $areas{$1}{"y"} = $4;
-    } elsif ($s =~ /^You are in '.*?', which is on the continent of ([A-Z][a-z]+). \(Coordinates: (\d)+x, (\d)+y\)$/o) {
-      # Area, continent
-      $$mob{"area"} = $1;
-      $$mob{"cont"} = $1;
-
-      $areas{$1}{"cont"} = $1;
-      $areas{$1}{"x"} = $2;
-      $areas{$1}{"y"} = $3;
-    } elsif ($s =~ /^You $sayregex '(-\?\?-|--\?\?--\?\?--\?\?--\?\?--)\.'$/o) {
-      set_state(2, $s);
-    } else {
-      set_state(-1, $s);
-    }
-  }
-  elsif ($state == 2) {
-    # Mostly just grab shortdesc here
-    if ($s =~ /^You $sayregex '(-==-|-=-=-=-=-=-=-=-=-)\.'$/o) {
-      set_state(3, $s);
-    } elsif ($s =~ /^(He|She|It) +\[[a-z]+\] \([0-9-]+\%\)/o) {
-      set_state(-1, $s);
-    } elsif ($s =~ /^You $sayregex /o) {
-      set_state(-1, $s);
-    } else {
-      $mob_sdesc = $s;
-    }
-  }
-  elsif ($state == 3) {
-    if ($s =~ /^ +([a-zA-Z ,-]+?)'s equipment:$/o) {
-      # End of long desc
-      set_state(4, $s);
-    } elsif ($s =~ /^(He|She|It) +\[[a-z]+\] \([0-9-]+\%\)$/o ||
-      $s =~ /^(He|She|It) is (in (a )?)?(excellent shape|good shape|slightly hurt|noticeably hurt|not in a good shape|bad shape|very bad shape|near death)/o) {
-      # End of long desc
-      set_state(4, $s);
-    } elsif ($s =~ /^You $sayregex /o) {
-      set_state(-1, $s);
-    } else {
-      # Collect long desc
-      $$mob{"ldesc"} .= $s." ";
-    }
-  }
-  elsif ($state == 4) {
-    if ($s =~ /^You $sayregex '====*'?\.'$/o) {
-      # Finished, submit information to hash
-      $monsters{$mob_sdesc} = $mob;
-      set_state(0, $s);
-    } elsif ($s =~ /^([A-Z][a-z, ]+): (.*)$/o) {
-      # Collect EQ and slot information
-      $$mob{"eqs"}{$1} = $2;
-    } elsif ($s =~ /^([A-Z][a-z, ]+)\s+\(partially hidden\)\s*: (.*)$/o) {
-      # Collect EQ and slot information
-      $$mob{"eqs"}{$1} = $2;
-    } elsif ($s =~ /^ +([a-zA-Z -]+?)'s equipment:$/o) {
-      # Ignore this line
-    } elsif ($s =~ /^((It|She|He) has a blueish black kiss on ... cheek\.|(It|She|He) suffers from scourge\.|Some glittering red mist is surrounding this creature.|Nothing\.|(It|He|She) has a faint ring of .+ magic mist around ... neck\.)$/o) {
-      # Ignore various useless lines such as holz markings
-    } else {
-      # Error.
-      set_state(-1, $s);
-    }
-  }
-}
-
-
-sub parse_identify($)
-{
-  my ($s) = @_;
-  
-  if ($state == 10) {
-    if ($s =~ /^You $sayregex '-#-\.'$/o) {
-      set_state(11, $s);
-    }
-    elsif ($s =~ /^:\s*(\d+\.\d+)\s+(.+)$/) {
-      # Weigh in kgs, and sdesc. Will have to match these later.
-      $$id{"kg"}{$2} = $1;
-      $$id{"full"} = $2;
-    }
-  }
-  elsif ($state == 11) {
-    if ($s =~ /^It is surrounded by .+? glow\.$|^It is labeled as|^This item is a present from santa to /) {
-      # Just skip these
-    }
-    elsif ($s =~ /You $sayregex '-!-\.'$/o) {
-      set_state(12, $s);
-    }
-    elsif ($s =~ /^It contains a tale;$/) {
-      $id_tale = 1;
-    }
-    elsif ($s =~ /^This (.+?) is in .+? condition\.$/) {
-      $$id{"type"} = $1;
-    }
-    elsif ($s =~ /^These (.+?) are in .+? condition\.$/) {
-      $$id{"type"} = $1;
-    }
-    elsif ($s =~ /^It looks (light weight|a bit heavy|heavy|very very heavy|very light weight|very heavy|ridiculously heavy)\.$/) {
-      $$id{"weight"} = $1;
-    }
-    else {
-      if ($id_tale) {
-        $$id{"tale"} .= $s." ";
-      } else {
-        my $len = length($s);
-        $$id{"ldesc"} .= $s;
-        if (defined($$id{"len"}) && $len + $$id{"len"} < 79) {
-          $$id{"ldesc"} .= "\n";
-        } else  {
-          $$id{"ldesc"} .= " ";
-        }
-        $$id{"len"} = $len;
-      }
-    }
-  }
-  elsif ($state == 12) {
-    if ($s =~ /^The following messages seem to vibrate from (.+?):$/o) {
-      $$id{"sdesc"} = $1;
-      set_state(13, $s);
-    }
-  }
-  elsif ($state == 13) {
-    if ($s =~ /^It is called (.+)\.$/) {
-      $$id{"handles"} = $1;
-      $id_tale2 = 0;
-    }
-    elsif ($s =~ /^It takes the following slots: (.+)\.$/) {
-      $$id{"slots"} = $1;
-      $id_tale2 = 0;
-    }
-    elsif ($s =~ /^A halo of purity surrounds it\.$/) {
-      push(@{$$id{"stats"}}, "[[:category:halo of purity|good wear only]]");
-      $$id{"cat"}{"halo of purity"} = 1;
-      $id_tale2 = 0;
-    }
-    elsif ($s =~ /^An aura of blackness surrounds it\.$/) {
-      push(@{$$id{"stats"}}, "[[:category:aura of darkness|evil wear only]]");
-      $$id{"cat"}{"aura of darkness"} = 1;
-      $id_tale2 = 0;
-    }
-    elsif ($s =~ /^It will (.+?) (improve|reduce) your (.+?)\.$/) {
-      my ($amt, $imp, $stat) = ($1, $2, $3);
-      push(@{$$id{"stats"}}, ($imp eq "improve" ? "+" : "-").$amt." ".trans_stat($stat));
-      $$id{"cat"}{trans_stat($stat)} = 1 if ($imp eq "improve");
-      $id_tale2 = 0;
-    }
-    elsif ($s =~ /^It will (raise|lower) your (.+?)\.$/) {
-      my $imp = $1;
-      my $stat = substr($2, 0, 3);
-      push(@{$$id{"stats"}}, ($imp eq "raise" ? "+" : "-").$stat);
-      $$id{"cat"}{$stat} = 1 if ($imp eq "raise");
-      $id_tale2 = 0;
-    }
-    elsif ($s =~ /^It contains a tale;$/) {
-      $id_tale2 = 1;
-    }
-    elsif ($s =~ /^(.+?) did the heroic deed to bring this piece of equipment before you (.+)$/) {
-      my $info = $2;
-      $$id{""} = "";
-      
-      # Parse the big data blob
-      if ($info =~ /It is ([A-Za-z -]+), ([A-Za-z -]+),/) {
-        $$id{"weight2"} = $1;
-        $$id{"size"} = $2;
-      }
-      
-      if ($info =~ /of ([A-Za-z ]+) quality/) {
-        $$id{"quality"} = $1;
-      }
-      
-      if ($info =~ /(emits darkness|emits light)/) {
-        push(@{$$id{"stats"}}, $1);
-        $$id{"cat"}{$1} = 1;
-      }
-      
-      if ($info =~ /made of,? ?(.+?), (feather|worth)/) {
-        @{$$id{"materials"}} = split(/\s*,\s*/, $1);
-        my $qmat = $$id{"materials"}[0];
-        my $qmax = -1;
-        foreach my $mat (@{$$id{"materials"}}) {
-          if ($mat =~ /^(\d+)% (.+)$/) {
-            if ($1 >= $qmax) {
-              $qmax = $1;
-              $qmat = $2;
-            }
-          }
-        }
-        $$id{"material"} = $qmat;
-        $$id{"cat"}{$qmat} = 1;
-      }
-      
-      # Check for nun relics
-      if ($$id{"full"} =~ / \(holy\)/) {
-        $$id{"cat"}{"relic"} = 1;
-      }
-      
-      # Set item class
-      $$id{"class"} = "Item";
-      if ($info =~ /The weapon skill to best use this in combat/) {
-        $$id{"class"} = "Weapon";
-      } elsif (defined($$id{"type"}) && $$id{"type"} ne "") {
-        $$id{"class"} = "Armour";
-      }
-      
-      # Check if the weight data is for FW'd item
-      if ($$id{"full"} =~ / <(yellow|green|white) glow>$/) {
-        $$id{"kg"} = "";
-        $$id{"weight"} = "";
-      } else {
-        if (defined($$id{"kg"}{$$id{"full"}})) {
-          $$id{"kg"} = $$id{"kg"}{$$id{"full"}};
-        } else {
-          $$id{"kg"} = "";
-        }
-      }
-      
-      # Submit data
-      $ids{$$id{"full"}} = $id;
-      set_state(0, $s);
-    }
-    else {
-      if ($id_tale2) {
-        $$id{"tale"} .= $s." ";
-      } else {
-        push(@{$$id{"other"}}, $s);
-      }
-    }
-  }
-}
-
-
-###
-### Main parsing loop
-###
-while (defined(my $s = <STDIN>)) {
-  $line++;
-  chomp($s);
-
-  # Strip ANSI colours and escapes
-  $s =~ s/\e\[?.*?[\@-~]//g if ($opt_ansi);
-
-  if
-  ($s =~ /^([A-Za-z][A-Za-z\ -]+?)\ ($spellregexps)\ \(([A-Za-z][A-Za-z\ ]+)\)/o)
-  {
-    # Grab cast spells
-    $spells{$1}{$line} = lc($3);
-  }
-  elsif ($s =~ /\| \d\d:\d\d +(\d+): (.+?) +\|$/) {
-    # Grab exp worth
-    my $exp = $1;
-    my $tmp = $2;
-    my $sdesc = substr($tmp, 0, $opt_pkills_crop);
-    if (defined($monsters{$sdesc}) && $line > $monsters{$sdesc}{"line"}) {
-      $monsters{$sdesc}{"exp"} = $exp;
-    } else {
-      $tmp .= " (undead)";
-      $sdesc = substr($tmp, 0, $opt_pkills_crop);
-      if (defined($monsters{$sdesc}) && $line > $monsters{$sdesc}{"line"}) {
-        $monsters{$sdesc}{"exp"} = $exp;
-      }
-    }
-  }
-  elsif ($s =~ /^\[\d\d:\d\d:\d\d\] hp|^You laugh out loud\.$|^Dunk dunk$/) {
-    # Ignore these lines
-  }
-  elsif ($s =~ /^You see nothing special\.$/o) {
-    # Reset parsing state if the target obviously didn't exist
-    set_state(0, $s);
-  }
-  elsif ($state == 0 && $s =~ /^You $sayregex '-+ .+? -+\.'$/o) {
-    next unless ($opt_npc);
-    # Beginning of NPC info block
-    set_state(1, $s);
-    undef($mob);
-    $mob_sdesc = "";
-    $$mob{"line"} = $line;
-  }
-  elsif ($state == 0 && $s =~ /^You $sayregex '-ID-\.'$/o) {
-    next unless ($opt_identify);
-    # Beginning of identify info block
-    set_state(10, $s);
-    $id = {};
-    undef($id);
-    $id_tale = 0;
-    $id_tale2 = 0;
-    $$id{"line"} = $line;
-  }
-  elsif ($state > 0 && $state < 10) {
-    # States for NPC parsing
-    parse_npc($s);
-  }
-  elsif ($state >= 10) {
-    parse_identify($s);
-  }
-  elsif ($s =~ /^(.+?) is (a bit good|a bit evil|evil|good|neutral)\.$/o) {
-    # Grab detect alignment
-    $aligns{$1}{$line} = $2;
-  }
-  elsif ($s =~ /^([A-Za-z][A-Za-z\ .-]+?)\ is an? ([a-z-]+)\.$/o) {
-    # Grab detect race
-    $races{$1}{$line} = $2;
-  }
-  elsif ($s =~ /^You $sayregex /o) {
-    # Error, reset parsing state
-    set_state(0, $s);
-  }
-}
-
-
-###
-### Print out item/identify information
-###
-foreach my $sdesc (sort { $a cmp $b } keys %ids) {
-  my $item = $ids{$sdesc};
-  my $name = $$item{"sdesc"};
-  $name =~ s/ labeled as .*$//;
-  my $qdesc = $name;
-  if ($$item{"full"} =~ / <(red|purple|white) glow>$/) {
-    $name .= " <red glow>";
-  }
-
-  print "---------------------------\n".
-  $qdesc."\n\n".
-  "{{ Infobox ".$$item{"class"}."\n".
-  "| name = ".$name."\n".
-  "| description = ".$$item{"ldesc"}."\n";
-
-  if (defined($$item{"tale"}) && $$item{"tale"} ne "") {
-    print "| tale = ".$$item{"tale"}."\n";
-  }
-
-  if (defined($$item{"type"})) {
-    print "| type = ".$$item{"type"}."\n";
-  }
-
-  if (defined($$item{"stats"})) {
-    print "| stats = ".join(", ", @{$$item{"stats"}})."\n";
-  } else {
-    print "| stats = \n";
-  }
-
-  print
-  "| weight = ".$$item{"weight"}."\n".
-  "| kg = ".$$item{"kg"}."\n".
-  "| sacvalue = \n".
-  "| handles = ".$$item{"handles"}."\n";
-  
-  if (defined($$item{"materials"})) {
-    print "| material = ".join(", ", @{$$item{"materials"}})."\n";
-  }
-
-  print
-  "| size = ".$$item{"size"}."\n".
-  "| quality = ".$$item{"quality"}."\n".
-  "| from = \n";
-
-  if ($$item{"class"} eq "Weapon") {
-    print
-    "| wep1 = \n".
-    "| wep2 = \n";
-  }
-
-  if (defined($$item{"other"})) {
-    print "| other = ".join("\n", @{$$item{"other"}})."\n";
-  }
-
-  print
-  "}}\n";
-
-  foreach my $cat (keys %{$$item{"cat"}}) {
-    print "[[Category:$cat]]\n";
-  }
-
-  print "---------------------\n";
-}
-
-
-###
-### Print out the NPC information
-###
-foreach my $sdesc (sort { $a cmp $b } keys %monsters) {
-  my $mob = $monsters{$sdesc};
-
-  print "---------------------------
-$sdesc
-
-{{ NPC
-| name = ".$$mob{"sname"}."
-| description = ".$$mob{"ldesc"}."
-| eqs = ";
-
-  foreach my $slot (sort { $a cmp $b } keys %{$$mob{"eqs"}}) {
-    my ($k, $s);
-    $k = $s = $$mob{"eqs"}{$slot};
-    $k =~ s/ <[a-z]+ glow>$//;
-    if ($k eq $s) {
-      print "$slot: [[$s]]\n\n";
-    } else {
-      print "$slot: [[$k|$s]]\n\n";
-    }
-  }
-  
-  print "none" unless (scalar keys %{$$mob{"eqs"}} > 0);
-  print "\n";
-        
-  if ($sdesc =~ / \(undead\)$/) {
-    print "| undead = x\n";
-  }
-
-  # Check if we find a matching alignment: find a cast of 'detect alignment'
-  # with matching short name and withing appropriate distance from the mob look.
-  my $mname = $$mob{"sname"};
-  my $mline = $$mob{"line"};
-
-  print "| alignment = ";
-  if (defined($aligns{$mname})) {
-    my $qoffs = 1000;
-    my $qline = -1;
-    foreach my $aline (sort { $a <=> $b } keys %{$aligns{$mname}}) {
-      my $offs = ($aline - $mline);
-      if ($offs < $qoffs) {
-        $qoffs = $offs;
-        $qline = $aline;
-      }
-    }
-    if ($qline >= 0) {
-      print STDERR "ALIGN: $mname ($sdesc) \@ #$qline ($qoffs)\n" if ($opt_debug);
-      print $aligns{$mname}{$qline};
-    }
-  }
-  print "\n".
-  "| race = ";
-  
-  # Check for race
-  if (defined($races{$mname})) {
-    my $qoffs = 1000;
-    my $qline = -1;
-    foreach my $aline (sort { $a <=> $b } keys %{$races{$mname}}) {
-      my $offs = ($aline - $mline);
-      if ($offs < $qoffs) {
-        $qoffs = $offs;
-        $qline = $aline;
-      }
-    }
-    if ($qline >= 0) {
-      print STDERR "RACE: $mname ($sdesc) \@ #$qline ($qoffs)\n" if ($opt_debug);
-      print $races{$mname}{$qline};
-    }
-  }
-  print "\n";
-
-  
-  # Spells
-  my $hasspells = 0;
-  if (defined($spells{$mname}) && length($mname) >= 4) {
-    my $maxdist = length($mname) * 150 * length($mname);
-    my $mindist = length($mname) * -5 * length($mname);
-    my %mspells = ();
-    foreach my $sline (sort { $a <=> $b } keys %{$spells{$mname}}) {
-      my $offs = $sline - $mline;
-#      print STDERR "TEST $mname @ $offs vs $mindist...$maxdist : '".$spells{$mname}{$sline}."'\n";
-      if ($offs < $maxdist && $offs > $mindist) {
-        print STDERR "SPELL $mname \@ $offs / $mindist...$maxdist : '".$spells{$mname}{$sline}."'\n" if ($opt_debug);
-        $mspells{$spells{$mname}{$sline}} = 1;
-        $hasspells++;
-      }
-    }
-    my $n = 1;
-    foreach my $spell (sort { $a cmp $b } keys %mspells) {
-      print "| spell".($n < 2 ? "" : $n)." = $spell\n";
-      $n++;
-    }
-  }
-
-unless ($hasspells > 0) {
-print "| spell = 
-| spell# = 
-";
-}
-
-  print "
-| area = ".$$mob{"area"}."
-| skill = 
-| skill# = 
-| exp = ";
-
-  if (defined($$mob{"exp"})) {
-    if ($$mob{"exp"} > 1000000) {
-      printf "%1.2fM", $$mob{"exp"} / 1000000.0;
-    } elsif ($$mob{"exp"} > 1000) {
-      printf "%dk", $$mob{"exp"} / 1000;
-    } else {
-      printf "%d", $$mob{"exp"};
-    }
-  }
-
-print "
-| GAP = 
-| PAP = 
-| kerbholz = 
-| other = 
-}}
----------------------
-";
-}

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/log2template.pl	Mon Jan 24 18:45:43 2011 +0200
@@ -0,0 +1,679 @@
+#!/usr/bin/perl -w
+#
+# log2npctemplate - Log parser for BatWiki NPC templates
+# Developed by Matti Hämäläinen (Ggr Pupunen) <ccr@tnsp.org>
+# (C) Copyright 2010-2011 Tecnic Software productions (TNSP)
+#
+# Requires Perl 5.8.
+#
+# Usage
+# =====
+# 1) command qla say -- $* --;prod $*;whereami;say -??-;blook at $*;say -==-;look at $*;say ====
+# 2) rip_action set party kills (or spam party kills every once in a while to collect expvalue data)
+# 3) qla monster
+# 4) Cast detect race, detect alignment, whatnot at monster (if you wish/can/have those).
+# 5) Fight and kill monster.
+# 6) run log2npctemplate.pl < logfile.log > output.txt
+#
+# 7) command id 
+#
+# Notes
+# =====
+# - You must have spellname translator, preferably one with format:
+#   Xxxx claps its hands and says (cure critical wounds)
+#
+# - There is some flexibility in the parser, it can filter out ANSI from the
+#   input log, etc. but you may have to customize it. And that requires Perl
+#   knowledge.
+#
+use strict;
+
+# Options
+my $opt_ansi = 1;	# 1 = strip ANSI, 0 = don't (is faster)
+my $opt_debug = 0;	# 1 = enable debug output
+my $opt_pkills_crop = 60;
+my $opt_outfile;
+my $opt_identify = 1;
+my $opt_npc = 1;
+
+
+# Define the regular expression to match any outputs of "say"
+# as this is somewhat race-dependant.
+my $sayregex = "(quack|say)";
+
+
+# Define the various spell chant prefixes here, we need them
+# for matching the spell cast lines themselves.
+my @spellchants = (
+"claps its hands and says",
+"claps his hands and whispers",
+"fills up his cheeks with air and exhales",
+"booms in sinister voice",
+"throws a pinch of magic dust in air and chants",
+"rolls her eyes wildly and exclaims",
+"rolls its eyes frantically and states",
+"utters the magic words",
+"spreads her fingers and whispers",
+"waves its index finger while uttering",
+"points an accusing finger and cries",
+"gets an evil gleam in its eyes and chants",
+"flaps arms and utters the magic words",
+"flaps his arms and utters the magic words",
+"taps its foot three times and utters the words",
+"is surrounded by blue waves as you hear the words:",
+"closes his eyes and with a dry, dark voice entones",
+"shakes with firey rage and yells",
+"traces fiery demonic night runes in the air",
+"weaves a mystic matrix with glowing red lines in arcane ways and chants",
+#"",
+);
+
+
+# Stat name translations
+my @statTransTable = (
+  sub { return $_[0] =~ s/^ability at the (skill|spell) (.+)$/$2/ },
+  sub { return $_[0] =~ s/^mental regeneration$/spr/g },
+  sub { return $_[0] =~ s/^physical regeneration$/hpr/g },
+#  sub { return $_[0] =~ s///g },
+);
+
+
+### Options
+while (defined(my $arg = shift)) {
+  if ($arg eq "-d") {
+    $opt_debug++;
+  }
+  elsif ($arg eq "-i") {
+    $opt_identify = 0;
+  }
+  elsif ($arg eq "-n") {
+    $opt_npc = 0;
+  }
+  elsif ($arg eq "-o") {
+    $opt_outfile = shift or die("Output file option -o requires an argument.\n");
+  }
+  else {
+    die("Invalid option '$arg'.
+Usage: $0 [options] < input.log > output.txt
+
+    -o <filename>         Output filename.
+    -d                    Enable debug mode.
+    -i                    Disable identify parser.
+    -n                    Disable NPC parser.
+
+");
+  }
+}
+
+print STDERR "Debug mode enabled, level=".$opt_debug.".\n" if ($opt_debug);
+
+if (defined($opt_outfile)) {
+  open(STDOUT, '>', $opt_outfile) or die("Could not open output file '$opt_outfile'.\n");
+}
+
+
+### Translate stats
+sub trans_stat($)
+{
+  my ($s) = @_;
+  foreach my $pat (@statTransTable) {
+    return $s if ($pat->($s));
+  }  
+  return $s;
+}
+
+
+### Globals
+my %monsters = ();
+my %aligns = ();
+my %spells = ();
+my %races = ();
+my %areas = ();
+my %ids = ();
+
+my $line = 0;
+
+my $mob_sdesc;
+my $mob = { };
+my $state = 0;
+
+my $id_tale;
+my $id_tale2;
+my $id = {};
+
+
+### Convert spellchants array to regexp
+my $spellregexps = join("|", map { s/ (his|its|her) / ... /g; $_ } @spellchants);
+
+
+### Change parsing state
+sub set_state($$)
+{
+  return unless ($_[0] != $state);
+  print STDERR "STATE = $_[0], old = $state\n" if ($opt_debug > 1);
+  $state = $_[0];
+  if ($state < 0) {
+    print STDERR "ERROR($line): $_[1]\n";
+    $state = 0;
+  }
+}
+
+
+sub parse_npc($)
+{
+  my ($s) = @_;
+  
+  if ($state == 1) {
+    if ($s =~ /^You prod (.+?) like a stray cow\.$/o) {
+      # Get 'short name'
+      $$mob{"sname"} = $1;
+    } elsif ($s =~ /^You are in '.*?' in (.+?) on the continent of ([A-Z][a-z]+). \(Coordinates: (\d+)x, (\d+)y\)$/o) {
+      # Area, continent
+      $$mob{"area"} = $1;
+      $$mob{"cont"} = $2;
+
+      $areas{$1}{"cont"} = $2;
+      $areas{$1}{"x"} = $3;
+      $areas{$1}{"y"} = $4;
+    } elsif ($s =~ /^You are in '.*?', which is on the continent of ([A-Z][a-z]+). \(Coordinates: (\d)+x, (\d)+y\)$/o) {
+      # Area, continent
+      $$mob{"area"} = $1;
+      $$mob{"cont"} = $1;
+
+      $areas{$1}{"cont"} = $1;
+      $areas{$1}{"x"} = $2;
+      $areas{$1}{"y"} = $3;
+    } elsif ($s =~ /^You $sayregex '(-\?\?-|--\?\?--\?\?--\?\?--\?\?--)\.'$/o) {
+      set_state(2, $s);
+    } else {
+      set_state(-1, $s);
+    }
+  }
+  elsif ($state == 2) {
+    # Mostly just grab shortdesc here
+    if ($s =~ /^You $sayregex '(-==-|-=-=-=-=-=-=-=-=-)\.'$/o) {
+      set_state(3, $s);
+    } elsif ($s =~ /^(He|She|It) +\[[a-z]+\] \([0-9-]+\%\)/o) {
+      set_state(-1, $s);
+    } elsif ($s =~ /^You $sayregex /o) {
+      set_state(-1, $s);
+    } else {
+      $mob_sdesc = $s;
+    }
+  }
+  elsif ($state == 3) {
+    if ($s =~ /^ +([a-zA-Z ,-]+?)'s equipment:$/o) {
+      # End of long desc
+      set_state(4, $s);
+    } elsif ($s =~ /^(He|She|It) +\[[a-z]+\] \([0-9-]+\%\)$/o ||
+      $s =~ /^(He|She|It) is (in (a )?)?(excellent shape|good shape|slightly hurt|noticeably hurt|not in a good shape|bad shape|very bad shape|near death)/o) {
+      # End of long desc
+      set_state(4, $s);
+    } elsif ($s =~ /^You $sayregex /o) {
+      set_state(-1, $s);
+    } else {
+      # Collect long desc
+      $$mob{"ldesc"} .= $s." ";
+    }
+  }
+  elsif ($state == 4) {
+    if ($s =~ /^You $sayregex '====*'?\.'$/o) {
+      # Finished, submit information to hash
+      $monsters{$mob_sdesc} = $mob;
+      set_state(0, $s);
+    } elsif ($s =~ /^([A-Z][a-z, ]+): (.*)$/o) {
+      # Collect EQ and slot information
+      $$mob{"eqs"}{$1} = $2;
+    } elsif ($s =~ /^([A-Z][a-z, ]+)\s+\(partially hidden\)\s*: (.*)$/o) {
+      # Collect EQ and slot information
+      $$mob{"eqs"}{$1} = $2;
+    } elsif ($s =~ /^ +([a-zA-Z -]+?)'s equipment:$/o) {
+      # Ignore this line
+    } elsif ($s =~ /^((It|She|He) has a blueish black kiss on ... cheek\.|(It|She|He) suffers from scourge\.|Some glittering red mist is surrounding this creature.|Nothing\.|(It|He|She) has a faint ring of .+ magic mist around ... neck\.)$/o) {
+      # Ignore various useless lines such as holz markings
+    } else {
+      # Error.
+      set_state(-1, $s);
+    }
+  }
+}
+
+
+sub parse_identify($)
+{
+  my ($s) = @_;
+  
+  if ($state == 10) {
+    if ($s =~ /^You $sayregex '-#-\.'$/o) {
+      set_state(11, $s);
+    }
+    elsif ($s =~ /^:\s*(\d+\.\d+)\s+(.+)$/) {
+      # Weigh in kgs, and sdesc. Will have to match these later.
+      $$id{"kg"}{$2} = $1;
+      $$id{"full"} = $2;
+    }
+  }
+  elsif ($state == 11) {
+    if ($s =~ /^It is surrounded by .+? glow\.$|^It is labeled as|^This item is a present from santa to /) {
+      # Just skip these
+    }
+    elsif ($s =~ /You $sayregex '-!-\.'$/o) {
+      set_state(12, $s);
+    }
+    elsif ($s =~ /^It contains a tale;$/) {
+      $id_tale = 1;
+    }
+    elsif ($s =~ /^This (.+?) is in .+? condition\.$/) {
+      $$id{"type"} = $1;
+    }
+    elsif ($s =~ /^These (.+?) are in .+? condition\.$/) {
+      $$id{"type"} = $1;
+    }
+    elsif ($s =~ /^It looks (light weight|a bit heavy|heavy|very very heavy|very light weight|very heavy|ridiculously heavy)\.$/) {
+      $$id{"weight"} = $1;
+    }
+    else {
+      if ($id_tale) {
+        $$id{"tale"} .= $s." ";
+      } else {
+        my $len = length($s);
+        $$id{"ldesc"} .= $s;
+        if (defined($$id{"len"}) && $len + $$id{"len"} < 79) {
+          $$id{"ldesc"} .= "\n";
+        } else  {
+          $$id{"ldesc"} .= " ";
+        }
+        $$id{"len"} = $len;
+      }
+    }
+  }
+  elsif ($state == 12) {
+    if ($s =~ /^The following messages seem to vibrate from (.+?):$/o) {
+      $$id{"sdesc"} = $1;
+      set_state(13, $s);
+    }
+  }
+  elsif ($state == 13) {
+    if ($s =~ /^It is called (.+)\.$/) {
+      $$id{"handles"} = $1;
+      $id_tale2 = 0;
+    }
+    elsif ($s =~ /^It takes the following slots: (.+)\.$/) {
+      $$id{"slots"} = $1;
+      $id_tale2 = 0;
+    }
+    elsif ($s =~ /^A halo of purity surrounds it\.$/) {
+      push(@{$$id{"stats"}}, "[[:category:halo of purity|good wear only]]");
+      $$id{"cat"}{"halo of purity"} = 1;
+      $id_tale2 = 0;
+    }
+    elsif ($s =~ /^An aura of blackness surrounds it\.$/) {
+      push(@{$$id{"stats"}}, "[[:category:aura of darkness|evil wear only]]");
+      $$id{"cat"}{"aura of darkness"} = 1;
+      $id_tale2 = 0;
+    }
+    elsif ($s =~ /^It will (.+?) (improve|reduce) your (.+?)\.$/) {
+      my ($amt, $imp, $stat) = ($1, $2, $3);
+      push(@{$$id{"stats"}}, ($imp eq "improve" ? "+" : "-").$amt." ".trans_stat($stat));
+      $$id{"cat"}{trans_stat($stat)} = 1 if ($imp eq "improve");
+      $id_tale2 = 0;
+    }
+    elsif ($s =~ /^It will (raise|lower) your (.+?)\.$/) {
+      my $imp = $1;
+      my $stat = substr($2, 0, 3);
+      push(@{$$id{"stats"}}, ($imp eq "raise" ? "+" : "-").$stat);
+      $$id{"cat"}{$stat} = 1 if ($imp eq "raise");
+      $id_tale2 = 0;
+    }
+    elsif ($s =~ /^It contains a tale;$/) {
+      $id_tale2 = 1;
+    }
+    elsif ($s =~ /^(.+?) did the heroic deed to bring this piece of equipment before you (.+)$/) {
+      my $info = $2;
+      $$id{""} = "";
+      
+      # Parse the big data blob
+      if ($info =~ /It is ([A-Za-z -]+), ([A-Za-z -]+),/) {
+        $$id{"weight2"} = $1;
+        $$id{"size"} = $2;
+      }
+      
+      if ($info =~ /of ([A-Za-z ]+) quality/) {
+        $$id{"quality"} = $1;
+      }
+      
+      if ($info =~ /(emits darkness|emits light)/) {
+        push(@{$$id{"stats"}}, $1);
+        $$id{"cat"}{$1} = 1;
+      }
+      
+      if ($info =~ /made of,? ?(.+?), (feather|worth)/) {
+        @{$$id{"materials"}} = split(/\s*,\s*/, $1);
+        my $qmat = $$id{"materials"}[0];
+        my $qmax = -1;
+        foreach my $mat (@{$$id{"materials"}}) {
+          if ($mat =~ /^(\d+)% (.+)$/) {
+            if ($1 >= $qmax) {
+              $qmax = $1;
+              $qmat = $2;
+            }
+          }
+        }
+        $$id{"material"} = $qmat;
+        $$id{"cat"}{$qmat} = 1;
+      }
+      
+      # Check for nun relics
+      if ($$id{"full"} =~ / \(holy\)/) {
+        $$id{"cat"}{"relic"} = 1;
+      }
+      
+      # Set item class
+      $$id{"class"} = "Item";
+      if ($info =~ /The weapon skill to best use this in combat/) {
+        $$id{"class"} = "Weapon";
+      } elsif (defined($$id{"type"}) && $$id{"type"} ne "") {
+        $$id{"class"} = "Armour";
+      }
+      
+      # Check if the weight data is for FW'd item
+      if ($$id{"full"} =~ / <(yellow|green|white) glow>$/) {
+        $$id{"kg"} = "";
+        $$id{"weight"} = "";
+      } else {
+        if (defined($$id{"kg"}{$$id{"full"}})) {
+          $$id{"kg"} = $$id{"kg"}{$$id{"full"}};
+        } else {
+          $$id{"kg"} = "";
+        }
+      }
+      
+      # Submit data
+      $ids{$$id{"full"}} = $id;
+      set_state(0, $s);
+    }
+    else {
+      if ($id_tale2) {
+        $$id{"tale"} .= $s." ";
+      } else {
+        push(@{$$id{"other"}}, $s);
+      }
+    }
+  }
+}
+
+
+###
+### Main parsing loop
+###
+while (defined(my $s = <STDIN>)) {
+  $line++;
+  chomp($s);
+
+  # Strip ANSI colours and escapes
+  $s =~ s/\e\[?.*?[\@-~]//g if ($opt_ansi);
+
+  if
+  ($s =~ /^([A-Za-z][A-Za-z\ -]+?)\ ($spellregexps)\ \(([A-Za-z][A-Za-z\ ]+)\)/o)
+  {
+    # Grab cast spells
+    $spells{$1}{$line} = lc($3);
+  }
+  elsif ($s =~ /\| \d\d:\d\d +(\d+): (.+?) +\|$/) {
+    # Grab exp worth
+    my $exp = $1;
+    my $tmp = $2;
+    my $sdesc = substr($tmp, 0, $opt_pkills_crop);
+    if (defined($monsters{$sdesc}) && $line > $monsters{$sdesc}{"line"}) {
+      $monsters{$sdesc}{"exp"} = $exp;
+    } else {
+      $tmp .= " (undead)";
+      $sdesc = substr($tmp, 0, $opt_pkills_crop);
+      if (defined($monsters{$sdesc}) && $line > $monsters{$sdesc}{"line"}) {
+        $monsters{$sdesc}{"exp"} = $exp;
+      }
+    }
+  }
+  elsif ($s =~ /^\[\d\d:\d\d:\d\d\] hp|^You laugh out loud\.$|^Dunk dunk$/) {
+    # Ignore these lines
+  }
+  elsif ($s =~ /^You see nothing special\.$/o) {
+    # Reset parsing state if the target obviously didn't exist
+    set_state(0, $s);
+  }
+  elsif ($state == 0 && $s =~ /^You $sayregex '-+ .+? -+\.'$/o) {
+    next unless ($opt_npc);
+    # Beginning of NPC info block
+    set_state(1, $s);
+    undef($mob);
+    $mob_sdesc = "";
+    $$mob{"line"} = $line;
+  }
+  elsif ($state == 0 && $s =~ /^You $sayregex '-ID-\.'$/o) {
+    next unless ($opt_identify);
+    # Beginning of identify info block
+    set_state(10, $s);
+    $id = {};
+    undef($id);
+    $id_tale = 0;
+    $id_tale2 = 0;
+    $$id{"line"} = $line;
+  }
+  elsif ($state > 0 && $state < 10) {
+    # States for NPC parsing
+    parse_npc($s);
+  }
+  elsif ($state >= 10) {
+    parse_identify($s);
+  }
+  elsif ($s =~ /^(.+?) is (a bit good|a bit evil|evil|good|neutral)\.$/o) {
+    # Grab detect alignment
+    $aligns{$1}{$line} = $2;
+  }
+  elsif ($s =~ /^([A-Za-z][A-Za-z\ .-]+?)\ is an? ([a-z-]+)\.$/o) {
+    # Grab detect race
+    $races{$1}{$line} = $2;
+  }
+  elsif ($s =~ /^You $sayregex /o) {
+    # Error, reset parsing state
+    set_state(0, $s);
+  }
+}
+
+
+###
+### Print out item/identify information
+###
+foreach my $sdesc (sort { $a cmp $b } keys %ids) {
+  my $item = $ids{$sdesc};
+  my $name = $$item{"sdesc"};
+  $name =~ s/ labeled as .*$//;
+  my $qdesc = $name;
+  if ($$item{"full"} =~ / <(red|purple|white) glow>$/) {
+    $name .= " <red glow>";
+  }
+
+  print "---------------------------\n".
+  $qdesc."\n\n".
+  "{{ Infobox ".$$item{"class"}."\n".
+  "| name = ".$name."\n".
+  "| description = ".$$item{"ldesc"}."\n";
+
+  if (defined($$item{"tale"}) && $$item{"tale"} ne "") {
+    print "| tale = ".$$item{"tale"}."\n";
+  }
+
+  if (defined($$item{"type"})) {
+    print "| type = ".$$item{"type"}."\n";
+  }
+
+  if (defined($$item{"stats"})) {
+    print "| stats = ".join(", ", @{$$item{"stats"}})."\n";
+  } else {
+    print "| stats = \n";
+  }
+
+  print
+  "| weight = ".$$item{"weight"}."\n".
+  "| kg = ".$$item{"kg"}."\n".
+  "| sacvalue = \n".
+  "| handles = ".$$item{"handles"}."\n";
+  
+  if (defined($$item{"materials"})) {
+    print "| material = ".join(", ", @{$$item{"materials"}})."\n";
+  }
+
+  print
+  "| size = ".$$item{"size"}."\n".
+  "| quality = ".$$item{"quality"}."\n".
+  "| from = \n";
+
+  if ($$item{"class"} eq "Weapon") {
+    print
+    "| wep1 = \n".
+    "| wep2 = \n";
+  }
+
+  if (defined($$item{"other"})) {
+    print "| other = ".join("\n", @{$$item{"other"}})."\n";
+  }
+
+  print
+  "}}\n";
+
+  foreach my $cat (keys %{$$item{"cat"}}) {
+    print "[[Category:$cat]]\n";
+  }
+
+  print "---------------------\n";
+}
+
+
+###
+### Print out the NPC information
+###
+foreach my $sdesc (sort { $a cmp $b } keys %monsters) {
+  my $mob = $monsters{$sdesc};
+
+  print "---------------------------
+$sdesc
+
+{{ NPC
+| name = ".$$mob{"sname"}."
+| description = ".$$mob{"ldesc"}."
+| eqs = ";
+
+  foreach my $slot (sort { $a cmp $b } keys %{$$mob{"eqs"}}) {
+    my ($k, $s);
+    $k = $s = $$mob{"eqs"}{$slot};
+    $k =~ s/ <[a-z]+ glow>$//;
+    if ($k eq $s) {
+      print "$slot: [[$s]]\n\n";
+    } else {
+      print "$slot: [[$k|$s]]\n\n";
+    }
+  }
+  
+  print "none" unless (scalar keys %{$$mob{"eqs"}} > 0);
+  print "\n";
+        
+  if ($sdesc =~ / \(undead\)$/) {
+    print "| undead = x\n";
+  }
+
+  # Check if we find a matching alignment: find a cast of 'detect alignment'
+  # with matching short name and withing appropriate distance from the mob look.
+  my $mname = $$mob{"sname"};
+  my $mline = $$mob{"line"};
+
+  print "| alignment = ";
+  if (defined($aligns{$mname})) {
+    my $qoffs = 1000;
+    my $qline = -1;
+    foreach my $aline (sort { $a <=> $b } keys %{$aligns{$mname}}) {
+      my $offs = ($aline - $mline);
+      if ($offs < $qoffs) {
+        $qoffs = $offs;
+        $qline = $aline;
+      }
+    }
+    if ($qline >= 0) {
+      print STDERR "ALIGN: $mname ($sdesc) \@ #$qline ($qoffs)\n" if ($opt_debug);
+      print $aligns{$mname}{$qline};
+    }
+  }
+  print "\n".
+  "| race = ";
+  
+  # Check for race
+  if (defined($races{$mname})) {
+    my $qoffs = 1000;
+    my $qline = -1;
+    foreach my $aline (sort { $a <=> $b } keys %{$races{$mname}}) {
+      my $offs = ($aline - $mline);
+      if ($offs < $qoffs) {
+        $qoffs = $offs;
+        $qline = $aline;
+      }
+    }
+    if ($qline >= 0) {
+      print STDERR "RACE: $mname ($sdesc) \@ #$qline ($qoffs)\n" if ($opt_debug);
+      print $races{$mname}{$qline};
+    }
+  }
+  print "\n";
+
+  
+  # Spells
+  my $hasspells = 0;
+  if (defined($spells{$mname}) && length($mname) >= 4) {
+    my $maxdist = length($mname) * 150 * length($mname);
+    my $mindist = length($mname) * -5 * length($mname);
+    my %mspells = ();
+    foreach my $sline (sort { $a <=> $b } keys %{$spells{$mname}}) {
+      my $offs = $sline - $mline;
+#      print STDERR "TEST $mname @ $offs vs $mindist...$maxdist : '".$spells{$mname}{$sline}."'\n";
+      if ($offs < $maxdist && $offs > $mindist) {
+        print STDERR "SPELL $mname \@ $offs / $mindist...$maxdist : '".$spells{$mname}{$sline}."'\n" if ($opt_debug);
+        $mspells{$spells{$mname}{$sline}} = 1;
+        $hasspells++;
+      }
+    }
+    my $n = 1;
+    foreach my $spell (sort { $a cmp $b } keys %mspells) {
+      print "| spell".($n < 2 ? "" : $n)." = $spell\n";
+      $n++;
+    }
+  }
+
+unless ($hasspells > 0) {
+print "| spell = 
+| spell# = 
+";
+}
+
+  print "
+| area = ".$$mob{"area"}."
+| skill = 
+| skill# = 
+| exp = ";
+
+  if (defined($$mob{"exp"})) {
+    if ($$mob{"exp"} > 1000000) {
+      printf "%1.2fM", $$mob{"exp"} / 1000000.0;
+    } elsif ($$mob{"exp"} > 1000) {
+      printf "%dk", $$mob{"exp"} / 1000;
+    } else {
+      printf "%d", $$mob{"exp"};
+    }
+  }
+
+print "
+| GAP = 
+| PAP = 
+| kerbholz = 
+| other = 
+}}
+---------------------
+";
+}