[Perl] DAQ system for the FAPG.
Target Perl 5.32.1 everywhere.
Changed files
roles/daq-node/bin/fapg-daq-node
@@ -1,7 +1,7 @@
1
1
#!/usr/bin/env perl
2
2
# -*- mode: perl-ts; -*-
3
3
4
Removed:
use 5.40.1;
4
Added:
use v5.32.1;
5
5
use strict;
6
6
use warnings;
7
7
@@ -34,12 +34,12 @@
34
34
EOF
35
35
36
36
while (1) {
37
Removed:
try {
37
Added:
eval {
38
38
my $reading = read_once( $serial, probe => $info->{probe} );
39
39
say "$reading->{probe}: $reading->{value} $reading->{unit}";
40
40
publish_mqtt($reading);
41
Removed:
} catch ($e) {
42
Removed:
warn "DAQ loop error: $e";
41
Added:
} or do {
42
Added:
warn "DAQ loop error: $@";
43
43
sleep 30;
44
44
next
45
45
};
roles/daq-node/lib/perl5/FAPG/DAQ/EZO/USB.pm
@@ -2,7 +2,7 @@
2
2
3
3
package FAPG::DAQ::EZO::USB;
4
4
5
Removed:
use v5.40.1;
5
Added:
use v5.32.1;
6
6
use strict;
7
7
use warnings;
8
8
@@ -26,7 +26,8 @@
26
26
my $DEFAULT_TIMEOUT_S = 1.5;
27
27
my $EOL = "\r";
28
28
29
Removed:
sub open_ezo_usb (%opt) {
29
Added:
sub open_ezo_usb {
30
Added:
my %opt = @_;
30
31
my $device = $opt{device} // croak 'open_ezo_usb requires device => "/dev/tty..."';
31
32
my $baudrate = $opt{baudrate} // $DEFAULT_BAUDRATE;
32
33
my $timeout_ms = $opt{timeout_ms} // 250;
@@ -48,7 +49,8 @@
48
49
return $port;
49
50
}
50
51
51
Removed:
sub drain_serial ( $io, %opt ) {
52
Added:
sub drain_serial {
53
Added:
my ( $io, %opt ) = @_;
52
54
my $max_s = $opt{max_s} // 0.20;
53
55
my $chunk_sz = $opt{chunk_sz} // 255;
54
56
my $deadline = time + $max_s;
@@ -63,7 +65,8 @@
63
65
return $drained;
64
66
}
65
67
66
Removed:
sub ezo_command ( $io, $command, %opt ) {
68
Added:
sub ezo_command {
69
Added:
my ( $io, $command, %opt ) = @_;
67
70
croak 'command must not contain carriage returns or newlines'
68
71
if $command =~ /[\r\n]/;
69
72
@@ -84,7 +87,8 @@
84
87
return $response;
85
88
}
86
89
87
Removed:
sub read_probe_info ( $io, %opt ) {
90
Added:
sub read_probe_info {
91
Added:
my ( $io, %opt ) = @_;
88
92
my $raw = ezo_command( $io, 'I', %opt );
89
93
90
94
my ( undef, $device, $firmware ) = split qr{,}, $raw, 3;
@@ -103,11 +107,13 @@
103
107
};
104
108
}
105
109
106
Removed:
sub detect_probe_type ( $io, %opt ) {
110
Added:
sub detect_probe_type {
111
Added:
my ( $io, %opt ) = @_;
107
112
return read_probe_info( $io, %opt )->{probe};
108
113
}
109
114
110
Removed:
sub read_once ( $io, %opt ) {
115
Added:
sub read_once {
116
Added:
my ( $io, %opt ) = @_;
111
117
my $probe = $opt{probe};
112
118
113
119
$probe = detect_probe_type( $io, %opt ) if not defined $probe;
@@ -125,7 +131,8 @@
125
131
};
126
132
}
127
133
128
Removed:
sub parse_reading ( $raw, %opt ) {
134
Added:
sub parse_reading {
135
Added:
my ( $raw, %opt ) = @_;
129
136
croak 'empty EZO reading'
130
137
if not defined $raw || $raw eq q{};
131
138
@@ -146,7 +153,8 @@
146
153
};
147
154
}
148
155
149
Removed:
sub normalize_probe_type ($probe) {
156
Added:
sub normalize_probe_type {
157
Added:
my ($probe) = @_;
150
158
croak 'probe type is required'
151
159
if not defined $probe || $probe eq q{};
152
160
@@ -161,7 +169,8 @@
161
169
: croak "unknown EZO probe type '$probe'";
162
170
}
163
171
164
Removed:
sub unit_for_probe_type ($probe) {
172
Added:
sub unit_for_probe_type {
173
Added:
my ($probe) = @_;
165
174
my $p = normalize_probe_type($probe);
166
175
167
176
return 'pH' if $p eq 'ph';
@@ -172,7 +181,8 @@
172
181
croak "unknown normalized probe type '$p'";
173
182
}
174
183
175
Removed:
sub _read_ezo_line ( $io, %opt ) {
184
Added:
sub _read_ezo_line {
185
Added:
my ( $io, %opt ) = @_;
176
186
my $timeout_s = $opt{timeout_s} // $DEFAULT_TIMEOUT_S;
177
187
my $deadline = time + $timeout_s;
178
188
my $buf = q{};
roles/daq-node/lib/perl5/FAPG/DAQ/MQTT.pm
@@ -2,7 +2,7 @@
2
2
3
3
package FAPG::DAQ::MQTT;
4
4
5
Removed:
use v5.40.1;
5
Added:
use v5.32.1;
6
6
use warnings;
7
7
8
8
use Carp qw(croak);
@@ -23,7 +23,8 @@
23
23
my $DEFAULT_SCHEMA = 'fapg.daq.reading.v1';
24
24
my $TOPIC_PREFIX = 'fapg/daq';
25
25
26
Removed:
sub publish_mqtt ($reading, %opt) {
26
Added:
sub publish_mqtt {
27
Added:
my ($reading, %opt) = @_;
27
28
my $client = $opt{client} // _mqtt_client(%opt);
28
29
my $topic = mqtt_topic_for_reading($reading, %opt);
29
30
my $payload = mqtt_payload_for_reading($reading, %opt);
@@ -36,7 +37,8 @@
36
37
};
37
38
}
38
39
39
Removed:
sub mqtt_payload_for_reading ($reading, %opt) {
40
Added:
sub mqtt_payload_for_reading {
41
Added:
my ($reading, %opt) = @_;
40
42
_assert_reading($reading);
41
43
42
44
my $probe = lc $reading->{probe};
@@ -61,7 +63,8 @@
61
63
return JSON::PP->new->canonical(1)->encode(\%payload);
62
64
}
63
65
64
Removed:
sub mqtt_topic_for_reading ($reading, %opt) {
66
Added:
sub mqtt_topic_for_reading {
67
Added:
my ($reading, %opt) = @_;
65
68
_assert_reading($reading);
66
69
67
70
my $prefix = $opt{topic_prefix} // $TOPIC_PREFIX;
@@ -73,7 +76,8 @@
73
76
return join '/', $prefix, $probe, $node, 'reading';
74
77
}
75
78
76
Removed:
sub mqtt_broker_endpoint (%opt) {
79
Added:
sub mqtt_broker_endpoint {
80
Added:
my (%opt) = @_;
77
81
my $host = $opt{host}
78
82
// $ENV{FAPG_MQTT_HOST}
79
83
// $ENV{MQTT_HOST}
@@ -88,7 +92,8 @@
88
92
return "$host:$port";
89
93
}
90
94
91
Removed:
sub _mqtt_client (%opt) {
95
Added:
sub _mqtt_client {
96
Added:
my (%opt) = @_;
92
97
my $endpoint = mqtt_broker_endpoint(%opt);
93
98
94
99
my $username = $opt{username}
@@ -120,7 +125,8 @@
120
125
return $clients{$cache_key} = $client;
121
126
}
122
127
123
Removed:
sub _assert_reading ($reading) {
128
Added:
sub _assert_reading {
129
Added:
my ($reading) = @_;
124
130
croak 'reading must be a HASH reference'
125
131
if ref($reading) ne 'HASH';
126
132
@@ -136,7 +142,8 @@
136
142
return;
137
143
}
138
144
139
Removed:
sub _node_name ($reading, %opt) {
145
Added:
sub _node_name {
146
Added:
my ($reading, %opt) = @_;
140
147
return $reading->{node}
141
148
// $opt{node}
142
149
// $ENV{FAPG_DAQ_NODE}
@@ -144,7 +151,8 @@
144
151
// hostname();
145
152
}
146
153
147
Removed:
sub _topic_level ($name, $value) {
154
Added:
sub _topic_level {
155
Added:
my ($name, $value) = @_;
148
156
croak "$name topic level is required"
149
157
if !defined $value || $value eq q{};
150
158
@@ -154,7 +162,7 @@
154
162
return $value;
155
163
}
156
164
157
Removed:
sub _utc_timestamp () {
165
Added:
sub _utc_timestamp {
158
166
return strftime '%Y-%m-%dT%H:%M:%SZ', gmtime;
159
167
}
160
168
roles/daq-node/t/01-ezo-usb.t
@@ -1,6 +1,6 @@
1
1
# -*- mode: cperl; -*-
2
2
3
Removed:
use v5.40.1;
3
Added:
use v5.32.1;
4
4
use strict;
5
5
use warnings;
6
6
@@ -23,10 +23,11 @@
23
23
24
24
package Local::FakeSerial;
25
25
26
Removed:
use v5.40.1;
26
Added:
use v5.32.1;
27
27
use warnings;
28
28
29
Removed:
sub new ( $class, @responses ) {
29
Added:
sub new {
30
Added:
my ( $class, @responses ) = @_;
30
31
return bless {
31
32
responses => [ map { $_ =~ /\r\z/ ? $_ : "$_\r" } @responses ],
32
33
rx => q{},
@@ -34,20 +35,23 @@
34
35
}, $class;
35
36
}
36
37
37
Removed:
sub write ( $self, $bytes ) {
38
Added:
sub write {
39
Added:
my ( $self, $bytes ) = @_;
38
40
push $self->{writes}->@*, $bytes;
39
41
$self->{rx} .= shift( $self->{responses}->@* ) // q{};
40
42
return length $bytes;
41
43
}
42
44
43
Removed:
sub read ( $self, $wanted ) {
45
Added:
sub read {
46
Added:
my ( $self, $wanted ) = @_;
44
47
return ( 0, q{} ) if $self->{rx} eq q{};
45
48
46
49
my $chunk = substr $self->{rx}, 0, $wanted, q{};
47
50
return ( length($chunk), $chunk );
48
51
}
49
52
50
Removed:
sub writes ($self) {
53
Added:
sub writes {
54
Added:
my ($self) = @_;
51
55
return $self->{writes};
52
56
}
53
57
}
roles/daq-node/t/02-probe.t
@@ -3,7 +3,7 @@
3
3
4
4
# Basic Atlas Scientific EZO probe smoke test.
5
5
6
Removed:
use 5.40.1;
6
Added:
use v5.32.1;
7
7
use strict;
8
8
use warnings;
9
9
roles/daq-node/t/03-mqtt.t
@@ -1,6 +1,6 @@
1
1
# -*- mode: cperl; -*-
2
2
3
Removed:
use v5.40.1;
3
Added:
use v5.32.1;
4
4
use strict;
5
5
use warnings;
6
6
@@ -20,19 +20,22 @@
20
20
{
21
21
package Local::FakeMQTT;
22
22
23
Removed:
use v5.40.1;
23
Added:
use v5.32.1;
24
24
use warnings;
25
25
26
Removed:
sub new ($class) {
26
Added:
sub new {
27
Added:
my ($class) = @_;
27
28
return bless { published => [] }, $class;
28
29
}
29
30
30
Removed:
sub publish ($self, $topic, $payload) {
31
Added:
sub publish {
32
Added:
my ($self, $topic, $payload) = @_;
31
33
push $self->{published}->@*, [$topic, $payload];
32
34
return 1;
33
35
}
34
36
35
Removed:
sub published ($self) {
37
Added:
sub published {
38
Added:
my ($self) = @_;
36
39
return $self->{published};
37
40
}
38
41
}
t/00-ping-from-dev.t
@@ -1,7 +1,7 @@
1
1
#!/usr/bin/env perl
2
2
# -*- mode: perl-ts; -*-
3
3
4
Removed:
use 5.32.0;
4
Added:
use v5.32.1;
5
5
use strict;
6
6
use warnings;
7
7
t/01-ssh-from-dev.t
@@ -1,7 +1,7 @@
1
1
#!/usr/bin/env perl
2
2
# -*- mode: perl-ts; -*-
3
3
4
Removed:
use 5.32.0;
4
Added:
use v5.32.1;
5
5
use strict;
6
6
use warnings;
7
7