[LON-CAPA-cvs] cvs: modules /gerd/scantron scantronserver.pl

www lon-capa-cvs@mail.lon-capa.org
Mon, 24 May 2004 21:26:08 -0000


www		Mon May 24 17:26:08 2004 EDT

  Modified files:              
    /modules/gerd/scantron	scantronserver.pl 
  Log:
  Requires autoconnect option c5 on device server.
  
  Tests for scanner being online and ready before sending commands over.
  
  
  
Index: modules/gerd/scantron/scantronserver.pl
diff -u modules/gerd/scantron/scantronserver.pl:1.1 modules/gerd/scantron/scantronserver.pl:1.2
--- modules/gerd/scantron/scantronserver.pl:1.1	Sun May 23 20:11:48 2004
+++ modules/gerd/scantron/scantronserver.pl	Mon May 24 17:26:07 2004
@@ -1,5 +1,5 @@
 use strict;
-use POSIX qw(:sys_wait_h);
+use POSIX;
 use IO::Socket;
 my $server_port=5664;
 my $server=IO::Socket::INET->new(LocalPort => $server_port,
@@ -26,6 +26,10 @@
     } else {
 	exit;
     }
+    $SIG{ALRM}=sub {
+	print "\n$$: Timed out";
+	exit;
+    };
     my $hostname;
     my $clientip;
     if (defined($iaddr)) {
@@ -33,15 +37,24 @@
 	$hostname=gethostbyaddr($iaddr,AF_INET);
     }
     print "\n$$: Connected $hostname $clientip\n";
-    print $client "0\n";
-    while (my $garbage=<$client>) {
-	if ($garbage=~/\w/) { last; }
+    my $status='';
+# See if scanner is online, else hang up
+    alarm(5);
+    print $client "q\n";
+    read($client,$status,3);
+# Disconnect after two hours of inactivity
+    alarm(7200);
+    my $binstatus=unpack('b*',$status);
+    unless (substr($binstatus,15,1) eq '1') {
+	print "Scanner not ready: $binstatus\n";
+    } else {
+	print "Scanner ready\n";
     }
-    print "Communicating\n";
-# Put into escrow mode
-    print $client "e\n";
+# Reset scanner, put into escrow mode
+    print $client "0\ne\n";
     while (my $line=<$client>) {
 	&analyse($client,$line);
+	alarm(7200);
     }
     print "\n$$: Disconnect $hostname $clientip\n";
     exit;                                   # child leaves
@@ -52,6 +65,6 @@
 #
 sub analyse {
     my ($client,$data)=@_;
-    print "\nData: $data";
+    print "\nData: ".pack('h',$data)."\n";
     print $client "3\n";
 }