[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";
}