perl/grepdbg

   1 #!/usr/bin/perl
   2 #
   3 # Program to do a grep with dates and times on the debug
   4 # files
   5 #
   6 # grepdbg [nn] [-mm] <regular expression>
   7 #
   8 # nn - is the day you what to look at: 1 is yesterday, 0 is today
   9 # and is optional if there is only one argument
  10 #
  11 # -mmm - print the mmm lines before the match. So -10 will print
  12 # ten lines including the line matching the regular expression.
  13 #
  14 # <regexp> is the regular expression you are searching for,
  15 # a caseless search is done
  16 #
  17 # If you specify something that likes a filename and that filename
  18 # has a .pm on the end of it and it exists then rather than doing
  19 # the regex match it executes the "main::handle()" function passing
  20 # it one line at a time.
  21 #
  22 #
  23
  24 require 5.004;
  25
  26 # search local then perl directories
  27 BEGIN {
  28         # root of directory tree for this system
  29         $root = "/spider";
  30         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  31
  32         unshift @INC, "$root/perl";     # this IS the right way round!
  33         unshift @INC, "$root/local";
  34 }
  35
  36 use SysVar;
  37 use DXUtil;
  38 use DXLog;
  39 use Julian;
  40
  41 use strict;
  42
  43 use vars qw(@list $fp $today $string);
  44
  45
  46 $fp = DXLog::new('debug', 'dat', 'd');
  47 $today = $fp->unixtoj(time());
  48 my $nolines = 1;
  49 my @prev;
  50
  51 for my $arg (@ARGV) {
  52         if ($arg =~ /^-/) {
  53                 $arg =~ s/^-//o;
  54                 if ($arg =~ /^\s*\-+(?:[h\?]e?l?p?)/) {
  55                         usage();
  56                         exit(0);
  57                 }
  58                 push @list, $arg;
  59         } elsif ($arg =~ /^\d+$/) {
  60                 $nolines = $arg;
  61         } elsif ($arg =~ /\.pm$/) {
  62                 if (-e $arg) {
  63                         my $fn = $arg;
  64                         $fn =~ s/\.pm$//;
  65                         eval { require $arg};
  66                         die "requiring $fn failed $@" if $@;
  67                 } else {
  68                         die "$arg not found";
  69                 }
  70         } else {
  71                 $string = $arg;
  72                 last;
  73         }
  74 }
  75
  76 $string ||= '.*';
  77
  78 push @list, "0" unless @list;
  79 for my $entry (@list) {
  80         my $now = $today->sub($entry);
  81         my $fh = $fp->open($now);
  82         my $line;
  83         my $do;
  84
  85         if (main->can('handle')) {
  86                 $do = \&handle;
  87         } else {
  88                 $do = \&process;
  89         }
  90
  91         begin() if main->can('begin');
  92         if ($fh) {
  93                 while (<$fh>) {
  94                         &$do($_);
  95                 }
  96                 $fp->close();
  97         }
  98         end() if main->can('end');
  99 }
 100
 101 sub process
 102 {
 103         my $line = shift;
 104         chomp $line;
 105         push @prev, $line;
 106         shift @prev while @prev > $nolines;
 107         if ($line =~ m{$string}io) {
 108                 for (@prev) {
 109                         s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg;
 110                         my ($t, $l) =  split /\^/, $_, 2;
 111                         print atime($t), ' ', $l, "\n";
 112                         print '----------------' if $nolines > 1;
 113                 }
 114                 @prev = ();
 115         }
 116 }
 117
 118 sub usage
 119 {
 120         die "usage: grepdbg [nn days before] [-nnn lines before] [<regexp>|<perl file name>]\n";
 121 }
 122 exit(0);