File Coverage

blib/lib/HiPi/Device/SPI.pm
Criterion Covered Total %
statement 24 74 32.4
branch 0 10 0.0
condition n/a
subroutine 8 25 32.0
pod 0 17 0.0
total 32 126 25.4


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Device::SPI
3             # Description: Wrapper for SPI communucation
4             # Copyright : Copyright (c) 2013-2017 Mark Dootson
5             # License : This is free software; you can redistribute it and/or modify it under
6             # the same terms as the Perl 5 programming language system itself.
7             #########################################################################################
8              
9             package HiPi::Device::SPI;
10              
11             #########################################################################################
12              
13 1     1   1533 use strict;
  1         3  
  1         31  
14 1     1   5 use warnings;
  1         2  
  1         28  
15 1     1   5 use parent qw( HiPi::Device );
  1         2  
  1         5  
16 1     1   56 use IO::File;
  1         4  
  1         113  
17 1     1   6 use Fcntl;
  1         2  
  1         343  
18 1     1   7 use XSLoader;
  1         3  
  1         21  
19 1     1   21 use Carp;
  1         2  
  1         65  
20 1     1   16 use HiPi qw( :rpi :spi );
  1         2  
  1         1384  
21              
22             our $VERSION ='0.81';
23              
24             __PACKAGE__->create_accessors( qw ( fh fno delay speed bitsperword ) );
25              
26             XSLoader::load('HiPi::Device::SPI', $VERSION) if HiPi::is_raspberry_pi();
27              
28             sub get_required_module_options {
29 0     0 0   my $moduleoptions = [
30             [ qw( spi_bcm2708 spidev ) ], # older spi modules
31             [ qw( spi_bcm2385 ) ], # recent spi modules
32             ];
33 0           return $moduleoptions;
34             }
35              
36             sub get_device_list {
37             # get the devicelist
38 0 0   0 0   opendir my $dh, '/dev' or croak qq(Failed to open dev : $!);
39 0           my @spidevs = grep { $_ =~ /^spidev\d+\.\d+$/ } readdir $dh;
  0            
40 0           closedir($dh);
41 0           for (my $i = 0; $i < @spidevs; $i++) {
42 0           $spidevs[$i] = '/dev/' . $spidevs[$i];
43             }
44 0           return @spidevs;
45             }
46              
47             sub new {
48 0     0 0   my ($class, %userparams) = @_;
49            
50 0           my %params = (
51             devicename => '/dev/spidev0.0',
52             speed => SPI_SPEED_MHZ_1(),
53             bitsperword => 8,
54             delay => 0,
55             );
56            
57 0           foreach my $key( sort keys( %params ) ) {
58 0 0         $params{$key} = $userparams{$key} if exists($userparams{$key});
59             }
60            
61             my $fh = IO::File->new(
62 0 0         $params{devicename}, O_RDWR, 0
63             ) or croak qq(open error on $params{devicename}: $!\n);
64            
65            
66 0           $params{fh} = $fh;
67 0           $params{fno} = $fh->fileno(),
68            
69             my $self = $class->SUPER::new(%params);
70            
71 0           return $self;
72             }
73              
74             sub transfer {
75 0     0 0   my($self, $buffer) = @_;
76            
77 0           my $rval = HiPi::Device::SPI::_transfer_data(
78             $self->fno, $buffer, $self->delay, $self->speed, $self->bitsperword
79             );
80            
81 0 0         if( !defined( $rval ) ) {
82 0           croak('SPI transfer failed');
83             }
84            
85 0           return $rval;
86             }
87              
88             sub transfer_byte_array {
89 0     0 0   my( $self, @bytes) = @_;
90 0           my $packcount = scalar( @bytes );
91 0           my $packfmt = 'C' . $packcount;
92 0           my @resultarray = unpack($packfmt, $self->transfer( pack($packfmt, @bytes) ) );
93 0           return @resultarray;
94             }
95              
96             sub bus_transfer {
97 0     0 0   my $self = shift;
98 0           return $self->transfer( @_ );
99             }
100              
101             sub set_bus_mode {
102 0     0 0   my($self, $mode) = @_;
103 0           return HiPi::Device::SPI::_set_spi_mode($self->fno, $mode);
104             }
105              
106             sub get_bus_mode {
107 0     0 0   my($self) = @_;
108 0           return HiPi::Device::SPI::_get_spi_mode($self->fno);
109             }
110              
111             sub set_bus_maxspeed {
112 0     0 0   my($self, $speed) = @_;
113 0           return HiPi::Device::SPI::_set_spi_max_speed($self->fno, $speed);
114             }
115              
116             sub get_bus_maxspeed {
117 0     0 0   my($self, $speed) = @_;
118 0           return HiPi::Device::SPI::_get_spi_max_speed($self->fno);
119             }
120              
121 0     0 0   sub set_transfer_bitsperword { shift->bitsperword( @_ ); }
122 0     0 0   sub get_transfer_bitsperword { shift->bitsperword(); }
123              
124 0     0 0   sub set_transfer_speed { shift->speed( @_ ); }
125 0     0 0   sub get_transfer_speed { shift->speed(); }
126              
127 0     0 0   sub set_transfer_delay { shift->delay( @_ ); }
128 0     0 0   sub get_transfer_delay { shift->delay(); }
129              
130             sub close {
131 0     0 0   my $self = shift;
132 0 0         if( $self->fh ) {
133 0           $self->fh->flush;
134 0           $self->fh->close;
135 0           $self->fh( undef );
136 0           $self->fno( undef );
137 0           $self->devicename( undef );
138             }
139             }
140              
141             1;
142              
143             __END__