mirror of
git://scm.dxcluster.org/scm/spider
synced 2024-09-21 07:47:10 +00:00
f0910da57e
2. Redo Julian stuff as proper objects 3. Make the various Log display come out forwards instead of backwards 4. Add the dbgclean routine to system cron to clear out all debug files more then 10 days old.
89 lines
1.8 KiB
Perl
Executable File
89 lines
1.8 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# watch the end of the current debug file (like tail -f) applying
|
|
# any regexes supplied on the command line.
|
|
#
|
|
# examples:-
|
|
#
|
|
# watchdbg g1tlh # watch everything g1tlh does
|
|
# watchdbg 2 PCPROT # watch all PCPROT messages + up to 2 lines before
|
|
# watchdbg gb7baa gb7djk # watch the conversation between BAA and DJK
|
|
#
|
|
|
|
require 5.004;
|
|
|
|
# search local then perl directories
|
|
BEGIN {
|
|
# root of directory tree for this system
|
|
$root = "/spider";
|
|
$root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
|
|
|
|
unshift @INC, "$root/perl"; # this IS the right way round!
|
|
unshift @INC, "$root/local";
|
|
}
|
|
|
|
use IO::File;
|
|
use DXVars;
|
|
use DXUtil;
|
|
use DXLog;
|
|
|
|
use strict;
|
|
|
|
my $fp = DXLog::new('debug', 'dat', 'd');
|
|
my $today = $fp->unixtoj(time());
|
|
my $fh = $fp->open($today) or die $!;
|
|
my $nolines = 1;
|
|
$nolines = shift if $ARGV[0] =~ /^-?\d+$/;
|
|
$nolines = abs $nolines if $nolines < 0;
|
|
my $exp = join '|', @ARGV;
|
|
my @prev;
|
|
|
|
# seek to end of file
|
|
$fh->seek(0, 2);
|
|
for (;;) {
|
|
my $line = <$fh>;
|
|
if ($line) {
|
|
if ($exp) {
|
|
push @prev, $line;
|
|
shift @prev while @prev > $nolines;
|
|
if ($line =~ m{(?:$exp)}oi) {
|
|
printit(@prev);
|
|
@prev = ();
|
|
}
|
|
} else {
|
|
printit($line);
|
|
}
|
|
} else {
|
|
sleep(1);
|
|
|
|
# check that the debug hasn't rolled over to next day
|
|
# open it if it has
|
|
my $now = $fp->unixtoj(time());
|
|
if ($today->cmp($now)) {
|
|
$fp->close;
|
|
my $i;
|
|
for ($i = 0; $i < 20; $i++) {
|
|
last if $fh = $fp->open($now);
|
|
sleep 5;
|
|
}
|
|
die $! if $i >= 20;
|
|
$today = $now;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub printit
|
|
{
|
|
while (@_) {
|
|
my $line = shift;
|
|
chomp $line;
|
|
$line =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg;
|
|
my ($t, $l) = split /\^/, $line, 2;
|
|
my ($sec,$min,$hour) = gmtime((defined $t) ? $t : time);
|
|
my $buf = sprintf "%02d:%02d:%02d", $hour, $min, $sec;
|
|
|
|
print $buf, ' ', $l, "\n";
|
|
}
|
|
}
|
|
exit(0);
|