X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fwinclient.pl;h=96898000701d404f4bf75d31d617eed29c809121;hb=refs%2Fheads%2Fnewdisc;hp=cf0da0a2ffef78deeceeac86b0356e9a8e3f64e1;hpb=939f8bb6109d870978d7db849136c8a2aa945e4d;p=spider.git

diff --git a/perl/winclient.pl b/perl/winclient.pl
index cf0da0a2..96898000 100755
--- a/perl/winclient.pl
+++ b/perl/winclient.pl
@@ -1,11 +1,11 @@
-#!/usr/bin/perl -w
+#!/usr/bin/env perl
 # The rudimentary beginnings of a Spider client which is known to run on ActiveState
 # Perl under Win32
 #
 # It's very scrappy, but it *does* do enough to allow SysOp console access. It also
 # means that since it's perl, Dirk might pretty it up a bit :-)
 #
-# $Id$
+#
 #
 # Iain Philipps, G0RDI	03-Mar-01
 #
@@ -28,7 +28,10 @@ BEGIN {
 
 use IO::Socket;
 use DXVars;
+use SysVar;
+
 use IO::File;
+use Config;
 
 #
 # deal with args
@@ -64,40 +67,67 @@ unless ($handle) {
 	exit(0);
 }
 
-# Fork one in / one out .....
+STDOUT->autoflush(1);
+$handle->autoflush(1);
+print $handle "A$call|local\n";
+
+# Fork or thread one in / one out .....
 my $childpid;
-die "can't fork: $!" unless defined($childpid = fork());
+my $t;
+if ($Config{usethreads}) {
+	require Thread;
+#	print "Using Thread Method\n";
+	$t = Thread->new(\&dostdin);
+	donetwork();
+	$t->join;
+	kill(-1, $$);
+} else {
+#	print "Using Fork Method\n";
+	die "can't fork: $!" unless defined($childpid = fork());	
+	if ($childpid) {
+		donetwork();
+		kill 'TERM', $childpid;
+	} else {
+		dostdin();
+	}
+}
+exit 0;
 
-# the communication .....
-if ($childpid) {
-	my ($lastend, $end);
+
+sub donetwork
+{
+	my ($lastend, $end) = ("\n", "\n");
 	
-	STDOUT->autoflush(1);
     while (defined (my $msg = <$handle>)) {
 		my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
+		next unless defined $sort;
+		$line =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
 		if ($sort eq 'Z') {
-			kill 'TERM', $childpid;
+			return;
 		} elsif ($sort eq 'E' || $sort eq 'B') {
 			;
 		} else {
 			# newline ends all lines except a prompt
 			$lastend = $end;
 			$end = "\n";
-			if ($line =~ /^$call de $mycall\s+\d+-\w\w\w-\d+\s+\d+Z >$/) {
+			if ($line =~ /^$call de $mycall\s+\d+-\w\w\w-\d+\s+\d+Z >$/o) {
 				$end = ' ';
 			}
 			my $begin = ($lastend eq "\n") ? '' : "\n";
 			print $begin . $line . $end;
 		}
     }
-    kill 'TERM', $childpid;
-} else {
-	$handle->autoflush(1);
-	print $handle "A$call|local\n";
+}
+
+sub dostdin
+{
     while (defined (my $line = <STDIN>)) {
         print $handle "I$call|$line\n";
+		if ($t && ($line =~ /^b/i || $line =~ /^q/i)) {
+			return;
+		}
     }
 }
 
-exit 0;
+