File Coverage

blib/lib/App/Device/Chip/sensor.pm
Criterion Covered Total %
statement 163 181 90.0
branch 19 28 67.8
condition 10 18 55.5
subroutine 29 33 87.8
pod 9 11 81.8
total 230 271 84.8


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-2022 -- leonerd@leonerd.org.uk
5              
6 7     7   656529 use v5.26;
  7         62  
7 7     7   649 use Object::Pad 0.73 ':experimental(init_expr)';
  7         10776  
  7         35  
8              
9             package App::Device::Chip::sensor 0.05;
10             class App::Device::Chip::sensor;
11              
12 7     7   2757 use Carp;
  7         17  
  7         455  
13              
14 7     7   3548 use Feature::Compat::Defer;
  7         2148  
  7         29  
15 7     7   11881 use Feature::Compat::Try;
  7         1982  
  7         33  
16 7     7   11673 use Future::AsyncAwait;
  7         32960  
  7         41  
17              
18 7     7   3826 use Device::Chip::Adapter;
  7         38504  
  7         333  
19 7     7   3059 use Device::Chip::Sensor 0.19; # ->type
  7         19618  
  7         35  
20 7     7   1996 use Future::IO 0.08; # ->alarm
  7         32707  
  7         330  
21 7     7   5356 use Getopt::Long qw( GetOptionsFromArray );
  7         78847  
  7         28  
22 7     7   1288 use List::Util 1.29 qw( all max pairgrep );
  7         142  
  7         816  
23 7     7   53 use Scalar::Util qw( refaddr );
  7         15  
  7         31759  
24              
25             =head1 NAME
26              
27             C - Base class to build C-based applications on
28              
29             =head1 SYNOPSIS
30              
31             #!/usr/bin/perl
32             use v5.26;
33              
34             use Object::Pad;
35             use Future::AsyncAwait;
36              
37             class App extends App::Device::Chip::sensor
38             {
39             method output_readings ( $now, $sensors, $values )
40             {
41             print "At time $now, we have some sensor values...\n";
42             }
43             }
44              
45             await App->new->parse_argv->run;
46              
47             =head1 DESCRIPTION
48              
49             This module provides a base class to assist in writing applications that
50             process data periodically from one or more L-based sensors, via
51             the L interface. A typical program using this module
52             would derive a subclass from it, provide the remaining methods as necessary,
53             and eventually call the L method to start the application.
54              
55             =cut
56              
57             =head1 COMMANDLINE OPTIONS
58              
59             The following commandline options are recognised by the base class and may be
60             used in addition to any defined by the actual application logic.
61              
62             =over 4
63              
64             =item * --blib, -b
65              
66             Uses the L module to add additional paths into C<@INC> to search for
67             more Perl modules. May be useful when testing chip drivers under development
68             without needing to install them.
69              
70             =item * --interval, -i TIME
71              
72             Specifies the time, in seconds, between every round of collecting sensor
73             readings and invoking the L method.
74              
75             Defaults to 10 seconds.
76              
77             =item * --adapter, -A STR
78              
79             Adapter configuration string to pass to L
80             to construct the chip adapter used for communication with the actual chip
81             hardware.
82              
83             =item * --mid3, -m
84              
85             Enable "middle-of-3" filtering of gauge values, to reduce sensor noise from
86             unreliable sensors. At each round of readings, the most recent three values
87             from the sensor are sorted numerically and the middle one is reported.
88              
89             =item * --best-effort, -B
90              
91             Enables best-effort mode, which causes failures of sensor readings to be
92             ignored, reporting C instead. In this mode, the C
93             method may be invoked for failures; it can further refine what the behaviour
94             should be.
95              
96             =back
97              
98             =cut
99              
100             field @_CHIPCONFIGS;
101 2     2   9 method _chipconfigs { @_CHIPCONFIGS } # for unit testing
  2         15  
102              
103 3     3 0 41 field $_interval :reader = 10;
104              
105 3         19 field $_best_effort;
106              
107             field $_mid3;
108              
109             method OPTSPEC
110 9     9 1 41 {
111             return (
112 0     0   0 'b|blib' => sub { require blib; blib->import; },
  0         0  
113              
114 9         98 'i|interval=i' => \$_interval,
115              
116             'm|mid3' => \$_mid3,
117              
118             'B|best-effort' => \$_best_effort,
119             );
120             }
121              
122             =head1 PROVIDED METHODS
123              
124             The following methods are provided on the base class, intended for subclasses
125             or applications to invoke.
126              
127             =cut
128              
129             =head2 parse_argv
130              
131             $app->parse_argv()
132             $app->parse_argv( \@argv )
133              
134             Provides a list of commandline arguments for parsing, either from a given
135             array reference or defaulting to the process C<@ARGV> if not supplied.
136              
137             This uses L to collect the defined arguments, whose references
138             should handle the results.
139              
140             =cut
141              
142 9         18 method parse_argv ( $argv = \@ARGV )
  9         17  
  9         18  
