X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXLogPrint.pm;h=c2434aba48f8f5eda22edc3c2c909e7371ffc095;hb=f0910da57e166acb22e83de4e4b771d175074c80;hp=60f8b685bb8768e3e935629aca988c2b0bcd2d06;hpb=0bd9d2811cc42417676a1b11b121681c2377d70a;p=spider.git diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index 60f8b685..c2434aba 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -27,7 +27,7 @@ sub print my $fcb = $DXLog::log; my $from = shift; my $to = shift; - my @date = Julian::unixtojm(shift); + my $jdate = $fcb->unixtoj(shift); my $pattern = shift; my $who = uc shift; my $search; @@ -35,20 +35,39 @@ sub print my @out = (); my $eval; my $count; + my $hint = ""; - $search = '1' unless $pattern || $who; - $search = "\$ref->[1] =~ /$pattern/" if $pattern; - $search .= ' && ' if $pattern && $who; - $search .= "(\$ref->[2] =~ /$who/ || \$ref->[3] =~ /$who/)" if $who; + if ($pattern) { + $search = "\$ref->[1] =~ m{^$pattern}i"; + $hint = "m{$pattern}i"; + } + if ($who) { + if ($search) { + $search .= ' && '; + $hint .= ' && '; + } + $search .= "(\$ref->[2] =~ m{$who}i || \$ref->[3] =~ m{$who}i)"; + $hint .= 'm{$who}i'; + } + $hint = "next unless $hint" if $hint; + $search = "1" unless $search; + $eval = qq( + \@in = (); + while (<\$fh>) { + $hint; + chomp; + \$ref = [ split '\\^' ]; + push \@\$ref, "" unless \@\$ref >= 4; + push \@in, \$ref; + } 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); + unshift \@out, print_item(\$ref); last if \$count >= \$to; # stop after n } } @@ -56,17 +75,10 @@ sub print $fcb->close; # close any open files - my $fh = $fcb->open(@date); + my $fh = $fcb->open($jdate); for ($count = 0; $count < $to; ) { my $ref; if ($fh) { - @in = (); - while (<$fh>) { - chomp; - $ref = [ split '\^' ]; - push @{$ref}, "" unless @{$ref} >= 4; - push @in, $ref; - } eval $eval; # do the search on this file last if $count >= $to; # stop after n return ("Log search error", $@) if $@;