Mercurial > hg > batmud > misc
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"; +}