]> scm.dxcluster.org Git - spider.git/blob - perl/watchdbg
c1d6b172beb11a09f63e2c288c7596f152f770f4
[spider.git] / 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 # examples:-
7
8 #   watchdbg g1tlh       # watch everything g1tlh does
9 #   watchdbg gb7baa gb7djk   # watch the conversation between BAA and DJK 
10 #
11
12 require 5.004;
13
14 # search local then perl directories
15 BEGIN {
16         # root of directory tree for this system
17         $root = "/spider"; 
18         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
19         
20         unshift @INC, "$root/perl";     # this IS the right way round!
21         unshift @INC, "$root/local";
22 }
23
24 use IO::File;
25 use DXVars;
26 use DXUtil;
27 use DXLog;
28
29 use strict;
30
31 my $fp = DXLog::new('debug', 'dat', 'd');
32 my @today = Julian::unixtoj(time()); 
33 my $fh = $fp->open(@today) or die $!; 
34 my $nolines = 1;
35 $nolines = shift if $ARGV[0] =~ /^\d+$/;
36 my $exp = join '|', @ARGV;
37 my @prev;
38
39 # seek to end of file
40 $fh->seek(0, 2);
41 for (;;) {
42         my $line = <$fh>;
43         if ($line) {
44                 if ($exp) {
45                         push @prev, $line;
46                         shift @prev while @prev > $nolines; 
47                         if ($line =~ m{(?:$exp)}oi) {
48                                 printit(@prev); 
49                                 @prev = ();
50                         }
51                 } else {
52                         printit($line);
53                 }
54         } else {
55                 sleep(1);
56                 
57                 # check that the debug hasn't rolled over to next day
58                 # open it if it has
59                 my @now = Julian::unixtoj(time()); 
60                 if ($today[1] != $now[1]) {
61                         $fp->close;
62                         my $i;
63                         for ($i = 0; $i < 20; $i++) {
64                                 last if $fh = $fp->open(@now);
65                                 sleep 5;
66                         }
67                         die $! if $i >= 20; 
68                         @today = @now;
69                 }
70         }
71 }
72
73 sub printit
74 {
75         while (@_) {
76                 my $line = shift;
77                 chomp $line;
78                 $line =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg; 
79                 my @line =  split '\^', $line;
80                 my $t = shift @line;
81                 my ($sec,$min,$hour) = gmtime((defined $t) ? $t : time);
82                 my $buf = sprintf "%02d:%02d:%02d", $hour, $min, $sec;
83                 
84                 print $buf, ' ', join('^', @line), "\n"; 
85         }
86 }
87 exit(0);