perl/DXLogPrint.pm

   1 #
   2 # Log Printing routines
   3 #
   4 # Copyright (c) - 1998 Dirk Koopman G1TLH
   5 #
   6 #
   7 #
   8
   9 package DXLog;
  10
  11 use 5.10.1;
  12
  13 use IO::File;
  14 use DXVars;
  15 use DXDebug qw(dbg isdbg);
  16 use DXUtil;
  17 use DXLog;
  18 use Julian;
  19
  20
  21 our $readback = `which tac`;
  22 chomp $readback;
  23 undef $readback;                                # yet another reason not to use the cloud!
  24
  25
  26 use strict;
  27
  28 use vars qw($maxmonths);
  29 $maxmonths = 36;
  30
  31 #
  32 # print some items from the log backwards in time
  33 #
  34 # This command outputs a list of n lines starting from time t with $pattern tags
  35 #
  36 sub print
  37 {
  38         my $fcb = $DXLog::log;
  39         my $from = shift || 0;
  40         my $to = shift || 10;
  41         my $jdate = $fcb->unixtoj(shift);
  42         my $pattern = shift;
  43         my $who = shift;
  44         my $search;
  45         my @in;
  46         my @out = ();
  47         my $eval;
  48         my $tot = $from + $to;
  49         my $hint = "";
  50
  51         $who = uc $who if defined $who;
  52
  53         if ($pattern) {
  54                 $hint = q{m{\Q$pattern\E}i};
  55         } else {
  56                 $hint = q{!m{\^(?:ann|rcmd|talk|chat)\^}};
  57         }
  58         if ($who) {
  59                 $hint .= ' && ' if $hint;
  60                 $hint .= q{m{\Q$who\E}oi};
  61         }
  62         $hint = "next unless $hint" if $hint;
  63         $hint .= "; next unless m{^\\d+\\^$pattern\\^}" if $pattern;
  64         $hint ||= "";
  65
  66         $eval = qq(while (<\$fh>) {
  67                                    $hint;
  68                                    chomp;
  69                    # say "line: \$_";
  70                                    push \@in, \$_;
  71                    last L1 if \@in >= $tot;
  72                            } );
  73
  74         if (isdbg('search')) {
  75                 dbg("sh/log hint: $hint");
  76                 dbg("sh/log eval: $eval");
  77         }
  78
  79         $fcb->close;                                      # close any open files
  80
  81         my $months;
  82         my $fh;
  83         if ($readback) {
  84                 my $fn = $fcb->fn($jdate);
  85                 $fh = IO::File->new("$readback $fn |");
  86         } else {
  87                 $fh = $fcb->open($jdate);
  88         }
  89  L1: for ($months = 0; $fh && $months < $maxmonths && @in < $tot; $months++) {
  90                 my $ref;
  91
  92                 if ($fh) {
  93                         my @tmp;
  94                         eval $eval;               # do the search on this file
  95                         return ("Log search error", $@) if $@;
  96                 }
  97
  98                 if ($readback) {
  99                         my $fn = $fcb->fn($jdate->sub(1));
 100                         $fh = IO::File->new("$readback $fn |");
 101                 } else {
 102                         $fh = $fcb->openprev();      # get the next file
 103                 }
 104         }
 105
 106         unless (@in) {
 107                 my $name = $pattern ? $pattern : "log";
 108                 my $s = "$who "|| '';
 109                 return "show/$name: ${s}not found";
 110         }
 111
 112         for (reverse @in) {
 113                 my @line = split /\^/ ;
 114                 push @out, print_item(\@line);
 115
 116         }
 117         return @out;
 118 }
 119
 120
 121 #
 122 # the standard log printing interpreting routine.
 123 #
 124 # every line that is printed should call this routine to be actually visualised
 125 #
 126 # Don't really know whether this is the correct place to put this stuff, but where
 127 # else is correct?
 128 #
 129 # I get a reference to an array of items
 130 #
 131 sub print_item
 132 {
 133         my $r = shift;
 134         my $d = atime($r->[0]);
 135         my $s = 'undef';
 136
 137         if ($r->[1] eq 'rcmd') {
 138                 $r->[6] ||= 'Unknown';
 139                 if ($r->[2] eq 'in') {
 140                         $r->[5] ||= "";
 141                         $s = "in: $r->[4] ($r->[6] priv: $r->[3]) rcmd: $r->[5]";
 142                 } else {
 143                         $r->[4] ||= "";
 144                         $s = "$r->[3] $r->[6] reply: $r->[4]";
 145                 }
 146         } elsif ($r->[1] eq 'talk') {
 147                 $r->[5] ||= "";
 148                 $s = "$r->[3] -> $r->[2] ($r->[4]) $r->[5]";
 149         } elsif ($r->[1] eq 'ann' || $r->[1] eq 'chat') {
 150                 $r->[4] ||= "";
 151                 $r->[4] =~ s/^\#\d+ //;
 152                 $s = "$r->[3] -> $r->[2] $r->[4]";
 153         } else {
 154                 $r->[2] ||= "";
 155                 $s = "$r->[2]";
 156         }
 157         return "$d $s";
 158 }
 159
 160 1;