Improve M$ Windows compatibility

diff --git a/Changes b/Changes
index 3ed25f8b7ba3412c4632c6f433b11190047cfba5..194013417965993fb7862f336654d6a5761fb62f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,17 @@
+14Feb23=======================================================================
+1. Attempt to be more M$ Windows compatible. This basically is to do with the
+   unfortunate fact that most of the Windows perl cannot do, or simulate 
+   spawning (running another process in parallel) and/or Mojolicious cannot
+   handle coping with one or more versions of these simulations. 
+
+   I don't have a windows perl available to me at moment so I can only
+   simulate running under windows by setting a variable.
+
+   You need to know that running any version of DXSpider on Windows will do
+   all long running commands in line. Much as the 'master' branch does. So
+   running large nodes on Windows boxes with versions of perl that do not
+   support running spawned processes continues to be contra-indicated. Much 
+   as it has ALWAYS been. 
 04Feb23=======================================================================
 1. Fixed sh/log so that callsigns beginning with a digit (or several) are 
    printed rather than being ignored.

diff --git a/cmd/nospawn.pl b/cmd/nospawn.pl
index ad81feb6e5be533c30472f85aac92dc453128514..3351334f023ef9af2d94ae93b13969d84ffcbad4 100644 (file)
--- a/cmd/nospawn.pl
+++ b/cmd/nospawn.pl
@@ -21,8 +21,8 @@ if ($self->remotecmd || $self->inscript) {
 }
 
 Log('DXCommand', "nospawn '$line' by $mycall");
-$self->{_nospawn} = 1;
+++$self->{_nospawn};
 my @out = $self->run_cmd($line);
-delete $self->{_nospawn};
+$self->{_nospawn} = 0 if exists $self->{_nospawn} && --$self->{_nospawn} <= 0;
 
 return (1, @out);

diff --git a/cmd/save.pl b/cmd/save.pl
index dce7b49cd5bb75b2662d215a3f1dfcb3216c6d16..0b97a662297d5b7fbad7fc589815ce1ae630542a 100644 (file)
--- a/cmd/save.pl
+++ b/cmd/save.pl
@@ -44,9 +44,9 @@ if ($rest =~ /^\s*\"/) {
 }
 open OF, "$app_req$fn" or return (1, $self->msg('e30', $fn));
 for (@cmd) {
-       $self->{_nospawn} = 1;
+       ++$self->{_nospawn};
        print OF map {"$_\n"} $self->run_cmd($_);
-       delete $self->{_nospawn};
+       $self->{_nospawn} = 0 if exists $self->{_nospawn} && --$self->{_nospawn} <= 0;
 }
 close OF;
 return (1, $self->msg('ok'));

diff --git a/cmd/show/announce.pl b/cmd/show/announce.pl
index d069f9768ad498b5ced24aeecb1e865d3839384e..30b1f8798706e2450251a7692d3ae3e822b4e2ae 100644 (file)
--- a/cmd/show/announce.pl
+++ b/cmd/show/announce.pl
@@ -49,7 +49,7 @@ if (!$who && !$from && $to < @AnnTalk::anncache) {
        return (1, @out);
 }
 
-return (1, DXLog::print($from, $to, $main::systime, 'ann', $who)) if $self->{_nospawn} || $DB::VERSION;
+return (1, DXLog::print($from, $to, $main::systime, 'ann', $who)) if ($self->{_nospawn} || $main::is_win == 1) || $DB::VERSION;
 return (1, $self->spawn_cmd("show/announce $cmdline", \&DXLog::print, args => [$from, $to, $main::systime, 'ann', $who]));
        
 return (1, @out);

