diff -r df25c194e3ce -r 1ad7e54c3dc4 me8100_test_perl/ME8100.pm --- 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