File Coverage

blib/lib/Device/Chip/MCP23x17/Adapter.pm
Criterion Covered Total %
statement 52 52 100.0
branch 7 12 58.3
condition n/a
subroutine 10 10 100.0
pod 3 4 75.0
total 72 78 92.3


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