Now add files that the previous commit refered to

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 9d9f60b45e90b199fda5f5c4246d064d8ef1e412..c83a7162602b2cc53c3f5cfbd2c7a816d8b19192 100644 (file)
--- 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 0c388e9d6aa77af2111dd50e4802cd40c7a68737..d2a109332aa2a89206b72463ba27af618bb25849 100644 (file)
--- 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 dc5dc0b99e5bc08198e96831a7853db07dea0807..5afb6716fcc8846aa825163964cd3ddb39f7d607 100644 (file)
--- 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 b3278d36a78a835405f2a72bf8adf68d4e7a142f..52009488db3f357e79a456dd301ff22e898de6e4 100644 (file)
--- 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 9c44fa057528e1ce0b57bc5e92670fb947b286a3..500a615023ebdcf3fcf22fd001d715814c9372f2 100644 (file)
--- 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 270587198928773eba4b9e1dd72f722aa593a324..6088a4628b92756d946bfe4eac2c8398e2592974 100644 (file)
--- 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;