1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
#!/usr/bin/env perl
# -*- mode: perl-ts; -*-
use strict;
use warnings;
use Test::More tests => 3;
use Time::HiRes qw(usleep);
# Basic Atlas Scientific EZO probe smoke test.
#
# Run on a daq-node:
# prove -v t/probe.t
#
# Optional overrides:
# FAPG_DAQ_SERIAL_PORT=/dev/ttyUSB1 FAPG_DAQ_SERIAL_BAUD=9600 prove -v t/probe.t
my $port = $ENV{FAPG_DAQ_SERIAL_PORT} // $ARGV[0] // '/dev/ttyUSB0';
my $baud = $ENV{FAPG_DAQ_SERIAL_BAUD} // $ARGV[1] // 9600;
my $serial_module_ok = eval {
require Device::SerialPort;
Device::SerialPort->import;
1;
};
BAIL_OUT("Device::SerialPort is required: $@") unless $serial_module_ok;
BAIL_OUT("Serial port does not exist: $port") unless -e $port;
my $serial = Device::SerialPort->new($port)
or BAIL_OUT("Cannot open serial port: $port");
$serial->baudrate($baud) or BAIL_OUT("Cannot set baudrate to $baud");
$serial->databits(8) or BAIL_OUT('Cannot set databits to 8');
$serial->parity('none') or BAIL_OUT('Cannot set parity to none');
$serial->stopbits(1) or BAIL_OUT('Cannot set stopbits to 1');
$serial->read_char_time(0);
$serial->read_const_time(100);
note("Testing EZO probe on $port at $baud baud");
my $info = ezo_command($serial, 'I', 500_000);
note("I => " . printable($info));
ok($info ne '', 'probe is reachable');
like($info, qr/(?:\?I,|EZO|PH|EC|DO|ORP)/i, 'probe is identifiable');
my $reading = ezo_command($serial, 'R', 1_500_000);
note("R => " . printable($reading));
like(
$reading,
qr/OK/,
'probe returns a single reading'
);
sub ezo_command {
my ($serial, $command, $wait_us) = @_;
drain_serial($serial);
my $written = $serial->write("$command\r");
return '' unless defined $written && $written > 0;
usleep($wait_us);
my $reply = '';
while (1) {
my ($count, $buffer) = $serial->read(255);
last unless $count;
$reply .= $buffer;
}
return clean_reply($reply);
}
sub drain_serial {
my ($serial) = @_;
while (1) {
my ($count, undef) = $serial->read(255);
last unless $count;
}
}
sub clean_reply {
my ($reply) = @_;
$reply =~ s/\r/\n/g;
$reply =~ s/\n+/\n/g;
$reply =~ s/^\n|\n$//g;
return $reply;
}
sub printable {
my ($value) = @_;
return $value eq '' ? '<no response>' : $value;
}
|
