line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Device::Velleman::K8055::Fuse; |
2
|
|
|
|
|
|
|
|
3
|
6
|
|
|
6
|
|
124092
|
use 5.008; |
|
6
|
|
|
|
|
26
|
|
|
6
|
|
|
|
|
250
|
|
4
|
|
|
|
|
|
|
|
5
|
6
|
|
|
6
|
|
67
|
use strict; |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
222
|
|
6
|
6
|
|
|
6
|
|
43
|
use warnings; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
277
|
|
7
|
|
|
|
|
|
|
|
8
|
6
|
|
|
6
|
|
30
|
use vars qw($VERSION @ISA $AUTOLOAD); |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
420
|
|
9
|
6
|
|
|
6
|
|
31
|
use Exporter; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
243
|
|
10
|
6
|
|
|
6
|
|
5523
|
use IO::File; |
|
6
|
|
|
|
|
74902
|
|
|
6
|
|
|
|
|
922
|
|
11
|
6
|
|
|
6
|
|
7750
|
use Data::Dumper; |
|
6
|
|
|
|
|
61502
|
|
|
6
|
|
|
|
|
20067
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
@ISA = (''); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our ( @EXPORT_OK, %EXPORT_TAGS ); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $VERSION = '1.0'; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=pod |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 NAME |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Device::Velleman::K8055::Fuse - Communication with the Velleman K8055 USB experiment board using Fuse and K8055fs |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 VERSION |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Version 0.96 |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 ABSTRACT |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
Device::Velleman::K8055::Fuse provides an object-oriented API to the k8055fs Fuse-based interface to the Velleman K8055 USB Experimental Interface Board. |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
Using the module, it is possible to set two 5v analog output ports, read from two 5v analog input boards, read from a 5-bit digital input stream, write to an 8-bit digital output stream, and set two digital counters with configurable gate times. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 SYNOPSIS |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
use Device::Velleman::K8055::Fuse |
38
|
|
|
|
|
|
|
my $dev = new(pathToDevice=>'/path/to/device','debug'=>1); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# let us flicker the Analog output leds three times each |
42
|
|
|
|
|
|
|
for (my $i = 0; $i < 3; $i++) |
43
|
|
|
|
|
|
|
{ |
44
|
|
|
|
|
|
|
for (my $j = 1; $j < 3; $j++) |
45
|
|
|
|
|
|
|
{ |
46
|
|
|
|
|
|
|
$dev->SetAnalogChannel($j); |
47
|
|
|
|
|
|
|
$dev->ClearAnalogChannel($j == 1 ? 2 : ($j -1)); |
48
|
|
|
|
|
|
|
sleep(1); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
# clear the analog output |
52
|
|
|
|
|
|
|
$dev->ClearAllAnalog(); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
In order to work with this module, the k8055fs utility must be installed. This utility relies on Fuse, which must also be installed. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=cut |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# Default attributes for constructor |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
my %default_attrs = ( |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# processing options |
63
|
|
|
|
|
|
|
pathToDevice => '/tmp/8055', # default path to device |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
#k8055 digital inputs are not synced correctly with the 8-bit number representing the signal. |
66
|
|
|
|
|
|
|
#There must a mapping. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
I => { |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
#decimal value vs I-number |
71
|
|
|
|
|
|
|
i2d => { |
72
|
|
|
|
|
|
|
1 => 16, |
73
|
|
|
|
|
|
|
2 => 32, |
74
|
|
|
|
|
|
|
3 => 1, |
75
|
|
|
|
|
|
|
4 => 64, |
76
|
|
|
|
|
|
|
5 => 128, |
77
|
|
|
|
|
|
|
}, |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
#binary value vs I-number |
80
|
|
|
|
|
|
|
i2b => { |
81
|
|
|
|
|
|
|
1 => '10000', |
82
|
|
|
|
|
|
|
2 => '100000', |
83
|
|
|
|
|
|
|
3 => '1', |
84
|
|
|
|
|
|
|
4 => '1000000', |
85
|
|
|
|
|
|
|
5 => '10000000' |
86
|
|
|
|
|
|
|
}, |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
#bit number (0-7) value vs I-number |
89
|
|
|
|
|
|
|
i2i => { |
90
|
|
|
|
|
|
|
1 => '4', |
91
|
|
|
|
|
|
|
2 => '5', |
92
|
|
|
|
|
|
|
3 => '0', |
93
|
|
|
|
|
|
|
4 => '6', |
94
|
|
|
|
|
|
|
5 => '7', |
95
|
|
|
|
|
|
|
}, |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
}, |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head2 new() |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
The constructor. Buils the object. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
Example: |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
New object with k8055 card initialisation |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
my $dev = Device::Velleman::K8055::Fuse->new( |
110
|
|
|
|
|
|
|
initDevice => { -U => 0, pathToDevice => '/tmp/k8055', -b => 2, test => 1 }, |
111
|
|
|
|
|
|
|
debug => 1 |
112
|
|
|
|
|
|
|
) || die "Failed to get an object $!"; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
New object using initialized k8055 card |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
my $dev = Device::Velleman::K8055::Fuse->new( |
118
|
|
|
|
|
|
|
pathToDevice => '/tmp/8055', |
119
|
|
|
|
|
|
|
debug => 1, |
120
|
|
|
|
|
|
|
) || die "Failed to get an object $!"; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
Inputs |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
(optional) initDevice: hash reference containing the inputs expected by InitialiseDevice. Refer to method documentation below for input specifications. If initDevice exists, then method InitialseDevice is called inside the constructor. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
debug = 0 / 1 : Debug flag for outputing debugging information |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
pathToDevice : the name of the path where the k8055fs commands are mounted. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
Returns the object on success |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
testHarness = 0/1 : Use a test harness rather than the card itself. This allows debugging of the applicaiton logic without relying on the hardware itself being present. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
When the test harness is activated, option test => 1 is automatically passed to the InitialiseDevice method. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
Furthermore, any Set functionality returns the set value or array of the value, as relevant. Any get function returns -1. |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=cut |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub new ($;@) { |
142
|
6
|
|
|
6
|
1
|
6083
|
my ( $proto, %attrs ) = @_; |
143
|
6
|
|
33
|
|
|
49
|
my $class = ref($proto) || $proto; |
144
|
6
|
|
|
|
|
15
|
my $self = {}; |
145
|
6
|
|
|
|
|
28
|
foreach my $key ( keys %default_attrs ) { |
146
|
12
|
|
|
|
|
39
|
$self->{$key} = $default_attrs{$key}; |
147
|
|
|
|
|
|
|
} |
148
|
6
|
|
|
|
|
22
|
foreach my $key ( keys %attrs ) { |
149
|
18
|
|
|
|
|
37
|
$self->{$key} = $attrs{$key}; |
150
|
|
|
|
|
|
|
} |
151
|
6
|
|
|
|
|
20
|
$self->{'decimal_out'} = "0"; |
152
|
6
|
|
|
|
|
30
|
$self->{'binary_out'} = [ 0, 0, 0, 0, 0, 0, 0, 0 ]; |
153
|
|
|
|
|
|
|
|
154
|
6
|
|
|
|
|
19
|
my $dev = bless( $self, $class ); |
155
|
6
|
100
|
|
|
|
51
|
if ( defined $dev->{initDevice} ) { |
156
|
|
|
|
|
|
|
|
157
|
1
|
|
|
|
|
3
|
$dev->InitDevice( $dev->{initDevice} ); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
else { |
161
|
5
|
100
|
|
|
|
28
|
unless ( $self->{testHarness} ) { |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
#check for the existance of the directory |
164
|
1
|
50
|
|
|
|
25
|
warn("Mount point [$dev->{pathToDevice}] does not exist") |
165
|
|
|
|
|
|
|
unless -d $dev->{pathToDevice}; |
166
|
1
|
50
|
|
|
|
18
|
warn("Mount point [$dev->{pathToDevice}] is not readable by user") |
167
|
|
|
|
|
|
|
unless -r $dev->{pathToDevice}; |
168
|
1
|
50
|
|
|
|
16
|
warn("Mount point [$dev->{pathToDevice}] is not writable by user") |
169
|
|
|
|
|
|
|
unless -w $dev->{pathToDevice}; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
6
|
|
|
|
|
23
|
return $dev; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head2 ReadAnalogChannel(); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
my $val1 = $dev->ReadAnalogChannel(1); |
179
|
|
|
|
|
|
|
my $val2 = $dev->ReadAnalogChannel(2); |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
my $channel = 1; |
182
|
|
|
|
|
|
|
my $val3 = $dev->ReadAnalogChannel($channel); |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Reads the value from the analog channel indicated by (1 or 2). |
187
|
|
|
|
|
|
|
The input voltage of the selected 8-bit Analogue to Digital converter channel is converted to a value |
188
|
|
|
|
|
|
|
which lies between 0 and 255. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Returns the numeric value. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=cut |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub ReadAnalogChannel ($$) { |
195
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
196
|
0
|
|
|
|
|
0
|
my $cid = shift; |
197
|
0
|
|
|
|
|
0
|
my $res = $self->get( "analog_in" . $cid ); |
198
|
0
|
|
|
|
|
0
|
return $res; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head2 ReadAllAnalog(); |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
my ($val1,$val2) = $dev->ReadAllAnalog(); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
ReadAllAnalog reads the values from the two analog ports into $data1 and $data2. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Inputs: None |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
Outputs: array of two numeric values |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=cut |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub ReadAllAnalog ($) { |
214
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
215
|
0
|
|
|
|
|
0
|
my $cid; |
216
|
0
|
|
|
|
|
0
|
$cid = 1; |
217
|
0
|
|
|
|
|
0
|
my $one = $self->get( "analog_in" . $cid ); |
218
|
0
|
|
|
|
|
0
|
$cid = 2; |
219
|
0
|
|
|
|
|
0
|
my $two = $self->get( "analog_in" . $cid ); |
220
|
0
|
|
|
|
|
0
|
return ( $one, $two ); |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=head2 OutputAnalogChannel(); |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
my $val = $dev->OutputAnalogChannel(1,0); |
226
|
|
|
|
|
|
|
my $val = $dev->OutputAnalogChannel(2,255); |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
This outputs $value to the analog channel indicated by $channel. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
The indicated 8-bit Digital to Analogue Converter channel is altered according to the new value. |
231
|
|
|
|
|
|
|
This means that the value corresponds to a specific voltage. The value 0 corresponds to a |
232
|
|
|
|
|
|
|
minimum output voltage (0 Volt) and the value 255 corresponds to a maximum output voltage (+5V). |
233
|
|
|
|
|
|
|
A value of $value lying in between these extremes can be translated by the following formula : |
234
|
|
|
|
|
|
|
$value / 255 * 5V. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
See also SetAnalogChannel() and SetAllAnalog() |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=cut |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub OutputAnalogChannel($$) { |
241
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
242
|
0
|
|
|
|
|
0
|
my $cid = shift; |
243
|
0
|
|
|
|
|
0
|
my $val = shift; |
244
|
0
|
|
|
|
|
0
|
$self->set( "analog_out" . $cid, $val ); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=head2 OutputAllAnalog(); |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
my ($val1,$val2) = $dev->OutputAllAnalog(0,255); |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
my $val = $dev->OutputAllAnalog(255); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
This outputs $value1 to the first analog channel, and $value2 to the |
254
|
|
|
|
|
|
|
second analog channel. If only one argument is passed, then both channels are given the same value. |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
See also: SetAllAnalog() |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=cut |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub OutputAllAnalog($@) { |
261
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
262
|
0
|
|
|
|
|
0
|
my $val1 = shift; |
263
|
0
|
|
|
|
|
0
|
my $val2; |
264
|
|
|
|
|
|
|
|
265
|
0
|
0
|
|
|
|
0
|
if ( scalar @_ ) { $val2 = shift; } |
|
0
|
|
|
|
|
0
|
|
266
|
0
|
|
|
|
|
0
|
else { $val2 = $val1 } |
267
|
|
|
|
|
|
|
|
268
|
0
|
|
|
|
|
0
|
my $cid; |
269
|
|
|
|
|
|
|
my @out; |
270
|
0
|
|
|
|
|
0
|
$cid = 1; |
271
|
0
|
|
|
|
|
0
|
push @out, $self->set( "analog_out" . $cid, $val1 ); |
272
|
0
|
|
|
|
|
0
|
$cid = 2; |
273
|
0
|
|
|
|
|
0
|
push @out, $self->set( "analog_out" . $cid, $val2 ); |
274
|
|
|
|
|
|
|
|
275
|
0
|
0
|
|
|
|
0
|
if ( $val1 != $val2 ) { return @out } |
|
0
|
|
|
|
|
0
|
|
276
|
0
|
|
|
|
|
0
|
else { return $out[0] } |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=head2 ClearAnalogChannel(); |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
This clears the analog channel indicated by $channel. The selected DA-channel is set to minimum output voltage (0 Volt). |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
Input: channel number |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
Output: value between 0 (min) and 255 (max) |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
my $dev->ClearAnalogChannel(1); |
288
|
|
|
|
|
|
|
my $dev->ClearAnalogChannel(2); |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
See also OutputAnalogChannel(), ClearAllAnalog() |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=cut |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub ClearAnalogChannel($$) { |
295
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
296
|
0
|
|
|
|
|
0
|
my $cid = shift; |
297
|
0
|
|
|
|
|
0
|
$self->OutputAnalogChannel( $cid, 0 ); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head2 ClearAllAnalog(); |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
The two DA-channels are set to the minimum output voltage (0 volt). |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Returns 0 on success. returns undef if either of the analog channels failed. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
my $dev->ClearAllAnalog(); |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=cut |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
sub ClearAllAnalog($) { |
311
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
312
|
0
|
|
|
|
|
0
|
my $cid; |
313
|
0
|
|
|
|
|
0
|
$cid = 1; |
314
|
0
|
|
|
|
|
0
|
my $one = $self->OutputAnalogChannel( $cid, 0 ); |
315
|
0
|
|
|
|
|
0
|
$cid = 2; |
316
|
0
|
|
|
|
|
0
|
my $two = $self->OutputAnalogChannel( $cid, 0 ); |
317
|
0
|
0
|
0
|
|
|
0
|
return undef if $one == undef || $two == undef; |
318
|
0
|
|
|
|
|
0
|
return 0; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=head2 SetAnalogChannel(); |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
Sets the selected 8-bit Digital output, which in turns sets the DAC voltage. |
324
|
|
|
|
|
|
|
Returns the set value (255) corresponding to this voltage. |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
my $channel = 1; |
327
|
|
|
|
|
|
|
my $val = $dev->SetAllAnalog($channel); |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=cut |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
sub SetAnalogChannel($$$) { |
332
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
333
|
0
|
|
|
|
|
0
|
my $cid = shift; |
334
|
0
|
|
|
|
|
0
|
$self->set( "analog_out" . $cid, 255 ); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=head2 SetAllAnalog(); |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
The two DA-channels are set to the maximum output voltage. |
340
|
|
|
|
|
|
|
Returns 255 on success. returns undef if either of the analog channels failed. |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
my $val = $dev->SetAllAnalog(); |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=cut |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
sub SetAllAnalog ($) { |
347
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
348
|
0
|
|
|
|
|
0
|
my $one = $self->OutputAnalogChannel( 1, 255 ); |
349
|
0
|
|
|
|
|
0
|
my $two = $self->OutputAnalogChannel( 2, 255 ); |
350
|
0
|
0
|
0
|
|
|
0
|
return undef unless ( $one && $two ); |
351
|
0
|
|
|
|
|
0
|
return 255; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=head2 WriteAllDigital(); |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
The channels of the digital output port are updated with the status of the corresponding |
357
|
|
|
|
|
|
|
bits in the $value parameter. A high (1) level means that the microcontroller IC1 output |
358
|
|
|
|
|
|
|
is set, and a low (0) level means that the output is cleared. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
$value is a decimal value between 0 and 255 that is sent to the output port (8 channels). |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
# set all 8 digital outputs to 1. |
363
|
|
|
|
|
|
|
my $val = 1; |
364
|
|
|
|
|
|
|
$res = $dev->WriteAllDigital($val); |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
Returns the value on success, returns undef on error. |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=cut |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub WriteAllDigital ($$) { |
371
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
372
|
0
|
|
|
|
|
0
|
my $val = shift; |
373
|
0
|
|
|
|
|
0
|
$self->set( "digital_out", $val ); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=head2 ClearDigitalChannel(); |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
This clears the digital output channel $channel, which can have a value between 1 and 8 |
379
|
|
|
|
|
|
|
that corresponds to the output channel that is to be cleared. |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
This is the opposite of SetDigitalChannel. |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# set digital channel 3 to 0 |
384
|
|
|
|
|
|
|
$res = $dev->ClearDigitalChannel(3); |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
Returns 0 on success, undef on error. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=cut |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub ClearDigitalChannel ($$) { |
391
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
392
|
0
|
|
|
|
|
0
|
my $cid = shift; |
393
|
0
|
|
|
|
|
0
|
my $res = $self->AssignDigitalChannel( $cid, 0 ); |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=head2 ClearAllDigital(); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
This clears (sets to 0) all digital output channels. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
# set all digital channels to 0 |
401
|
|
|
|
|
|
|
$res = $dev->ClearAllDigital(); |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
Returns 0 on success, undef on error. |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=cut |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub ClearAllDigital ($) { |
408
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
409
|
0
|
|
|
|
|
0
|
for my $i ( 1 .. 8 ) { $self->ClearDigitalChannel($i); } |
|
0
|
|
|
|
|
0
|
|
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
#$self->set('digital_out',0); |
412
|
0
|
|
|
|
|
0
|
return 0; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=head2 SetDigitalChannel(); |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
This sets the digital output channel $channel, which can have a value between 1 and 8 |
419
|
|
|
|
|
|
|
that corresponds to the output channel that is to be cleared. |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
This is the opposite of ClearDigitalChannel. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
# set digital channel 3 to 1 |
424
|
|
|
|
|
|
|
$res = $dev->SetDigitalChannel(3); |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=cut |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub SetDigitalChannel ($$) { |
429
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
430
|
0
|
|
|
|
|
0
|
my $cid = shift; |
431
|
0
|
|
|
|
|
0
|
return $self->AssignDigitalChannel( $cid, 1 ); |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=head2 AssignDigitalChannel(); |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
This assigns a value todigital channel $channel to the assigned value. |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
# set digital channel $channel to binary value $value |
439
|
|
|
|
|
|
|
$res = $dev->AssignDigitalChannel($channel,$value); |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
# set digital channel 3 to 1 |
442
|
|
|
|
|
|
|
$res = $dev->AssignDigitalChannel(3,1); |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
# set digital channel 5 to 0 |
445
|
|
|
|
|
|
|
$res = $dev->AssignDigitalChannel(5,0); |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=cut |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
sub AssignDigitalChannel ($$$) { |
450
|
|
|
|
|
|
|
|
451
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
452
|
0
|
|
|
|
|
0
|
my $cid = shift; |
453
|
0
|
|
|
|
|
0
|
my $val = shift; |
454
|
|
|
|
|
|
|
|
455
|
0
|
0
|
0
|
|
|
0
|
unless ( $val == 1 || $val == 0 ) { |
456
|
0
|
|
|
|
|
0
|
die |
457
|
|
|
|
|
|
|
"AssignDigitalChannel: Type error: string [$val] for chanel ID [$cid] is not a binary"; |
458
|
|
|
|
|
|
|
} |
459
|
0
|
0
|
|
|
|
0
|
print "cid:$cid val:$val\n" if $self->{'debug'}; |
460
|
0
|
|
0
|
|
|
0
|
my $decVal = $self->{'decimal_out'} || '0'; |
461
|
0
|
0
|
|
|
|
0
|
print "Current digital value: $decVal\n" if $self->{'debug'}; |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
#convert it to binary string |
464
|
0
|
|
|
|
|
0
|
my @curBinVal = @{ $self->{'binary_out'} }; |
|
0
|
|
|
|
|
0
|
|
465
|
|
|
|
|
|
|
##dec2bin($decVal); |
466
|
|
|
|
|
|
|
|
467
|
0
|
0
|
|
|
|
0
|
if ( $self->{'debug'} ) { |
468
|
0
|
|
|
|
|
0
|
print "Old Binary array: ", Dumper $self->{'binary_out'}; |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
#set the register |
472
|
0
|
|
|
|
|
0
|
$self->{'binary_out'}->[ 8 - $cid ] = $val; |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
#If the array was null and we gave a N-length array, we can end up with undefs. |
475
|
|
|
|
|
|
|
|
476
|
0
|
0
|
|
|
|
0
|
if ( $self->{'debug'} ) { |
477
|
0
|
|
|
|
|
0
|
print "New Binary Array:"; |
478
|
0
|
|
|
|
|
0
|
print Dumper $self->{'binary_out'}; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
#turn binary array back into a string |
482
|
0
|
|
|
|
|
0
|
my $newBinVal = join( '', @{ $self->{'binary_out'} } ); |
|
0
|
|
|
|
|
0
|
|
483
|
|
|
|
|
|
|
|
484
|
0
|
0
|
|
|
|
0
|
print "Binary new digital value: $newBinVal\n" |
485
|
|
|
|
|
|
|
if $self->{'debug'}; |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
#convert back to decimal |
488
|
0
|
|
|
|
|
0
|
my $newDecVal = $self->{'decimal_out'} = $self->bin2dec($newBinVal); |
489
|
|
|
|
|
|
|
|
490
|
0
|
0
|
|
|
|
0
|
print "Decimal new digital value: $newDecVal\n" |
491
|
|
|
|
|
|
|
if $self->{'debug'}; |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
#send to the device |
494
|
0
|
|
|
|
|
0
|
return $self->set( 'digital_out', $newDecVal ); |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=head2 SetAllDigital(); |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
This sets all digital output channels to 1 (true). |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# set digital channels to 1 |
503
|
|
|
|
|
|
|
$res = $dev->SetAllDigital(); |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sets all digital output channels to 1, giving '1111111'. |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=cut |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
sub SetAllDigital ($) { |
510
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
511
|
0
|
|
|
|
|
0
|
my $errors = 0; |
512
|
0
|
|
|
|
|
0
|
for my $i ( 1 .. 8 ) { |
513
|
0
|
|
|
|
|
0
|
my $r = $self->SetDigitalCh; |
514
|
0
|
|
|
|
|
0
|
annel($i); |
515
|
0
|
0
|
|
|
|
0
|
$errors++ unless $r; |
516
|
|
|
|
|
|
|
} |
517
|
0
|
0
|
|
|
|
0
|
return undef if $errors; |
518
|
0
|
|
|
|
|
0
|
$self->{binary_out} = [ 0, 0, 0, 0, 0, 0, 0, 0 ]; |
519
|
0
|
|
|
|
|
0
|
return 1; |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
=head2 ReadAllDigital() |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
This reads all 5 digital ports at once. The 5 least significant bits correspond to the |
525
|
|
|
|
|
|
|
status of the input channels. A high (1) means that the channel is set, a low (0) means that the channel is cleared. |
526
|
|
|
|
|
|
|
Returns the decimal value of the the 8-channel interface card (0-255) unless flag 'bin' is set. |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
If input contains one string with content 'bin' , then returns an array of binary characters (0/1). |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
# Get the value of all digital input channels as an array of binary values in big-endian order |
531
|
|
|
|
|
|
|
$res = $dev->ReadAllDigital(); |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
# Get the value of all digital input channels as a decimal value |
534
|
|
|
|
|
|
|
$res = $dev->ReadAllDigital('dec'); |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
Returns undef on error. |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
=cut |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
sub ReadAllDigital ($;$) { |
541
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
542
|
0
|
|
0
|
|
|
0
|
my $flag = shift || 'dec'; |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
#get decimal value from the device |
545
|
0
|
|
|
|
|
0
|
my $decVal = $self->get('digital_in'); |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
#convert it to binary string |
548
|
0
|
0
|
|
|
|
0
|
if ( $flag eq 'bin' ) { |
549
|
0
|
|
|
|
|
0
|
my $curBinVal = $self->dec2bin($decVal); |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
#stick the string into an array. Reverse it to get the right order for an array |
552
|
|
|
|
|
|
|
|
553
|
0
|
|
|
|
|
0
|
my @index = split( '', $curBinVal ); |
554
|
|
|
|
|
|
|
|
555
|
0
|
0
|
|
|
|
0
|
print "ReadAllDigital:[$flag]", Dumper \@index if $self->{debug}; |
556
|
|
|
|
|
|
|
|
557
|
0
|
|
|
|
|
0
|
return @index; |
558
|
|
|
|
|
|
|
} |
559
|
0
|
|
|
|
|
0
|
return $decVal; |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
=head2 ReadDigitalChannel(); |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
The status of the selected input $channel is read. |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
$channel can have a value between 1 and 8 which corresponds to the input channel whose |
568
|
|
|
|
|
|
|
status is to be read. |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
The return value will be true (1) if the channel has been set, false (0) otherwise |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
returns undef on error. |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
# Get the value of a digital input channel |
575
|
|
|
|
|
|
|
$res = $dev->ReadDigitalChannel(1); |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
Note: on the K8055, the addresses of digital inputs 1-5 are not the equivalent binary values. |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
Refer to the hash $dev->{I} giving the mappings between the card digital input number I and equivalent decimal and binary value, and bit number. $dev->{I} is defined in the constructor. |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
$dev->{I} = { |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
#decimal value vs I-number |
584
|
|
|
|
|
|
|
i2d => { |
585
|
|
|
|
|
|
|
1 => 16, |
586
|
|
|
|
|
|
|
2 => 32, |
587
|
|
|
|
|
|
|
3 => 1, |
588
|
|
|
|
|
|
|
4 => 64, |
589
|
|
|
|
|
|
|
5 => 128, |
590
|
|
|
|
|
|
|
}, |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
#binary value vs I-number |
593
|
|
|
|
|
|
|
i2b => { |
594
|
|
|
|
|
|
|
1 => '10000', |
595
|
|
|
|
|
|
|
2 => '100000', |
596
|
|
|
|
|
|
|
3 => '1', |
597
|
|
|
|
|
|
|
4 => '1000000', |
598
|
|
|
|
|
|
|
5 => '10000000' |
599
|
|
|
|
|
|
|
}, |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
#bit number (0-7) value vs I-number |
602
|
|
|
|
|
|
|
i2i => { |
603
|
|
|
|
|
|
|
1 => '4', |
604
|
|
|
|
|
|
|
2 => '5', |
605
|
|
|
|
|
|
|
3 => '0', |
606
|
|
|
|
|
|
|
4 => '6', |
607
|
|
|
|
|
|
|
5 => '7', |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
=cut |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
sub ReadDigitalChannel ($$) { |
613
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
614
|
0
|
|
|
|
|
0
|
my $cid = shift; |
615
|
0
|
0
|
|
|
|
0
|
die "Digital Input channel $cid not defined for this board" |
616
|
|
|
|
|
|
|
unless exists $self->{I}->{i2i}->{$cid}; |
617
|
0
|
|
|
|
|
0
|
$cid = $self->{I}->{i2i}->{$cid}; |
618
|
|
|
|
|
|
|
|
619
|
0
|
|
|
|
|
0
|
my @array = $self->ReadAllDigital('bin'); |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
#fetch the value for $cid |
622
|
0
|
|
0
|
|
|
0
|
my $val = $array[$cid] || 0; |
623
|
|
|
|
|
|
|
|
624
|
0
|
|
|
|
|
0
|
return $val; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=head2 ReadCounter(); |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
The function returns the status of the selected 16 bit pulse counter. |
630
|
|
|
|
|
|
|
The counter number 1 counts the pulses fed to the input I1 and the counter number 2 counts the |
631
|
|
|
|
|
|
|
pulses fed to the input I2. |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
returns an 16 bit count on success. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
returns undef on error. |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
my $count = $dev->ReadCounter(1); |
638
|
|
|
|
|
|
|
my $count = $dev->ReadCounter(2); |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
=cut |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
sub ReadCounter ($$) { |
643
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
644
|
0
|
|
|
|
|
0
|
my $cid = shift; |
645
|
0
|
|
|
|
|
0
|
$self->get( "counter" . $cid ); |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
=head2 ResetCounter(); |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
This resets the selected pulse counter. |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
returns undef on error. |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
$my val = $dev->ResetCounter(1); |
655
|
|
|
|
|
|
|
$my val = $dev->ResetCounter(2); |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
=cut |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
sub ResetCounter ($$) { |
660
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
661
|
0
|
|
|
|
|
0
|
my $cid = shift; |
662
|
0
|
|
|
|
|
0
|
$self->set( "counter" . $cid, 0 ); |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
=head2 SetCounterDebounceTime(); |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
The counter inputs are debounced in the software to prevent false triggering when mechanical |
668
|
|
|
|
|
|
|
switches or relay inputs are used. The debounce time is equal for both falling and rising edges. The |
669
|
|
|
|
|
|
|
default debounce time is 2ms. This means the counter input must be stable for at least 2ms before it is |
670
|
|
|
|
|
|
|
recognised, giving the maximum count rate of about 200 counts per second. |
671
|
|
|
|
|
|
|
If the debounce time is set to 0, then the maximum counting rate is about 2000 counts per second. |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
The $deboucetime value corresponds to the debounce time in milliseconds (ms) to be set for the |
674
|
|
|
|
|
|
|
pulse counter. Debounce time value may vary between 0 and 5000. |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
returns the set time in milliseconds on success. |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
returns undef on error. |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
#set the debounce time for counter 2 to 500ms |
681
|
|
|
|
|
|
|
$my time = $dev->SetCounterDebounceTime(2,500); |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
#set the debounce time for counter 1 to 2 seconds |
684
|
|
|
|
|
|
|
$my time = $dev->SetCounterDebounceTime(1,2000); |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=cut |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
sub SetCounterDebounceTime($$$) { |
689
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
690
|
0
|
|
|
|
|
0
|
my $cid = shift; |
691
|
0
|
|
|
|
|
0
|
my $time = shift; |
692
|
|
|
|
|
|
|
|
693
|
0
|
0
|
0
|
|
|
0
|
unless ( $time >= 0 && $time <= 5000 ) { |
694
|
0
|
|
|
|
|
0
|
warn |
695
|
|
|
|
|
|
|
"SetCounterDebounceTime Range Error: Shound be between 0 and 5000."; |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
|
698
|
0
|
|
|
|
|
0
|
$self->set( "debounce" . $cid, $time ); |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
=head2 get() |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
uses IO::File to retrieve data from the FUSE files. Refer to the k8055fs readme for details. |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
my $res = $dev->get('digital_in',255); |
706
|
|
|
|
|
|
|
my $res = $dev->get('analog_in1',255); |
707
|
|
|
|
|
|
|
my $res = $dev->get('analog_in2',255); |
708
|
|
|
|
|
|
|
my $res = $dev->get('counter1',255); |
709
|
|
|
|
|
|
|
my $res = $dev->get('counter2',255); |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
This is a low-level call that is not particualrly intended for direct access from the API. |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
The path to the command is defined by hash key pathToDevice in the constructor. |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
Returns $value on success and undef on error. |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=cut |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
sub get ($$) { |
720
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
721
|
0
|
|
|
|
|
0
|
my $mfile = shift; |
722
|
0
|
|
|
|
|
0
|
my $fh = new IO::File; |
723
|
0
|
|
|
|
|
0
|
my $res = undef; |
724
|
|
|
|
|
|
|
|
725
|
0
|
|
|
|
|
0
|
my $file = $self->{pathToDevice} . "/$mfile"; |
726
|
|
|
|
|
|
|
|
727
|
0
|
0
|
0
|
|
|
0
|
if ( !$self->{testHarness} && $fh->open("< $file") ) { |
|
|
0
|
|
|
|
|
|
728
|
0
|
|
|
|
|
0
|
my @io = <$fh>; |
729
|
0
|
|
|
|
|
0
|
$fh->close; |
730
|
0
|
0
|
|
|
|
0
|
if ( scalar(@io) != 1 ) { |
731
|
0
|
|
|
|
|
0
|
warn "01 get: $file: failed. $!\n"; |
732
|
|
|
|
|
|
|
} |
733
|
0
|
|
|
|
|
0
|
$res = shift @io; |
734
|
0
|
0
|
|
|
|
0
|
print "get: $file: $res\n" if $self->{'debug'}; |
735
|
0
|
|
|
|
|
0
|
chomp $res; |
736
|
0
|
|
|
|
|
0
|
$self->{io}->{$mfile} = $res; |
737
|
0
|
|
|
|
|
0
|
return $res; |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
elsif ( $self->{testHarness} ) { |
740
|
0
|
|
|
|
|
0
|
$res = -1; |
741
|
0
|
|
|
|
|
0
|
$self->{io}->{$mfile} = $res; |
742
|
0
|
|
|
|
|
0
|
return $res; |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
0
|
|
|
|
|
0
|
die "02 get: $file: failed. $!\n"; |
746
|
0
|
|
|
|
|
0
|
$self->{io}->{$mfile} = undef; |
747
|
0
|
|
|
|
|
0
|
return $self->{io}->{$mfile}; |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=head2 set($file,$value) |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
uses IO::File to send io to the FUSE files. Refer to the k8055fs readme for details. |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
my $res = $dev->set('digital_out',255); |
755
|
|
|
|
|
|
|
my $res = $dev->set('analog_out1',255); |
756
|
|
|
|
|
|
|
my $res = $dev->set('debounce1',255); |
757
|
|
|
|
|
|
|
my $res = $dev->set('debounce2',255); |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
This is a low-level call that is not particualrly intended for direct access from the API. |
761
|
|
|
|
|
|
|
Using the set function could desynchronize the internal representation for the binary array |
762
|
|
|
|
|
|
|
held in array |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
$dev->{binary_out} |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
The path to the command is defined by hash key pathToDevice in the constructor. |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
Returns $value on success and undef on error. |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=cut |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
sub set ($$$) { |
773
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
774
|
0
|
|
|
|
|
0
|
my $mfile = shift; |
775
|
0
|
|
|
|
|
0
|
my $val = shift; |
776
|
|
|
|
|
|
|
|
777
|
0
|
0
|
|
|
|
0
|
$val = "-1" unless defined $val; |
778
|
|
|
|
|
|
|
|
779
|
0
|
|
|
|
|
0
|
my $fh = new IO::File; |
780
|
|
|
|
|
|
|
|
781
|
0
|
|
|
|
|
0
|
my $file = $self->{pathToDevice} . "/$mfile"; |
782
|
|
|
|
|
|
|
|
783
|
0
|
0
|
0
|
|
|
0
|
if ( !$self->{testHarness} && $fh->open("> $file") ) { |
|
|
0
|
|
|
|
|
|
784
|
0
|
0
|
|
|
|
0
|
print "set: $file: $val\n" if $self->{'debug'}; |
785
|
0
|
|
|
|
|
0
|
print $fh $val; |
786
|
0
|
|
|
|
|
0
|
$fh->close; |
787
|
0
|
|
|
|
|
0
|
chomp $val; |
788
|
0
|
|
|
|
|
0
|
$self->{io}->{$mfile} = $val; |
789
|
0
|
|
|
|
|
0
|
return $self->{io}->{$mfile}; |
790
|
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
|
elsif ( $self->{testHarnes} ) { |
792
|
0
|
|
|
|
|
0
|
$self->{io}->{$mfile} = $val; |
793
|
0
|
|
|
|
|
0
|
return $val; |
794
|
|
|
|
|
|
|
} |
795
|
|
|
|
|
|
|
|
796
|
0
|
|
|
|
|
0
|
die "01 set: $file: failed. Unable to open file handle: $!\n"; |
797
|
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
#from Perl Cookbook (Oreilly) |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=head2 dec2bin($dec) |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
convert a decimal to a string representing a bin |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
The binary string is represented as a big-endian. In big-endian encoding, digits increase as the string progresses to the left: |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
0 (dec) = 0 (bin). |
808
|
|
|
|
|
|
|
1 (dec) = 1 (bin). |
809
|
|
|
|
|
|
|
2 (dec) = 10 (bin). |
810
|
|
|
|
|
|
|
3 (dec) = 11 (bin). |
811
|
|
|
|
|
|
|
4 (dec) = 100 (bin). |
812
|
|
|
|
|
|
|
255 (dec) = 11111111 (bin). |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
=cut |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
sub dec2bin ($$) { |
817
|
5
|
|
|
5
|
1
|
210
|
my $self = shift; |
818
|
5
|
|
100
|
|
|
13
|
my $dec = shift || 0; |
819
|
5
|
|
|
|
|
19
|
my $str = unpack( "B32", pack( "N", $dec ) ); |
820
|
5
|
|
|
|
|
18
|
$str =~ s/^0+(?=\d)//; # otherwise you'll get leading zeros |
821
|
5
|
|
|
|
|
20
|
return $str; |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
=head2 bin2dec($bin) |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
convert a string representing a binary number to a decimal number. |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
Refer to dec2bin for information on the binary format in use. |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=cut |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
sub bin2dec ($$) { |
833
|
17
|
|
|
17
|
1
|
21
|
my $self = shift; |
834
|
17
|
|
|
|
|
20
|
my $bin = shift; |
835
|
17
|
|
|
|
|
99
|
return unpack( "N", pack( "B32", substr( "0" x 32 . $bin, -32 ) ) ); |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
=head2 InitDevice (\%args) |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
Initialises the k8055 USB device by mounting the k8055 file system. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
usage: |
843
|
|
|
|
|
|
|
$dev->InitialseDevice({-U=>1, -b=>2, pathToDevice=>'/tmp/8055'}) |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
Input arguments |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
-b board number. (2-4) If skipped, default board (1) number is taken. |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
-U 1 0r 0 turn on USB debugging if true. |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
pathToDevice: Desired mount point of the k8055fs application. This directory needs to be accessible by the user. |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
fuseOptions: additional options to pass to FUSE. |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
test: do not run the k8055fs initialiaation. Print the command to STDOUT and return success. This is for debugging support. |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
See also new(). |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
=cut |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
sub InitDevice ($$) { |
863
|
1
|
|
|
1
|
1
|
3
|
my $self = shift; |
864
|
|
|
|
|
|
|
|
865
|
1
|
|
|
|
|
1
|
my $p = shift; |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
#initialise command line attributes |
868
|
1
|
|
|
|
|
2
|
my $b = ''; |
869
|
1
|
|
|
|
|
1
|
my $U = ''; |
870
|
1
|
|
|
|
|
2
|
my $fuseArgs = ''; |
871
|
|
|
|
|
|
|
|
872
|
1
|
|
|
|
|
2
|
$self->{initParams} = $p; |
873
|
1
|
50
|
|
|
|
3
|
$b = "-b " . $p->{'-b'} if $p->{'-b'}; |
874
|
1
|
50
|
|
|
|
3
|
$U = "-U" if $p->{'-U'}; |
875
|
1
|
50
|
|
|
|
3
|
$fuseArgs = '-o ' . $p->{fuseArgs} if $p->{fuseArgs}; |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
#pass the device path to the object |
878
|
1
|
|
|
|
|
2
|
$self->{pathToDevice} = $p->{pathToDevice}; |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
#Allow us to use the testHarness functionality without actually having the card plugged in. |
881
|
|
|
|
|
|
|
#This needs to automatically also invoke the test option. |
882
|
|
|
|
|
|
|
|
883
|
1
|
50
|
|
|
|
2
|
unless ( $self->{testHarness} ) { |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
#check for the existance of the directory |
886
|
0
|
0
|
|
|
|
0
|
warn("Mount point [$self->{pathToDevice}] does not exist") |
887
|
|
|
|
|
|
|
unless -d $self->{pathToDevice}; |
888
|
0
|
0
|
|
|
|
0
|
warn("Mount point [$self->{pathToDevice}] is not readable by user") |
889
|
|
|
|
|
|
|
unless -r $self->{pathToDevice}; |
890
|
0
|
0
|
|
|
|
0
|
warn("Mount point [$self->{pathToDevice}] is not writable by user") |
891
|
|
|
|
|
|
|
unless -w $self->{pathToDevice}; |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
} |
894
|
|
|
|
|
|
|
else { |
895
|
1
|
|
|
|
|
2
|
$p->{test} = 1; |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
#see k8055fs README |
899
|
1
|
|
|
|
|
3
|
my $commands = [ |
900
|
|
|
|
|
|
|
[ 'modprobe', 'fuse' ], |
901
|
|
|
|
|
|
|
[ 'k8055fs', $b, $U, $p->{pathToDevice}, $fuseArgs ] |
902
|
|
|
|
|
|
|
]; |
903
|
|
|
|
|
|
|
|
904
|
1
|
|
|
|
|
2
|
my $failed = 0; |
905
|
1
|
|
|
|
|
1
|
foreach my $action (@$commands) { |
906
|
2
|
|
|
|
|
4
|
my @args = @$action; |
907
|
|
|
|
|
|
|
|
908
|
2
|
|
|
|
|
4
|
my $cmd = join( " ", @args ); |
909
|
|
|
|
|
|
|
|
910
|
2
|
|
|
|
|
2
|
push( @{ $self->{init}->{cmd} }, $cmd ); |
|
2
|
|
|
|
|
4
|
|
911
|
|
|
|
|
|
|
|
912
|
2
|
50
|
|
|
|
5
|
if ( $p->{test} ) { |
913
|
2
|
|
|
|
|
12
|
print "InitialiseDevice Test: $cmd\n"; |
914
|
2
|
|
|
|
|
6
|
next; |
915
|
|
|
|
|
|
|
} |
916
|
0
|
0
|
|
|
|
0
|
system($cmd) == 0 or warn "system $cmd failed: $?"; |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
#You can check all the failure possibilities by inspecting $? like this: |
919
|
0
|
0
|
|
|
|
0
|
if ( $? == -1 ) { |
|
|
0
|
|
|
|
|
|
920
|
0
|
|
|
|
|
0
|
push( |
921
|
0
|
|
|
|
|
0
|
@{ $self->{init}->{errors} }, |
922
|
|
|
|
|
|
|
"Failed: [$cmd]" . $failed++ . ":$!" |
923
|
|
|
|
|
|
|
); |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
elsif ( $? & 127 ) { |
926
|
0
|
|
|
|
|
0
|
push( |
927
|
0
|
0
|
|
|
|
0
|
@{ $self->{initParams}->{errors} }, |
928
|
|
|
|
|
|
|
printf "child died with signal %d, %s coredump\n", |
929
|
|
|
|
|
|
|
( $? & 127 ), |
930
|
|
|
|
|
|
|
( $? & 128 ) ? 'with' : 'without' |
931
|
|
|
|
|
|
|
); |
932
|
0
|
|
|
|
|
0
|
$failed++; |
933
|
0
|
|
|
|
|
0
|
push( |
934
|
0
|
|
|
|
|
0
|
@{ $self->{init}->{errors} }, |
935
|
|
|
|
|
|
|
"Failed: [$cmd]" . $failed++ . ":$!" |
936
|
|
|
|
|
|
|
); |
937
|
|
|
|
|
|
|
} |
938
|
|
|
|
|
|
|
else { |
939
|
0
|
|
|
|
|
0
|
push( |
940
|
0
|
|
|
|
|
0
|
@{ $self->{init}->{errors} }, |
941
|
|
|
|
|
|
|
printf "child exited with value %d\n", |
942
|
|
|
|
|
|
|
$? >> 8 |
943
|
|
|
|
|
|
|
); |
944
|
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
|
947
|
1
|
50
|
|
|
|
3
|
if ($failed) { |
948
|
0
|
0
|
|
|
|
0
|
print STDERR join( "\n", @{ $self->{init}->{errors} } ) if $failed; |
|
0
|
|
|
|
|
0
|
|
949
|
0
|
|
|
|
|
0
|
return undef; |
950
|
|
|
|
|
|
|
} |
951
|
1
|
|
|
|
|
3
|
return; |
952
|
|
|
|
|
|
|
} |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
=head1 AUTHOR |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
Ronan Oger, C<< >> |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
Special thanks to Jouke Visser, author of Device::Velleman::K8055 for writing the original win32-based module. I extensively copied his documentation and derived the method names from the names used by Jouke. |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=head1 BUGS |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
Likely to be many, please use http://rt.cpan.org/ for reporting bugs. The counter functionality is poorly tested and I suspect it has bugs. |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=head1 SEE ALSO |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
For more information on this board, visit http://www.velleman.be. |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
For more information on the K0855fs fuse implementation of K0855, visit https://launchpad.net/k8055fs |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
For more information on the Fuse driver, visit the FUSE project on sourceforge: http://fuse.sourceforge.net |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
For Win32 applications, see Jouke Visser's Device::Velleman::K8055 implementation. |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
Copyright 2008 Ronan Oger, All Rights Reserved. |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
981
|
|
|
|
|
|
|
under the same terms as Perl itself. |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
=cut |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
1 |