diff -r 4516904df6b3 -r df25c194e3ce me8100_test_perl/ME8100.pm --- a/me8100_test_perl/ME8100.pm Sat Jan 26 18:02:03 2002 +0100 +++ b/me8100_test_perl/ME8100.pm Sat Jan 26 19:46:15 2002 +0100 @@ -10,45 +10,41 @@ my %Objects = (); +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"; +} + # If an interrupt occurs, we've to search for the file descriptor(s) -# that caused the interrupt. The file descriptor(s) should in turn -# point us the the proper me8100 object ... -# +# 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); - foreach my $fd (@ready) { - my $current = $Objects{$fd}; - my $idx = $current->{idx}; - my $object = $current->{object}; - - #$object->_read($fd); + print "May read on fds: @ready\n"; - warn "read ", $fd->fileno(), "\n"; - - my $val; - $fd->sysread($val, 2) or carp("sysread(): $!\n"); - $object->{inputs}->[$idx] = $val; - $object->{changed} = 1; + foreach (@ready) { + my $object = $Objects{$_}->{object}; + my $fd = $Objects{$_}->{fd}; + $object->_read($fd); } - #kill("ALRM", $$); warn "done signal\n"; }; -sub _read { - my $self = shift; - my $fd = shift; - warn "read from ", $fd->fileno(), "\n"; -} - - - # Create a new object. Open all the named devices (read only) # and read the current values (as the driver guarantees the # very first read to succeed). @@ -61,6 +57,7 @@ bless $self, $class; my (@fds, @inputs); + my %idx = (); my $idx = 0; foreach my $device (@_) { my ($flags, $val); @@ -71,35 +68,51 @@ $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} = { fd => $fd, idx => $idx, object => $self }; $fd->sysread($val, 2); + $Objects{$fd} = { object => $self, fd => $fd }; + $idx{$fd} = $idx; push @inputs, $val; push @fds, $fd; ++$idx; } - $self->{fds} = [@fds]; - $self->{inputs} = [@inputs]; + $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->{changed} = 1; return $self; } +sub _read { + my ($self, $fd) = @_; + my $val; + + my $idx = $self->{idx}->{$fd}; + $self->{fds}->[$idx]->sysread($val, 2) or carp("sysread(): $!\n"); + $self->{inputs}->[$idx] = $val; +} + sub read { - my $self = shift; - my $timeout = shift; + my ($self, $timeout) = @_; + + local $SIG{IO} = sub { warn "*** SIG $_[0] diverted\n" }; + my @ready = $self->{select}->can_read($timeout); + + if (!@ready) { + warn "select() returned nothing: $!\n"; + return undef; + } + + foreach (@ready) { + $self->_read($_); + } return split //, unpack("b*", join("", @{$self->{inputs}})); } -sub changed { - my $self; - return $self->{changed}; -} - sub DESTROY { my $self = shift;