File Coverage

blib/lib/HiPi/Interface/MCP23S17.pm
Criterion Covered Total %
statement 21 44 47.7
branch 0 2 0.0
condition n/a
subroutine 7 10 70.0
pod 0 3 0.0
total 28 59 47.4


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::MCP23S17
3             # Description : Control MCP23S17 Port Extender via SPI
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::Interface::MCP23S17;
10              
11             #########################################################################################
12              
13 1     1   1302 use strict;
  1         2  
  1         32  
14 1     1   5 use warnings;
  1         2  
  1         34  
15 1     1   5 use parent qw( HiPi::Interface::Common::MCP23X17 );
  1         3  
  1         6  
16 1     1   69 use HiPi qw( :rpi :spi :mcp23S17 );
  1         4  
  1         602  
17 1     1   9 use HiPi::Device::SPI;
  1         9  
  1         44  
18 1     1   23 use Carp;
  1         3  
  1         204  
19              
20             our $VERSION ='0.80';
21              
22             # compatibility
23              
24             our @EXPORT = ();
25             our @EXPORT_OK = ();
26             our %EXPORT_TAGS = ( all => \@EXPORT_OK );
27              
28             # legacy compat exports
29             {
30             my @const = qw(
31             MCP23S17_A0 MCP23S17_A1 MCP23S17_A2 MCP23S17_A3 MCP23S17_A4 MCP23S17_A5 MCP23S17_A6 MCP23S17_A7
32             MCP23S17_B0 MCP23S17_B1 MCP23S17_B2 MCP23S17_B3 MCP23S17_B4 MCP23S17_B5 MCP23S17_B6 MCP23S17_B7
33             MCP23S17_BANK MCP23S17_MIRROR MCP23S17_SEQOP MCP23S17_DISSLW MCP23S17_HAEN MCP23S17_ODR MCP23S17_INTPOL
34             MCP23S17_INPUT MCP23S17_OUTPUT MCP23S17_HIGH MCP23S17_LOW
35            
36             MCP23017_A0 MCP23017_A1 MCP23017_A2 MCP23017_A3 MCP23017_A4 MCP23017_A5 MCP23017_A6 MCP23017_A7
37             MCP23017_B0 MCP23017_B1 MCP23017_B2 MCP23017_B3 MCP23017_B4 MCP23017_B5 MCP23017_B6 MCP23017_B7
38             MCP23017_BANK MCP23017_MIRROR MCP23017_SEQOP MCP23017_DISSLW MCP23017_HAEN MCP23017_ODR MCP23017_INTPOL
39             MCP23017_INPUT MCP23017_OUTPUT MCP23017_HIGH MCP23017_LOW
40             );
41            
42             my @constpins = qw(
43             MCP_PIN_A0 MCP_PIN_A1 MCP_PIN_A2 MCP_PIN_A3 MCP_PIN_A4 MCP_PIN_A5 MCP_PIN_A6 MCP_PIN_A7
44             MCP_PIN_B0 MCP_PIN_B1 MCP_PIN_B2 MCP_PIN_B3 MCP_PIN_B4 MCP_PIN_B5 MCP_PIN_B6 MCP_PIN_B7
45             );
46            
47             push( @EXPORT_OK, @const, @constpins );
48             $EXPORT_TAGS{mcp23017} = \@const;
49             $EXPORT_TAGS{mcp23S17} = \@const;
50             $EXPORT_TAGS{mcppin} = \@constpins;
51             }
52              
53             use constant {
54 1         428 MCP_SPI_READ_MASK => 0x41,
55             MCP_SPI_WRITE_MASK => 0x40,
56 1     1   7 };
  1         1  
57              
58             sub new {
59 0     0 0   my ($class, %userparams) = @_;
60            
61 0           my %params = (
62             devicename => '/dev/spidev0.0',
63             speed => SPI_SPEED_MHZ_1,
64             bitsperword => 8,
65             delay => 0,
66             device => undef,
67             address => 0,
68             );
69            
70 0           foreach my $key (sort keys(%userparams)) {
71 0           $params{$key} = $userparams{$key};
72             }
73            
74 0 0         unless( defined($params{device}) ) {
75             my $dev = HiPi::Device::SPI->new(
76             speed => $params{speed},
77             bitsperword => $params{bitsperword},
78             delay => $params{delay},
79             devicename => $params{devicename},
80 0           );
81            
82 0           $params{device} = $dev;
83             }
84            
85 0           my $self = $class->SUPER::new(%params);
86            
87             # get current register address config so correct settings are loaded
88 0           $self->read_register_bytes('IOCON');
89 0           return $self;
90             }
91              
92             sub do_write_register_bytes {
93 0     0 0   my($self, $regaddress, @bytes) = @_;
94 0           my $devaddr = MCP_SPI_WRITE_MASK + ( $self->address << 1 );
95 0           $self->device->transfer( pack('C*', ( $devaddr, $regaddress, @bytes ) ) );
96 0           return 1;
97             }
98              
99             sub do_read_register_bytes {
100 0     0 0   my($self, $regaddress, $numbytes) = @_;
101 0           my @bufferbytes = ( (1) x $numbytes );
102 0           my $packbytes = $numbytes + 2;
103 0           my $format = 'C' . $packbytes;
104 0           my $devaddr = MCP_SPI_READ_MASK + ( $self->address << 1 );
105 0           my @vals = unpack($format, $self->device->transfer( pack($format, ( $devaddr, $regaddress, @bufferbytes )) ));
106             # first 2 vals in return buffer are not part of returned data
107 0           shift @vals; shift @vals;
  0            
108 0           return @vals;
109             }
110              
111              
112             1;
113              
114             __END__