File Coverage

blib/lib/HiPi/Device/GPIO.pm
Criterion Covered Total %
statement 21 153 13.7
branch 0 50 0.0
condition 0 17 0.0
subroutine 7 29 24.1
pod 0 17 0.0
total 28 266 10.5


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Device::GPIO
3             # Description: Wrapper for GPIO
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::Device::GPIO;
10              
11             #########################################################################################
12 1     1   1068 use strict;
  1         3  
  1         33  
13 1     1   13 use warnings;
  1         2  
  1         28  
14 1     1   5 use parent qw( HiPi::Device );
  1         1  
  1         6  
15 1     1   59 use Carp;
  1         2  
  1         101  
16 1     1   7 use HiPi qw( :rpi );
  1         2  
  1         256  
17 1     1   453 use HiPi::Device::GPIO::Pin;
  1         3  
  1         43  
18 1     1   6 use Fcntl;
  1         2  
  1         2163  
19              
20             our $VERSION ='0.81';
21              
22             my $sysroot = '/sys/class/gpio';
23              
24              
25             sub new {
26 0     0 0   my ($class, %userparams) = @_;
27            
28 0           my %params = ();
29            
30 0           foreach my $key (sort keys(%userparams)) {
31 0           $params{$key} = $userparams{$key};
32             }
33            
34 0           my $self = $class->SUPER::new(%params);
35 0           return $self;
36             }
37              
38             # Methods are class methods
39              
40             sub export_pin {
41 0     0 0   my( $class, $pinno ) = @_;
42 0           my $pinroot = $class->_do_export( $pinno );
43 0           return HiPi::Device::GPIO::Pin->_open( pinid => $pinno );
44             }
45              
46             sub unexport_pin {
47 0     0 0   my( $class, $pinno ) = @_;
48 0           my $pinroot = qq(${sysroot}/gpio${pinno});
49 0 0         return if !-d $pinroot;
50             # unexport the pin
51 0 0         system( qq(/bin/echo $pinno > ${sysroot}/unexport) ) and croak qq(failed to unexport pin $pinno : $!);
52             }
53              
54             sub unexport_all {
55            
56 0 0   0 0   opendir(my $dir, $sysroot) or die qq(failed to open sysfs root : $!);
57 0           my @gpios = grep { /gpio\d+$/ } readdir( $dir );
  0            
58 0           closedir($dir);
59            
60 0           for my $gpio ( @gpios ) {
61 0           $gpio =~ s/^gpio//;
62 0           system( qq(/bin/echo $gpio > ${sysroot}/unexport) );
63             }
64            
65 0           return scalar @gpios;
66             }
67              
68             sub pin_status {
69 0     0 0   my($class, $pinno) = @_;
70 0           my $pinroot = qq(${sysroot}/gpio${pinno});
71 0 0         return (-d $pinroot ) ? DEV_GPIO_PIN_STATUS_EXPORTED : DEV_GPIO_PIN_STATUS_NONE;
72             }
73              
74             sub pin_write {
75 0     0 0   my($class, $gpio, $level) = @_;
76 0 0         my $wval = ( $level ) ? 1 : 0;
77 0           my $fh = _open_fh( _get_pin_filepath( $gpio, 'value' ) );
78 0           _write_fh( $fh, $wval);
79 0           close( $fh );
80 0           return $wval;
81             }
82              
83             sub pin_read {
84 0     0 0   my($class, $gpio) = @_;
85 0           my $fh = _open_fh( _get_pin_filepath( $gpio, 'value' ) );
86 0           my $rval = _read_fh( $fh, 1);
87 0           close( $fh );
88 0           return $rval;
89             }
90              
91             sub set_pin_mode {
92 0     0 0   my($class, $gpio, $mode, $init ) = @_;
93            
94 0           my $inst;
95 0 0         if( $mode == RPI_MODE_OUTPUT ) {
    0          
96 0 0         if( $init ) {
97 0           $inst = 'high';
98             } else {
99 0           $inst = 'low';
100             }
101             } elsif( $mode == RPI_MODE_INPUT ) {
102 0           $inst = 'in';
103             } else {
104 0           croak qq(Invalid value for mode : $mode);
105             }
106            
107 0           my $fh = _open_fh( _get_pin_filepath( $gpio, 'direction' ) );
108 0           _write_fh( $fh, $inst);
109 0           close( $fh );
110 0           return $mode;
111             }
112              
113             sub get_pin_mode {
114 0     0 0   my($class, $gpio ) = @_;
115 0           my $fh = _open_fh( _get_pin_filepath( $gpio, 'direction' ) );
116 0           my $result = _read_fh( $fh, 16);
117 0           close($fh);
118 0 0         return ( $result eq 'out' ) ? RPI_MODE_OUTPUT : RPI_MODE_INPUT;
119             }
120              
121             sub get_pin_function {
122 0     0 0   my($class, $gpio) = @_;
123 0           require HiPi::GPIO;
124 0           return HiPi::GPIO->get_pin_function( $gpio );
125             }
126              
127             sub set_pin_pud {
128 0     0 0   my($class, $gpio , $pud ) = @_;
129            
130 0           require HiPi::GPIO;
131            
132             # we want to force pin export
133 0           _get_pin_filepath( $gpio, 'value' );
134            
135 0           return HiPi::GPIO->set_pin_pud( $gpio, $pud );
136             }
137              
138             sub get_pin_pud {
139 0     0 0   my($class, $gpio ) = @_;
140            
141 0           require HiPi::GPIO;
142            
143             # we want to force pin export
144 0           _get_pin_filepath( $gpio, 'value' );
145            
146 0           return HiPi::GPIO->get_pin_pud( $gpio );
147             }
148              
149             sub set_pin_activelow {
150 0     0 0   my($class, $gpio, $alow ) = @_;
151 0 0         $alow = ( $alow ) ? 1 : 0;
152 0           my $fh = _open_fh( _get_pin_filepath( $gpio, 'active_low' ) );
153 0           _write_fh( $fh, $alow);
154 0           close( $fh );
155 0           return $alow;
156             }
157              
158             sub get_pin_activelow {
159 0     0 0   my($class, $gpio ) = @_;
160 0           my $fh = _open_fh( _get_pin_filepath( $gpio, 'active_low' ) );
161 0           my $result = _read_fh( $fh, 1);
162 0           close($fh);
163 0 0         return ( $result ) ? 1 : 0;
164             }
165              
166             sub get_pin_interrupt_filepath {
167 0     0 0   my($class, $gpio ) = @_;
168 0           my $fpath = _get_pin_filepath( $gpio, 'value' );
169 0           return $fpath;
170             }
171              
172             sub set_pin_interrupt {
173 0     0 0   my($class, $gpio, $newedge ) = @_;
174            
175 0   0       $newedge ||= RPI_INT_NONE;
176 0           my $stredge = 'none';
177 0 0 0       if ( $newedge == RPI_INT_AFALL || $newedge == RPI_INT_FALL || $newedge == RPI_INT_LOW ) {
    0 0        
    0 0        
      0        
178 0           $stredge = 'falling';
179             } elsif( $newedge == RPI_INT_ARISE || $newedge == RPI_INT_RISE || $newedge == RPI_INT_HIGH ) {
180 0           $stredge = 'rising';
181             } elsif( $newedge == RPI_INT_BOTH ) {
182 0           $stredge = 'both';
183             } else {
184 0           $stredge = 'none';
185 0           $newedge = RPI_INT_NONE;
186             }
187            
188 0           my $fh = _open_fh( _get_pin_filepath( $gpio, 'edge' ) );
189 0           _write_fh( $fh, $stredge );
190 0           close( $fh );
191 0           return $newedge;
192             }
193              
194             sub get_pin_interrupt {
195 0     0 0   my($class, $gpio ) = @_;
196 0           my $fh = _open_fh( _get_pin_filepath( $gpio, 'edge' ) );
197 0           my $result = _read_fh( $fh, 16);
198 0           close($fh);
199            
200 0           my $edge = RPI_INT_NONE;
201            
202 0 0         if($result eq 'rising') {
    0          
    0          
203 0           $edge = RPI_INT_RISE;
204             } elsif($result eq 'falling') {
205 0           $edge = RPI_INT_FALL;
206             } elsif($result eq 'both') {
207 0           $edge = RPI_INT_BOTH;
208             }
209            
210 0           return $edge;
211             }
212              
213             sub _do_export {
214 0     0     my ($class, $pinno ) = @_;
215 0           my $pinroot = qq(${sysroot}/gpio${pinno});
216 0 0         return $pinroot if -d $pinroot;
217 0 0         system(qq(/bin/echo $pinno > ${sysroot}/export)) and croak qq(failed to export pin $pinno : $!);
218            
219             # We have to wait for the system to export the pin correctly.
220             # Max 10 seconds
221 0           my $checkpath = qq($pinroot/value);
222 0           my $counter = 100;
223 0           while( $counter ){
224 0 0 0       last if( -e $checkpath && -w $checkpath );
225 0           $class->delay( 100 );
226 0           $counter --;
227             }
228            
229 0 0         unless( $counter ) {
230 0           croak qq(failed to export pin $checkpath);
231             }
232            
233 0           return $pinroot;
234             }
235              
236             sub _get_pin_filepath {
237 0     0     my( $pinno, $type ) = @_;
238 0           my $pinroot = __PACKAGE__->_do_export( $pinno );
239            
240 0           my $filepath = qq($pinroot/$type);
241            
242 0 0         if( -e $filepath ) {
243 0           return $filepath;
244             } else {
245 0           croak qq(could not find $type file for pin $pinno);
246             }
247             }
248              
249             sub _open_fh {
250 0     0     my $filepath = shift;
251 0           my $fh;
252 0 0         sysopen($fh, $filepath, O_RDWR|O_NONBLOCK) or croak qq(failed to open $filepath : $!);
253 0           return $fh;
254             }
255              
256             sub _read_fh {
257 0     0     my($fh, $bytes) = @_;
258 0           my $value;
259 0           sysseek($fh,0,0);
260 0 0         defined( sysread($fh, $value, $bytes) ) or croak(qq(Failed to read from filehandle : $!));
261 0           chomp $value;
262 0           return $value;
263             }
264              
265             sub _write_fh {
266 0     0     my($fh, $val) = @_;
267 0           sysseek($fh,0,0);
268 0 0         defined( syswrite($fh, $val) ) or croak(qq(Failed to write to filehandle : $!));
269             }
270              
271              
272             # Aliases
273              
274             *HiPi::Device::GPIO::get_pin = \&export_pin;
275             *HiPi::Device::GPIO::get_pin_level = \&pin_read;
276             *HiPi::Device::GPIO::set_pin_level = \&pin_write;
277              
278              
279             1;
280              
281             __END__