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