--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/me8100_test_perl/ME8100.pm Thu Jan 24 17:51:57 2002 +0100
@@ -0,0 +1,87 @@
+package ME8100;
+
+# (c) 2002 Heiko Schlittermann
+
+use strict;
+use Fcntl;
+use IO::File;
+use IO::Select;
+use Carp;
+
+my %Objects = ();
+
+# 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 ...
+#
+$SIG{IO} = sub {
+ my $val;
+ warn "Got Signal $_[0]\n";
+
+ 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};
+
+ my $val;
+ $fd->sysread($val, 2) or carp("sysread(): $!\n");
+ $object->{inputs}->[$idx] = $val;
+ }
+
+};
+
+
+# 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).
+# The order depends on the order the device names are passed
+# to the new() method;
+
+sub new {
+ my $self = {};
+ my $class = shift;
+ bless $self, $class;
+
+ my (@fds, @inputs);
+ my $idx = 0;
+ foreach my $device (@_) {
+ my ($flags, $val);
+ my $fd = new IO::File($device, "r")
+ or croak("open($device): $!\n");
+
+ fcntl($fd, F_SETOWN, $$) or croak "Can't set owner: $!\n";
+ $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);
+
+ push @inputs, $val;
+ push @fds, $fd;
+
+ ++$idx;
+ }
+
+ $self->{fds} = [@fds];
+ $self->{inputs} = [@inputs];
+
+ return $self;
+}
+
+sub read {
+ my $self = shift;
+ return split //, unpack("b*", join("", @{$self->{inputs}}));
+}
+
+sub DESTROY
+{
+ my $self = shift;
+ delete @Objects{ @{$self->{fds}} };
+}
+
+
+1;
+# vim:sts=4 sw=4 aw ai sm:
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/me8100_test_perl/Makefile Thu Jan 24 17:51:57 2002 +0100
@@ -0,0 +1,12 @@
+bin_SCRIPTS = test
+
+.PHONY: all clean
+
+all: $(bin_SCRIPTS)
+clean:
+ -rm -f $(bin_SCRIPTS)
+
+%: %.pl
+ perl -c $<
+ cp -f $< $@
+ chmod +x $@
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/me8100_test_perl/test.pl Thu Jan 24 17:51:57 2002 +0100
@@ -0,0 +1,18 @@
+#! /usr/bin/perl -w
+
+use ME8100;
+
+my @DEVICES = ("/dev/me8100_0a");
+
+MAIN: {
+ my $me8100 = new ME8100(@DEVICES);
+
+ while (1) {
+ my @a = $me8100->read();
+ print "@a\n";
+ sleep(1);
+ }
+
+}
+
+# vim:sts=4 sw=4 aw ai sm: