# HG changeset patch
# User heiko
# Date 1011894729 -3600
# Node ID a486940be0fb316453c5fd3c1ad4c0823f9b7067
# Parent  b95a08e3a04fbc185c63042af12535b8a3243fa2
read blocking/nonblocking ?

diff -r b95a08e3a04f -r a486940be0fb me8100_test_perl/ME8100.pm
--- a/me8100_test_perl/ME8100.pm	Thu Jan 24 17:51:57 2002 +0100
+++ b/me8100_test_perl/ME8100.pm	Thu Jan 24 18:52:09 2002 +0100
@@ -16,7 +16,8 @@
 #
 $SIG{IO} = sub { 
     my $val;
-    warn "Got Signal $_[0]\n";
+    warn "Got signal $_[0]\n";
+    return;
 
     my $select = new IO::Select(map { $Objects{$_}->{fd} } keys %Objects);
     my @ready = $select->can_read(0);
@@ -26,11 +27,16 @@
 	my $idx = $current->{idx};
 	my $object = $current->{object};
 
+	warn "read ", $fd->fileno(), "\n";
+
 	my $val;
 	$fd->sysread($val, 2) or carp("sysread(): $!\n");
 	$object->{inputs}->[$idx] = $val;
+	$object->{changed} = 1;
     }
 
+    warn "done signal\n";
+
 };
 
 
@@ -67,15 +73,41 @@
 
     $self->{fds} = [@fds];
     $self->{inputs} = [@inputs];
+    $self->{select} = new IO::Select(@fds);
+    $self->{changed} = 1;
 
     return $self;
 }
 
 sub read {
     my $self = shift;
+    my $timeout = shift;
+
+    if (!$self->{irq_seen}) {
+	# This might be a race with the signal handler above,
+	# thus we'll have to really read if select returns, as
+	# we can't know for sure if the signal handler did it already.
+	warn "select() w/ timeout " 
+	    . (defined($timeout) ? $timeout : " undef") . "\n";
+	my @fds = $self->{select}->can_read($timeout);
+	warn "done select()\n";
+	foreach my $fd (@fds) {
+	    my $val;
+	    $fd->sysread($val, 2)
+		or croak("sysread(): $!\n");
+	    $self->{inputs}->[$Objects{$fd}->{idx}] = $val;
+	}
+    } else {
+	$self->{irq_seen} = 0;
+    }
     return split //, unpack("b*", join("", @{$self->{inputs}}));
 }
 
+sub changed {
+    my $self;
+    return $self->{changed};
+}
+
 sub DESTROY
 {
     my $self = shift;
diff -r b95a08e3a04f -r a486940be0fb me8100_test_perl/test.pl
--- a/me8100_test_perl/test.pl	Thu Jan 24 17:51:57 2002 +0100
+++ b/me8100_test_perl/test.pl	Thu Jan 24 18:52:09 2002 +0100
@@ -8,9 +8,8 @@
     my $me8100 = new ME8100(@DEVICES);
 
     while (1) { 
-	my @a = $me8100->read();
-	print "@a\n";
-	sleep(1);
+	my @a = $me8100->read(1);
+	print "read: @a\n";
     }
 
 }