# HG changeset patch
# User heiko
# Date 1012391202 -3600
# Node ID e0b741bb5ce0ecf171db5ca13afed0bfdd31804d
# Parent  33280ad0f4b2a78b8bcc129b50c787ae80b8d0ec
Hm - getestet und scheint so etwas zu funktionieren.

diff -r 33280ad0f4b2 -r e0b741bb5ce0 me8100_test_perl/ME8100.pm
--- a/me8100_test_perl/ME8100.pm	Mon Jan 28 22:23:55 2002 +0100
+++ b/me8100_test_perl/ME8100.pm	Wed Jan 30 12:46:42 2002 +0100
@@ -12,12 +12,12 @@
 my $gotSignal = 0;
 my $opt_async = 0;
 
-sub iohandler($);
+sub _iohandler($);
 sub import { $opt_async = grep { /^:async/ } @_; }
 
 # Install the signal handler only if we have passed the ':async' tag
 # to the module...
-INIT { $SIG{IO} = \&iohandler if $opt_async; }
+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
@@ -59,7 +59,7 @@
 
     $self->{bits} = $idx * 16;
     $self->{inputBits} = $inputBits;
-    $self->{oldBits} = "";		
+    $self->{oldBits} = undef;		
     $self->{changedBits} = "";
 
     $self->{changed} = [split //, "0" x $self->{bits} ];
@@ -73,11 +73,11 @@
     # the suddenly succeeding select() indicate a possible successful
     # read... But only one of them will be successful!
 
-    my ($self, $timeout) = @_;
+    my ($self, %args) = @_;
 
     {
 	local $SIG{IO} = sub { $gotSignal = $_[0] } if $opt_async;
-	my @ready = $self->{select}->can_read($timeout);
+	my @ready = $self->{select}->can_read($args{timeout});
 
 	if (!@ready) {
 	    warn "select() returned nothing: $!\n";
@@ -87,9 +87,7 @@
 	$self->_read(@ready);
     }
 
-    $gotSignal and iohandler($gotSignal);
-    $self->{changedBits} = "";
-    $self->{changed} = [ split //, "0" x $self->{bits} ];
+    $gotSignal and _iohandler($gotSignal);
     return split //, unpack("b*", $self->{inputBits});
 }
 
@@ -100,7 +98,7 @@
 
 # Read *really* from the board and store the result at the proper
 # element of our @inputs array.
-sub _read {
+sub _read($@) {
     my ($self, @fds) = @_;
     my $val;	# bit0-7 bit8-15
 
@@ -113,6 +111,7 @@
     # Now get the difference between the old bits and the current values...
     # and then add these values to the array containing the change counters
     
+    $self->{oldBits} = $self->{inputBits} if not defined $self->{oldBits};
     my $changedBits = $self->{inputBits} ^ $self->{oldBits};
 
     my @changed = split //, unpack("b*", $changedBits);
@@ -128,7 +127,7 @@
     $self->{oldBits} = $self->{inputBits};
 }
 
-sub iohandler($) { 
+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 })
@@ -139,9 +138,6 @@
     # 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);
 
@@ -156,20 +152,25 @@
 
 sub changed {
     my $self = shift;
+    my @changed = @{$self->{changed}};
     my $r = 0;
 
-    wantarray and return @{$self->{changed}};
-    foreach (@{$self->{changed}}) {
+    $self->{changedBits} = "";
+    $self->{changed} = [ split //, "0" x $self->{bits} ];
+
+    wantarray and return @changed;
+
+    foreach (@changed) {
 	$r += $_;
     }
     return $r;
 }
 
-sub DESTROY
-{
-    my $self = shift;
-    delete @Objects{ @{$self->{fds}} };
-}
+#sub DESTROY
+#{
+#    my $self = shift;
+#    delete @Objects{ @{$self->{fds} }};
+#}
 
 
 #-- Documenation follows 
@@ -199,7 +200,7 @@
 
 Creates a new ME8100 object connected to all the listed devices.
 
-=item read([I<timeout>])
+=item read(I<[timeout =E<gt> 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
@@ -207,21 +208,22 @@
 
 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.
+Never blocks.  No side effects.
 
 =item changed()
 
-Returns an array containing the number of detected changes per input
-bit.
+In array context returns an array containing the counts of changes
+for every single bit.  In scalar context returns the total number of
+changes.
 
-=item iohandler(I<signal>)
+Every call resets the counter.
+
+=item _iohandler(I<signal>)
 
 For internal use only.
 
diff -r 33280ad0f4b2 -r e0b741bb5ce0 me8100_test_perl/test.pl
--- a/me8100_test_perl/test.pl	Mon Jan 28 22:23:55 2002 +0100
+++ b/me8100_test_perl/test.pl	Wed Jan 30 12:46:42 2002 +0100
@@ -15,23 +15,22 @@
     # first read will be always go through
     @inputs{@INPUTS} = $me8100->read();
 
-    print "Read:\n";
+    print "Read " . localtime() . "\n";
     print map { sprintf "%20s: %d\n", $_, $inputs{$_} } @INPUTS;
 
-    _sleep(10);		   
+    _sleep(10);
 			  
+    @changed{@INPUTS} = $me8100->changed();
     @inputs{@INPUTS} = $me8100->status();
-    print "Status2:\n";
-    print map { sprintf "%20s: %d\n", $_, $inputs{$_} } @INPUTS;
+    print "Status / Changed " . localtime() . "\n";
+    print map { sprintf "%20s: %d %d\n", $_, $inputs{$_}, $changed{$_} } @INPUTS;
 
-    @inputs{@INPUTS} = $me8100->changed();
-    print "Changed:\n";
-    print map { sprintf "%20s: %d\n", $_, $inputs{$_} } @INPUTS;
+    print "\nWating...\n\n";
 
     # and now block 'til the next change...
     @inputs{@INPUTS} = $me8100->read();
     @changed{@INPUTS} = $me8100->changed();
-    print "Finally:\n";
+    print "Status / Changed " . localtime() . "\n";
     print map { sprintf "%20s: %d (%d)\n", $_, $inputs{$_}, $changed{$_} } @INPUTS;
 
 }