perl/watchdbg

   1 #!/usr/bin/perl
   2 #
   3 # watch the end of the current debug file (like tail -f) applying
   4 # any regexes supplied on the command line.
   5 #
   6 # There can be more than one <regexp>. a <regexp> preceeded by a '!' is
   7 # treated as NOT <regexp>. Each <regexp> is implcitly ANDed together.
   8 # All <regexp> are caseless.
   9 #
  10 # examples:-
  11 #
  12 #   watchdbg g1tlh       # watch everything g1tlh does
  13 #   watchdbg -2 PCPROT       # watch all PCPROT messages + up to 2 lines before
  14 #   watchdbg gb7baa gb7djk   # watch the conversation between BAA and DJK
  15 #
  16
  17 require 5.004;
  18
  19 # search local then perl directories
  20 BEGIN {
  21         # root of directory tree for this system
  22         $root = "/spider";
  23         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  24
  25         unshift @INC, "$root/perl";     # this IS the right way round!
  26         unshift @INC, "$root/local";
  27 }
  28
  29 use IO::File;
  30 use SysVar;
  31 use DXUtil;
  32 use DXLog;
  33
  34 use strict;
  35
  36 my $fp = DXLog::new('debug', 'dat', 'd');
  37 my $today = $fp->unixtoj(time());
  38 my $fh = $fp->open($today) or die $!;
  39 my $nolines = 1;
  40 my @patt;
  41 my @prev;
  42
  43 while (@ARGV) {
  44         my $arg = shift;
  45         if ($arg =~ /^-+(\d+)/) {
  46                 $nolines += $1;
  47                 next;
  48         }
  49         usage(), exit(0) if $arg =~ /^-+[h\?]/i;
  50         push @patt, $arg;
  51 }
  52
  53
  54 # seek to end of file
  55 $fh->seek(0, 2);
  56 for (;;) {
  57         my $line = $fh->getline;
  58         if ($line) {
  59                 if (@patt) {
  60                         push @prev, $line;
  61                         shift @prev while @prev > $nolines;
  62                         my $flag = 0;
  63                         foreach my $p (@patt) {
  64                                 if ($p =~ /^!/) {
  65                                         my $r = substr $p, 1;
  66                                         last if $line =~ m{$r}i;
  67                                 } else {
  68                                         last unless $line =~ m{$p}i;
  69                                 }
  70                                 ++$flag;
  71                         }
  72                         if ($flag == @patt) {
  73                                 printit(@prev);
  74                                 @prev = ();
  75                         }
  76                 } else {
  77                         printit($line);
  78                 }
  79         } else {
  80                 sleep(1);
  81
  82                 # check that the debug hasn't rolled over to next day
  83                 # open it if it has
  84                 my $now = $fp->unixtoj(time());
  85                 if ($today->cmp($now)) {
  86                         $fp->close;
  87                         my $i;
  88                         for ($i = 0; $i < 20; $i++) {
  89                                 last if $fh = $fp->open($now);
  90                                 sleep 5;
  91                         }
  92                         die $! if $i >= 20;
  93                         $today = $now;
  94                 }
  95         }
  96 }
  97
  98 sub printit
  99 {
 100         while (@_) {
 101                 my $line = shift;
 102                 chomp $line;
 103                 $line =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg;
 104                 my ($t, $l) =  split /\^/, $line, 2;
 105                 $t = time unless defined $t;
 106                 printf "%02d:%02d:%02d %s\n", (gmtime($t))[2,1,0], $l;
 107         }
 108 }
 109 exit(0);
 110
 111 sub usage
 112 {
 113         print << "XXX";
 114
 115  usage: watchdbg [-nnn lines before] [<regexp>|!<regexp>]...
 116
 117         You can have more than one <regexp> with an implicit 'and' between them. All
 118         <regexes> are caseless. It's recommended to put 'not' (!<regex>) first in any list.
 119         Don't forget that you are doing this in a shell and you may need to quote your
 120         <regex>s.
 121
 122           watchdbg -2 progress
 123
 124         will display any line containing 'progress' and also the two lines before that.
 125
 126 XXX
 127 }