downgrade perl on console.pl

backport grepdbg from mojo
This commit is contained in:
Dirk Koopman 2022-01-21 17:06:58 +00:00
parent f63d598af3
commit d8d7d25e92
5 changed files with 80 additions and 27 deletions

View File

@ -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=======================================================================

View File

@ -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

View File

@ -13,7 +13,7 @@
#
#
require 5.10.1;
require 5.8.1;
use warnings;
use vars qw($data $clusteraddr $clusterport);

View File

@ -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);

View File

@ -27,7 +27,7 @@ BEGIN {
}
use IO::File;
use DXVars;
use SysVar;
use DXUtil;
use DXLog;