File Coverage

blib/lib/HiPi.pm
Criterion Covered Total %
statement 25 55 45.4
branch 0 16 0.0
condition 0 6 0.0
subroutine 9 15 60.0
pod 0 6 0.0
total 34 98 34.6


line stmt bran cond sub pod time code
1             ###############################################################################
2             # Distribution : HiPi Modules for Raspberry Pi
3             # File : lib/HiPi.pm
4             # Description : Pepi module for Raspberry Pi
5             # Copyright : Copyright (c) 2013-2019 Mark Dootson
6             # License : This is free software; you can redistribute it and/or modify it under
7             # the same terms as the Perl 5 programming language system itself.
8             #########################################################################################
9              
10             package HiPi;
11              
12             ###############################################################################
13 5     5   730641 use strict;
  5         19  
  5         138  
14 5     5   22 use warnings;
  5         8  
  5         141  
15 5     5   1989 use parent qw( Exporter );
  5         1489  
  5         24  
16 5     5   2631 use HiPi::Constant qw( :hipi );
  5         65  
  5         2025  
17 5     5   91 use HiPi::RaspberryPi;
  5         13  
  5         195  
18 5     5   27 use constant hipi_export_constants();
  5         10  
  5         16  
19 5     5   84 use Scalar::Util qw( weaken isweak refaddr );
  5         13  
  5         609  
20 5     5   29 use Carp;
  5         10  
  5         3428  
21              
22             our $VERSION ='0.80';
23              
24             our @EXPORT_OK = hipi_export_ok();
25             our %EXPORT_TAGS = hipi_export_tags();
26              
27             my $registered_exits = {};
28              
29             our $interrupt_verbose = 0;
30              
31             # who knows what we can catch
32             $SIG{INT} = \&_call_registered_and_exit;
33             $SIG{TERM} = \&_call_registered_and_exit;
34             $SIG{PIPE} = \&_call_registered_and_exit;
35             $SIG{HUP} = \&_call_registered_and_exit;
36              
37 7     7 0 40 sub is_raspberry_pi { return HiPi::RaspberryPi::is_raspberry() ; }
38              
39 0     0 0   sub alt_func_version { return HiPi::RaspberryPi::alt_func_version() ; }
40              
41             sub twos_compliment {
42 0     0 0   my( $class, $value, $numbytes) = @_;
43 0           my $onescomp = (~$value) & ( 2**(8 * $numbytes) -1 );
44 0           return $onescomp + 1;
45             }
46              
47             sub register_exit_method {
48 0     0 0   my($class, $obj, $method) = @_;
49 0           my $key = refaddr( $obj );
50 0           $registered_exits->{$key} = [ $obj, $method ];
51 0           weaken( $registered_exits->{$key}->[0] );
52             }
53              
54             sub unregister_exit_method {
55 0     0 0   my($class, $obj) = @_;
56 0           my $key = refaddr( $obj );
57 0 0         delete($registered_exits->{$key}) if exists($registered_exits->{$key});
58             }
59              
60             sub _call_registered_and_exit {
61 0     0     my $interrupt = shift;
62 0           my $tid = 0;
63 0 0         if( $HiPi::Threads::threads ) {
64 0           $tid = threads->tid();
65 0 0         HiPi::Threads->signal_handler( $interrupt ) unless( $tid ); # only call in main thread
66             }
67            
68 0           for my $key ( keys %$registered_exits ) {
69 0           my $method = $registered_exits->{$key}->[1];
70 0 0 0       if( isweak( $registered_exits->{$key}->[0] ) && $registered_exits->{$key}->[0]->can($method) ) {
71 0           $registered_exits->{$key}->[0]->$method();
72             }
73             }
74 0 0         unless( $tid ) {
75             # only in main thread
76 0 0         if($interrupt_verbose) {
77 0           Carp::confess(qq(\nInterrupt SIG$interrupt));
78             } else {
79 0           die qq(\nInterrupt SIG$interrupt);
80             }
81             }
82             }
83              
84             sub call_registered_exit_method {
85 0     0 0   my($class, $instance) = @_;
86 0           my $key = refaddr( $instance );
87 0 0         if(exists($registered_exits->{$key})) {
88 0           my $method = $registered_exits->{$key}->[1];
89 0 0 0       if( isweak( $registered_exits->{$key}->[0] ) && $registered_exits->{$key}->[0]->can($method) ) {
90 0           $registered_exits->{$key}->[0]->$method();
91             }
92             }
93             }
94              
95             1;
96              
97             =pod
98              
99             =encoding UTF-8
100              
101             =head1 NAME
102              
103             HiPi - Modules for Raspberry Pi GPIO
104              
105             =head1 SYNOPSIS
106              
107             use HiPi;
108             ....
109             use HiPi qw( :rpi :i2c :spi :mcp3adc :mcp4dac :mpl3115a2 );
110             ....
111             use HiPi qw( :mcp23x17 :lcd :hrf69 :openthings :energenie );
112              
113             =head1 DESCRIPTION
114              
115             HiPi provides modules for use with the Raspberry Pi GPIO and
116             peripherals.
117              
118             Documentation and details are available at
119              
120             L
121              
122             =head1 AUTHOR
123              
124             Mark Dootson, C<< mdootson@cpan.org >>.
125              
126             =head1 COPYRIGHT
127              
128             Copyright (c) 2013 - 2019 Mark Dootson
129              
130             =cut
131              
132             __END__