File Coverage

blib/lib/HiPi/GPIO.pm
Criterion Covered Total %
statement 28 91 30.7
branch 1 24 4.1
condition n/a
subroutine 10 27 37.0
pod 0 17 0.0
total 39 159 24.5


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::GPIO
3             # Description : Wrapper for GPIO
4             # Copyright : Copyright (c) 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::GPIO;
10              
11             #########################################################################################
12              
13 1     1   7 use strict;
  1         2  
  1         31  
14 1     1   6 use warnings;
  1         1  
  1         28  
15 1     1   9 use parent qw( HiPi::Class );
  1         2  
  1         5  
16 1     1   51 use XSLoader;
  1         2  
  1         10  
17 1     1   33 use Carp;
  1         2  
  1         50  
18 1     1   5 use HiPi 0.80;
  1         22  
  1         60  
19 1     1   7 use HiPi qw( :rpi );
  1         2  
  1         240  
20 1     1   8 use HiPi::RaspberryPi;
  1         2  
  1         8  
21              
22             our $VERSION ='0.81';
23              
24             __PACKAGE__->create_accessors( );
25              
26             XSLoader::load('HiPi::GPIO', $VERSION) if HiPi::is_raspberry_pi();
27              
28             my $xsok = ( HiPi::is_raspberry_pi() ) ? xs_initialise_gpio_block() : 0;
29 1 50   1   1069 END { xs_release_gpio_block() if HiPi::is_raspberry_pi(); };
30              
31             use constant {
32 1         1019 GPEDS0 => 16,
33             GPREN0 => 19,
34             GPFEN0 => 22,
35             GPHEN0 => 25,
36             GPLEN0 => 28,
37             GPAREN0 => 31,
38             GPAFEN0 => 34,
39 1     1   172 };
  1         2  
