From 8e14149148baba63ce5ae2b95aacda8ab6dd0d87 Mon Sep 17 00:00:00 2001
From: Dirk Koopman <djk@tobit.co.uk>
Date: Tue, 14 Feb 2023 23:05:13 +0000
Subject: [PATCH] Improve M$ Windows compatibility

---
 Changes                 | 14 +++++++
 cmd/nospawn.pl          |  4 +-
 cmd/save.pl             |  4 +-
 cmd/show/announce.pl    |  2 +-
 cmd/show/chat.pl        |  2 +-
 cmd/show/dx.pl          |  2 +-
 cmd/show/groups.pl      |  2 +-
 cmd/show/hfstats.pl     |  2 +-
 cmd/show/hftable.pl     |  2 +-
 cmd/show/isolate.pl     |  2 +-
 cmd/show/log.pl         |  2 +-
 cmd/show/rcmd.pl        |  2 +-
 cmd/show/registered.pl  |  2 +-
 cmd/show/seeme.pl       |  2 +-
 cmd/show/talk.pl        |  2 +-
 cmd/show/vhfstats.pl    |  2 +-
 cmd/show/vhftable.pl    |  2 +-
 cmd/show/wx.pl          |  2 +-
 cmd/unset/registered.pl | 82 -----------------------------------------
 perl/DXChannel.pm       |  1 +
 perl/DXCommandmode.pm   |  2 +-
 perl/DXCron.pm          |  2 +-
 perl/DXLogPrint.pm      |  2 +-
 perl/DXProt.pm          |  2 +-
 perl/Spot.pm            |  2 +-
 25 files changed, 39 insertions(+), 106 deletions(-)
 delete mode 100644 cmd/unset/registered.pl

diff --git a/Changes b/Changes
index 3ed25f8b..19401341 100644
--- 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 ad81feb6..3351334f 100644
--- 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 dce7b49c..0b97a662 100644
--- 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 d069f976..30b1f879 100644
--- 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 6b01d206..f4ae651f 100644
--- 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 4f71c13e..a7ee33d5 100644
--- 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 85e3fe2b..aaa9d4cf 100644
--- 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 1964a23a..29568f4b 100644
--- 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 4ad679d2..bc3153ef 100644
--- 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 cefae9dc..65b636d4 100644
--- 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 2abe8257..fa8806c2 100644
--- 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 df64298b..0143b290 100644
--- 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 4876aea2..6b930be2 100644
--- 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 2fef50d4..de04d93e 100644
--- 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 6b3c4ea9..4adeb726 100644
--- 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 22001a63..9d8ffdf9 100644
--- 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 38c584a8..cd2f1d0b 100644
--- 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 807b88fd..62f04b18 100644
--- 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
index 4876aea2..00000000
--- 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 84585ef1..dcd7b909 100644
--- 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 2c49fabe..46d2b1d3 100644
--- 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 adeff216..c8b17273 100644
--- 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 92deee42..a6d074a6 100644
--- 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 bf2d5ed3..9f4f3840 100644
--- 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 24124f5a..056fd628 100644
--- 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`;
-- 
2.34.1