# HG changeset patch
# User heiko
# Date 1011990697 -3600
# Node ID 984e6da93d95ec55bd3b9054f58e941ae69f1931
# Parent  24a49943680f5ff51e5726538e5863153c692363
Freitag

diff -r 24a49943680f -r 984e6da93d95 me8100_test_perl/ME8100.pm
--- a/me8100_test_perl/ME8100.pm	Fri Jan 25 20:26:39 2002 +0100
+++ b/me8100_test_perl/ME8100.pm	Fri Jan 25 21:31:37 2002 +0100
@@ -17,7 +17,6 @@
 $SIG{IO} = sub { 
     my $val;
     warn "Got signal $_[0]\n";
-    return;
 
     my $select = new IO::Select(map { $Objects{$_}->{fd} } keys %Objects);
     my @ready = $select->can_read(0);
@@ -27,6 +26,8 @@
 	my $idx = $current->{idx};
 	my $object = $current->{object};
 
+	#$object->_read($fd);
+
 	warn "read ", $fd->fileno(), "\n";
 
 	my $val;
@@ -35,10 +36,18 @@
 	$object->{changed} = 1;
     }
 
+    #kill("ALRM", $$);
     warn "done signal\n";
 
 };
 
+sub _read {
+    my $self = shift;
+    my $fd = shift;
+    warn "read from ", $fd->fileno(), "\n";
+}
+
+
 
 # Create a new object. Open all the named devices (read only)
 # and read the current values (as the driver guarantees the
@@ -83,23 +92,6 @@
     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}}));
 }
 
diff -r 24a49943680f -r 984e6da93d95 me8100_test_perl/test.pl
--- a/me8100_test_perl/test.pl	Fri Jan 25 20:26:39 2002 +0100
+++ b/me8100_test_perl/test.pl	Fri Jan 25 21:31:37 2002 +0100
@@ -2,13 +2,13 @@
 
 use ME8100;
 
-my @DEVICES = ("/dev/me8100_0a");
+my @DEVICES = qw(/dev/me8100_0a /dev/me8100_0b);
 
 MAIN: {
     my $me8100 = new ME8100(@DEVICES);
 
     while (1) { 
-	my @a = $me8100->read(1);
+	my @a = $me8100->read();    # should block
 	print "read: @a\n";
     }