File Coverage

blib/lib/App/Device/Chip/sensor.pm
Criterion Covered Total %
statement 135 149 90.6
branch 18 24 75.0
condition 8 12 66.6
subroutine 23 26 88.4
pod 6 8 75.0
total 190 219 86.7


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2020-2021 -- leonerd@leonerd.org.uk
5              
6 6     6   553922 use v5.26;
  6         54  
7 6     6   642 use Object::Pad 0.19;
  6         11407  
  6         34  
8              
9             package App::Device::Chip::sensor 0.03;
10             class App::Device::Chip::sensor;
11              
12 6     6   2230 use Carp;
  6         15  
  6         571  
13              
14 6     6   3187 use Feature::Compat::Defer;
  6         2014  
  6         30  
15 6     6   9688 use Future::AsyncAwait;
  6         31974  
  6         49  
16              
17 6     6   3445 use Device::Chip::Adapter;
  6         35157  
  6         308  
18 6     6   1709 use Future::IO 0.08; # ->alarm
  6         15434  
  6         316  
19 6     6   5025 use Getopt::Long qw( GetOptionsFromArray );
  6         71325  
  6         36  
20 6     6   1428 use List::Util qw( all max );
  6         17  
  6         1972  
21 6     6   56 use Scalar::Util qw( refaddr );
  6         15  
  6         22552  
22              
23             =head1 NAME
24              
25             C - Base class to build C-based applications on
26              
27             =head1 SYNOPSIS
28              
29             #!/usr/bin/perl
30             use v5.26;
31              
32             use Object::Pad;
33             use Future::AsyncAwait;
34              
35             class App extends App::Device::Chip::sensor
36             {
37             method output_readings ( $now, $sensors, $values )
38             {
39             print "At time $now, we have some sensor values...\n";
40             }
41             }
42              
43             await App->new->parse_argv->run;
44              
45             =head1 DESCRIPTION
46              
47             This module provides a base class to assist in writing applications that
48             process data periodically from one or more L-based sensors, via
49             the L interface. A typical program using this module
50             would derive a subclass from it, provide the remaining methods as necessary,
51             and eventually call the L method to start the application.
52              
53             =cut
54              
55             =head1 COMMANDLINE OPTIONS
56              
57             The following commandline options are recognised by the base class and may be
58             used in addition to any defined by the actual application logic.
59              
60             =over 4
61              
62             =item * --blib, -b
63              
64             Uses the L module to add additional paths into C<@INC> to search for
65             more Perl modules. May be useful when testing chip drivers under development
66             without needing to install them.
67              
68             =item * --interval, -i TIME
69              
70             Specifies the time, in seconds, between every round of collecting sensor
71             readings and invoking the L method.
72              
73             Defaults to 10 seconds.
74              
75             =item * --adapter, -A STR
76              
77             Adapter configuration string to pass to L
78             to construct the chip adapter used for communication with the actual chip
79             hardware.
80              
81             =item * --mid3, -m
82              
83             Enable "middle-of-3" filtering of gauge values, to reduce sensor noise from
84             unreliable sensors. At each round of readings, the most recent three values
85             from the sensor are sorted numerically and the middle one is reported.
86              
87             =back
88              
89             =cut
90              
91             has @_CHIPCONFIGS;
92 2     2   12 method _chipconfigs { @_CHIPCONFIGS } # for unit testing
  2         14  
93              
94 3     3 0 305 has $_interval :reader = 10;
  3         18  
95              
96             has $_best_effort;
97              
98             has $_mid3;
99              
100             method OPTSPEC
101 8     8 1 40 {
102             return (
103 0     0   0 'b|blib' => sub { require blib; blib->import; },
  0         0  
104              
105 8         75 'i|interval=i' => \$_interval,
106              
107             'm|mid3' => \$_mid3,
108              
109             'B|best-effort' => \$_best_effort,
110             );
111             }
112              
113             =head1 PROVIDED METHODS
114              
115             The following methods are provided on the base class, intended for subclasses
116             or applications to invoke.
117              
118             =cut
119              
120             =head2 parse_argv
121              
122             $app->parse_argv()
123             $app->parse_argv( \@argv )
124              
125             Provides a list of commandline arguments for parsing, either from a given
126             array reference or defaulting to the process C<@ARGV> if not supplied.
127              
128             This uses L to collect the defined arguments, whose references
129             should handle the results.
130              
131             =cut
132              
133 8         18 method parse_argv ( $argv = \@ARGV )
  8         20  
  8         13  
