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 $nolines = shift if $ARGV[0] =~ /^-?\d+$/;
  41 $nolines = abs $nolines if $nolines < 0;
  42 my @patt = @ARGV;
  43 my @prev;
  44
  45 # seek to end of file
  46 $fh->seek(0, 2);
  47 for (;;) {
  48         my $line = $fh->getline;
  49         if ($line) {
  50                 if (@patt) {
  51                         push @prev, $line;
  52                         shift @prev while @prev > $nolines;
  53                         my $flag = 0;
  54                         foreach my $p (@patt) {
  55                                 if ($p =~ /^!/) {
  56                                         my $r = substr $p, 1;
  57                                         last if $line =~ m{$r}i;
  58                                 } else {
  59                                         last unless $line =~ m{$p}i;
  60                                 }
  61                                 ++$flag;
  62                         }
  63                         if ($flag == @patt) {
  64                                 printit(@prev);
  65                                 @prev = ();
  66                         }
  67                 } else {
  68                         printit($line);
  69                 }
  70         } else {
  71                 sleep(1);
  72
  73                 # check that the debug hasn't rolled over to next day
  74                 # open it if it has
  75                 my $now = $fp->unixtoj(time());
  76                 if ($today->cmp($now)) {
  77                         $fp->close;
  78                         my $i;
  79                         for ($i = 0; $i < 20; $i++) {
  80                                 last if $fh = $fp->open($now);
  81                                 sleep 5;
  82                         }
  83                         die $! if $i >= 20;
  84                         $today = $now;
  85                 }
  86         }
  87 }
  88
  89 sub printit
  90 {
  91         while (@_) {
  92                 my $line = shift;
  93                 chomp $line;
  94                 $line =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg;
  95                 my ($t, $l) =  split /\^/, $line, 2;
  96                 $t = time unless defined $t;
  97                 printf "%02d:%02d:%02d %s\n", (gmtime($t))[2,1,0], $l;
  98         }
  99 }
 100 exit(0);