--- a/me8100_test_perl/ME8100.pm	Mon Jan 28 17:18:06 2002 +0100
+++ b/me8100_test_perl/ME8100.pm	Mon Jan 28 22:23:55 2002 +0100
@@ -1,23 +1,6 @@
 package ME8100;
 # (c) 2002 Heiko Schlittermann
-
-=head1 NAME
-
-    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);
-    @bits = $me8100->read();
-    @bits = $me8100->status();
-
-=head1 DESCRIPTION
-
-This module is an interface to the me8100 driver talking with the Meilhaus
-D I/O board ME8100.
-
-=cut
+# For POD documentation see the end of this file.
 
 use strict;
 use Fcntl;
@@ -26,25 +9,15 @@
 use Carp;
 
 my %Objects = ();
-
-sub sigiohandler($);
-
-if (defined $SIG{IO}) {
-    die "SIG IO is already defined.  Since we won't disturb your application\n"
-      . "we decided to refuse loading this module.  Sorry\n";
-}
+my $gotSignal = 0;
+my $opt_async = 0;
 
-my $gotSignal = 0;
-$SIG{IO} = \&sigiohandler;
-
-=over 4
+sub iohandler($);
+sub import { $opt_async = grep { /^:async/ } @_; }
 
-=item new(I<device, ...>);
-
-The C<new()> function creates a new ME8100 object connected to the
-passed devices.
-
-=cut
+# Install the signal handler only if we have passed the ':async' tag
+# to the module...
+INIT { $SIG{IO} = \&iohandler if $opt_async; }
 
 # Create a new object. Open all the named devices (read only)
 # and read the current values (as the driver guarantees the
@@ -66,9 +39,11 @@
 	my $fd = new IO::File($device, "r")
 	    or croak("open($device): $!\n");
 
-	fcntl($fd, F_SETOWN, $$) or croak "Can't set owner: $!\n";
-	$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";
+	if ($opt_async) {
+	    fcntl($fd, F_SETOWN, $$) or croak "Can't set owner: $!\n";
+	    $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";
+	}
 
 	$Objects{$fd} = { object => $self, fd => $fd };
 	$idx{$fd} = $idx;
@@ -82,27 +57,15 @@
     $self->{fds} = [@fds];	    # list of fds
     $self->{select} = new IO::Select(@fds);
 
+    $self->{bits} = $idx * 16;
     $self->{inputBits} = $inputBits;
     $self->{oldBits} = "";		
     $self->{changedBits} = "";
 
-    $self->{changed} = undef;
-
+    $self->{changed} = [split //, "0" x $self->{bits} ];
     return $self;
 }
 
