--- a/me8100_test_perl/ME8100.pm	Sat Jan 26 19:46:15 2002 +0100
+++ b/me8100_test_perl/ME8100.pm	Mon Jan 28 16:33:37 2002 +0100
@@ -1,5 +1,18 @@
 package ME8100;
 
+=head1 ME8100
+    
+    ME8100 - a perl interface to the me8100 driver (Meilhaus Digital I/O)
+
+=head1 SYNOPSIS
+
+    use ME8100;
+    $me8100 = new ME8100 qw(/dev/me8100_0a /dev/me8100_0b);
+
+=cut
+
+
+
 # (c) 2002 Heiko Schlittermann
 
 use strict;
@@ -10,40 +23,15 @@
 
 my %Objects = ();
 
+sub sigiohandler($);
+
 if (defined $SIG{IO}) {
     die "SIG IO is already defined.  Since we won't disturb your application\n"
-      . "we decied to refuse loading this module.  Sorry\n";
+      . "we decided to refuse loading this module.  Sorry\n";
 }
 
-# If an interrupt occurs, we've to search for the file descriptor(s)
-# that caused the interrupt.  This is done by a lookup in the module global
-# %Objects hash.  ("fd" -> { fd => XXX, object => XXXX })
-
-$SIG{IO} = sub { 
-    my $val;
-    warn "Got signal $_[0]\n";
-
-    # I do some magic(?) here, since the key isn't usable a a refence
-    # anymore, we stored the reference itself behind the key, as well
-    # as the object reference...
-    
-
-    # Now a race condition might occur.  It's possible that an other
-    # select() runs too (called in the read() method).
-    my $select = new IO::Select(map { $Objects{$_}->{fd} } keys %Objects);
-    my @ready = $select->can_read(0);
-
-    print "May read on fds: @ready\n";
-
-    foreach (@ready) {
-	my $object = $Objects{$_}->{object};
-	my $fd = $Objects{$_}->{fd};
-	$object->_read($fd);
-    }
-
-    warn "done signal\n";
-
-};
+my $gotSignal = 0;
+$SIG{IO} = \&sigiohandler;
 
 # Create a new object. Open all the named devices (read only)
 # and read the current values (as the driver guarantees the
@@ -59,6 +47,8 @@
     my (@fds, @inputs);
     my %idx = ();
     my $idx = 0;
+    my $inputBits = "";
+
     foreach my $device (@_) {
 	my ($flags, $val);
 	my $fd = new IO::File($device, "r")
@@ -68,11 +58,9 @@
 	$flags = fcntl($fd, F_GETFL, 0) or croak "Can't get flags: $!\n";
 	fcntl($fd, F_SETFL, $flags | O_ASYNC) or croak "Can't set flags: $!\n";
 
-	$fd->sysread($val, 2);
-
 	$Objects{$fd} = { object => $self, fd => $fd };
 	$idx{$fd} = $idx;
-	push @inputs, $val;
+	vec($inputBits, $idx, 16) = 0x0;
 	push @fds, $fd;
 
 	++$idx;
@@ -80,37 +68,104 @@
 
     $self->{idx} = {%idx};	    # fd -> index in input word array
     $self->{fds} = [@fds];	    # list of fds
-    $self->{inputs} = [@inputs];    # array of input words
     $self->{select} = new IO::Select(@fds);
 
+    $self->{inputBits} = $inputBits;
+    $self->{oldBits} = "";		
+    $self->{changedBits} = "";
+
+    $self->{changed} = undef;
+
     return $self;
 }
 
