1 package ME8100; |
1 package ME8100; |
2 |
2 # (c) 2002 Heiko Schlittermann |
3 =head1 ME8100 |
3 |
4 |
4 =head1 NAME |
|
5 |
5 ME8100 - a perl interface to the me8100 driver (Meilhaus Digital I/O) |
6 ME8100 - a perl interface to the me8100 driver (Meilhaus Digital I/O) |
6 |
7 |
7 =head1 SYNOPSIS |
8 =head1 SYNOPSIS |
8 |
9 |
9 use ME8100; |
10 use ME8100; |
10 $me8100 = new ME8100 qw(/dev/me8100_0a /dev/me8100_0b); |
11 $me8100 = new ME8100 qw(/dev/me8100_0a /dev/me8100_0b); |
11 |
12 @bits = $me8100->read(); |
12 =cut |
13 @bits = $me8100->status(); |
13 |
14 |
14 |
15 =head1 DESCRIPTION |
15 |
16 |
16 # (c) 2002 Heiko Schlittermann |
17 This module is an interface to the me8100 driver talking with the Meilhaus |
|
18 D I/O board ME8100. |
|
19 |
|
20 =cut |
17 |
21 |
18 use strict; |
22 use strict; |
19 use Fcntl; |
23 use Fcntl; |
20 use IO::File; |
24 use IO::File; |
21 use IO::Select; |
25 use IO::Select; |
31 } |
35 } |
32 |
36 |
33 my $gotSignal = 0; |
37 my $gotSignal = 0; |
34 $SIG{IO} = \&sigiohandler; |
38 $SIG{IO} = \&sigiohandler; |
35 |
39 |
|
40 =over 4 |
|
41 |
|
42 =item new(I<device, ...>); |
|
43 |
|
44 The C<new()> function creates a new ME8100 object connected to the |
|
45 passed devices. |
|
46 |
|
47 =cut |
|
48 |
36 # Create a new object. Open all the named devices (read only) |
49 # Create a new object. Open all the named devices (read only) |
37 # and read the current values (as the driver guarantees the |
50 # and read the current values (as the driver guarantees the |
38 # very first read to succeed). |
51 # very first read to succeed). |
39 # The order depends on the order the device names are passed |
52 # The order depends on the order the device names are passed |
40 # to the new() method; |
53 # to the new() method; |
41 |
|
42 sub new { |
54 sub new { |
43 my $self = {}; |
55 my $self = {}; |
44 my $class = shift; |
56 my $class = shift; |
45 bless $self, $class; |
57 bless $self, $class; |
46 |
58 |
76 |
88 |
77 $self->{changed} = undef; |
89 $self->{changed} = undef; |
78 |
90 |
79 return $self; |
91 return $self; |
80 } |
92 } |
|
93 |
|
94 =item read([I<timeout>]) |
|
95 |
|
96 Read the input from the devices. This call is guaranteed to succeede |
|
97 on the first run, but every following call will block until the status |
|
98 of the input changed. (This behaviour is due to the driver.) |
|
99 |
|
100 A timeout may be passed. |
|
101 |
|
102 On success an array of the input bits is returned, otherwise undef. |
|
103 |
|
104 =cut |
|
105 |
|
106 sub read { |
|
107 # This functions should read a set of values from the board. But: a |
|
108 # race condition might occur: while we're waiting for the select() |
|
109 # to complete, the SIGIO might be catched. Both, SIGIO as well as |
|
110 # the suddenly succeeding select() indicate a possible successful |
|
111 # read... But only one of them will be successful! |
|
112 |
|
113 my ($self, $timeout) = @_; |
|
114 |
|
115 { |
|
116 local $SIG{IO} = sub { $gotSignal = $_[0] }; |
|
117 my @ready = $self->{select}->can_read($timeout); |
|
118 |
|
119 if (!@ready) { |
|
120 warn "select() returned nothing: $!\n"; |
|
121 return undef; |
|
122 } |
|
123 |
|
124 $self->_read(@ready); |
|
125 } |
|
126 |
|
127 $gotSignal and sigiohandler($gotSignal); |
|
128 $self->{oldBits} = $self->{inputBits}; |
|
129 return split //, unpack("b*", $self->{inputBits}); |
|
130 } |
|
131 |
|
132 sub status { |
|
133 my $self = shift; |
|
134 return split //, unpack("b*", $self->{inputBits}); |
|
135 } |
|
136 |
81 |
137 |
82 # Read *really* from the board and store the result at the proper |
138 # Read *really* from the board and store the result at the proper |
83 # element of our @inputs array. |
139 # element of our @inputs array. |
84 sub _read { |
140 sub _read { |
85 my ($self, @fds) = @_; |
141 my ($self, @fds) = @_; |
101 $self->{changed}->[$i] += $changed[$i]; |
157 $self->{changed}->[$i] += $changed[$i]; |
102 } |
158 } |
103 |
159 |
104 } |
160 } |
105 |
161 |
106 # This functions should read a set of values from the board. But: a race |
|
107 # condition might occur: while we're waiting for the select() to complete, |
|
108 # the SIGIO might be catched. Both, SIGIO as well as the suddenly succeeding |
|
109 # select() indicate a possible successful read... But only one of them will |
|
110 # be successful! |
|
111 sub read { |
|
112 my ($self, $timeout) = @_; |
|
113 |
|
114 { |
|
115 local $SIG{IO} = sub { $gotSignal = $_[0] }; |
|
116 my @ready = $self->{select}->can_read($timeout); |
|
117 |
|
118 if (!@ready) { |
|
119 warn "select() returned nothing: $!\n"; |
|
120 return undef; |
|
121 } |
|
122 |
|
123 $self->_read(@ready); |
|
124 } |
|
125 |
|
126 $gotSignal and sigiohandler($gotSignal); |
|
127 $self->{oldBits} = $self->{inputBits}; |
|
128 return split //, unpack("b*", $self->{inputBits}); |
|
129 } |
|
130 |
|
131 sub status { |
|
132 my $self = shift; |
|
133 return split //, unpack("b*", $self->{inputBits}); |
|
134 } |
|
135 |
|
136 # If an interrupt occurs, we've to search for the file descriptor(s) |
162 # If an interrupt occurs, we've to search for the file descriptor(s) |
137 # that caused the interrupt. This is done by a lookup in the module global |
163 # that caused the interrupt. This is done by a lookup in the module global |
138 # %Objects hash. ("fd" -> { fd => XXX, object => XXXX }) |
164 # %Objects hash. ("fd" -> { fd => XXX, object => XXXX }) |
139 sub sigiohandler($) { |
165 sub sigiohandler($) { |
140 my $signal = shift; |
166 my $signal = shift; |