perl/DXLogPrint.pm

   1 #
   2 # Log Printing routines
   3 #
   4 # Copyright (c) - 1998 Dirk Koopman G1TLH
   5 #
   6 # $Id$
   7 #
   8
   9 package DXLog;
  10
  11 use IO::File;
  12 use DXVars;
  13 #use DXDebug ();
  14 use DXUtil;
  15 use DXLog;
  16 use Julian;
  17
  18 use strict;
  19
  20 #
  21 # print some items from the log backwards in time
  22 #
  23 # This command outputs a list of n lines starting from time t with $pattern tags
  24 #
  25 sub print
  26 {
  27         my $fcb = $DXLog::log;
  28         my $from = shift || 0;
  29         my $to = shift || 20;
  30         my $count;
  31         my $jdate = $fcb->unixtoj(shift);
  32         my $pattern = shift;
  33         my $who = uc shift;
  34         my $search;
  35         my @in;
  36         my @out = ();
  37         my $eval;
  38         my $tot = $from + $to;
  39         my $hint = "";
  40
  41         if ($pattern) {
  42                 $hint = "m{\\Q$pattern\\E}i";
  43         }
  44         if ($who) {
  45                 if ($hint) {
  46                         $hint .= ' && ';
  47                 }
  48                 $hint .= 'm{\\Q$who\\E}i';
  49         }
  50         $hint = "next unless $hint" if $hint;
  51
  52         $eval = qq(
  53                            \@in = ();
  54                            while (<\$fh>) {
  55                                    $hint;
  56                                    chomp;
  57                                    push \@in, \$_;
  58                                    shift \@in, if \@in > $tot;
  59                            }
  60                    );
  61
  62         $fcb->close;                                      # close any open files
  63
  64         my $fh = $fcb->open($jdate);
  65         L1: for ($count = 0; $count < $to; ) {
  66                 my $ref;
  67                 if ($fh) {
  68                         eval $eval;               # do the search on this file
  69                         return ("Log search error", $@) if $@;
  70                         my @tmp;
  71                         while (@in) {
  72                                 last L1 if $count >= $to;
  73                                 my $ref = [ split /\^/, shift @in ];
  74                                 next if defined $pattern && $ref->[1] ne $pattern;
  75                                 push @tmp, print_item($ref);
  76                                 $count++;
  77                         }
  78                         @out = (@tmp, @out);
  79                 }
  80                 $fh = $fcb->openprev();      # get the next file
  81                 last if !$fh;
  82         }
  83
  84         return @out;
  85 }
  86
  87 #
  88 # the standard log printing interpreting routine.
  89 #
  90 # every line that is printed should call this routine to be actually visualised
  91 #
  92 # Don't really know whether this is the correct place to put this stuff, but where
  93 # else is correct?
  94 #
  95 # I get a reference to an array of items
  96 #
  97 sub print_item
  98 {
  99         my $r = shift;
 100         my @ref = @$r;
 101         my $d = atime($ref[0]);
 102         my $s = 'undef';
 103
 104         if ($ref[1] eq 'rcmd') {
 105                 if ($ref[2] eq 'in') {
 106                         $s = "$ref[4] (priv: $ref[3]) rcmd: $ref[5]";
 107                 } else {
 108                         $s = "$ref[3] reply: $ref[4]";
 109                 }
 110         } elsif ($ref[1] eq 'talk') {
 111                 $s = "$ref[3] -> $ref[2] ($ref[4]) $ref[5]";
 112         } elsif ($ref[1] eq 'ann') {
 113                 $s = "$ref[3] -> $ref[2] $ref[4]";
 114         } else {
 115                 $s = "$ref[2]";
 116         }
 117         return "$d $s";
 118 }
 119
 120 1;