X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXLogPrint.pm;h=0d99eb41804a740a9d0e95a18c13cabdf2a93b36;hb=8c339125008c925eefda7c815ccabac9c577ae3f;hp=752e72acd64aaa5470d0d3cae4cb619041d0ed4a;hpb=defc60f3e7fab9bb99d1c9f7b8bccc4ec37628d5;p=spider.git diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index 752e72ac..0d99eb41 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -3,25 +3,33 @@ # # Copyright (c) - 1998 Dirk Koopman G1TLH # -# $Id$ +# # package DXLog; +use 5.10.1; + use IO::File; use DXVars; -#use DXDebug (); +use DXDebug qw(dbg isdbg); use DXUtil; use DXLog; use Julian; + +our $readback = 1; +if ($readback) { + $readback = `which tac`; +} +chomp $readback; +#undef $readback; # yet another reason not to use the cloud! + + use strict; -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; +use vars qw($maxmonths); +$maxmonths = 36; # # print some items from the log backwards in time @@ -32,10 +40,10 @@ sub print { my $fcb = $DXLog::log; my $from = shift || 0; - my $to = shift || 20; + my $to = shift || 10; my $jdate = $fcb->unixtoj(shift); my $pattern = shift; - my $who = uc shift; + my $who = shift; my $search; my @in; my @out = (); @@ -43,44 +51,68 @@ sub print my $tot = $from + $to; my $hint = ""; + $who = uc $who if defined $who; + if ($pattern) { - $hint = "m{\\Q$pattern\\E}i"; + $hint = q{m{\Q$pattern\E}i}; } else { - $hint = "!m{ann|rcmd|talk|chat}"; + $hint = q{!m{\^(?:ann|rcmd|talk|chat)\^}}; } if ($who) { $hint .= ' && ' if $hint; - $hint .= 'm{\\Q$who\\E}i'; + $hint .= q{m{\Q$who\E}oi}; } $hint = "next unless $hint" if $hint; - $hint .= ";next unless /^\\d+\\^$pattern\\^/" if $pattern; + $hint .= "; next unless m{^\\d+\\^$pattern\\^}" if $pattern; $hint ||= ""; $eval = qq(while (<\$fh>) { $hint; chomp; - push \@tmp, \$_; + # say "line: \$_"; + push \@in, \$_; + last L1 if \@in >= $tot; } ); + if (isdbg('search')) { + dbg("sh/log hint: $hint"); + dbg("sh/log eval: $eval"); + } + $fcb->close; # close any open files - my $fh = $fcb->open($jdate); - L1: for (;@in < $to;) { + my $months; + my $fh; + if ($readback) { + my $fn = $fcb->fn($jdate); + $fh = IO::File->new("$readback $fn |"); + } else { + $fh = $fcb->open($jdate); + } + L1: for ($months = 0; $fh && $months < $maxmonths && @in < $tot; $months++) { my $ref; + if ($fh) { my @tmp; eval $eval; # do the search on this file return ("Log search error", $@) if $@; - @in = (@tmp, @in); - if (@in > $to) { - @in = splice @in, -$to, $to; - last L1; - } } - $fh = $fcb->openprev(); # get the next file - last if !$fh; + + if ($readback) { + my $fn = $fcb->fn($jdate->sub(1)); + $fh = IO::File->new("$readback $fn |"); + } else { + $fh = $fcb->openprev(); # get the next file + } } - for (@in) { + + unless (@in) { + my $name = $pattern ? $pattern : "log"; + my $s = "$who "|| ''; + return "show/$name: ${s}not found"; + } + + for (sort {$a <=> $b } @in) { my @line = split /\^/ ; push @out, print_item(\@line); @@ -88,6 +120,7 @@ sub print return @out; } + # # the standard log printing interpreting routine. # @@ -105,12 +138,13 @@ sub print_item my $s = 'undef'; if ($r->[1] eq 'rcmd') { + $r->[6] ||= 'Unknown'; if ($r->[2] eq 'in') { $r->[5] ||= ""; - $s = "$r->[4] (priv: $r->[3]) rcmd: $r->[5]"; + $s = "in: $r->[4] ($r->[6] priv: $r->[3]) rcmd: $r->[5]"; } else { $r->[4] ||= ""; - $s = "$r->[3] reply: $r->[4]"; + $s = "$r->[3] $r->[6] reply: $r->[4]"; } } elsif ($r->[1] eq 'talk') { $r->[5] ||= "";