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; |