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