X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXLogPrint.pm;h=a6d074a6a64bfd78c768dae4e7388126f537117f;hb=8e14149148baba63ce5ae2b95aacda8ab6dd0d87;hp=6012d71d065cfa2bec14488d648c1bb68b9a8064;hpb=dbf7523a9b228dbdf1d03109afde351b8b194fab;p=spider.git diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index 6012d71d..a6d074a6 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -3,40 +3,47 @@ # # 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 = $main::is_win ? 0 : 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 # # This command outputs a list of n lines starting from time t with $pattern tags # -sub print +sub search { my $fcb = $DXLog::log; - my $from = shift || 0; - my $to = shift || 20; - my $count; + my $from = shift // 0; + 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 = (); @@ -44,54 +51,88 @@ sub print my $tot = $from + $to; my $hint = ""; + $who = uc $who if defined $who; + + dbg("from: $from to: $to pattern: $pattern hint: $hint") if isdbg('search'); + if ($pattern) { - $hint = "m{\\Q$pattern\\E}i"; + $hint = qq{m{\Q$pattern\E}i}; } else { - $hint = "!m{ann|rcmd|talk}"; + $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}i}; } $hint = "next unless $hint" if $hint; + $hint .= "; next unless m{^\\d+\\^$pattern\\^}i" 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 cmp $b } @in) { + push @out, [ split /\^/ ] + } + return @out; } +sub print +{ + my @out; + + my @in = search(@_); + for (@in) { + push @out, print_item($_); + } + return @out; +} + + # # the standard log printing interpreting routine. # @@ -105,22 +146,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"; }