--- a/me8100_test_perl/.cvsignore Mon Jan 28 16:33:37 2002 +0100
+++ b/me8100_test_perl/.cvsignore Mon Jan 28 17:18:06 2002 +0100
@@ -1,1 +1,2 @@
+ME8100.3
test
--- a/me8100_test_perl/ME8100.pm Mon Jan 28 16:33:37 2002 +0100
+++ b/me8100_test_perl/ME8100.pm Mon Jan 28 17:18:06 2002 +0100
@@ -1,20 +1,24 @@
package ME8100;
+# (c) 2002 Heiko Schlittermann
-=head1 ME8100
-
+=head1 NAME
+
ME8100 - a perl interface to the me8100 driver (Meilhaus Digital I/O)
=head1 SYNOPSIS
use ME8100;
$me8100 = new ME8100 qw(/dev/me8100_0a /dev/me8100_0b);
+ @bits = $me8100->read();
+ @bits = $me8100->status();
+
+=head1 DESCRIPTION
+
+This module is an interface to the me8100 driver talking with the Meilhaus
+D I/O board ME8100.
=cut
-
-
-# (c) 2002 Heiko Schlittermann
-
use strict;
use Fcntl;
use IO::File;
@@ -33,12 +37,20 @@
my $gotSignal = 0;
$SIG{IO} = \&sigiohandler;
+=over 4
+
+=item new(I<device, ...>);
+
+The C<new()> function creates a new ME8100 object connected to the
+passed devices.
+
+=cut
+
# 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;
@@ -79,6 +91,50 @@
return $self;
}
+=item read([I<timeout>])
+
+Read the input from the devices. This call is guaranteed to succeede
+on the first run, but every following call will block until the status
+of the input changed. (This behaviour is due to the driver.)
+
+A timeout may be passed.
+
+On success an array of the input bits is returned, otherwise undef.
+
+=cut
+
+sub read {
+ # This functions should read a set of values from the board. But: a
+ # race condition might occur: while we're waiting for the select()
+ # to complete, the SIGIO might be catched. Both, SIGIO as well as
+ # the suddenly succeeding select() indicate a possible successful
+ # read... But only one of them will be successful!
+
+ my ($self, $timeout) = @_;
+
+ {
+ local $SIG{IO} = sub { $gotSignal = $_[0] };
+ my @ready = $self->{select}->can_read($timeout);
+
+ if (!@ready) {
+ warn "select() returned nothing: $!\n";
+ return undef;
+ }
+
+ $self->_read(@ready);
+ }
+
+ $gotSignal and sigiohandler($gotSignal);
+ $self->{oldBits} = $self->{inputBits};
+ return split //, unpack("b*", $self->{inputBits});
+}
+
+sub status {
+ my $self = shift;
+ return split //, unpack("b*", $self->{inputBits});
+}
+
+
# Read *really* from the board and store the result at the proper
# element of our @inputs array.
sub _read {
@@ -103,36 +159,6 @@
}
-# This functions should read a set of values from the board. But: a race
-# condition might occur: while we're waiting for the select() to complete,
-# the SIGIO might be catched. Both, SIGIO as well as the suddenly succeeding
-# select() indicate a possible successful read... But only one of them will
-# be successful!
-sub read {
- my ($self, $timeout) = @_;
-
- {
- local $SIG{IO} = sub { $gotSignal = $_[0] };
- my @ready = $self->{select}->can_read($timeout);
-
- if (!@ready) {
- warn "select() returned nothing: $!\n";
- return undef;
- }
-
- $self->_read(@ready);
- }
-
- $gotSignal and sigiohandler($gotSignal);
- $self->{oldBits} = $self->{inputBits};
- return split //, unpack("b*", $self->{inputBits});
-}
-
-sub status {
- my $self = shift;
- return split //, unpack("b*", $self->{inputBits});
-}
-
# If an interrupt occurs, we've to search for the file descriptor(s)
# that caused the interrupt. This is done by a lookup in the module global
# %Objects hash. ("fd" -> { fd => XXX, object => XXXX })
@@ -174,6 +200,15 @@
delete @Objects{ @{$self->{fds}} };
}
+=head1 AUTHOR
+
+Heiko Schlittermann <hs@schlittermann.de>
+
+=head1 COPYRIGHT
+
+The GNU Copyright applies.
+
+=cut
1;
# vim:sts=4 sw=4 aw ai sm:
--- a/me8100_test_perl/Makefile Mon Jan 28 16:33:37 2002 +0100
+++ b/me8100_test_perl/Makefile Mon Jan 28 17:18:06 2002 +0100
@@ -1,14 +1,19 @@
bin_SCRIPTS = test
+man_DATA = ME8100.3
.PHONY: all clean
-all: $(bin_SCRIPTS)
+all: $(bin_SCRIPTS) $(man_DATA)
clean:
- -rm -f $(bin_SCRIPTS)
+ -rm -f $(bin_SCRIPTS) $(man_DATA)
test: test.pl ME8100.pm
-%: %.pl
+%: %.pl Makefile
perl -c $<
cp -f $< $@
chmod +x $@
+
+%.3: %.pm Makefile
+ pod2man --section 3 $< >$@ || rm $@
+ @test -f $@