mirror of
git://scm.dxcluster.org/scm/spider
synced 2024-09-21 07:47:10 +00:00
downgrade perl on console.pl
backport grepdbg from mojo
This commit is contained in:
parent
f63d598af3
commit
d8d7d25e92
6
Changes
6
Changes
@ -1,3 +1,9 @@
|
||||
21Jan22=======================================================================
|
||||
1. downgrade console.pl require to perl 5.8.1.
|
||||
2. Backport grepdbg from mojo.
|
||||
20Jan22=======================================================================
|
||||
1. Fix version tracking related bugs.
|
||||
2. Backport grepdbg from mojo.
|
||||
09Jan22=======================================================================
|
||||
1. Add New Year CTY 3201 prefix data.
|
||||
07Jan22=======================================================================
|
||||
|
@ -448,7 +448,7 @@ sub is_latlong
|
||||
# is it an ip address?
|
||||
sub is_ipaddr
|
||||
{
|
||||
return $_[0] =~ /^\d+\.\d+\.\d+\.\d+$/ || $_[0] =~ /^[0-9a-f:,]+$/;
|
||||
return $_[0] =~ /^\d+\.\d+\.\d+\.\d+$/ || $_[0] =~ /^(?:[\da-f]{1,4}:|:)(?:\:[0-9a-f]{1,4}){1,6}/i ;
|
||||
}
|
||||
|
||||
# is it a zulu time hhmmZ
|
||||
|
@ -13,7 +13,7 @@
|
||||
#
|
||||
#
|
||||
|
||||
require 5.10.1;
|
||||
require 5.8.1;
|
||||
use warnings;
|
||||
|
||||
use vars qw($data $clusteraddr $clusterport);
|
||||
|
95
perl/grepdbg
95
perl/grepdbg
@ -5,7 +5,6 @@
|
||||
#
|
||||
# grepdbg [nn] [-mm] <regular expression>
|
||||
#
|
||||
|
||||
# nn - is the day you what to look at: 1 is yesterday, 0 is today
|
||||
# and is optional if there is only one argument
|
||||
#
|
||||
@ -13,14 +12,18 @@
|
||||
# ten lines including the line matching the regular expression.
|
||||
#
|
||||
# <regexp> is the regular expression you are searching for,
|
||||
# a caseless search is done
|
||||
# a caseless search is done. There can be more than one <regexp>
|
||||
# a <regexp> preceeded by a '!' is treated as NOT <regexp>. Each
|
||||
# <regexp> is implcitly ANDed together.
|
||||
#
|
||||
# If you specify something that likes a filename and that filename
|
||||
# has a .pm on the end of it and it exists then rather than doing
|
||||
# the regex match it executes the "main::handle()" function passing
|
||||
# it one line at a time.
|
||||
#
|
||||
#
|
||||
|
||||
require 5.004;
|
||||
package main;
|
||||
|
||||
use vars qw($data);
|
||||
|
||||
# search local then perl directories
|
||||
BEGIN {
|
||||
@ -32,9 +35,7 @@ BEGIN {
|
||||
unshift @INC, "$root/local";
|
||||
}
|
||||
|
||||
$data = "$root/data";
|
||||
|
||||
use DXVars;
|
||||
use SysVar;
|
||||
use DXUtil;
|
||||
use DXLog;
|
||||
use Julian;
|
||||
@ -43,45 +44,91 @@ use strict;
|
||||
|
||||
use vars qw(@list $fp $today $string);
|
||||
|
||||
|
||||
$fp = DXLog::new('debug', 'dat', 'd');
|
||||
$today = $fp->unixtoj(time());
|
||||
my $nolines = 1;
|
||||
my @prev;
|
||||
my @patt;
|
||||
|
||||
for my $arg (@ARGV) {
|
||||
foreach my $arg (@ARGV) {
|
||||
if ($arg =~ /^-/) {
|
||||
$arg =~ s/^-//o;
|
||||
if ($arg =~ /^\s*\-+(?:[h\?]e?l?p?)/) {
|
||||
usage();
|
||||
exit(0);
|
||||
}
|
||||
push @list, $arg;
|
||||
} elsif ($arg =~ /^\d+$/) {
|
||||
$nolines = $arg;
|
||||
} elsif ($arg =~ /\.pm$/) {
|
||||
if (-e $arg) {
|
||||
my $fn = $arg;
|
||||
$fn =~ s/\.pm$//;
|
||||
eval { require $arg};
|
||||
die "requiring $fn failed $@" if $@;
|
||||
} else {
|
||||
die "$arg not found";
|
||||
}
|
||||
} else {
|
||||
$string = $arg;
|
||||
last;
|
||||
push @patt, $arg;
|
||||
}
|
||||
}
|
||||
die "usage: grepdbg [nn] [[-nnn] ..] <regexp>\n" unless $string;
|
||||
|
||||
push @patt, '.*' unless @patt;
|
||||
|
||||
push @list, "0" unless @list;
|
||||
for my $entry (@list) {
|
||||
my $now = $today->sub($entry);
|
||||
my $fh = $fp->open($now);
|
||||
my $line;
|
||||
my $do;
|
||||
|
||||
if (main->can('handle')) {
|
||||
$do = \&handle;
|
||||
} else {
|
||||
$do = \&process;
|
||||
}
|
||||
|
||||
begin() if main->can('begin');
|
||||
if ($fh) {
|
||||
while (<$fh>) {
|
||||
my $line = $_;
|
||||
chomp $line;
|
||||
push @prev, $line;
|
||||
shift @prev while @prev > $nolines;
|
||||
if ($line =~ m{$string}io) {
|
||||
for (@prev) {
|
||||
s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg;
|
||||
my ($t, $l) = split /\^/, $_, 2;
|
||||
print atime($t), ' ', $l, "\n";
|
||||
}
|
||||
@prev = ();
|
||||
}
|
||||
&$do($_);
|
||||
}
|
||||
$fp->close();
|
||||
}
|
||||
end() if main->can('end');
|
||||
}
|
||||
|
||||
sub process
|
||||
{
|
||||
my $line = shift;
|
||||
chomp $line;
|
||||
push @prev, $line;
|
||||
shift @prev while @prev > $nolines;
|
||||
my $flag = 0;
|
||||
foreach my $p (@patt) {
|
||||
if ($p =~ /^!/) {
|
||||
my $r = substr $p, 1;
|
||||
last if $line =~ m{$r}i;
|
||||
} else {
|
||||
last unless $line =~ m{$p}i;
|
||||
}
|
||||
++$flag;
|
||||
}
|
||||
if ($flag == @patt) {
|
||||
for (@prev) {
|
||||
s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg;
|
||||
my ($t, $l) = split /\^/, $_, 2;
|
||||
print atime($t), ' ', $l, "\n";
|
||||
print '----------------' if $nolines > 1;
|
||||
}
|
||||
@prev = ();
|
||||
}
|
||||
}
|
||||
|
||||
sub usage
|
||||
{
|
||||
die "usage: grepdbg [nn days before] [-nnn lines before] [<perl file name>] [<regexp>|!<regexp>]...\n";
|
||||
}
|
||||
exit(0);
|
||||
|
@ -27,7 +27,7 @@ BEGIN {
|
||||
}
|
||||
|
||||
use IO::File;
|
||||
use DXVars;
|
||||
use SysVar;
|
||||
use DXUtil;
|
||||
use DXLog;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user