From b33cb7a3d3842fabb787105b89aa1094bf5372e0 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Fri, 15 May 2020 16:56:32 +0100 Subject: [PATCH] Now add files that the previous commit refered to --- perl/DXCommandmode.pm | 11 ++++++----- perl/DXCron.pm | 36 ++++++++++++++++++++++-------------- perl/DXProt.pm | 9 +++++---- perl/DXProtHandle.pm | 17 +++++++++-------- perl/DXUtil.pm | 3 ++- perl/DXXml/Ping.pm | 9 +++++---- 6 files changed, 49 insertions(+), 36 deletions(-) diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 9d9f60b4..c83a7162 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -42,9 +42,10 @@ use AsyncMsg; use JSON; use Time::HiRes qw(gettimeofday tv_interval); +use Mojo::UserAgent; use Mojo::IOLoop; use Mojo::IOLoop::Subprocess; -use Mojo::UserAgent; +use DXSubprocess; use strict; use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug @@ -1316,14 +1317,14 @@ sub spawn_cmd return @out; } - my $fc = Mojo::IOLoop::Subprocess->new; + my $fc = DXSubprocess->new; # $fc->serializer(\&encode_json); # $fc->deserializer(\&decode_json); $fc->run( sub { my $subpro = shift; - if (isdbg('progress')) { - my $s = qq{line: "$line"}; + if (isdbg('spawn')) { + my $s = __PACKAGE__ . qq{ line: "$line"}; $s .= ", args: " . join(', ', map { defined $_ ? qq{'$_'} : q{'undef'} } @$args) if $args && @$args; dbg($s); } @@ -1357,7 +1358,7 @@ sub spawn_cmd $dxchan->send(@res); } } - diffms("by $call", $line, $t0, scalar @res) if isdbg('progress'); + diffms(__PACKAGE__, "by $call", $line, $t0, scalar @res) if isdbg('progress'); }); return @out; diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 0c388e9d..d2a10933 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -16,6 +16,7 @@ use IO::File; use DXLog; use Time::HiRes qw(gettimeofday tv_interval); use Mojo::IOLoop::Subprocess; +use DXSubprocess; use strict; @@ -257,11 +258,10 @@ sub spawn my $t0 = [gettimeofday]; dbg("DXCron::spawn: $line") if isdbg("cron"); - my $fc = Mojo::IOLoop::Subprocess->new(); + my $fc = DXSubprocess->new(); $fc->run( sub { my @res = `$line`; -# diffms("DXCron spawn 1", $line, $t0, scalar @res) if isdbg('chan'); return @res }, sub { @@ -275,7 +275,7 @@ sub spawn chomp; dbg("DXCron::spawn: $_") if isdbg("cron"); } - diffms("by DXCron::spawn", $line, $t0, scalar @res) if isdbg('progress'); + diffms(__PACKAGE__, "::spawn", $line, $t0, scalar @res) if isdbg('progress'); } ); } @@ -283,29 +283,37 @@ sub spawn sub spawn_cmd { my $line = shift; + my $chan = shift || $main::me; + my $pkg = ref $chan || __PACKAGE__; my $t0 = [gettimeofday]; - - dbg("DXCron::spawn_cmd run: $line") if isdbg('cron'); - my $fc = Mojo::IOLoop::Subprocess->new(); + + dbg("$pkg::spawn_cmd run: $line") if isdbg('cron'); + my $fc = DXSubprocess->new; $fc->run( sub { - $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'); + $chan->{_nospawn} = 1; + my @res = $chan->run_cmd($line); + delete $chan->{_nospawn}; return @res; }, sub { my ($fc, $err, @res) = @_; if ($err) { - my $s = "DXCron::spawn_cmd: error $err"; + chomp $err; + my $s = "$pkg::spawn_cmd: error $err"; dbg($s); } for (@res) { - chomp; - dbg("DXCron::spawn_cmd: $_") if isdbg("cron"); + if (ref $chan) { + dbg("send: $_"); + $chan->send($_); + } elsif (isdbg('cron')) { + dbg("$pkg::spawn_cmd: $_"); + } else { + last; # don't care + } } - diffms("by DXCron::spawn_cmd", $line, $t0, scalar @res) if isdbg('progress'); + diffms($pkg, "::spawn_cmd", $line, $t0, scalar @res) if isdbg('progress'); } ); } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index dc5dc0b9..5afb6716 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -36,6 +36,7 @@ use DXProtHandle; use Time::HiRes qw(gettimeofday tv_interval); use Mojo::IOLoop::Subprocess; +use DXSubprocess; use strict; @@ -1216,7 +1217,7 @@ sub spawn_cmd no strict 'refs'; - my $fc = Mojo::IOLoop::Subprocess->new; + my $fc = DXSubprocess->new; # just behave normally if something has set the "one-shot" _nospawn in the channel if ($self->{_nospawn}) { @@ -1233,8 +1234,8 @@ sub spawn_cmd $fc->run( sub { my $subpro = shift; - if (isdbg('progress')) { - my $s = qq{line: "$line"}; + if (isdbg('spawn')) { + my $s = __PACKAGE__ . qq{ line: "$line"}; $s .= ", args: " . join(', ', map { defined $_ ? qq{'$_'} : q{'undef'} } @$args) if $args && @$args; dbg($s); } @@ -1272,7 +1273,7 @@ sub spawn_cmd $self->send(@res); } } - diffms("rcmd from $user on $call", $line, $t0, scalar @res) if isdbg('progress'); + diffms(__PACKAGE__, " rcmd from $user on $call", $line, $t0, scalar @res) if isdbg('progress'); }); return @out; diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index b3278d36..52009488 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -252,7 +252,7 @@ sub handle_11 my $long = $user->long; if (defined $lat && defined $long) { $user->qra(DXBearing::lltoqra($lat, $long)); - $user->put; + $user->put unless $self->{_nospawn}; } } @@ -285,7 +285,7 @@ sub handle_11 } } $user->lastoper($main::systime); - $user->put; + $user->put unless $self->{_nospawn}; } } } @@ -512,7 +512,7 @@ sub handle_16 $user->homenode($parent->call) if !$user->homenode; $user->node($parent->call); $user->lastin($main::systime) unless DXChannel::get($call); - $user->put; + $user->put unless $self->{_nospawn}; # send info to all logged in thingies $self->tell_login('loginu', "$ncall: $call") if $user->is_local_node; @@ -628,7 +628,7 @@ sub handle_18 unless ($self->is_spider) { dbg("Change U " . $self->user->sort . " C $self->{sort} -> S"); $self->user->sort('S'); - $self->user->put; + $self->user->put unless $self->{_nospawn}; $self->sort('S'); } # $self->{handle_xml}++ if DXXml::available() && $pc->[1] =~ /\bxml/; @@ -662,7 +662,8 @@ sub check_add_node my $call = shift; # add this station to the user database, if required (don't remove SSID from nodes) - my $user = DXUser::get_current($call); + my $chan = DXChannel::get($call); + my $user = $chan->user || DXUser::get($call); unless ($user) { $user = DXUser->new($call); $user->priv(1); # I have relented and defaulted nodes @@ -671,7 +672,7 @@ sub check_add_node $user->node($call); $user->sort('A'); $user->lastin($main::systime); # this make it last longer than just this invocation - $user->put; # just to make sure it gets written away!!! + $user->put unless $chan && $chan->{_nospawn}; # just to make sure it gets written away!!! } return $user; } @@ -800,7 +801,7 @@ sub handle_19 $mref->stop_msg($call) if $mref; $user->lastin($main::systime) unless DXChannel::get($call); - $user->put; + $user->put unless $self->{_nospawn}; } # we are not automatically sending out PC19s, we send out a composite PC21,PC19 instead @@ -1234,7 +1235,7 @@ sub handle_41 } } $user->lastoper($main::systime); # to cut down on excessive for/opers being generated - $user->put; + $user->put unless $self->{_nospawn}; unless ($self->{isolate}) { DXChannel::broadcast_nodes($line, $self); # send it to everyone but me diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 9c44fa05..500a6150 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -511,6 +511,7 @@ sub _diffms sub diffms { + my $pkg = shift; my $call = shift; my $line = shift; my $ta = shift; @@ -519,7 +520,7 @@ sub diffms my $msecs = _diffms($ta, $tb); $line =~ s|\s+$||; - my $s = "subprocess stats cmd: '$line' $call ${msecs}mS"; + my $s = "$pkg subprocess stats cmd: '$line' $call ${msecs}mS"; $s .= " $no lines" if $no; DXDebug::dbg($s); } diff --git a/perl/DXXml/Ping.pm b/perl/DXXml/Ping.pm index 27058719..6088a462 100644 --- a/perl/DXXml/Ping.pm +++ b/perl/DXXml/Ping.pm @@ -71,7 +71,7 @@ sub add my $u = DXUser::get_current($to); if ($u) { $u->lastping(($via || $from), $main::systime); - $u->put; + $u->put unless $dxchan->{_nospawn}; } } @@ -136,11 +136,12 @@ sub handle_ping_reply sub _handle_believe { my ($from, $via) = @_; - - my $user = DXUser::get_current($from); + + my $dxchan = DXChannel::get($from); + my $user = $dxchan->user || DXUser::get($from); if ($user) { $user->set_believe($via); - $user->put; + $user->put unless $dxchan->{_nospawn}; } } 1; -- 2.34.1