]> www.dxcluster.org Git - spider.git/blob - perl/DXLogPrint.pm
fix DXChannel::get
[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 use vars qw($VERSION $BRANCH);
21 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
22 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
23 $main::build += $VERSION;
24 $main::branch += $BRANCH;
25
26 #
27 # print some items from the log backwards in time
28 #
29 # This command outputs a list of n lines starting from time t with $pattern tags
30 #
31 sub print
32 {
33         my $fcb = $DXLog::log;
34         my $from = shift || 0;
35         my $to = shift || 20;
36         my $jdate = $fcb->unixtoj(shift);
37         my $pattern = shift;
38         my $who = uc shift;
39         my $search;
40         my @in;
41         my @out = ();
42         my $eval;
43         my $tot = $from + $to;
44         my $hint = "";
45             
46         if ($pattern) {
47                 $hint = "m{\\Q$pattern\\E}i";
48         } else {
49                 $hint = "!m{ann|rcmd|talk|chat}";
50         }
51         if ($who) {
52                 $hint .= ' && ' if $hint;
53                 $hint .= 'm{\\Q$who\\E}i';
54         } 
55         $hint = "next unless $hint" if $hint;
56         $hint .= ";next unless /^\\d+\\^$pattern\\^/" if $pattern;
57         $hint ||= "";
58         
59         $eval = qq(while (<\$fh>) {
60                                    $hint;
61                                    chomp;
62                                    push \@tmp, \$_;
63                            } );
64         
65         $fcb->close;                                      # close any open files
66
67         my $fh = $fcb->open($jdate); 
68  L1: for (;@in < $to;) {
69                 my $ref;
70                 if ($fh) {
71                         my @tmp;
72                         eval $eval;               # do the search on this file
73                         return ("Log search error", $@) if $@;
74                         @in = (@tmp, @in);
75                         if (@in > $to) {
76                                 @in = splice @in, -$to, $to;
77                                 last L1;
78                         } 
79                 }
80                 $fh = $fcb->openprev();      # get the next file
81                 last if !$fh;
82         }
83         for (@in) {
84                 my @line = split /\^/ ;
85                 push @out, print_item(\@line);
86         
87         }
88         return @out;
89 }
90
91 #
92 # the standard log printing interpreting routine.
93 #
94 # every line that is printed should call this routine to be actually visualised
95 #
96 # Don't really know whether this is the correct place to put this stuff, but where
97 # else is correct?
98 #
99 # I get a reference to an array of items
100 #
101 sub print_item
102 {
103         my $r = shift;
104         my $d = atime($r->[0]);
105         my $s = 'undef';
106         
107         if ($r->[1] eq 'rcmd') {
108                 if ($r->[2] eq 'in') {
109                         $r->[5] ||= "";
110                         $s = "$r->[4] (priv: $r->[3]) rcmd: $r->[5]";
111                 } else {
112                         $r->[4] ||= "";
113                         $s = "$r->[3] reply: $r->[4]";
114                 }
115         } elsif ($r->[1] eq 'talk') {
116                 $r->[5] ||= "";
117                 $s = "$r->[3] -> $r->[2] ($r->[4]) $r->[5]";
118         } elsif ($r->[1] eq 'ann' || $r->[1] eq 'chat') {
119                 $r->[4] ||= "";
120                 $r->[4] =~ s/^\#\d+ //;
121                 $s = "$r->[3] -> $r->[2] $r->[4]";
122         } else {
123                 $r->[2] ||= "";
124                 $s = "$r->[2]";
125         }
126         return "$d $s";
127 }
128
129 1;