File Coverage

blib/lib/Device/Velleman/K8055/Fuse.pm
Criterion Covered Total %
statement 70 244 28.6
branch 13 88 14.7
condition 3 29 10.3
subroutine 11 32 34.3
pod 25 25 100.0
total 122 418 29.1


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