143 9     9 1 22660 {
144 9         39 my %optspec = $self->OPTSPEC;
145              
146 9         34 @_CHIPCONFIGS = ();
147              
148 9         21 my $ADAPTERDESC; my $adapter;
149              
150             GetOptionsFromArray( $argv, %optspec,
151             'adapter|A=s' => sub {
152 6     6   3984 $ADAPTERDESC = $_[1];
153 6         20 undef $adapter;
154             },
155             '<>' => sub {
156 10     10   2671 my ( $chiptype, $opts ) = split m/:/, $_[0], 2;
157              
158 10   66     117 $adapter //= Device::Chip::Adapter->new_from_description( $ADAPTERDESC );
159              
160 10         816 my %config = (
161             type => $chiptype,
162             adapter => $adapter,
163             );
164              
165 10         45 while( length $opts ) {
166 1 50       8 if( $opts =~ s/^-C:(.*?)=(.*)(?:$|,)// ) {
    0          
167 1         6 $config{config}{$1} = $2;
168             }
169             elsif( $opts =~ s/^-M:(.*?)=(.*)(?:$|,)// ) {
170 0         0 $config{mountopts}{$1} = $2;
171             }
172             else {
173 0         0 croak "Unable to parse chip configuration options '$opts' for $chiptype'";
174             }
175             }
176              
177 10         70 $self->add_chip( %config );
178             },
179 9 50       103 ) or exit 1;
180              
181 9         339 return $self;
182             }
183              
184             =head2 add_chip
185              
186             $app->add_chip( %config );
187              
188             I
189              
190             Adds a new chip to the stored configuration, as if it had been given as a
191             commandline argument. Takes the following named arguments:
192              
193             =over 4
194              
195             =item type => STR
196              
197             Required string that gives the name of the chip class.
198              
199             =item adapter => Device::Chip::Adapter
200              
201             Required L instance.
202              
203             =item mountopts => HASH
204              
205             Optional hASH reference containing extra mount parameters.
206              
207             =item config => HASH
208              
209             Optional HASH reference containing extra chip configuration to set up using
210             the C method once mounted.
211              
212             =back
213              
214             =cut
215              
216 10         22 method add_chip ( %config )
  10         26  
  10         17  
