From ed993b76a84e36b22efd1fc762d6a466497bcf7e Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sun, 19 Apr 2020 16:12:57 +0100 Subject: [PATCH] improve spawn dbg, move "use Mojolicious" We have moved the first use of "use Mojolicious " AFTER the "use DXDebug" to allow capture of Mojo errors into the debug log. --- perl/DXCommandmode.pm | 21 +++------------------ perl/DXCron.pm | 13 +++++++++++-- perl/DXProt.pm | 3 ++- perl/DXUtil.pm | 21 ++++++++++++++++++++- perl/cluster.pl | 7 +++++-- 5 files changed, 41 insertions(+), 24 deletions(-) diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index d5271313..3d5ce0c9 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -1265,22 +1265,6 @@ sub send_motd $self->send_file($motd) if -e $motd; } -sub _diffms -{ - return unless isdbg('chan'); - my $call = shift; - my $line = shift; - 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); - my $msecs = $b - $a; - - my $s = "forkcall stats: $call '$line' "; - $s .= "${msecs}mS"; - dbg($s); -} # Punt off a long running command into a separate process # @@ -1324,6 +1308,7 @@ sub spawn_cmd $s .= ", args: " . join(', ', @$args) if $args && @$args; } my @res = $cmdref->(@$args); +# diffms("rcmd from $call 1", $line, $t0, scalar @res) if isdbg('chan'); return @res; }, # $args, @@ -1333,7 +1318,7 @@ sub spawn_cmd return unless $dxchan; if ($err) { - my $s = "DXCommand::spawn_cmd: call $call error $err"; + my $s = "DXProt::spawn_cmd: call $call error $err"; dbg($s) if isdbg('chan'); $dxchan->send($s); return; @@ -1349,7 +1334,7 @@ sub spawn_cmd $dxchan->send(@res); } } - _diffms($call, $line, $t0); + diffms("by $call", $line, $t0, scalar @res) if isdbg('chan'); }); return @out; diff --git a/perl/DXCron.pm b/perl/DXCron.pm index c011d7b3..9a3aac50 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -14,7 +14,7 @@ use DXM; use DXDebug; use IO::File; use DXLog; - +use Time::HiRes qw(gettimeofday tv_interval); use Mojo::IOLoop::Subprocess; use strict; @@ -245,11 +245,16 @@ sub start_connect sub spawn { my $line = shift; + my $t0 = [gettimeofday]; dbg("DXCron::spawn: $line") if isdbg("cron"); my $fc = Mojo::IOLoop::Subprocess->new(); $fc->run( - sub {my @res = `$line`; return @res}, + sub { + my @res = `$line`; +# diffms("DXCron spawn 1", $line, $t0, scalar @res) if isdbg('chan'); + return @res + }, sub { my ($fc, $err, @res) = @_; if ($err) { @@ -261,6 +266,7 @@ sub spawn chomp; dbg("DXCron::spawn: $_") if isdbg("cron"); } + diffms("by DXCron::spawn", $line, $t0, scalar @res) if isdbg('chan'); } ); } @@ -268,6 +274,7 @@ sub spawn sub spawn_cmd { my $line = shift; + my $t0 = [gettimeofday]; dbg("DXCron::spawn_cmd run: $line") if isdbg('cron'); my $fc = Mojo::IOLoop::Subprocess->new(); @@ -276,6 +283,7 @@ sub spawn_cmd $main::me->{_nospawn} = 1; my @res = $main::me->run_cmd($line); delete $main::me->{_nospawn}; +# diffms("DXCron spawn_cmd 1", $line, $t0, scalar @res) if isdbg('chan'); return @res; }, sub { @@ -288,6 +296,7 @@ sub spawn_cmd chomp; dbg("DXCron::spawn_cmd: $_") if isdbg("cron"); } + diffms("by DXCron::spawn_cmd", $line, $t0, scalar @res) if isdbg('chan'); } ); } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 9493637a..d7e34e61 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -1231,6 +1231,7 @@ sub spawn_cmd } my @res = $cmdref->(@$args); +# diffms("by $call 1", $line, $t0, scalar @res) if isdbg('chan'); return @res; }, # $args, @@ -1260,7 +1261,7 @@ sub spawn_cmd $self->send(@res); } } - DXCommandmode::_diffms($call, $line, $t0); + diffms("rcmd from $user on $call", $line, $t0, scalar @res) if isdbg('chan'); }); return @out; diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index b9afba12..157ff609 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -13,7 +13,7 @@ use Date::Parse; use IO::File; use File::Copy; use Data::Dumper; - +use Time::HiRes qw(gettimeofday tv_interval); use strict; @@ -27,6 +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 ); @@ -497,3 +498,21 @@ sub localdata_mv } } +# measure the time taken for something to happen; use Time::HiRes qw(gettimeofday tv_interval); +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; + + $line =~ s|\s+$||; + my $s = "subprocess stats cmd: '$line' $call ${msecs}mS"; + $s .= " $no lines" if $no; + DXDebug::dbg($s); +} diff --git a/perl/cluster.pl b/perl/cluster.pl index 9e14396b..6dc3573a 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -89,11 +89,12 @@ use SysVar; use strict; -use Mojolicious 7.26; +# order here is important - DXDebug snarfs Carp et al so that Mojo errors go into the debug log +use DXDebug; +use Mojolicious 7.26; use Mojo::IOLoop; -use DXDebug; use Msg; use IntMsg; use Internet; @@ -146,6 +147,8 @@ use DXSql; use IsoTime; use BPQMsg; + + use Data::Dumper; use IO::File; use Fcntl ':flock'; -- 2.34.1