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 3d5ce0c9f6fb5fa9744939c7e121b8429b06b706..36b3ea3e27220825440d796d40343d8b0692edb5 100644 (file)
--- 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 08703d7c8230e49b780d71821d60cbd65719a1d4..ca5339a154c5080c3f6f5074e4321f5f3442b783 100644 (file)
--- 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 e108666c9283adad0cf6e4106369a3970ed53da5..82e906037c085ff42fb49f34e9b3f7db8565423d 100644 (file)
--- 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 157ff609534515009faf6ff07914e690784fd349..28e7396dcebd3143d25d29b49c989e98c4c7592d 100644 (file)
--- 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 ebf581bd50a5b33d745229ebabd6a3523df3b6f9..f133a143448972d0e75e5f019fb9015665ef77ff 100755 (executable)
--- 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);