From: Dirk Koopman Date: Fri, 21 Jan 2022 17:06:58 +0000 (+0000) Subject: downgrade perl on console.pl X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=d8d7d25e92a56847754a237166ca926adc2199ca;p=spider.git downgrade perl on console.pl backport grepdbg from mojo --- diff --git a/Changes b/Changes index 91d4a855..a9b75993 100644 --- a/Changes +++ b/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======================================================================= diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 7288afb7..f0e7a8ae 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -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 diff --git a/perl/console.pl b/perl/console.pl index c816e373..13f2bfa1 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -13,7 +13,7 @@ # # -require 5.10.1; +require 5.8.1; use warnings; use vars qw($data $clusteraddr $clusterport); diff --git a/perl/grepdbg b/perl/grepdbg index 1282d71f..06f7df63 100755 --- a/perl/grepdbg +++ b/perl/grepdbg @@ -5,7 +5,6 @@ # # grepdbg [nn] [-mm] # - # 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. # # is the regular expression you are searching for, -# a caseless search is done +# a caseless search is done. There can be more than one +# a preceeded by a '!' is treated as NOT . Each +# 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] ..] \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] [] [|!]...\n"; } exit(0); diff --git a/perl/watchdbg b/perl/watchdbg index 79a72f60..a497eff9 100755 --- a/perl/watchdbg +++ b/perl/watchdbg @@ -27,7 +27,7 @@ BEGIN { } use IO::File; -use DXVars; +use SysVar; use DXUtil; use DXLog;