From: Dirk Koopman <djk@tobit.co.uk>
Date: Fri, 24 Apr 2020 09:32:42 +0000 (+0100)
Subject: add progress indications
X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=f6abc902d49e13eeca3ff50f84a74f28a3aa3390

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

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] ..] <regexp>\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] ..] <regexp>\n";
+}
 exit(0);