X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=85df95b16cfc3602e377c284643951ee3cc45c20;hb=8be46ac1786265a7ba6ee91b31141ecd017ecb49;hp=e86abd1a4f76c3f35a7150b7a0a72550e7d4a658;hpb=6227d68be0d99f20afc56c023b81455d100924b7;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index e86abd1a..85df95b1 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -13,6 +13,8 @@ package DXCommandmode; @ISA = qw(DXChannel); +require 5.10.1; + use POSIX qw(:math_h); use DXUtil; use DXChannel; @@ -38,6 +40,7 @@ use VE7CC; use DXXml; use AsyncMsg; use JSON; +use Time::HiRes qw(gettimeofday tv_interval); use Mojo::IOLoop; use Mojo::IOLoop::ForkCall; @@ -1092,7 +1095,7 @@ sub broadcast_debug { my $s = shift; # the line to be rebroadcast - foreach my $dxchan (DXChannel::get_all) { + foreach my $dxchan (DXChannel::get_all_users) { next unless $dxchan->{enhanced} && $dxchan->{senddbg}; if ($dxchan->{gtk}) { $dxchan->send_later('L', dd(['db', $s])); @@ -1251,6 +1254,23 @@ 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 # # This is called from commands to run some potentially long running @@ -1261,10 +1281,11 @@ sub send_motd # IT DOES NOT START UP SOME NEW PROGRAM AND RELIES ON THE FACT THAT IT IS RUNNING DXSPIDER # THE CURRENT CONTEXT!! # -# call: $self->spawn_cmd(\, [cb => sub{...}], [prefix => "cmd> "], [progress => 0|1], [args => [...]]); +# call: $self->spawn_cmd($original_cmd_line, \, [cb => sub{...}], [prefix => "cmd> "], [progress => 0|1], [args => [...]]); sub spawn_cmd { my $self = shift; + my $line = shift; my $cmdref = shift; my $call = $self->{call}; my %args = @_; @@ -1274,6 +1295,7 @@ sub spawn_cmd my $prefix = delete $args{prefix}; my $progress = delete $args{progress}; my $args = delete $args{args} || []; + my $t0 = [gettimeofday]; no strict 'refs'; @@ -1304,7 +1326,9 @@ sub spawn_cmd $dxchan->send(@res); } } + _diffms($call, $line, $t0); }); + return @out; }