134 8     8 1 24435 {
135 8         40 my %optspec = $self->OPTSPEC;
136              
137 8         29 @_CHIPCONFIGS = ();
138              
139 8         20 my $ADAPTERDESC; my $adapter;
140              
141             GetOptionsFromArray( $argv, %optspec,
142             'adapter|A=s' => sub {
143 5     5   3420 $ADAPTERDESC = $_[1];
144 5         18 undef $adapter;
145             },
146             '<>' => sub {
147 9     9   2495 my ( $chiptype, $opts ) = split m/:/, $_[0], 2;
148              
149 9   66     88 $adapter //= Device::Chip::Adapter->new_from_description( $ADAPTERDESC );
150              
151 9         702 my $config = {
152             type => $chiptype,
153             adapter => $adapter,
154             };
155              
156 9         38 while( length $opts ) {
157 1 50       9 if( $opts =~ s/^-C:(.*?)=(.*)(?:$|,)// ) {
158 1         6 $config->{config}{$1} = $2;
159             }
160             else {
161 0         0 croak "Unable to parse chip configuration options '$opts' for $chiptype'";
162             }
163             }
164              
165 9         34 push @_CHIPCONFIGS, $config;
166             },
167 8 50       104 ) or exit 1;
168              
169 8         261 return $self;
170             }
171              
172             =head2 chips
173              
174             @chips = await $app->chips;
175              
176             An asynchronous memoized lazy accessor for the list of L
177             instances, whose class names are taken from the remaining commandline
178             arguments after the options are parsed.
179              
180             =cut
181              
182             has $_chips; # arrayref
183             async method chips
184 9         36 {
185 9 100       60 return @$_chips if $_chips;
186              
187 4         14 foreach my $chipconfig ( @_CHIPCONFIGS ) {
188 4         12 my $chiptype = $chipconfig->{type};
189 4         10 my $adapter = $chipconfig->{adapter};
190              
191 4         15 my $class = "Device::Chip::$chiptype";
192              
193 4         44 require ( "$class.pm" ) =~ s(::)(/)gr;
194              
195 4         53 my $chip = $class->new;
196 4         105 await $chip->mount( $adapter );
197              
198 4 50       720 if( $chipconfig->{config} ) {
199 0         0 await $chip->change_config( $chipconfig->{config}->%* );
200             }
201              
202 4         32 await $chip->protocol->power(1);
203              
204 4 100       204 if( $chip->can( "initialize_sensors" ) ) {
205 1         4 await $chip->initialize_sensors;
206             }
207              
208 4         66 push @$_chips, $chip;
209             }
210              
211 4         32 return @$_chips;
212 9     9 1 25 }
213              
214             =head2 chips
215              
216             @sensors = await $app->sensors;
217              
218             An asynchronous memoized lazy accessor for the list of L
219             instances of each of the configured chips (from the L method).
220              
221             =cut
222              
223             has $_sensors; # arrayref
224              
225             has $_chipname_width;
226             has $_sensorname_width;
227              
228 6     6   12 sub _chipname ( $chip ) { return ( ref $chip ) =~ s/^Device::Chip:://r }
  6         12  
  6         11  
  6         55  
229              
230             async method sensors
231 5         29 {
232 5 100       32 return @$_sensors if $_sensors;
233              
234 4         17 @$_sensors = map { $_->list_sensors } await $self->chips;
  4         160  
235              
236 4         298 $_chipname_width = max map { length _chipname $_ } @$_chips;
  4         18  
237 4         16 $_sensorname_width = max map { length $_->name } @$_sensors;
  5         24  
238              
239 4         48 await $self->after_sensors( @$_sensors );
240              
241 4         165 return @$_sensors;
242 5     5 0 1695 }
243              
244 3     3 1 9 async method after_sensors ( @sensors ) { }
  3         8  
  3         6  
  3         10  
  3         15  
245              
246             =head2 run
247              
248             await $app->run;
249              
250             An asynchronous method which performs the actual run loop of the sensor
251             application. This implements the main application logic, of regular collection
252             of values from all of the sensor instances and reporting them to the
253             L method.
254              
255             In normal circumstances the L instance returned by this method would
256             remain pending for the lifetime of the program, and not complete. For an
257             application that has nothing else to perform concurrently it can simply
258             C this future to run the logic. If it has other logic to perform as
259             well it could combine this with other futures using a C<< Future->needs_all >>
260             or similar techniques.
261              
262             =cut
263              
264 4         7 async method run ()
  4         8  
265 4         16 {
266 4         22 my @chips = await $self->chips;
267              
268 0     0   0 $SIG{INT} = $SIG{TERM} = sub { exit 1; };
  4         308  
269              
270 4         23 defer {
271             $chips[0] and $chips[0]->protocol->power(0)->get;
272             }
273              
274 4         27 my @sensors = await $self->sensors;
275              
276 4         136 my %readings_by_chip;
277              
278 4         28 my $waittime = Time::HiRes::time();
279 4         9 while(1) {
280             # Read concurrently
281 8         674 my $now = Time::HiRes::time();
282              
283             my @values = await Future->needs_all(
284             map {
285 8         21 my $sensor = $_;
286             my $f = $sensor->read;
287 0     0   0 $f = $f->else( async sub ($failure, @) {
  0         0  
  0         0  
  0         0  
288 0         0 my $sensorname = $sensor->name;
289 0         0 my $chipname = ref ( $sensor->chip );
290 0         0 warn "Unable to read $sensorname of $chipname: $failure";
291 0         0 return undef;
292             } ) if $_best_effort;
293             $f;
294             } @sensors
295             );
296              
297 8 100       3884 if( $_mid3 ) {
298 3         19 foreach my $idx ( 0 .. $#sensors ) {
299 3         9 my $sensor = $sensors[$idx];
300 3         5 my $value = $values[$idx];
301              
302 3 50       13 next unless $sensor->type eq "gauge";
303              
304             # Accumulate the past 3 readings
305 3   100     37 my $readings = $readings_by_chip{ refaddr $sensor } //= [];
306 3         6 push @$readings, $value;
307 3         10 shift @$readings while @$readings > 3;
308              
309             # Take the middle of the 3
310 3 100 66 3   10 if( @$readings == 3 and all { defined } @$readings ) {
  3         18  
311 1         7 my @sorted = sort { $a <=> $b } @$readings;
  3         9  
312 1         6 $values[$idx] = $sorted[1];
313             }
314             }
315             }
316              
317 8         43 $self->output_readings( $now, \@sensors, \@values );
318              
319 8         264 $waittime += $_interval;
320 8         80 await Future::IO->alarm( $waittime );
321             }
322 4     4 1 2093 }
323              
324             =head2 print_readings
325              
326             $app->print_readings( $sensors, $values )
327              
328             Prints the sensor names and current readings in a human-readable format to the
329             currently-selected output handle (usually C).
330              
331             =cut
332              
333 1         2 method print_readings ( $sensors, $values )
  1         2  
  1         3  
  1         2  
334 1     1 1 18 {
335 1         6 foreach my $i ( 0 .. $#$sensors ) {
336 2         16 my $sensor = $sensors->[$i];
337 2         4 my $value = $values->[$i];
338              
339 2         8 my $chip = $sensor->chip;
340 2         13 my $chipname = _chipname $chip;
341              
342 2         8 my $units = $sensor->units;
343 2 50       14 $units = " $units" if defined $units;
344              
345 2         3 my $valuestr;
346 2 50       9 if( !defined $value ) {
    100          
347 0         0 $valuestr = "";
348             }
349             elsif( $sensor->type eq "gauge" ) {
350 1   50     10 $valuestr = sprintf "%s%s", $sensor->format( $value ), $units // "";
351             }
352             else {
353 1   50     13 $valuestr = sprintf "%s%s/sec", $sensor->format( $value / $self->interval ), $units // "";
354             }
355              
356 2         61 printf "% *s/% *s: %s\n",
357             $_chipname_width, $chipname, $_sensorname_width, $sensor->name, $valuestr;
358             }
359             }
360              
361             =head1 REQUIRED METHODS
362              
363             This base class itself is incomplete, requiring the following methods to be
364             provided by an implementing subclass to contain the actual application logic.
365              
366             =cut
367              
368             =head2 output_readings
369              
370             $app->output_readings( $now, $sensors, $values );
371              
372             This method is invoked regularly by the L method, to provide the
373             application with the latest round of sensor readings. It is passed the current
374             UNIX epoch timestamp as C<$now>, an array reference containing the individual
375             L instances as C<$sensors>, and a congruent array
376             reference containing the most recent readings taken from them, as plain
377             numbers.
378              
379             The application should put the bulk of its processing logic in here, for
380             example writing the values to some sort of file or database, displaying them
381             in some form, or whatever else the application is supposed to do.
382              
383             =cut
384              
385             =head1 OVERRIDABLE METHODS
386              
387             The base class provides the following methods, but it is expected that
388             applications may wish to override them to customise the logic contained in
389             them.
390              
391             If using L to do so, don't forget to provide the C<:override>
392             method attribute.
393              
394             =cut
395              
396             =head2 OPTSPEC
397              
398             %optspec = $app->OPTSPEC;
399              
400             This method is invoked by the L method to construct a definition
401             of the commandline options understood by the program. These are returned in a
402             key/value list to be processed by L. If the application wishes
403             to parse additional arguments it should override this method, call the
404             superclass version, and append any extra argument specifications it requires.
405              
406             As this is invoked as a regular instance method, a convenient way to store the
407             parsed values is to pass references to instance slot variables created by the
408             L C keyword:
409              
410             has $_title;
411             has $_bgcol = "#cccccc";
412              
413             method OPTSPEC :override
414             {
415             return ( $self->SUPER::OPTSPEC,
416             'title=s' => \$_title,
417             'background-color=s' => \$_bgcol,
418             );
419             }
420              
421             =cut
422              
423             =head2 after_sensors
424              
425             await $app->after_sensors( @sensors )
426              
427             This method is invoked once on startup by the L method, after it has
428             configured the chip adapter and chips and obtained their individual sensor
429             instances. The application may wish to perform one-time startup tasks in here,
430             such as creating database files with knowledge of the specific sensor data
431             types, or other such behaviours.
432              
433             =cut
434              
435             =head1 AUTHOR
436              
437             Paul Evans
438              
439             =cut
440              
441             0x55AA;