changeset 184:84fa86a54038 misc

Added script for parsing crap spewed by Rubi in Silverlake.
author Matti Hamalainen <ccr@tnsp.org>
date Sat, 15 Jan 2011 08:08:57 +0200
parents 9bb617528b25
children 76411af070f2
files parse_rubi.pl
diffstat 1 files changed, 177 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/parse_rubi.pl	Sat Jan 15 08:08:57 2011 +0200
@@ -0,0 +1,177 @@
+#!/usr/bin/perl -w
+use strict;
+
+my %rawdata = ();
+my $mismatches = "";
+
+sub addto($$)
+{
+  my ($target, $str) = @_;
+
+  foreach my $result (@{$rawdata{$target}{"results"}}) {
+    return if ($result eq $str);
+  }
+  
+  if ($str ne "") {
+    push(@{$rawdata{$target}{"results"}}, $str);
+
+    if ($target =~ /^an? ([a-z]+) of (.+)$/) {
+      $rawdata{$target}{"organ"} = $1;
+      $rawdata{$target}{"name"} = $2;
+    } else {
+      $rawdata{$target}{"organ"} = "";
+      $rawdata{$target}{"name"} = $target;
+    }
+  }
+}
+
+sub err($)
+{
+  print STDERR "!! ".$_[0];
+  $mismatches .= $_[0];
+}
+
+my %says = ();
+my %races = ();
+
+my $result = "";
+my $target = "";
+my $dis_flag = 0;
+my $dis_corpse = "";
+my $dr_name = "";
+my $dr_race = "";
+
+while (<STDIN>) {
+  chomp;
+  if (/^Rubi tosses (.+?) into a cauldron, and it dissolves away\.$/) {
+    addto($1, $result);
+    $result = "";
+  }
+  elsif (/^Rubi says 'No, no, that won't do at all/) {
+    $result = "NO" if ($result eq "");
+  }
+  elsif (/^Rubi says 'Hmm, seems a bit shoddy./) {
+    $result = "SHODDY" if ($result eq "");
+  }
+  elsif (/^Rubi takes (.+?) and starts a new potion\.$/) {
+    $target = $1;
+  }
+  elsif (/^Rubi puts (\d+ potions?) on her shelves\.$/) {
+    addto($target, $1);
+    $target = "";
+  }
+  elsif (/^Rubi says '(.+?)'$/) {
+    $says{$1} = 1;
+  }
+  elsif (/^You say \'-dis-\.\'$/) {
+    $dis_flag = 1;
+    $dis_corpse = "";
+  }
+  elsif (/^This is the dead body of (.+)\.$/) {
+    $dis_corpse = $1;
+  }
+  elsif (/^You start slicing into the corpse of '(.+?)'\.\.\.$/) {
+    my $race = $1;
+    if ($dis_flag && $dis_corpse ne "") {
+      if (defined($races{$dis_corpse}) && $races{$dis_corpse} ne $race) {
+        err("'$dis_corpse' race mismatch '".$races{$dis_corpse}."' <=> '$race'.\n");
+      } else {
+        $races{$dis_corpse} = $race;
+      }
+    }
+    $dis_flag = 0;
+  }
+  elsif (/^([A-Za-z ]+) is an? ([a-z]+)\.$/) {
+    $dr_name = $1;
+    $dr_race = $2;
+  }
+  elsif (/^That race has the following organs:(.+)$/) {
+    my $organs = $1;
+    if ($dr_name ne "" && $dr_race ne "" && !($dr_name =~ /^Corpse of /)) {
+      if (defined($races{$dr_name}) && $races{$dr_name} ne $dr_race) {
+        err("'$dr_name' race mismatch '".$races{$dr_name}."' <=> '$dr_race'.\n");
+      } else {
+        $races{$dr_name} = $dr_race;
+      }
+    }
+    $dr_name = $dr_race = "";
+  } else {
+    $dr_name = $dr_race = "";
+  }
+}
+
+## Process data with matching races
+my %data = ();
+foreach my $i (keys %rawdata) {
+  my $name = $rawdata{$i}{"name"};
+  $data{$i}{"name"} = $rawdata{$i}{"name"};
+  $data{$i}{"organ"} = $rawdata{$i}{"organ"};
+  $data{$i}{"results"} = $rawdata{$i}{"results"};
+  $data{$i}{"race"} = defined($races{$name}) ? $races{$name} : "";
+}
+
+## List what Rubi says .. e.g. the "hints"
+if ($mismatches ne "") {
+  print "Following possible problems were detected:\n\n".$mismatches."\n";
+  print "\n=====================================================================\n\n";
+}
+
+
+foreach my $i (sort { $a cmp $b } keys %says) {
+  print "$i\n"; 
+}
+
+print "\n\n=====================================================================\n\n";
+print "-------- Sorted by results --------\nOnly matches or near-matches shown!\n\n";
+
+foreach my $i (keys %data) {
+  $data{$i}{"sort"} = join(", ", sort @{$data{$i}{"results"}});
+}
+
+sub printentry($$)
+{
+  my ($i, $res) = @_;
+  
+  if ($data{$i}{"organ"} ne "") {
+    if ($data{$i}{"race"} ne "") {
+      printf "%-30s (%-10s) [%-10s] : %s\n", $data{$i}{"name"}, $data{$i}{"race"}, $data{$i}{"organ"}, $res;
+    } else {
+      printf "%-43s [%-10s] : %s\n", $data{$i}{"name"}, $data{$i}{"organ"}, $res;
+    }
+  } else {
+    printf "%-56s : %s\n", $i, $res;
+  }
+}
+
+foreach my $i (sort { $data{$a}{"sort"} cmp $data{$b}{"sort"} } keys %data) {
+  my $res = join(", ", sort @{$data{$i}{"results"}});
+  if ($res ne "NO") {
+    printentry($i, $res);
+  }
+}
+
+print "\n\n=====================================================================\n\n";
+print "-------- Sorted by name --------\n\n";
+
+foreach my $i (sort { $data{$a}{"name"} cmp $data{$b}{"name"} } keys %data) {
+  my $res = join(", ", sort @{$data{$i}{"results"}});
+  printentry($i, $res);
+}
+
+print "\n\n=====================================================================\n\n";
+print "-------- Sorted by race --------\nOnly data with known race shown!\n\n";
+
+my %byrace = ();
+foreach my $i (keys %data) {
+  if ($data{$i}{"race"} ne "") {
+    $byrace{$data{$i}{"race"}}{$data{$i}{"organ"}} = $data{$i}{"results"};
+  }
+}
+
+foreach my $i (sort { $a cmp $b } keys %byrace) {
+  foreach my $o (sort { $a cmp $b } keys %{$byrace{$i}}) {
+    my $res = join(", ", sort @{$byrace{$i}{$o}});
+    printf "%-43s (%-10s) : %s\n", $i, $o, $res;
+  }
+  print "\n";
+}