File Coverage

blib/lib/HiPi/Device.pm
Criterion Covered Total %
statement 18 47 38.3
branch 0 6 0.0
condition n/a
subroutine 6 13 46.1
pod 0 6 0.0
total 24 72 33.3


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Device
3             # Description : Base class for /dev devices
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;
10              
11             #########################################################################################
12              
13 1     1   1242 use strict;
  1         2  
  1         33  
14 1     1   6 use warnings;
  1         2  
  1         30  
15 1     1   5 use parent qw( HiPi::Class );
  1         2  
  1         4  
16 1     1   55 use HiPi qw( :rpi );
  1         10  
  1         321  
17 1     1   9 use Time::HiRes qw( usleep );
  1         2  
  1         7  
18 1     1   120 use Carp;
  1         2  
  1         502  
19              
20             __PACKAGE__->create_accessors( qw( devicename ) );
21              
22             our $VERSION ='0.81';
23              
24             sub new {
25 0     0 0   my ($class, %params) = @_;
26 0           my $self = $class->SUPER::new(%params);
27 0           return $self;
28             }
29              
30             sub delay {
31 0     0 0   my($class, $millis) = @_;
32 0           usleep( int($millis * 1000));
33             }
34              
35             sub delayMicroseconds {
36 0     0 0   my($class, $micros) = @_;
37 0           usleep( int($micros) );
38             }
39              
40             *HiPi::Device::sleep_milliseconds = \&delay;
41             *HiPi::Device::sleep_microseconds = \&delayMicroseconds;
42              
43             sub modules_are_loaded {
44 0     0 0   my $class = shift;
45 0           my $modulesloaded = 0;
46 0           my $moduleoptions = $class->get_required_module_options();
47 0           my @lsmod= qx(lsmod);
48 0 0         if( $?) {
49 0           carp q(unable to determine if modules are loaded for HiPi::Device);
50             } else {
51 0           my %modules = map { (split(/\s+/, $_))[0..1] } @lsmod;
  0            
52 0           for my $optionlist ( @$moduleoptions ) {
53 0           my $thislistgood = 1;
54 0           for my $module ( @$optionlist ) {
55 0 0         unless( exists($modules{$module}) ) {
56 0           $thislistgood = 0;
57 0           last;
58             }
59             }
60 0 0         if( $thislistgood) {
61             # we found an option where required
62             # modules are loaded so we are good
63 0           $modulesloaded = 1;
64             }
65             }
66             }
67 0           return $modulesloaded;
68             }
69              
70             sub get_required_module_options {
71 0     0 0   return [ [ qw( override in derived class with module list ) ] ];
72             }
73              
74 0     0 0   sub close { 1; }
75              
76             sub DESTROY {
77 0     0     my $self = shift;
78 0           $self->SUPER::DESTROY;
79 0           $self->close;
80             }
81              
82             1;
83              
84             __END__