217 10     10 1 29 {
218 10   33     33 $config{type} // croak "Require 'type'";
219 10   33     34 $config{adapter} // croak "Require 'adapter'";
220              
221 10     40   150 push @_CHIPCONFIGS, { pairgrep { defined $b } %config{qw( type adapter mountopts config )} };
  40         119  
222             }
223              
224             =head2 chips
225              
226             @chips = await $app->chips;
227              
228             An asynchronous memoized lazy accessor for the list of L
229             instances, whose class names are taken from the remaining commandline
230             arguments after the options are parsed.
231              
232             =cut
233              
234             field $_chips; # arrayref
235             async method chips
236 12         30 {
237 12 100       69 return @$_chips if $_chips;
238              
239 5         26 foreach my $chipconfig ( @_CHIPCONFIGS ) {
240 5         28 my $chiptype = $chipconfig->{type};
241 5         15 my $adapter = $chipconfig->{adapter};
242              
243 5         16 my $class = "Device::Chip::$chiptype";
244              
245 5         62 require ( "$class.pm" ) =~ s(::)(/)gr;
246              
247 5         73 my $chip = $class->new;
248              
249 5         114 my %mountopts;
250 5 50       29 %mountopts = $chipconfig->{mountopts}->%* if $chipconfig->{mountopts};
251              
252 5         36 await $chip->mount( $adapter, %mountopts );
253              
254 5 50       988 if( $chipconfig->{config} ) {
255 0         0 await $chip->change_config( $chipconfig->{config}->%* );
256             }
257              
258 5         34 await $chip->protocol->power(1);
259              
260 5 100       284 if( $chip->can( "initialize_sensors" ) ) {
261 1         5 await $chip->initialize_sensors;
262             }
263              
264 5         67 push @$_chips, $chip;
265             }
266              
267 5         53 return @$_chips;
268 12     12 1 31 }
269              
270             =head2 chips
271              
272             @sensors = await $app->sensors;
273              
274             An asynchronous memoized lazy accessor for the list of L
275             instances of each of the configured chips (from the L method).
276              
277             =cut
278              
279             field $_sensors; # arrayref
280              
281             field $_chipname_width;
282             field $_sensorname_width;
283              
284 7     7   15 sub _chipname ( $chip ) { return ( ref $chip ) =~ s/^Device::Chip:://r }
  7         24  
  7         14  
  7         62  
285              
286             async method sensors
287 7         27 {
288 7 100       34 return @$_sensors if $_sensors;
289              
290 5         17 @$_sensors = map { $_->list_sensors } await $self->chips;
  5         200  
291              
292 5         389 $_chipname_width = max map { length _chipname $_ } @$_chips;
  5         16  
293 5         15 $_sensorname_width = max map { length $_->name } @$_sensors;
  6         25  
294              
295 5         60 await $self->after_sensors( @$_sensors );
296              
297 5         206 return @$_sensors;
298 7     7 0 1807 }
299              
300 4     4 1 10 async method after_sensors ( @sensors ) { }
  4         12  
  4         24  
  4         22  
  4         28  
301              
302             =head2 run
303              
304             await $app->run;
305              
306             An asynchronous method which performs the actual run loop of the sensor
307             application. This implements the main application logic, of regular collection
308             of values from all of the sensor instances and reporting them to the
309             L method.
310              
311             In normal circumstances the L instance returned by this method would
312             remain pending for the lifetime of the program, and not complete. For an
313             application that has nothing else to perform concurrently it can simply
314             C this future to run the logic. If it has other logic to perform as
315             well it could combine this with other futures using a C<< Future->needs_all >>
316             or similar techniques.
317              
318             =cut
319              
320 6         12 async method run ()
  6         11  
321 6         27 {
322 6         25 my @chips = await $self->chips;
323              
324 0     0   0 $SIG{INT} = $SIG{TERM} = sub { exit 1; };
  6         463  
325              
326 6         28 defer {
327             try {
328             $chips[0] and $chips[0]->protocol->power(0)->get;
329             }
330             catch ($e) {
331             warn "Failed to turn off power while shutting down: $e";
332             }
333             }
334              
335 6         35 my @sensors = await $self->sensors;
336              
337 6         216 my %readings_by_sensor;
338              
339 6         22 my $waittime = Time::HiRes::time();
340 6         11 while(1) {
341             # Read concurrently
342 12         1098 my $now = Time::HiRes::time();
343              
344             my @values = await Future->needs_all(
345             map {
346 12         29 my $sensor = $_;
347             my $f = $sensor->read;
348 1         4 $f = $f->then(
349 1     1   397 async sub ($reading) {
  1         23  
  1         2  
350 1         5 $self->on_sensor_ok( $sensor );
351 1         14 return $reading;
352 3         6 },
353 3     3   1238 async sub ($failure, @) {
  3         5  
  3         5  
354 3         11 $self->on_sensor_fail( $sensor, $failure );
355 3         38 return undef;
356             },
357             ) if $_best_effort;
358             $f;
359             } @sensors
360             );
361              
362 12 100       6298 if( $_mid3 ) {
363 3         9 foreach my $idx ( 0 .. $#sensors ) {
364 3         6 my $sensor = $sensors[$idx];
365 3         7 my $value = $values[$idx];
366              
367 3 50       7 next unless $sensor->type eq "gauge";
368              
369             # Accumulate the past 3 readings
370 3   100     37 my $readings = $readings_by_sensor{ refaddr $sensor } //= [];
371 3         7 push @$readings, $value;
372 3         7 shift @$readings while @$readings > 3;
373              
374             # Take the middle of the 3
375 3 100 66 3   8 if( @$readings == 3 and all { defined } @$readings ) {
  3         16  
376 1         5 my @sorted = sort { $a <=> $b } @$readings;
  3         29  
377 1         6 $values[$idx] = $sorted[1];
378             }
379             }
380             }
381              
382 12         54 $self->output_readings( $now, \@sensors, \@values );
383              
384 12         390 $waittime += $_interval;
385 12         65 await Future::IO->alarm( $waittime );
386             }
387 6     6 1 3342 }
388              
389             =head2 print_readings
390              
391             $app->print_readings( $sensors, $values )
392              
393             Prints the sensor names and current readings in a human-readable format to the
394             currently-selected output handle (usually C).
395              
396             =cut
397              
398 1         2 method print_readings ( $sensors, $values )
  1         2  
  1         2  
  1         2  
399 1     1 1 15 {
400 1         5 foreach my $i ( 0 .. $#$sensors ) {
401 2         13 my $sensor = $sensors->[$i];
402 2         5 my $value = $values->[$i];
403              
404 2         6 my $chip = $sensor->chip;
405 2         12 my $chipname = _chipname $chip;
406              
407 2         13 my $units = $sensor->units;
408 2 50       15 $units = " $units" if defined $units;
409              
410 2         4 my $valuestr;
411 2 50       32 if( !defined $value ) {
    100          
412 0         0 $valuestr = "";
413             }
414             elsif( $sensor->type eq "gauge" ) {
415 1   50     14 $valuestr = sprintf "%s%s", $sensor->format( $value ), $units // "";
416             }
417             else {
418 1   50     11 $valuestr = sprintf "%s%s/sec", $sensor->format( $value / $self->interval ), $units // "";
419             }
420              
421 2         42 printf "% *s/% *s: %s\n",
422             $_chipname_width, $chipname, $_sensorname_width, $sensor->name, $valuestr;
423             }
424             }
425              
426             =head1 REQUIRED METHODS
427              
428             This base class itself is incomplete, requiring the following methods to be
429             provided by an implementing subclass to contain the actual application logic.
430              
431             =cut
432              
433             =head2 output_readings
434              
435             $app->output_readings( $now, $sensors, $values );
436              
437             This method is invoked regularly by the L method, to provide the
438             application with the latest round of sensor readings. It is passed the current
439             UNIX epoch timestamp as C<$now>, an array reference containing the individual
440             L instances as C<$sensors>, and a congruent array
441             reference containing the most recent readings taken from them, as plain
442             numbers.
443              
444             The application should put the bulk of its processing logic in here, for
445             example writing the values to some sort of file or database, displaying them
446             in some form, or whatever else the application is supposed to do.
447              
448             =cut
449              
450             =head1 OVERRIDABLE METHODS
451              
452             The base class provides the following methods, but it is expected that
453             applications may wish to override them to customise the logic contained in
454             them.
455              
456             If using L to do so, don't forget to provide the C<:override>
457             method attribute.
458              
459             =cut
460              
461             =head2 OPTSPEC
462              
463             %optspec = $app->OPTSPEC;
464              
465             This method is invoked by the L method to construct a definition
466             of the commandline options understood by the program. These are returned in a
467             key/value list to be processed by L. If the application wishes
468             to parse additional arguments it should override this method, call the
469             superclass version, and append any extra argument specifications it requires.
470              
471             As this is invoked as a regular instance method, a convenient way to store the
472             parsed values is to pass references to instance slot variables created by the
473             L C keyword:
474              
475             field $_title;
476             field $_bgcol = "#cccccc";
477              
478             method OPTSPEC :override
479             {
480             return ( $self->SUPER::OPTSPEC,
481             'title=s' => \$_title,
482             'background-color=s' => \$_bgcol,
483             );
484             }
485              
486             =cut
487              
488             =head2 after_sensors
489              
490             await $app->after_sensors( @sensors )
491              
492             This method is invoked once on startup by the L method, after it has
493             configured the chip adapter and chips and obtained their individual sensor
494             instances. The application may wish to perform one-time startup tasks in here,
495             such as creating database files with knowledge of the specific sensor data
496             types, or other such behaviours.
497              
498             =cut
499              
500             =head2 on_sensor_ok
501              
502             $app->on_sensor_ok( $sensor )
503              
504             This method is invoked in C<--best-effort> mode after a successful reading
505             from sensor; typically this is used to clear a failure state.
506              
507             The default implementation does nothing.
508              
509             =cut
510              
511 0     0 1   method on_sensor_ok ( $sensor ) { }
  0            
  0            
512              
513             =head2 on_sensor_fail
514              
515             $app->on_sensor_fail( $sensor, $failure )
516              
517             This method is invoked in C<--best-effort> mode after a failure of the given
518             sensor. The caught exception is passed as C<$failure>.
519              
520             The defaullt implementation prints this as a warning using the core C
521             function.
522              
523             =cut
524              
525 0           method on_sensor_fail ( $sensor, $failure )
  0            
  0            
  0            
526 0     0 1   {
527 0           my $sensorname = $sensor->name;
528 0           my $chipname = ref ( $sensor->chip );
529              
530 0           warn "Unable to read ${sensorname} of ${chipname}: $failure";
531             }
532              
533             =head1 AUTHOR
534              
535             Paul Evans
536              
537             =cut
538              
539             0x55AA;