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