diff --git a/cmd/show/chat.pl b/cmd/show/chat.pl
index 6b01d20675b557432d161cb4cf9c3ed8e62d59bb..f4ae651f8d21ffc28731abf10aa4a0cff8978b06 100644 (file)
--- a/cmd/show/chat.pl
+++ b/cmd/show/chat.pl
@@ -37,7 +37,7 @@ while ($f = shift @f) {                 # next field
 $to = 20 unless $to;
 $from = 0 unless $from;
 
-if ($self->{_nospawn}) {
+if ($self->{_nospawn} || $main::is_win == 1) {
        @out = DXLog::print($from, $to, $main::systime, 'chat', $who);
 } else {
        @out = $self->spawn_cmd("show/chat $cmdline", \&DXLog::print, args => [$from, $to, $main::systime, 'chat', $who]);

diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl
index 4f71c13e51d69adf01d86e40b3c3e3af405b4fab..a7ee33d5e1062f5b5651a12be4df7cf5eb29ab36 100644 (file)
--- a/cmd/show/dx.pl
+++ b/cmd/show/dx.pl
@@ -164,7 +164,7 @@ sub handle
   
        # now do the search
 
-       if ($self->{_nospawn} || ($Spot::spotcachedays && !$expr && $from == 0 && $fromday == 0 && $today == 0)) {
+       if (($self->{_nospawn} || $main::is_win == 1) || ($Spot::spotcachedays && !$expr && $from == 0 && $fromday == 0 && $today == 0)) {
                my @res = Spot::search($expr, $fromday, $today, $from, $to, $user, $dofilter, $self);
                my $ref;
                my @dx;

diff --git a/cmd/show/groups.pl b/cmd/show/groups.pl
index 85e3fe2b0057dc6853e1297e4127c141c60774e6..aaa9d4cf334ac640d8f423abc860f86d080b48df 100644 (file)
--- a/cmd/show/groups.pl
+++ b/cmd/show/groups.pl
@@ -20,7 +20,7 @@ sub handle
        }
        $to = 500 unless $to;
 
-       if ($self->{_nospawn}) {
+       if ($self->{_nospawn} || $main::is_win == 1) {
                return (1, doit($self, DXLog::print(undef, $to, $main::systime, 'chat', undef)));
        }
        return (1, $self->spawn_cmd("show/groups $to", \&DXLog::print, args => [0, $to, $main::systime, 'chat', undef], cb => \&doit));

diff --git a/cmd/show/hfstats.pl b/cmd/show/hfstats.pl
index 1964a23ab60550f9023db22feb74ac22ac9ed3be..29568f4b50b6f1b51a1f4c45d06d6f6301bc5e9a 100644 (file)
--- a/cmd/show/hfstats.pl
+++ b/cmd/show/hfstats.pl
@@ -57,7 +57,7 @@ sub handle
 #      @out = $self->spawn_cmd("show/hfstats $line", sub {
 #                                                      });
 
-       if ($self->{_nospawn}) {
+       if ($self->{_nospawn} || $main::is_win == 1) {
                return (1, generate($self, $days, $now, $today));
        }
        else {

diff --git a/cmd/show/hftable.pl b/cmd/show/hftable.pl
index 4ad679d2bd59cc995c992e76fcd322ab912298bb..bc3153ef7ad9899dd6b333e06af04c6e57cb327e 100644 (file)
--- a/cmd/show/hftable.pl
+++ b/cmd/show/hftable.pl
@@ -103,7 +103,7 @@
         }
 
 
-        if ($self->{_nospawn}) {
+        if ($self->{_nospawn} || $main::is_win == 1) {
                 @out = generate($self);
         } else {
                 @out = $self->spawn_cmd("show/hftable $line", sub { return (generate($self)); });

diff --git a/cmd/show/isolate.pl b/cmd/show/isolate.pl
index cefae9dc6dfeab77d6cd30cfdd708002fd6e8e9d..65b636d49539cd4d5a2bb7f7cbcbab388f7fde8b 100644 (file)
--- a/cmd/show/isolate.pl
+++ b/cmd/show/isolate.pl
@@ -17,7 +17,7 @@ sub handle
 
        my @out;
 
-       if ($self->{_nospawn}) {
+       if ($self->{_nospawn} || $main::is_win == 1) {
                return (1, generate($self));
        } else {
                return (1, $self->spawn_cmd("show/isolate $line", sub { return (generate($self)); }));

diff --git a/cmd/show/log.pl b/cmd/show/log.pl
index 2abe825762e531a09dfa53f89529c5cc1037f360..fa8806c21f68554c30b7e6fb64ae85035cd35586 100644 (file)
--- a/cmd/show/log.pl
+++ b/cmd/show/log.pl
@@ -41,6 +41,6 @@ sub handle
                $who = $self->call;
        }
 
-       return (1, DXLog::print($from, $to, $main::systime, undef, $who)) if $self->{_nospawn};
+       return (1, DXLog::print($from, $to, $main::systime, undef, $who)) if ($self->{_nospawn} || $main::is_win == 1);
        return (1, $self->spawn_cmd("show/log $cmdline", \&DXLog::print, args => [$from, $to, $main::systime, undef, $who]));
 }

diff --git a/cmd/show/rcmd.pl b/cmd/show/rcmd.pl
index df64298b640e161b870ee6fa4fddce16a250ea9f..0143b29063270c2e7babfef5b100529266293e5e 100644 (file)
--- a/cmd/show/rcmd.pl
+++ b/cmd/show/rcmd.pl
@@ -35,6 +35,6 @@ while ($f = shift @f) {                 # next field
 $to = 20 unless $to;
 $from = 0 unless $from;
 
-return (1, DXLog::print($from, $to, $main::systime, 'rcmd', $who)) if $self->{_nospawn};
+return (1, DXLog::print($from, $to, $main::systime, 'rcmd', $who)) if ($self->{_nospawn} || $main::is_win == 1);
 return (1, $self->spawn_cmd("show/rcmd $cmdline", \&DXLog::print, args => [$from, $to, $main::systime, 'rcmd', $who]));
 

diff --git a/cmd/show/registered.pl b/cmd/show/registered.pl
index 4876aea2a7d6f9740f413eda68422f7f389b0afe..6b930be224d3d3f7ce6cf45ef65345ca08e7d818 100644 (file)
--- a/cmd/show/registered.pl
+++ b/cmd/show/registered.pl
@@ -22,7 +22,7 @@ sub handle
                $line = "\U\Q$line";
        }
 
-       if ($self->{_nospawn}) {
+       if ($self->{_nospawn} || $main::is_win == 1) {
                @out = generate($self, $line);
        } else {
                @out = $self->spawn_cmd("show/registered $line", sub { return (generate($self, $line)); });

diff --git a/cmd/show/seeme.pl b/cmd/show/seeme.pl
index 2fef50d4dbfaf8ed1fcd008c156d19a2dbb421ea..de04d93e02aabf4b0ec73dbf77f8b3c2cd926584 100644 (file)
--- a/cmd/show/seeme.pl
+++ b/cmd/show/seeme.pl
@@ -22,7 +22,7 @@ sub handle
                $line = "\U\Q$line";
        }
 
-       if ($self->{_nospawn}) {
+       if ($self->{_nospawn} || $main::is_win == 1) {
                @out = generate($self, $line);
        } else {
                @out = $self->spawn_cmd("show/seeme $line", sub { return (generate($self, $line)); });

diff --git a/cmd/show/talk.pl b/cmd/show/talk.pl
index 6b3c4ea95a724957a2256a05ed7b70face4d1a27..4adeb7261355b3411c40f677b7ec14feed5c8aa0 100644 (file)
--- a/cmd/show/talk.pl
+++ b/cmd/show/talk.pl
@@ -38,5 +38,5 @@ if ($self->priv < 6) {
        return (1, $self->msg('e5')) if $who ne $self->call;
 }
 
-return (1, DXLog::print($from, $to, $main::systime, 'talk', $who)) if $self->{_nospawn};
+return (1, DXLog::print($from, $to, $main::systime, 'talk', $who)) if ($self->{_nospawn} || $main::is_win == 1);
 return (1, $self->spawn_cmd("show/talk $cmdline", \&DXLog::print, args => [$from, $to, $main::systime, 'talk', $who]));

diff --git a/cmd/show/vhfstats.pl b/cmd/show/vhfstats.pl
index 22001a639ee8f85434112ae71cc64cefe0a59055..9d8ffdf9f5fdbbfc022c0c51496c7df5013102b8 100644 (file)
--- a/cmd/show/vhfstats.pl
+++ b/cmd/show/vhfstats.pl
@@ -57,7 +57,7 @@ sub handle
 #      @out = $self->spawn_cmd("show/vhfstats $line", sub {
 #                                                      });
 
-       if ($self->{_nospawn}) {
+       if ($self->{_nospawn} || $main::is_win == 1) {
                return (1, generate($self, $days, $now, $today));
        }
        else {

diff --git a/cmd/show/vhftable.pl b/cmd/show/vhftable.pl
index 38c584a8498bbc4eaf6cc3fcebaa1e5e41203bab..cd2f1d0b7f0b9b7d8ea6ec2cdccd5aa6145ee84f 100644 (file)
--- a/cmd/show/vhftable.pl
+++ b/cmd/show/vhftable.pl
@@ -71,7 +71,7 @@ sub handle
                $now = Julian::Day->new(time); #no starting date
                $date = cldate(time);
        }
-       if ($self->{_nospawn}) {
+       if ($self->{_nospawn} || $main::is_win == 1) {
                @out = generate($self);
        }
        else {

diff --git a/cmd/show/wx.pl b/cmd/show/wx.pl
index 807b88fdbaa892434ef150158677a2b769ca4322..62f04b180443a38061a7681c5e1e820068a8a2e0 100644 (file)
--- a/cmd/show/wx.pl
+++ b/cmd/show/wx.pl
@@ -28,7 +28,7 @@ while ($f = shift @f) {                 # next field
 $to = 20 unless $to;
 $from = 0 unless $from;
 
-if ($self->{_nospawn}) {
+if ($self->{_nospawn} || $main::is_win == 1) {
        @out = $self->spawn_cmd("show/wx $cmdline", \&DXLog::print, args => [$from, $to, $main::systime, 'ann', 'WX']);
 } else {
        @out = DXLog::print($from, $to, $main::systime, 'ann', 'WX');

diff --git a/cmd/unset/registered.pl b/cmd/unset/registered.pl
deleted file mode 100644 (file)
index 4876aea..0000000
--- a/cmd/unset/registered.pl
+++ /dev/null
@@ -1,82 +0,0 @@
-#
-# show/registered
-#
-# show all registered users 
-#
-# Copyright (c) 2001 Dirk Koopman G1TLH
-#
-#
-#
-
-sub handle
-{
-       my ($self, $line) = @_;
-       return (1, $self->msg('e5')) unless $self->priv >= 9;
-
-       my @out;
-
-       use DB_File;
-
-       if ($line) {
-               $line =~ s/[^\w\-\/]+//g;
-               $line = "\U\Q$line";
-       }
-
-       if ($self->{_nospawn}) {
-               @out = generate($self, $line);
-       } else {
-               @out = $self->spawn_cmd("show/registered $line", sub { return (generate($self, $line)); });
-       }
-
-       return (1, @out);
-}
-
-sub generate
-{
-       my $self = shift;
-       my $line = shift;
-       my @out;
-       my @val;
-
-#      dbg("set/register line: $line");
-
-       my %call = ();
-       $call{$_} = 1 for split /\s+/, $line;
-       delete $call{'ALL'};
-
-       my ($action, $count, $key, $data) = (0,0,0,0);
-       unless (keys %call) {
-               for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) {
-                       if ($data =~ m{registered}) {
-                               $call{$key} = 1;       # possible candidate
-                       }
-               }
-       }
-
-       foreach $key (sort keys %call) {
-               my $u = DXUser::get_current($key);
-               if ($u && defined (my $r = $u->registered)) {
-                       push @val, "${key}($r)";
-                       ++$count;
-               }
-       }
-
-       my @l;
-       push @out, "Registration is " . ($main::reqreg ? "Required" :  "NOT Required");
-       foreach my $call (@val) {
-               if (@l >= 5) {
-                       push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
-                       @l = ();
-               }
-               push @l, $call;
-       }
-       if (@l) {
-               push @l, "" while @l < 5;
-               push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
-       }
-
-       push @out, $self->msg('rec', $count);
-       return @out;
-       
-}
-

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 84585ef1ee240f8d19ad10ba6d3468d386b26953..dcd7b909bf25af8983044ace748da460efb896eb 100644 (file)
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -175,6 +175,7 @@ sub alloc
        $self->{lang} = $main::lang if !$self->{lang};
        $self->{func} = "";
        $self->{width} ||=  80;
+       $self->{_nospawn} = 0;
 
        # add in all the dxcc, itu, zone info
        my @dxcc = Prefix::extract($call);

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 2c49fabe07cb7422ef8536efb981a5fce5c980c5..46d2b1d38bd4d450f0f95b0fbda2e7b37281f274 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -1379,7 +1379,7 @@ sub spawn_cmd
        no strict 'refs';
 
        # just behave normally if something has set the "one-shot" _nospawn in the channel
-       if ($self->{_nospawn}) {
+       if ($self->{_nospawn} || $main::is_win == 1) {
                eval { @out = $cmdref->(@$args); };
                if ($@) {
                        DXDebug::dbgprintring(25);

diff --git a/perl/DXCron.pm b/perl/DXCron.pm
index adeff2162d477618093ef22f9b6ef3c6e3e4877f..c8b172735a2532b8e574c6c607c75922c305a2ee 100644 (file)
--- a/perl/DXCron.pm
+++ b/perl/DXCron.pm
@@ -311,7 +311,7 @@ sub spawn_cmd
                         sub {
                                 my ($fc, $err, @res) = @_; 
                                 --$main::me->{_nospawn};
-                                delete $main::me->{_nospawn} if exists $main::me->{_nospawn} && $main::me->{_nospawn} <= 0;
+                                $main::me->{_nospawn} = 0 if exists $main::me->{_nospawn} && $main::me->{_nospawn} <= 0;
                                 if ($err) {
                                         my $s = "DXCron::spawn_cmd: error $err";
                                         dbg($s);

diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm
index 92deee427026cf1e574b3a66c5d479a88131304f..a6d074a6a64bfd78c768dae4e7388126f537117f 100644 (file)
--- a/perl/DXLogPrint.pm
+++ b/perl/DXLogPrint.pm
@@ -18,7 +18,7 @@ use DXLog;
 use Julian;
 
 
-our $readback = 1;
+our $readback = $main::is_win ? 0 : 1;
 if ($readback) {
        $readback = `which tac`;
 } 

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index bf2d5ed30395899d488fa4f2315f190c930d71fd..9f4f3840242adaa38085bf34c7a01f815a7392ba 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -1234,7 +1234,7 @@ sub spawn_cmd
        my $fc = DXSubprocess->new;
 
        # just behave normally if something has set the "one-shot" _nospawn in the channel
-       if ($self->{_nospawn}) {
+       if ($self->{_nospawn} || $main::is_win == 1) {
                eval { @out = $cmdref->(@$args); };
                if ($@) {
                        DXDebug::dbgprintring(25);

diff --git a/perl/Spot.pm b/perl/Spot.pm
index 24124f5a3184e6b826800cb036c40a2f79e9d77a..056fd628557a1947706598f54f958358ef5807fb 100644 (file)
--- a/perl/Spot.pm
+++ b/perl/Spot.pm
@@ -73,7 +73,7 @@ our %spotcache;                                       # the cache of data within the last $spotcachedays 0 or 2+ d
 our $spotcachedays = 2;                        # default 2 days worth
 our $minselfspotqrg = 1240000; # minimum freq above which self spotting is allowed
 
-our $readback = 1;
+our $readback = $main::is_win ? 0 : 1;
 
 if ($readback) {
        $readback = `which tac`;