.
--- a/me8100.c Sat Jan 26 18:02:03 2002 +0100
+++ b/me8100.c Sat Jan 26 19:46:15 2002 +0100
@@ -2322,8 +2322,8 @@
int me8100_read_proc(char *buffer, char **start, off_t offset, int count, int *eof, void *data)
{
int len = 0;
- len += sprintf(buffer + len, VERSION_H);
- len += sprintf(buffer + len, VERSION_C);
+ len += sprintf(buffer + len, "Version: " VERSION_H);
+ len += sprintf(buffer + len, "Version: " VERSION_C);
*eof = 1;
return len;
}
--- 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;
--- a/me8100_test_perl/Makefile Sat Jan 26 18:02:03 2002 +0100
+++ b/me8100_test_perl/Makefile Sat Jan 26 19:46:15 2002 +0100
@@ -6,6 +6,8 @@
clean:
-rm -f $(bin_SCRIPTS)
+test: test.pl ME8100.pm
+
%: %.pl
perl -c $<
cp -f $< $@
--- a/me8100_test_perl/test.pl Sat Jan 26 18:02:03 2002 +0100
+++ b/me8100_test_perl/test.pl Sat Jan 26 19:46:15 2002 +0100
@@ -9,7 +9,8 @@
while (1) {
my @a = $me8100->read(); # should block
- print "read: @a\n";
+ print "** <@a> **\n";
+ sleep(1000);
}
}