40              
41             sub error_report {
42 0     0 0   my ( $error ) = @_;
43 0           carp qq($error);
44             }
45              
46 0     0 0   sub ok { return $xsok; }
47              
48             sub new {
49 0     0 0   my ($class, %userparams) = @_;
50            
51 0           my %params = ( );
52            
53 0           foreach my $key( sort keys( %params ) ) {
54 0 0         $params{$key} = $userparams{$key} if exists($userparams{$key});
55             }
56            
57 0           my $self = $class->SUPER::new(%params);
58            
59 0           return $self;
60             }
61              
62             sub get_pin {
63 0     0 0   my( $class, $pinid ) = @_;
64 0           require HiPi::GPIO::Pin;
65 0           HiPi::GPIO::Pin->_open( pinid => $pinid );
66             }
67              
68             sub pin_write {
69 0     0 0   my($class, $gpio, $level) = @_;
70 0           return xs_gpio_write( $gpio, $level );
71             }
72              
73             sub pin_read {
74 0     0 0   my($class, $gpio) = @_;
75 0           return xs_gpio_read( $gpio );
76             }
77              
78             sub set_pin_mode {
79 0     0 0   my($class, $gpio, $mode) = @_;
80 0           return xs_gpio_set_mode( $gpio, $mode );
81             }
82              
83             sub get_pin_mode {
84 0     0 0   my($class, $gpio ) = @_;
85 0           return xs_gpio_get_mode( $gpio );
86             }
87              
88             sub set_pin_pud {
89 0     0 0   my($class, $gpio , $pud ) = @_;
90 0           return xs_gpio_set_pud( $gpio, $pud);
91             }
92              
93             sub get_pin_pud {
94 0     0 0   my($class, $gpio ) = @_;
95 0           return xs_gpio_get_pud( $gpio );
96             }
97              
98             sub set_pin_activelow {
99 0     0 0   my($class, $gpio, $alow ) = @_;
100 0           warn q(HiPi::GPIO does not support active_low);
101 0           return undef;
102             }
103              
104             sub get_pin_activelow {
105 0     0 0   my($class, $gpio ) = @_;
106 0           warn q(HiPi::GPIO does not support active_low);
107 0           return undef;
108             }
109              
110             sub get_pin_interrupt_filepath {
111 0     0 0   my($class, $gpio ) = @_;
112 0           warn q(HiPi::GPIO does not support interrupts);
113 0           return undef;
114             }
115              
116             sub set_pin_interrupt {
117 0     0 0   my($class, $gpio, $newedge ) = @_;
118 0           warn q(HiPi::GPIO does not support interrupts);
119 0           return undef;
120             }
121              
122             sub get_pin_interrupt {
123 0     0 0   my($class, $gpio ) = @_;
124 0           warn q(HiPi::GPIO does not support interrupts);
125 0           return undef;
126             }
127              
128             sub get_pin_function {
129 0     0 0   my($class, $gpio) = @_;
130 0           my $mode = $class->get_pin_mode( $gpio );
131 0           my $funcname = 'UNKNOWN';
132 0           my $altnum = undef;
133            
134 0           my $alt_function_names = HiPi::RaspberryPi::get_alt_function_names();
135            
136 0 0         if( $mode == -1 ) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
137 0           $funcname = 'ERROR';
138             } elsif( $mode == RPI_MODE_INPUT ) {
139 0           $funcname = 'INPUT';
140             } elsif( $mode == RPI_MODE_OUTPUT ) {
141 0           $funcname = 'OUTPUT';
142             } elsif( $mode == RPI_MODE_ALT0 ) {
143 0           $funcname = $alt_function_names->[$gpio]->[0];
144 0           $altnum = 0;
145             } elsif( $mode == RPI_MODE_ALT1 ) {
146 0           $funcname = $alt_function_names->[$gpio]->[1];
147 0           $altnum = 1;
148             } elsif( $mode == RPI_MODE_ALT2 ) {
149 0           $funcname = $alt_function_names->[$gpio]->[2];
150 0           $altnum = 2;
151             } elsif( $mode == RPI_MODE_ALT3 ) {
152 0           $funcname = $alt_function_names->[$gpio]->[3];
153 0           $altnum = 3;
154             } elsif( $mode == RPI_MODE_ALT4 ) {
155 0           $funcname = $alt_function_names->[$gpio]->[4];
156 0           $altnum = 4;
157             } elsif( $mode == RPI_MODE_ALT5 ) {
158 0           $funcname = $alt_function_names->[$gpio]->[5];
159 0           $altnum = 5;
160             } else {
161 0           $funcname = 'ERROR';
162             }
163            
164 0 0         return ( wantarray ) ? ( $funcname, $altnum ) : $funcname;
165             }
166              
167             sub get_peripheral_base_address {
168 0     0 0   return xs_gpio_get_peripheral_base_address();
169             }
170              
171             ## edge detect functions conflict with system
172              
173             #sub get_pin_edge_detect {
174             # my( $self, $gpio ) = @_;
175             # return xs_gpio_read_edge_detect( $gpio );
176             #}
177             #
178             #sub clear_pin_edge_detect {
179             # my( $self, $gpio ) = @_;
180             # return xs_gpio_clear_edge_detect( $gpio );
181             #}
182             #
183             #sub set_rising_edge_detect {
184             # my($class, $gpio, $val) = @_;
185             # $val //= 0;
186             # return xs_gpio_set_edge_detect( $gpio, GPREN0(), $val);
187             #}
188             #
189             #sub get_rising_edge_detect {
190             # my($class, $gpio) = @_;
191             # return xs_gpio_get_edge_detect( $gpio, GPREN0());
192             #}
193             #
194             #sub set_falling_edge_detect {
195             # my($class, $gpio, $val) = @_;
196             # $val //= 0;
197             # return xs_gpio_set_edge_detect( $gpio, GPFEN0(), $val);
198             #}
199             #
200             #sub get_falling_edge_detect {
201             # my($class, $gpio) = @_;
202             # return xs_gpio_get_edge_detect( $gpio, GPFEN0());
203             #}
204             #
205             #sub set_high_edge_detect {
206             # my($class, $gpio, $val) = @_;
207             # $val //= 0;
208             # return xs_gpio_set_edge_detect( $gpio, GPHEN0(), $val);
209             #}
210             #
211             #sub get_high_edge_detect {
212             # my($class, $gpio) = @_;
213             # return xs_gpio_get_edge_detect( $gpio, GPHEN0());
214             #}
215             #
216             #sub set_low_edge_detect {
217             # my($class, $gpio, $val) = @_;
218             # $val //= 0;
219             # return xs_gpio_set_edge_detect( $gpio, GPLEN0(), $val);
220             #}
221             #
222             #sub get_low_edge_detect {
223             # my($class, $gpio) = @_;
224             # return xs_gpio_get_edge_detect( $gpio, GPLEN0());
225             #}
226             #
227             #sub set_async_rising_edge_detect {
228             # my($class, $gpio, $val) = @_;
229             # $val //= 0;
230             # return xs_gpio_set_edge_detect( $gpio, GPAREN0(), $val);
231             #}
232             #
233             #sub get_async_rising_edge_detect {
234             # my($class, $gpio) = @_;
235             # return xs_gpio_get_edge_detect( $gpio, GPAREN0());
236             #}
237             #
238             #sub set_async_falling_edge_detect {
239             # my($class, $gpio, $val) = @_;
240             # $val //= 0;
241             # return xs_gpio_set_edge_detect( $gpio, GPAFEN0(), $val);
242             #}
243             #
244             #sub get_async_falling_edge_detect {
245             # my($class, $gpio) = @_;
246             # return xs_gpio_get_edge_detect( $gpio, GPAFEN0());
247             #}
248              
249             # Aliases
250              
251             *HiPi::GPIO::get_pin_level = \&pin_read;
252             *HiPi::GPIO::set_pin_level = \&pin_write;
253              
254             1;
255              
256             __END__