# HG changeset patch
# User heiko
# Date 1011891117 -3600
# Node ID b95a08e3a04fbc185c63042af12535b8a3243fa2
# Parent  d1686272f84d617a90d982713fa2abcef7c0925e
Test script started (perl!)

diff -r d1686272f84d -r b95a08e3a04f me8100_test_perl/ME8100.pm
--- /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:
diff -r d1686272f84d -r b95a08e3a04f me8100_test_perl/Makefile
--- /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 $@
diff -r d1686272f84d -r b95a08e3a04f me8100_test_perl/test.pl
--- /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: