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=======================================================================
|
09Jan22=======================================================================
|
||||||
1. Add New Year CTY 3201 prefix data.
|
1. Add New Year CTY 3201 prefix data.
|
||||||
07Jan22=======================================================================
|
07Jan22=======================================================================
|
||||||
|
@ -448,7 +448,7 @@ sub is_latlong
|
|||||||
# is it an ip address?
|
# is it an ip address?
|
||||||
sub is_ipaddr
|
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
|
# is it a zulu time hhmmZ
|
||||||
|
@ -13,7 +13,7 @@
|
|||||||
#
|
#
|
||||||
#
|
#
|
||||||
|
|
||||||
require 5.10.1;
|
require 5.8.1;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
use vars qw($data $clusteraddr $clusterport);
|
use vars qw($data $clusteraddr $clusterport);
|
||||||
|
81
perl/grepdbg
81
perl/grepdbg
@ -5,7 +5,6 @@
|
|||||||
#
|
#
|
||||||
# grepdbg [nn] [-mm] <regular expression>
|
# grepdbg [nn] [-mm] <regular expression>
|
||||||
#
|
#
|
||||||
|
|
||||||
# nn - is the day you what to look at: 1 is yesterday, 0 is today
|
# nn - is the day you what to look at: 1 is yesterday, 0 is today
|
||||||
# and is optional if there is only one argument
|
# and is optional if there is only one argument
|
||||||
#
|
#
|
||||||
@ -13,14 +12,18 @@
|
|||||||
# ten lines including the line matching the regular expression.
|
# ten lines including the line matching the regular expression.
|
||||||
#
|
#
|
||||||
# <regexp> is the regular expression you are searching for,
|
# <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;
|
require 5.004;
|
||||||
package main;
|
|
||||||
|
|
||||||
use vars qw($data);
|
|
||||||
|
|
||||||
# search local then perl directories
|
# search local then perl directories
|
||||||
BEGIN {
|
BEGIN {
|
||||||
@ -32,9 +35,7 @@ BEGIN {
|
|||||||
unshift @INC, "$root/local";
|
unshift @INC, "$root/local";
|
||||||
}
|
}
|
||||||
|
|
||||||
$data = "$root/data";
|
use SysVar;
|
||||||
|
|
||||||
use DXVars;
|
|
||||||
use DXUtil;
|
use DXUtil;
|
||||||
use DXLog;
|
use DXLog;
|
||||||
use Julian;
|
use Julian;
|
||||||
@ -43,45 +44,91 @@ use strict;
|
|||||||
|
|
||||||
use vars qw(@list $fp $today $string);
|
use vars qw(@list $fp $today $string);
|
||||||
|
|
||||||
|
|
||||||
$fp = DXLog::new('debug', 'dat', 'd');
|
$fp = DXLog::new('debug', 'dat', 'd');
|
||||||
$today = $fp->unixtoj(time());
|
$today = $fp->unixtoj(time());
|
||||||
my $nolines = 1;
|
my $nolines = 1;
|
||||||
my @prev;
|
my @prev;
|
||||||
|
my @patt;
|
||||||
|
|
||||||
for my $arg (@ARGV) {
|
foreach my $arg (@ARGV) {
|
||||||
if ($arg =~ /^-/) {
|
if ($arg =~ /^-/) {
|
||||||
$arg =~ s/^-//o;
|
$arg =~ s/^-//o;
|
||||||
|
if ($arg =~ /^\s*\-+(?:[h\?]e?l?p?)/) {
|
||||||
|
usage();
|
||||||
|
exit(0);
|
||||||
|
}
|
||||||
push @list, $arg;
|
push @list, $arg;
|
||||||
} elsif ($arg =~ /^\d+$/) {
|
} elsif ($arg =~ /^\d+$/) {
|
||||||
$nolines = $arg;
|
$nolines = $arg;
|
||||||
|
} elsif ($arg =~ /\.pm$/) {
|
||||||
|
if (-e $arg) {
|
||||||
|
my $fn = $arg;
|
||||||
|
$fn =~ s/\.pm$//;
|
||||||
|
eval { require $arg};
|
||||||
|
die "requiring $fn failed $@" if $@;
|
||||||
} else {
|
} else {
|
||||||
$string = $arg;
|
die "$arg not found";
|
||||||
last;
|
}
|
||||||
|
} else {
|
||||||
|
push @patt, $arg;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
die "usage: grepdbg [nn] [[-nnn] ..] <regexp>\n" unless $string;
|
|
||||||
|
push @patt, '.*' unless @patt;
|
||||||
|
|
||||||
push @list, "0" unless @list;
|
push @list, "0" unless @list;
|
||||||
for my $entry (@list) {
|
for my $entry (@list) {
|
||||||
my $now = $today->sub($entry);
|
my $now = $today->sub($entry);
|
||||||
my $fh = $fp->open($now);
|
my $fh = $fp->open($now);
|
||||||
my $line;
|
my $line;
|
||||||
|
my $do;
|
||||||
|
|
||||||
|
if (main->can('handle')) {
|
||||||
|
$do = \&handle;
|
||||||
|
} else {
|
||||||
|
$do = \&process;
|
||||||
|
}
|
||||||
|
|
||||||
|
begin() if main->can('begin');
|
||||||
if ($fh) {
|
if ($fh) {
|
||||||
while (<$fh>) {
|
while (<$fh>) {
|
||||||
my $line = $_;
|
&$do($_);
|
||||||
|
}
|
||||||
|
$fp->close();
|
||||||
|
}
|
||||||
|
end() if main->can('end');
|
||||||
|
}
|
||||||
|
|
||||||
|
sub process
|
||||||
|
{
|
||||||
|
my $line = shift;
|
||||||
chomp $line;
|
chomp $line;
|
||||||
push @prev, $line;
|
push @prev, $line;
|
||||||
shift @prev while @prev > $nolines;
|
shift @prev while @prev > $nolines;
|
||||||
if ($line =~ m{$string}io) {
|
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) {
|
for (@prev) {
|
||||||
s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg;
|
s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg;
|
||||||
my ($t, $l) = split /\^/, $_, 2;
|
my ($t, $l) = split /\^/, $_, 2;
|
||||||
print atime($t), ' ', $l, "\n";
|
print atime($t), ' ', $l, "\n";
|
||||||
|
print '----------------' if $nolines > 1;
|
||||||
}
|
}
|
||||||
@prev = ();
|
@prev = ();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
$fp->close();
|
|
||||||
}
|
sub usage
|
||||||
|
{
|
||||||
|
die "usage: grepdbg [nn days before] [-nnn lines before] [<perl file name>] [<regexp>|!<regexp>]...\n";
|
||||||
}
|
}
|
||||||
exit(0);
|
exit(0);
|
||||||
|
@ -27,7 +27,7 @@ BEGIN {
|
|||||||
}
|
}
|
||||||
|
|
||||||
use IO::File;
|
use IO::File;
|
||||||
use DXVars;
|
use SysVar;
|
||||||
use DXUtil;
|
use DXUtil;
|
||||||
use DXLog;
|
use DXLog;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user