X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXLogPrint.pm;h=92deee427026cf1e574b3a66c5d479a88131304f;hb=2fe3813e70786483d2d928f8fa44eb9ff9cb76ca;hp=185912cda4948abefe7d3408da3d371651921417;hpb=c20a2c1e01d707d6c3fa25067df93d491aba8fff;p=spider.git diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index 185912cd..92deee42 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -3,81 +3,136 @@ # # 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 # # 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; - my $to = shift; - my @date = Julian::unixtojm(shift); + 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 = (); my $eval; - my $count; + my $tot = $from + $to; + my $hint = ""; - $search = '1' unless $pattern || $who; - $search = "\$ref->[1] =~ /$pattern/i" if $pattern; - $search .= ' && ' if $pattern && $who; - $search .= "(\$ref->[2] =~ /$who/i || \$ref->[3] =~ /$who/i)" if $who; - $eval = qq( - my \$c; - my \$ref; - for (\$c = \$#in; \$c >= 0; \$c--) { - \$ref = \$in[\$c]; - if ($search) { - \$count++; - next if \$count < $from; - push \@out, print_item(\$ref); - last if \$count >= \$to; # stop after n - } - } - ); + $who = uc $who if defined $who; + + dbg("from: $from to: $to pattern: $pattern hint: $hint") if isdbg('search'); + + if ($pattern) { + $hint = qq{m{\Q$pattern\E}i}; + } else { + $hint = q{!m{\^(?:ann|rcmd|talk|chat)\^}}; + } + if ($who) { + $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(while (<\$fh>) { + $hint; + chomp; + # 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(@date); - 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) { - @in = (); - while (<$fh>) { - chomp; - $ref = [ split '\^' ]; - push @{$ref}, "" unless @{$ref} >= 4; - push @in, $ref; - } + my @tmp; eval $eval; # do the search on this file - last if $count >= $to; # stop after n return ("Log search error", $@) if $@; } - $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. # @@ -91,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"; }