File Coverage

blib/lib/Device/Chip/MCP23x17/Adapter.pm
Criterion Covered Total %
statement 49 49 100.0
branch 7 12 58.3
condition n/a
subroutine 9 9 100.0
pod 3 4 75.0
total 68 74 91.8


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2015-2022 -- leonerd@leonerd.org.uk
5              
6 2     2   996 use v5.26;
  2         6  
7 2     2   10 use Object::Pad 0.66;
  2         23  
  2         12  
8              
9             package Device::Chip::MCP23x17::Adapter 0.06;
10             class Device::Chip::MCP23x17::Adapter;
11             # can't 'extends Device::Chip::Adapter' because that doesn't provide a SUPER::new
12 2     2   590 use base qw( Device::Chip::Adapter );
  2         4  
  2         569  
13              
14 2     2   4657 use Carp;
  2         4  
  2         110  
15              
16 2     2   10 use Future::AsyncAwait;
  2         4  
  2         10  
17              
18             =head1 NAME
19              
20             C - C over F chip
21              
22             =head1 SYNOPSIS
23              
24             use Device::Chip::MCP23S17;
25             use Future::AsyncAwait;
26              
27             my $chip = Device::Chip::MCP23S17->new;
28             await $chip->mount( Device::Chip::Adapter::...->new );
29              
30             my $adapter = $chip->as_adapter;
31              
32             my $second_chip = Device::Chip::...->new;
33             await $second_chip->mount( $adapter );
34              
35             =head1 DESCRIPTION
36              
37             This implementation of the L API provides the C
38             protocol, by exposing the 16bit GPIO registers of a F chip as 16
39             named GPIO pins. It allows, for example, a second instance of some
40             L implementation that uses the GPIO protocol, to be attached via
41             the F chip.
42              
43             Instances of this class are not created directly; they are returned by
44             L.
45              
46             =cut
47              
48             field $_chip :param;
49              
50             # Only supports GPIO
51 1     1 0 11 method make_protocol_GPIO () { $self }
  1         2  
  1         1  
  1         4  
52              
53             my %GPIOs = (
54             ( map { +"A$_", ( 1 << $_ ) } 0 .. 7 ),
55             ( map { +"B$_", ( 1 << $_ ) << 8 } 0 .. 7 ),
56             );
57              
58 1         2 method list_gpios ()
  1         1  
59 1     1 1 392 {
60 1         17 return sort keys %GPIOs;
61             }
62              
63 1         1 async method write_gpios ( $gpios )
  1         2  
  1         1  
64 1         2 {
65 1         2 my $val = 0;
66 1         1 my $mask = 0;
67              
68 1         3 foreach ( keys %$gpios ) {
69 2 50       5 my $bitmask = $GPIOs{$_} or croak "Unrecognised GPIO name $_";
70              
71 2 50       4 $val |= $bitmask if $gpios->{$_};
72 2         4 $mask |= $bitmask;
73             }
74              
75 1 50       2 $mask or return;
76              
77 1         7 await $_chip->write_gpio( $val, $mask );
78 1     1 1 2 }
79              
80 1         2 async method read_gpios ( $gpios )
  1         2  
  1         1  
81 1         3 {
82 1         1 my $mask = 0;
83              
84 1         3 foreach ( @$gpios ) {
85 2 50       6 my $bitmask = $GPIOs{$_} or croak "Unrecognised GPIO name $_";
86              
87 2         3 $mask |= $bitmask;
88             }
89              
90 1 50       5 $mask or return {};
91              
92 1         7 my $bits = await $_chip->read_gpio( $mask );
93              
94 1         57 my %ret;
95              
96 1 100       5 $ret{$_} = $bits & $GPIOs{$_} ? 1 : 0 for @$gpios;
97              
98 1         5 return \%ret;
99 1     1 1 4110 }
100              
101             0x55AA;