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. There can be more than one <regexp>
  16 # a <regexp> preceeded by a '!' is treated as NOT <regexp>. Each
  17 # <regexp> is implcitly ANDed together.
  18 #
  19 # If you specify something that likes a filename and that filename
  20 # has a .pm on the end of it and it exists then rather than doing
  21 # the regex match it executes the "main::handle()" function passing
  22 # it one line at a time.
  23 #
  24 #
  25
  26 require 5.004;
  27
  28 package main;
  29
  30 # search local then perl directories
  31 BEGIN {
  32         # root of directory tree for this system
  33         $root = "/spider";
  34         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  35
  36         unshift @INC, "$root/perl";     # this IS the right way round!
  37         unshift @INC, "$root/local";
  38 }
  39
  40 use SysVar;
  41 use DXUtil;
  42 use DXLog;
  43 use Julian;
  44
  45 use strict;
  46
  47 use vars qw(@days $fp $today $string);
  48
  49
  50 $fp = DXLog::new('debug', 'dat', 'd');
  51 $today = $fp->unixtoj(time());
  52 my $nolines = 1;
  53 my @prev;
  54 my @patt;
  55
  56 foreach my $arg (@ARGV) {
  57         if ($arg =~ /^-/) {
  58                 $arg =~ s/^-+//;
  59                 if ($arg =~ /\?|^he?l?p?/) {
  60                         usage();
  61                         exit(0);
  62                 }
  63                 $nolines = $arg if $arg =~ /^\d+$/;
  64         } elsif ($arg =~ /^\d+$/) {
  65                 push @days, $arg;
  66         } elsif ($arg =~ /\.pm$/) {
  67                 if (-e $arg) {
  68                         my $fn = $arg;
  69                         $fn =~ s/\.pm$//;
  70                         eval { require $arg};
  71                         die "requiring $fn failed $@" if $@;
  72                         die "required $fn does not contain 'sub handle' (check that 'package main;' exists)" unless main->can('handle');
  73                 } else {
  74                         die "$arg not found";
  75                 }
  76         } else {
  77                 push @patt, $arg;
  78         }
  79 }
  80
  81 push @patt, '.*' unless @patt;
  82
  83 push @days, "0" unless @days;
  84 for my $entry (@days) {
  85         my $now = $today->sub($entry);
  86         my $fh = $fp->open($now);
  87         my $line;
  88         my $do;
  89
  90
  91         begin() if main->can('begin');
  92         if ($fh) {
  93                 while (<$fh>) {
  94                         if (main->can('handle')) {
  95                                 handle($_);
  96                         } else {
  97                                 process($_);
  98                         }
  99                 }
 100                 $fp->close();
 101         }
 102         end() if main->can('end');
 103 }
 104
 105 total() if main->can('total');
 106 exit 0;
 107
 108 sub process
 109 {
 110         my $line = shift;
 111         chomp $line;
 112         push @prev, $line;
 113         shift @prev while @prev > $nolines;
 114         my $flag = 0;
 115         foreach my $p (@patt) {
 116                 if ($p =~ /^!/) {
 117                         my $r = substr $p, 1;
 118                         last if $line =~ m{$r}i;
 119                 } else {
 120                         last unless $line =~ m{$p}i;
 121                 }
 122                 ++$flag;
 123         }
 124         if ($flag == @patt) {
 125                 for (@prev) {
 126                         s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg;
 127                         my ($t, $l) =  split /\^/, $_, 2;
 128                         print atime($t), ' ', $l, "\n";
 129                 }
 130                 print "------------------\n" if $nolines > 1;
 131                 @prev = ();
 132         }
 133 }
 134
 135 sub usage
 136 {
 137         print << "XXX";
 138
 139  usage: grepdbg [nn days before] [-nnn lines before] [<perl file name>] [<regexp>|!<regexp>]...
 140
 141         grepdbg with no argumants will simply list the current debug log with the timestamp
 142         for each line decoded into a human readable form.
 143
 144           grepdbg | less
 145
 146         is a handy way of scrolling through the debug log.
 147
 148         You can install your own content and display arrangement (useful for filtering data
 149         in some complicated way). You call it like this (assuming it is called 'filter.pm').
 150
 151         grepdbg filter.pm
 152
 153         All the other arguments to grepdbg are available to limit the input to your filter.
 154         If you want them.
 155
 156         The filter module MUST contain at least:
 157
 158                   package main;
 159
 160                   sub handle
 161                   {
 162                      your code goes here
 163                   }
 164                   1;
 165
 166         It can also have a 'sub begin {...}' and / or 'sub end {...}' which are executed
 167         immediately after opening a logfile and then just before closing it, respectively.
 168
 169         You can also add a 'sub total {...}' which executes after the last line is
 170         printed and grepdbg exits.
 171
 172         Read the code of this program and copy'n'paste the 'sub process' code and its name
 173         to 'sub handle'. Modify it to your requirements...
 174
 175 XXX
 176 }