.
authorheiko
Sat, 26 Jan 2002 19:46:15 +0100
changeset 28 df25c194e3ce
parent 27 4516904df6b3
child 29 1ad7e54c3dc4
.
me8100.c
me8100_test_perl/ME8100.pm
me8100_test_perl/Makefile
me8100_test_perl/test.pl
--- 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);
     }
 
 }