--- 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