+# Read *really* from the board and store the result at the proper
+# element of our @inputs array.
 sub _read {
-    my ($self, $fd) = @_;
-    my $val;
+    my ($self, @fds) = @_;
+    my $val;	# bit0-7 bit8-15
 
-    my $idx = $self->{idx}->{$fd};
-    $self->{fds}->[$idx]->sysread($val, 2) or carp("sysread(): $!\n");
-    $self->{inputs}->[$idx] = $val;
+    foreach my $fd (@fds) {
+	my $idx = $self->{idx}->{$fd};
+	$self->{fds}->[$idx]->sysread($val, 2) or carp("sysread(): $!\n");
+	vec($self->{inputBits}, $idx, 16) = unpack("n2", $val);
+    }
+
+    # Now get the difference between the old bits and the current values...
+    # and then add these values to the array containing the change counters
+    my $changedBits = $self->{inputBits} ^ $self->{oldBits};
+    my @changed = split //, unpack("b*", $changedBits);
+
+    $self->{changedBits} |= $changedBits;
+    for (my $i = 0; $i < $#changed; ++$i) {
+	$self->{changed}->[$i] += $changed[$i];
+    }
+
 }
 
+# This functions should read a set of values from the board.  But: a race
+# condition might occur: while we're waiting for the select() to complete,
+# the SIGIO might be catched.  Both, SIGIO as well as the suddenly succeeding
+# select() indicate a possible successful read... But only one of them will
+# be successful!
 sub read {
     my ($self, $timeout) = @_;
 
-    local $SIG{IO} = sub { warn "*** SIG $_[0] diverted\n" };
-    my @ready = $self->{select}->can_read($timeout);
+    {
+	local $SIG{IO} = sub { $gotSignal = $_[0] };
+	my @ready = $self->{select}->can_read($timeout);
 
-    if (!@ready) {
-	warn "select() returned nothing: $!\n";
-	return undef;
+	if (!@ready) {
+	    warn "select() returned nothing: $!\n";
+	    return undef;
+	}
+
+	$self->_read(@ready);
     }
 
+    $gotSignal and sigiohandler($gotSignal);
+    $self->{oldBits} = $self->{inputBits};
+    return split //, unpack("b*", $self->{inputBits});
+}
+
+sub status {
+    my $self = shift;
+    return split //, unpack("b*", $self->{inputBits});
+}
+
+# If an interrupt occurs, we've to search for the file descriptor(s)
+# that caused the interrupt.  This is done by a lookup in the module global
+# %Objects hash.  ("fd" -> { fd => XXX, object => XXXX })
+sub sigiohandler($) { 
+    my $signal = shift;
+
+    # I do some magic(?) here, since the key isn't usable a a refence
+    # anymore, we stored the reference itself behind the key, as well
+    # as the object reference...
+    
+
+    # Now a race condition might occur.  It's possible that an other
+    # select() runs too (called in the read() method).
+    my $select = new IO::Select(map { $Objects{$_}->{fd} } keys %Objects);
+    my @ready = $select->can_read(0);
+
     foreach (@ready) {
-	$self->_read($_);
+	my $object = $Objects{$_}->{object};
+	my $fd = $Objects{$_}->{fd};
+	$object->_read($fd);
     }
+    $gotSignal = 0;
+};
 
-    return split //, unpack("b*", join("", @{$self->{inputs}}));
+sub changed {
+    my $self = shift;
+    return @{$self->{changed}} if wantarray;
+
+    my $r;
+    foreach (@{$self->{changed}}) {
+	$r += $_;
+    }
+    return $r;
 }
 
 sub DESTROY

--- a/me8100_test_perl/test.pl	Sat Jan 26 19:46:15 2002 +0100
+++ b/me8100_test_perl/test.pl	Mon Jan 28 16:33:37 2002 +0100
@@ -3,15 +3,22 @@
 use ME8100;
 
 my @DEVICES = qw(/dev/me8100_0a /dev/me8100_0b);
+my @INPUTS = qw(Tür1 Tür2 Feuerlöscher);
+
 
 MAIN: {
     my $me8100 = new ME8100(@DEVICES);
+    my %inputs;
 
-    while (1) { 
-	my @a = $me8100->read();    # should block
-	print "** <@a> **\n";
-	sleep(1000);
-    }
+    # first read will be always go through
+    @inputs{@INPUTS} = $me8100->read();
+    print "Read:\n";
+    print map { sprintf "%20s: %d\n", $_, $inputs{$_} } @INPUTS;
+
+    @inputs{@INPUTS} = $me8100->status();
+    print "Status:\n";
+    print map { sprintf "%20s: %d\n", $_, $inputs{$_} } @INPUTS;
+
 
 }