-=item read([I<timeout>])
-
-Read the input from the devices.  This call is guaranteed to succeede
-on the first run, but every following call will block until the status
-of the input changed.  (This behaviour is due to the driver.)
-
-A timeout may be passed.
-
-On success an array of the input bits is returned, otherwise undef.
-
-=cut
-
 sub read {
     # This functions should read a set of values from the board.  But: a
     # race condition might occur: while we're waiting for the select()
@@ -113,7 +76,7 @@
     my ($self, $timeout) = @_;
 
     {
-	local $SIG{IO} = sub { $gotSignal = $_[0] };
+	local $SIG{IO} = sub { $gotSignal = $_[0] } if $opt_async;
 	my @ready = $self->{select}->can_read($timeout);
 
 	if (!@ready) {
@@ -124,8 +87,9 @@
 	$self->_read(@ready);
     }
 
-    $gotSignal and sigiohandler($gotSignal);
-    $self->{oldBits} = $self->{inputBits};
+    $gotSignal and iohandler($gotSignal);
+    $self->{changedBits} = "";
+    $self->{changed} = [ split //, "0" x $self->{bits} ];
     return split //, unpack("b*", $self->{inputBits});
 }
 
@@ -134,7 +98,6 @@
     return split //, unpack("b*", $self->{inputBits});
 }
 
-
 # Read *really* from the board and store the result at the proper
 # element of our @inputs array.
 sub _read {
@@ -149,20 +112,27 @@
 
     # 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);
+    #print STDERR "o: ", unpack("b*", $self->{oldBits}), "\n";
+    #print STDERR "n: ", unpack("b*", $self->{inputBits}), "\n";
+    #print STDERR "=: ", @changed, "\n\n";
 
-    $self->{changedBits} |= $changedBits;
     for (my $i = 0; $i < $#changed; ++$i) {
 	$self->{changed}->[$i] += $changed[$i];
     }
 
+    $self->{changedBits} |= $changedBits;
+    $self->{oldBits} = $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($) { 
+sub iohandler($) { 
+    # 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 })
+
     my $signal = shift;
 
     # I do some magic(?) here, since the key isn't usable a a refence
@@ -183,11 +153,12 @@
     $gotSignal = 0;
 };
 
+
 sub changed {
     my $self = shift;
-    return @{$self->{changed}} if wantarray;
+    my $r = 0;
 
-    my $r;
+    wantarray and return @{$self->{changed}};
     foreach (@{$self->{changed}}) {
 	$r += $_;
     }
@@ -200,6 +171,68 @@
     delete @Objects{ @{$self->{fds}} };
 }
 
+
+#-- Documenation follows 
+
+=head1 NAME
+
+    ME8100 - a perl interface to the me8100 driver (Meilhaus Digital I/O)
+
+=head1 SYNOPSIS
+
+    use ME8100;
+or
+    use ME8100 qw/:async/;
+
+    $me8100 = new ME8100 qw(/dev/me8100_0a /dev/me8100_0b);
+    @bits = $me8100->read();
+    @bits = $me8100->status();
+
+=head1 DESCRIPTION
+
+This module is an interface to the me8100 driver talking with the Meilhaus
+D I/O board ME8100.
+
+=over 4
+
+=item new(I<device>,...)
+
+Creates a new ME8100 object connected to all the listed devices.
+
+=item read([I<timeout>])
+
+Read the input from the devices.  This call is guaranteed to succeede
+on the first run, but every following call will block until the status
+of the input changed.  (This behaviour is due to the driver.)
+
+A timeout may be passed.
+
+Every read() resets the register for obtaining the changed bits.
+
+On success an array of the input bits is returned, otherwise undef.
+
+=item status()
+
+Returns an array with the current status of all input bits.
+Never blocks.
+
+=item changed()
+
+Returns an array containing the number of detected changes per input
+bit.
+
+=item iohandler(I<signal>)
+
+For internal use only.
+
+=item _read()
+
+For internal use only.
+
+=item DESTROY()
+
+For internal use only.
+
 =head1 AUTHOR
 
 Heiko Schlittermann <hs@schlittermann.de>

--- a/me8100_test_perl/test.pl	Mon Jan 28 17:18:06 2002 +0100
+++ b/me8100_test_perl/test.pl	Mon Jan 28 22:23:55 2002 +0100
@@ -1,25 +1,48 @@
 #! /usr/bin/perl -w
 
-use ME8100;
+use ME8100 qw/:async/;
 
 my @DEVICES = qw(/dev/me8100_0a /dev/me8100_0b);
 my @INPUTS = qw(Tür1 Tür2 Feuerlöscher);
 
+sub _sleep($);
+
 
 MAIN: {
     my $me8100 = new ME8100(@DEVICES);
-    my %inputs;
+    my (%inputs, %changed);
 
     # first read will be always go through
     @inputs{@INPUTS} = $me8100->read();
+
     print "Read:\n";
     print map { sprintf "%20s: %d\n", $_, $inputs{$_} } @INPUTS;
 
+    _sleep(10);		   
+			  
     @inputs{@INPUTS} = $me8100->status();
-    print "Status:\n";
+    print "Status2:\n";
     print map { sprintf "%20s: %d\n", $_, $inputs{$_} } @INPUTS;
 
+    @inputs{@INPUTS} = $me8100->changed();
+    print "Changed:\n";
+    print map { sprintf "%20s: %d\n", $_, $inputs{$_} } @INPUTS;
+
+    # and now block 'til the next change...
+    @inputs{@INPUTS} = $me8100->read();
+    @changed{@INPUTS} = $me8100->changed();
+    print "Finally:\n";
+    print map { sprintf "%20s: %d (%d)\n", $_, $inputs{$_}, $changed{$_} } @INPUTS;
 
 }
 
+# Sleep replacement, since the standard sleep 
+# gets awoken on every signal
+sub _sleep($) {
+    my $timeout = shift;
+    while ($timeout > 0) {
+	$timeout -= sleep($timeout);
+    }
+}
+
 # vim:sts=4 sw=4 aw ai sm: