X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXLogPrint.pm;h=0d99eb41804a740a9d0e95a18c13cabdf2a93b36;hb=5bbe803ffc8771aa87c9d37ca92170f13bbc6bc1;hp=153f8f06e4941772729cba258bb968b979cede1a;hpb=2a43619b670b8f9249558f814b0183262c3ba4f6;p=spider.git diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index 153f8f06..0d99eb41 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -3,20 +3,34 @@ # # 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($maxmonths); +$maxmonths = 36; + # # print some items from the log backwards in time # @@ -26,11 +40,10 @@ sub print { my $fcb = $DXLog::log; my $from = shift || 0; - my $to = shift || 20; - my $count; + 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 = (); @@ -38,52 +51,76 @@ 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 = q{!m{\^(?:ann|rcmd|talk|chat)\^}}; } if ($who) { - if ($hint) { - $hint .= ' && '; - } - $hint .= 'm{\\Q$who\\E}i'; - } + $hint .= ' && ' if $hint; + $hint .= q{m{\Q$who\E}oi}; + } $hint = "next unless $hint" if $hint; + $hint .= "; next unless m{^\\d+\\^$pattern\\^}" if $pattern; + $hint ||= ""; - $eval = qq( - \@in = (); - while (<\$fh>) { + $eval = qq(while (<\$fh>) { $hint; chomp; + # say "line: \$_"; push \@in, \$_; - shift \@in, if \@in > $tot; - } - ); + 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 ($count = 0; $count < $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 $@; - my @tmp; - while (@in) { - last L1 if $count >= $to; - my $ref = [ split /\^/, shift @in ]; - next if defined $pattern && $ref->[1] ne $pattern; - push @tmp, print_item($ref); - $count++; - } - @out = (@tmp, @out); } - $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 + } } + + 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); + } return @out; } + # # the standard log printing interpreting routine. # @@ -97,22 +134,28 @@ sub print sub print_item { my $r = shift; - my @ref = @$r; - my $d = atime($ref[0]); + my $d = atime($r->[0]); my $s = 'undef'; - if ($ref[1] eq 'rcmd') { - if ($ref[2] eq 'in') { - $s = "$ref[4] (priv: $ref[3]) rcmd: $ref[5]"; + if ($r->[1] eq 'rcmd') { + $r->[6] ||= 'Unknown'; + if ($r->[2] eq 'in') { + $r->[5] ||= ""; + $s = "in: $r->[4] ($r->[6] priv: $r->[3]) rcmd: $r->[5]"; } else { - $s = "$ref[3] reply: $ref[4]"; + $r->[4] ||= ""; + $s = "$r->[3] $r->[6] reply: $r->[4]"; } - } elsif ($ref[1] eq 'talk') { - $s = "$ref[3] -> $ref[2] ($ref[4]) $ref[5]"; - } elsif ($ref[1] eq 'ann') { - $s = "$ref[3] -> $ref[2] $ref[4]"; + } elsif ($r->[1] eq 'talk') { + $r->[5] ||= ""; + $s = "$r->[3] -> $r->[2] ($r->[4]) $r->[5]"; + } elsif ($r->[1] eq 'ann' || $r->[1] eq 'chat') { + $r->[4] ||= ""; + $r->[4] =~ s/^\#\d+ //; + $s = "$r->[3] -> $r->[2] $r->[4]"; } else { - $s = "$ref[2]"; + $r->[2] ||= ""; + $s = "$r->[2]"; } return "$d $s"; }