File Coverage

blib/lib/HiPi/Interface/PCF8574.pm
Criterion Covered Total %
statement 15 66 22.7
branch 0 16 0.0
condition 0 9 0.0
subroutine 5 14 35.7
pod 0 9 0.0
total 20 114 17.5


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::PCF8574
3             # Description : Control NXP PCF8574 8-channel port extender
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::PCF8574;
10              
11             #########################################################################################
12              
13 1     1   6 use strict;
  1         3  
  1         29  
14 1     1   5 use warnings;
  1         2  
  1         27  
15 1     1   5 use parent qw( HiPi::Interface );
  1         2  
  1         6  
16 1     1   54 use HiPi qw( :i2c :rpi );
  1         3  
  1         297  
17 1     1   7 use Carp;
  1         2  
  1         746  
18              
19             __PACKAGE__->create_ro_accessors( qw(
20             backend
21             ) );
22              
23             our $VERSION ='0.80';
24              
25              
26             sub new {
27 0     0 0   my ($class, %userparams) = @_;
28            
29 0           my $pi = HiPi::RaspberryPi->new();
30            
31 0 0         my %params = (
32             devicename => ( $pi->board_type == RPI_BOARD_TYPE_1 ) ? '/dev/i2c-0' : '/dev/i2c-1',
33             address => 0x3f,
34             device => undef,
35             backend => 'i2c',
36             );
37            
38             # get user params
39 0           foreach my $key( keys (%userparams) ) {
40 0           $params{$key} = $userparams{$key};
41             }
42            
43 0 0         unless( defined($params{device}) ) {
44 0 0         if ( $params{backend} eq 'bcm2835' ) {
45 0           require HiPi::BCM2835::I2C;
46             $params{device} = HiPi::BCM2835::I2C->new(
47             address => $params{address},
48 0 0         peripheral => ( $params{devicename} eq '/dev/i2c-0' ) ? HiPi::BCM2835::I2C::BB_I2C_PERI_0() : HiPi::BCM2835::I2C::BB_I2C_PERI_1(),
49             );
50             } else {
51 0           require HiPi::Device::I2C;
52             $params{device} = HiPi::Device::I2C->new(
53             devicename => $params{devicename},
54             address => $params{address},
55             busmode => $params{backend},
56 0           );
57             }
58             }
59            
60 0           my $self = $class->SUPER::new(%params);
61            
62 0           return $self;
63             }
64              
65             sub read_byte {
66 0     0 0   my ( $self ) = @_;
67 0           my @bytes = $self->device->bus_read(undef, 1);
68 0           return $bytes[0];
69             }
70              
71             sub write_byte {
72 0     0 0   my( $self, $byte) = @_;
73 0           $self->device->bus_write($byte & 0xFF);
74             }
75              
76             sub read_bits {
77 0     0 0   my ( $self ) = @_;
78 0           my $byte = $self->read_byte;
79 0           my @bits;
80 0           for ( my $i = 0; $i < 8; $i++ ) {
81 0           push @bits, ( $byte >> $i ) & 1;
82             }
83 0           return @bits;
84             }
85              
86             sub write_bits {
87 0     0 0   my( $self, @bits) = @_;
88 0           my $bitcount = @bits;
89 0 0         unless( $bitcount == 8 ) {
90 0           warn qq(Only $bitcount bits provided in write_bits. Needs 8);
91 0           return;
92             }
93 0           my $byte = 0;
94 0           for ( my $i = 0; $i < 8; $i++ ) {
95 0           $byte += ($bits[$i] & 1 ) << $i;
96             }
97 0           $self->write_byte( $byte );
98             }
99              
100             sub set_bit {
101 0     0 0   my( $self, $bit, $value) = @_;
102 0 0 0       if($bit < 0 || $bit > 7) {
103 0           warn qq(Bit argument must be between 0 and 7 in set_bit. You passed $bit);
104 0           return;
105             }
106            
107 0 0 0       if($value < 0 || $value > 1) {
108 0           warn qq(Value argument muist be 1 or 0 in set_bit. You passed $value);
109 0           return;
110             }
111            
112 0           my @bits = $self->read_bits;
113 0           $bits[$bit] = $value;
114 0           $self->write_bits(@bits);
115             }
116              
117             sub get_bit {
118 0     0 0   my( $self, $bit ) = @_;
119 0 0 0       if($bit < 0 || $bit > 7) {
120 0           warn qq(Bit argument must be between 0 and 7 in get_bit. You passed $bit);
121 0           return;
122             }
123 0           my @bits = $self->read_bits;
124 0           return $bits[$bit];
125             }
126              
127 0     0 0   sub set_port { set_bit( @_ ); }
128              
129 0     0 0   sub get_port { get_bit( @_ ); }
130              
131              
132             1;
133              
134             __END__