From f6abc902d49e13eeca3ff50f84a74f28a3aa3390 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Fri, 24 Apr 2020 10:32:42 +0100 Subject: [PATCH] add progress indications set/debug progress (now a default) will show signs of stuff happening in concentrated form, e.g a new spot or someone using a command. This is especially useful in 'nolog' (i,e "ring buffer") modes. Fix grepdbg so that no input line just lists the latest dbg file --- perl/DXCommandmode.pm | 11 ++++++++++- perl/DXDebug.pm | 13 +++++++++++++ perl/DXProtHandle.pm | 7 +++++++ perl/DXUtil.pm | 18 ++++++++++++------ perl/grepdbg | 42 +++++++++++++++++++++++++++++------------- 5 files changed, 71 insertions(+), 20 deletions(-) diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 3d5ce0c9..36b3ea3e 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -544,8 +544,17 @@ sub run_cmd if ($package && $self->can("${package}::handle")) { no strict 'refs'; dbg("cmd: package $package") if isdbg('command'); + if (isdbg('progress')) { + my $s = "CMD: '$cmd' by $call ip $self->{hostname}"; + } + my $t0 = [gettimeofday]; eval { @ans = &{"${package}::handle"}($self, $args) }; return (DXDebug::shortmess($@)) if $@; + if (isdbg('progress')) { + my $msecs = _diffms($t0); + my $s = "CMD: '$cmd' by $call ip: $self->{hostname} ${msecs}mS"; + dbg($s); + } } else { dbg("cmd: $package not present") if isdbg('command'); return $self->_error_out('e1'); @@ -1334,7 +1343,7 @@ sub spawn_cmd $dxchan->send(@res); } } - diffms("by $call", $line, $t0, scalar @res) if isdbg('chan'); + diffms("by $call", $line, $t0, scalar @res) if isdbg('progress'); }); return @out; diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 08703d7c..ca5339a1 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -8,6 +8,19 @@ # To allow debugging of a category (e.g. 'chan') but not onto disc (just into the ring buffer) # do: set/debug chan nologchan # +# To print the current contents into the debug log: show/debug_ring +# +# On exit or serious error the ring buffer is printed to the current debug log +# +# In Progress: +# Expose a localhost listener on port (default) 27755 to things like watchdbg so that they can carry on +# as normal, possibly with a "remember" button to permanently capture stuff observed. +# +# Future: +# This is likely to be some form of triggering or filtering controlling (some portion +# of) ring_buffer dumping. +# +# package DXDebug; diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index e108666c..82e90603 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -224,6 +224,13 @@ sub handle_11 # add it Spot::add(@spot); + if (isdbg('progress')) { + my $s = sprintf "SPOT: $spot[1] on $spot[0] \@ %s by $spot[4]\@$spot[7]", cldatetime($spot[2]); + $s .= " '$spot[3]'" if $spot[3]; + $s .= " from ip $spot[14]" if $spot[14]; + dbg($s); + } + # # @spot at this point contains:- # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 157ff609..28e7396d 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -27,7 +27,7 @@ require Exporter; print_all_fields cltounix unpad is_callsign is_latlong is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem is_prefix dd is_ipaddr $pi $d2r $r2d localdata localdata_mv - diffms + diffms _diffms ); @@ -499,17 +499,23 @@ sub localdata_mv } # measure the time taken for something to happen; use Time::HiRes qw(gettimeofday tv_interval); +sub _diffms +{ + my $ta = shift; + my $tb = shift || [gettimeofday]; + my $a = int($ta->[0] * 1000) + int($ta->[1] / 1000); + my $b = int($tb->[0] * 1000) + int($tb->[1] / 1000); + return $b - $a; +} + sub diffms { my $call = shift; my $line = shift; my $ta = shift; my $no = shift; - my $tb = shift || [gettimeofday]; - - my $a = int($ta->[0] * 1000) + int($ta->[1] / 1000); - my $b = int($tb->[0] * 1000) + int($tb->[1] / 1000); - my $msecs = $b - $a; + my $tb = shift; + my $msecs = _diffms($ta, $tb); $line =~ s|\s+$||; my $s = "subprocess stats cmd: '$line' $call ${msecs}mS"; diff --git a/perl/grepdbg b/perl/grepdbg index ebf581bd..f133a143 100755 --- a/perl/grepdbg +++ b/perl/grepdbg @@ -38,6 +38,7 @@ use strict; use vars qw(@list $fp $today $string); + $fp = DXLog::new('debug', 'dat', 'd'); $today = $fp->unixtoj(time()); my $nolines = 1; @@ -46,6 +47,10 @@ my @prev; for 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; @@ -54,7 +59,8 @@ for my $arg (@ARGV) { last; } } -die "usage: grepdbg [nn] [[-nnn] ..] \n" unless $string; + +$string ||= '.*'; push @list, "0" unless @list; for my $entry (@list) { @@ -63,20 +69,30 @@ for my $entry (@list) { my $line; 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 = (); - } + process($_); } $fp->close(); } } + +sub process +{ + my $line = shift; + 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 = (); + } +} + +sub usage +{ + die "usage: grepdbg [nn] [[-nnn] ..] \n"; +} exit(0); -- 2.43.0