df-log-filter.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use Cwd 'abs_path';
   6 use File::Basename;
   7
   8 my $script = dirname(abs_path($0)) . "/print-colored.pl";
   9 my $beep = dirname(abs_path($0)) . "/beep";
  10 my $unpause = dirname(abs_path($0)) . "/unpause.sh";
  11
  12
  13 #uncommented line below to use pc speaker
  14 #my $beep = dirname(abs_path($0)) . "perl -e 'print \"\\a\"'";
  15
  16 my @conditions = (
  17 #spam info
  18         ["^x([0-9])+", [""]],
  19         ["has created a masterpiece", [""]],
  20         ["has engraved a masterpiece", [""]],
  21         ["has become a", [""]],
  22 #job cancellation
  23         ["Drop-off inaccessible", [""]],
  24         ["Job item misplaced", [""]],
  25         ["Item inaccessible", [""]],
  26         ["Equipment mismatch", [""]],
  27         [" Getting something to ", [""]],
  28         ["Needs unrotten body part", [""]],
  29         ["Needs butcherable unrotten nearby item", [""]],
  30         ["Seeking Infant", [""]],
  31 #deadly strikes
  32         ["tearing the brain", [$script . " green"]],
  33         ["lower body(.+)and the severed part sails off in an arc", [$script . " green"]],
  34         ["head(.+)and the severed part sails off in an arc", [$script . " green"]],
  35 #sparring/fighting
  36         ["but the shot is blocked", [""]],
  37         [" lightly tapping ", [""]],
  38         ["charges at", [""]],
  39         ["latches on firmly", [""]],
  40         [" bites ", [""]],
  41         [" shakes ", [""]],
  42         [" scratches ", [""]],
  43         [" tearing the fat", [""]],
  44         [" bruising the ", [""]],
  45         ["looks surprised", [""]],
  46         ["counterstrikes", [""]],
  47         ["collides", [""]],
  48         ["knocked over", [""]],
  49         ["stands up", [""]],
  50         [" bounces ", [""]],
  51         ["looks sick", [""]],
  52         ["even more sick", [""]],
  53         ["trouble breathing", [""]],
  54         ["falls over", [""]],
  55         ["stunned", [""]],
  56         ["onslaught", [""]],
  57         [" tangle together", [""]],
  58         [" attacks ", [""]],
  59         [" strikes ", [""]],
  60         [" misses ", [""]],
  61         [" regains ", [""]],
  62         [" gives in to pain", [""]],
  63         [" become enraged", [""]],
  64         [" knocked unconscious", [""]],
  65         [" has been opened", [""]],
  66         [" bashes ", [""]],
  67         [" blocks ", [""]],
  68         [" loses hold ", [""]],
  69         [" vomit", [""]],
  70         [" twists", [""]],
  71         [" tendon (.+) torn", [""]],
  72         ["lodged firmly", [""]],
  73 #danger/death
  74         ["stolen", [$script . " magenta"]],
  75         ["Dangerous terrain", [$script . " red", $beep]],
  76         ["^An ambush! ", [$script . " red", $beep]],
  77         ["^A vile force of ", [$script . " red", $beep]],
  78         ["^The forgotten beast (.+) has come", [$script . " red", $beep]],
  79         ["Interrupted by", [$script . " red", $beep]],
  80         [" has bled to death.", [$script . " red", $beep]],
  81         ["drowned", [$script . " red", $beep]],
  82         [" died ", [$script . " red", $beep]],
  83         ["^The (.+) struck", [$script . " magenta"]],   #indicates that an unnamed being has been slaughtered/killed
  84         ["^You have struck", [$script . " yellow"]],    # some stone has been discovered
  85         ["struck", [$script . " red", $beep]],  #indicates that a named being has been struck down, most likely of our population.
  86         [" is throwing a tantrum", [$script . " red", $beep]],
  87         [" has gone berserk", [$script . " red", $beep]],
  88         [" Went insane", [$script . " red", $beep]],
  89 #game pausing/important events
  90         ["(D|d)amp (S|s)tone", [$script . " yellow", $beep, $unpause]],
  91         ["Praise the miners", [$script . " green", $beep]], #adamantine discovered
  92         [" has bestowed the name ", [$script . " yellow", $beep, $unpause]], #named a weapon
  93         #merchants
  94         ["will be leaving soon", [$script . " yellow", $beep]],
  95         ["embarked", [$script . " yellow"]],
  96         ["arrived", [$script . " yellow", $beep, $unpause]],
  97         #moods
  98         [" withdraws from society", [$script . " white", $beep, $unpause]],
  99         [" fey mood", [$script . " white", $beep]],
 100         [" posessed", [$script . " white", $beep]],
 101         [" claimed ", [$script . " white", $beep, $unpause]], #remove the unpause tag in a fresh game, when its likely you dont have everything in stock urist mcmood wants.
 102         [" begun a mysterious construction", [$script . " white", $beep]], #dont unpause, so you can still forbid stuff
 103         [" has created ", [$script . " white", $beep]], #dont unpause, so you can look what he created
 104         #damn, more dwarfes/pets -> lower fps.
 105         [" has given birth to a (girl|boy)", [$script . " blue", $beep, $unpause]],
 106         [" has given birth to ", [$script . " blue"]],
 107 #other interesting info
 108         ["has mandated ", [$script . " yellow", $beep]],
 109         ["has imposed a ban ", [$script . " yellow", $beep]],
 110         ["has grown to", [$script . " blue"]],
 111         ["has been completed", [$script . " cyan"]],
 112         [" suspended the", [$script . " yellow", $beep]]
 113 );
 114
 115 while (<>) {
 116         #print; #uncomment to see which line may have caused an error.
 117         my $matched = 0;
 118         foreach my $cond(@conditions) {
 119                 my $regex = $cond->[0];
 120                 my $cmds = $cond->[1];
 121                 if ($_ =~ /$regex/) {
 122                         for(my $i = 0; $i <= $#$cmds; $i++) {
 123                                 my $cmd = $cmds->[$i];
 124                                 my @args = split " ", $cmd;
 125                                 system @args, $_ if $cmd ne "";
 126                                 $matched = 1;
 127                         }
 128                         last if $matched;
 129                 }
 130         }
 131         if (!$matched) {
 132                 # TODO place code to print when no regex matched
 133                 print;
 134         }
 135 }