line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Device::Velleman::PPS10; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
################################################################################ |
4
|
|
|
|
|
|
|
# Class for reading data from Velleman pps10 scope over serial line. |
5
|
|
|
|
|
|
|
# Currently the module is geared towards processing only BA packets. |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# Note: This may work for the HPS40 model, but is untested. |
8
|
|
|
|
|
|
|
# Tested only on a Linux system. |
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
21287
|
use 5.008000; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
31
|
|
11
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
12
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
36
|
|
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
4
|
use base qw(Exporter); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
140
|
|
15
|
|
|
|
|
|
|
BEGIN { |
16
|
1
|
|
|
1
|
|
16
|
our $VERSION = 0.03; |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
1
|
|
|
1
|
|
1296
|
use Device::SerialPort; |
|
1
|
|
|
|
|
38259
|
|
|
1
|
|
|
|
|
73
|
|
20
|
1
|
|
|
1
|
|
951
|
use Hash::Util qw(lock_hash lock_keys); |
|
1
|
|
|
|
|
2259
|
|
|
1
|
|
|
|
|
7
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
################################################################################ |
24
|
|
|
|
|
|
|
# Scope Characteristics |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
use constant { |
27
|
|
|
|
|
|
|
# The ascii string of the delimiters defining the start of a data packet. |
28
|
|
|
|
|
|
|
# The binary values in the buffer will be matched in string context. |
29
|
1
|
|
|
|
|
2182
|
BA_DELIM => 'BA' . chr(10) . chr(1), |
30
|
|
|
|
|
|
|
BR_DELIM => 'BR', |
31
|
|
|
|
|
|
|
BS_DELIM => 'BS' . chr(11) . chr(0), |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# There are 8 full divisions for volts on the scope LCD display spanning the 0-255 8-bit range output. |
34
|
|
|
|
|
|
|
POINTS_PER_VOLT_DIV => 32, # number of points per division out of the full 8-bit 0-255 point range. |
35
|
|
|
|
|
|
|
POINTS_PER_TIME_DIV => 10, # number of samples per division out of the full 256 samples per frame. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# The voltage sample value defined to be the 0V baseline. |
38
|
|
|
|
|
|
|
BASELINE_POINT => 127, |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
DEFAULT_SERIAL_PORT => '/dev/ttyS0', |
41
|
|
|
|
|
|
|
DEFAULT_SERIAL_READ => 255, |
42
|
1
|
|
|
1
|
|
116
|
}; |
|
1
|
|
|
|
|
1
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# Volts per divisions mappings for packet header values. |
45
|
|
|
|
|
|
|
my @volts = ('0.005', '0.01', '0.02', '0.05', '0.1', '0.2', '0.4', '1', '2', '4', '8', '20'); |
46
|
|
|
|
|
|
|
my @volts_10x = map { $_ * 10 } @volts; # 10x |
47
|
|
|
|
|
|
|
my %volt_divs; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# AC |
50
|
|
|
|
|
|
|
@volt_divs{ 0 .. 11} = @volts; # 1x |
51
|
|
|
|
|
|
|
@volt_divs{16 .. 27} = @volts_10x; # 10x |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# DC |
54
|
|
|
|
|
|
|
@volt_divs{32 .. 43} = @volts; # 1x |
55
|
|
|
|
|
|
|
@volt_divs{48 .. 59} = @volts_10x; # 10x |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# Times in seconds. |
58
|
|
|
|
|
|
|
# Note: there are higher time/div resolutions than 1 second. |
59
|
|
|
|
|
|
|
# It appears that the scope returns BR packets (and even BS packets) for times 0.5s/div and longer. |
60
|
|
|
|
|
|
|
my @times = ( |
61
|
|
|
|
|
|
|
'0.0000002', |
62
|
|
|
|
|
|
|
'0.0000005', |
63
|
|
|
|
|
|
|
'0.000001', |
64
|
|
|
|
|
|
|
'0.000002', |
65
|
|
|
|
|
|
|
'0.000005', # 5 us |
66
|
|
|
|
|
|
|
'0.00001', |
67
|
|
|
|
|
|
|
'0.00002', |
68
|
|
|
|
|
|
|
'0.00005', |
69
|
|
|
|
|
|
|
'0.0001', |
70
|
|
|
|
|
|
|
'0.0002', |
71
|
|
|
|
|
|
|
'0.0005', |
72
|
|
|
|
|
|
|
'0.001', |
73
|
|
|
|
|
|
|
'0.002', |
74
|
|
|
|
|
|
|
'0.005', # 5 ms |
75
|
|
|
|
|
|
|
'0.01', |
76
|
|
|
|
|
|
|
'0.02', |
77
|
|
|
|
|
|
|
'0.05', |
78
|
|
|
|
|
|
|
'0.1', |
79
|
|
|
|
|
|
|
'0.2', |
80
|
|
|
|
|
|
|
'0.5', |
81
|
|
|
|
|
|
|
'1' # 1 s |
82
|
|
|
|
|
|
|
); |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# Times per division mapping to header values. |
85
|
|
|
|
|
|
|
my %time_divs; |
86
|
|
|
|
|
|
|
@time_divs{ 0 .. 20} = @times; |
87
|
|
|
|
|
|
|
@time_divs{64 .. 84} = @times; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
################################################################################ |
91
|
|
|
|
|
|
|
# Local Functions |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Identify the packet type from the raw packet data. |
94
|
|
|
|
|
|
|
# Simply check to see if the given strings begins with one of the delimiters. |
95
|
|
|
|
|
|
|
sub _identify_packet_type { |
96
|
0
|
|
|
0
|
|
0
|
my $packet_bin = shift; |
97
|
|
|
|
|
|
|
|
98
|
0
|
0
|
|
|
|
0
|
if (index($packet_bin, BA_DELIM) == 0) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
99
|
0
|
|
|
|
|
0
|
return 'BA'; |
100
|
|
|
|
|
|
|
} elsif (index($packet_bin, BR_DELIM) == 0) { |
101
|
0
|
|
|
|
|
0
|
return 'BR'; |
102
|
|
|
|
|
|
|
} elsif (index($packet_bin, BS_DELIM) == 0) { |
103
|
0
|
|
|
|
|
0
|
return 'BS'; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# Convert the trace data points from 0:255 to voltage according to v/div. |
108
|
|
|
|
|
|
|
# Convert the time data points from 0:255 to time where the first sample is 0 seconds. |
109
|
|
|
|
|
|
|
# The shift_only does not scale the values, but centers the voltage sample values on 127, |
110
|
|
|
|
|
|
|
# the 0V baseline. |
111
|
|
|
|
|
|
|
sub _format_trace { |
112
|
0
|
|
|
0
|
|
0
|
my ($p_info, $shift_only) = @_; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# x_max: The width of the x-axis. |
115
|
|
|
|
|
|
|
# y_max: The height of the y-axis above and below the 0V baseline. |
116
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
0
|
my (@new_trace, @new_time); |
118
|
0
|
0
|
|
|
|
0
|
if ($shift_only) { |
119
|
|
|
|
|
|
|
# Simply shift the trace half-way down, where 127 is the 0V baseline. |
120
|
0
|
|
|
|
|
0
|
@new_trace = map { $_ - BASELINE_POINT } @{$p_info->{trace}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
121
|
0
|
|
|
|
|
0
|
@new_time = @{$p_info->{time}}; |
|
0
|
|
|
|
|
0
|
|
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
0
|
$p_info->{x_max} = 256; |
124
|
0
|
|
|
|
|
0
|
$p_info->{y_max} = BASELINE_POINT; |
125
|
|
|
|
|
|
|
} else { |
126
|
|
|
|
|
|
|
# Scale the time points to seconds. |
127
|
0
|
0
|
|
|
|
0
|
if (my $time_per_point = $p_info->{time_per_point}) { |
128
|
0
|
|
|
|
|
0
|
$p_info->{x_max} = 256 * $time_per_point; |
129
|
0
|
|
|
|
|
0
|
@new_time = map { $_ * $time_per_point } @{$p_info->{time}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
130
|
|
|
|
|
|
|
} else { |
131
|
0
|
|
|
|
|
0
|
@new_time = @{$p_info->{time}}; |
|
0
|
|
|
|
|
0
|
|
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# Scale the trace data volts/div. |
135
|
0
|
0
|
|
|
|
0
|
if (my $volts_per_point = $p_info->{volts_per_point}) { |
136
|
0
|
|
|
|
|
0
|
$p_info->{y_max} = BASELINE_POINT * $volts_per_point; |
137
|
0
|
|
|
|
|
0
|
@new_trace = map { ($_ - BASELINE_POINT) * $volts_per_point } @{$p_info->{trace}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
138
|
|
|
|
|
|
|
} else { |
139
|
0
|
|
|
|
|
0
|
@new_trace = @{$p_info->{trace}}; |
|
0
|
|
|
|
|
0
|
|
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
0
|
$p_info->{trace_scaled} = \@new_trace; |
144
|
0
|
|
|
|
|
0
|
$p_info->{time_scaled} = \@new_time; |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
0
|
return; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
################################################################################ |
151
|
|
|
|
|
|
|
# Class Methods |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# Return all the packet header code to /div translation hashes. |
154
|
|
|
|
|
|
|
sub get_division_maps { |
155
|
0
|
|
|
0
|
0
|
0
|
my $class = shift; |
156
|
|
|
|
|
|
|
|
157
|
0
|
|
|
|
|
0
|
return { time_divs => { %time_divs }, |
158
|
|
|
|
|
|
|
volt_divs => { %volt_divs } }; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# Make pps10 scope object. |
162
|
|
|
|
|
|
|
sub new { |
163
|
1
|
|
|
1
|
1
|
15
|
my $class = shift; |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Define defaults and allow them to be overridden. |
166
|
1
|
|
|
|
|
3
|
my %args = @_; |
167
|
1
|
|
|
|
|
3
|
my ($port, $read_bytes, $verbose, $debug) = @args{qw(port read_bytes verbose debug)}; |
168
|
|
|
|
|
|
|
|
169
|
1
|
50
|
|
|
|
5
|
$port = defined $port ? $port : DEFAULT_SERIAL_PORT; |
170
|
1
|
50
|
|
|
|
4
|
$read_bytes = defined $read_bytes ? $read_bytes : DEFAULT_SERIAL_READ; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# Create a Serial port object, or fail here. |
173
|
1
|
50
|
|
|
|
11
|
my $sp = Device::SerialPort->new($port) or |
174
|
|
|
|
|
|
|
die "Could not open $port: $!\n"; |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# Serial port settings specific to the Velleman PPS10. |
177
|
0
|
|
|
|
|
|
$sp->handshake('none'); |
178
|
0
|
|
|
|
|
|
$sp->baudrate(57600); |
179
|
0
|
|
|
|
|
|
$sp->parity('none'); |
180
|
0
|
|
|
|
|
|
$sp->databits(8); |
181
|
0
|
|
|
|
|
|
$sp->stopbits(1); |
182
|
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
$sp->read_char_time(0); # don't wait for each character |
184
|
0
|
|
|
|
|
|
$sp->read_const_time(1000); # 1 second per unfulfilled "read" call |
185
|
|
|
|
|
|
|
|
186
|
0
|
0
|
|
|
|
|
print STDERR "Reading in chunks of $read_bytes bytes\n" |
187
|
|
|
|
|
|
|
if $verbose; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# Cause fatal error if accessing and undefined header value |
190
|
0
|
0
|
|
|
|
|
if ($debug) { |
191
|
0
|
|
|
|
|
|
lock_hash(%time_divs); |
192
|
0
|
|
|
|
|
|
lock_hash(%volt_divs); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
0
|
0
|
|
|
|
|
my %self = (serial_port => $sp, |
|
|
0
|
|
|
|
|
|
196
|
|
|
|
|
|
|
port => $port, |
197
|
|
|
|
|
|
|
read_bytes => $read_bytes, |
198
|
|
|
|
|
|
|
verbose => defined $verbose ? $verbose : 0, |
199
|
|
|
|
|
|
|
debug => defined $debug ? $debug : 0, |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# Data read from serial port |
202
|
|
|
|
|
|
|
read_data => undef, # last data read from serial port. |
203
|
|
|
|
|
|
|
read_total_bytes => undef, # length of requested serial port data. |
204
|
|
|
|
|
|
|
read_count => 0, # count of serial port readings. |
205
|
|
|
|
|
|
|
read_buffer => undef, # buffer of serial port data, holding candidate packets. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# Packet info. |
208
|
|
|
|
|
|
|
packet_count => 0, |
209
|
|
|
|
|
|
|
current_packet => undef, |
210
|
|
|
|
|
|
|
first_ba_seen => 0, |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# Opened file handle of the file to dump raw serial port reads. |
213
|
|
|
|
|
|
|
# A defined value indicates that a dump should happen. |
214
|
|
|
|
|
|
|
raw_out_fh => undef); |
215
|
|
|
|
|
|
|
|
216
|
0
|
|
|
|
|
|
bless \%self, $class; |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Catch any invalid hash key usage. |
219
|
0
|
|
|
|
|
|
lock_keys(%self); |
220
|
|
|
|
|
|
|
|
221
|
0
|
|
|
|
|
|
return \%self; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
################################################################################ |
226
|
|
|
|
|
|
|
# Object Methods |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# Read n number of of bytes from the serial port using Device::SerialPort->read into the buffer. |
229
|
|
|
|
|
|
|
sub read { |
230
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
231
|
|
|
|
|
|
|
|
232
|
0
|
|
|
|
|
|
my $verbose = $self->{verbose}; |
233
|
0
|
|
|
|
|
|
my $read_bytes = $self->{read_bytes}; |
234
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
|
my ($read_length, $read_data) = ($self->{serial_port}->read($read_bytes)); |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# Total read count and bytes. |
238
|
0
|
|
|
|
|
|
$self->{read_count}++; |
239
|
0
|
|
|
|
|
|
$self->{read_total_bytes}+= length($read_data); |
240
|
|
|
|
|
|
|
|
241
|
0
|
0
|
|
|
|
|
if ($verbose) { |
242
|
0
|
|
|
|
|
|
print STDERR "Serial port reading $self->{read_count} ... "; |
243
|
0
|
|
|
|
|
|
print STDERR "reported length: $read_length, string length: " . length($read_data) . "\n"; |
244
|
|
|
|
|
|
|
|
245
|
0
|
0
|
|
|
|
|
if ($read_length == 0) { |
|
|
0
|
|
|
|
|
|
246
|
0
|
|
|
|
|
|
print STDERR "Serial port read: no data.\n"; |
247
|
|
|
|
|
|
|
} elsif ($read_length < $read_bytes) { |
248
|
0
|
|
|
|
|
|
print STDERR "Serial port read: under read $read_length/$read_bytes.\n"; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
0
|
0
|
|
|
|
|
if (my $raw_fh = $self->{raw_out_fh}) { |
253
|
0
|
|
|
|
|
|
print $raw_fh $read_data; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# Append to read buffer. This buffer will be truncated from the |
257
|
|
|
|
|
|
|
# start by get_next_packet() as it extracts any packets it finds. |
258
|
0
|
|
|
|
|
|
$self->{read_data} = $read_data; # Last read serial data. |
259
|
0
|
|
|
|
|
|
$self->{read_buffer}.= $read_data; |
260
|
|
|
|
|
|
|
|
261
|
0
|
0
|
|
|
|
|
return ($read_length, $read_data) |
262
|
|
|
|
|
|
|
if defined wantarray; |
263
|
|
|
|
|
|
|
|
264
|
0
|
|
|
|
|
|
return; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# To be called after a read() from the serial port. |
268
|
|
|
|
|
|
|
# Get the next BA packet that's available based on the read serial port data. |
269
|
|
|
|
|
|
|
# The caller should call get_next_packet() in a loop until all packets |
270
|
|
|
|
|
|
|
# have been processed and fetch more data using read() in the outer loop. |
271
|
|
|
|
|
|
|
# Returns undef if there was not enough data to process. |
272
|
|
|
|
|
|
|
# TODO: Use of $read_buffer may be unnecessary and could be an opportunity to introduce bugs. |
273
|
|
|
|
|
|
|
sub get_next_packet { |
274
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
275
|
|
|
|
|
|
|
|
276
|
0
|
|
|
|
|
|
my $verbose = $self->{verbose}; |
277
|
0
|
|
|
|
|
|
my $debug = $self->{debug}; |
278
|
|
|
|
|
|
|
|
279
|
0
|
|
|
|
|
|
my $read_buffer = $self->{read_buffer}; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# Get the index of the first BA delimiter. |
282
|
0
|
|
|
|
|
|
my $ba_index_0 = index($read_buffer, BA_DELIM); |
283
|
0
|
|
|
|
|
|
my $ba_index_1; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# Get indexes of other delimiters. |
286
|
0
|
|
|
|
|
|
my $br_index = index($read_buffer, BR_DELIM); |
287
|
0
|
|
|
|
|
|
my $bs_index = index($read_buffer, BS_DELIM); |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# Make this verbose? |
290
|
0
|
0
|
0
|
|
|
|
if ($verbose and $ba_index_0 == -1) { |
291
|
0
|
|
|
|
|
|
print "No BA delim found in buffer of size: " . length($read_buffer) . ".\n"; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
return |
295
|
0
|
0
|
|
|
|
|
if $ba_index_0 == -1; |
296
|
|
|
|
|
|
|
|
297
|
0
|
0
|
|
|
|
|
if ($ba_index_0 >= 0) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
298
|
0
|
0
|
|
|
|
|
print STDERR "Found start of BA packet in buffer.\n" |
299
|
|
|
|
|
|
|
if $debug; |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
# If no BA has been seen before this instance of get_next_packet() call, then strip off bytes |
302
|
|
|
|
|
|
|
# leading up to the first BA delim. |
303
|
|
|
|
|
|
|
# It's not clear if the leading data is a complete BA packet or not. |
304
|
|
|
|
|
|
|
# It needs to be stripped off, leaving the buffer to start with the BA delim. |
305
|
0
|
0
|
|
|
|
|
if (not $self->{first_ba_seen}) { |
306
|
0
|
|
|
|
|
|
substr($self->{read_buffer}, 0, $ba_index_0, ''); |
307
|
0
|
|
|
|
|
|
$self->{first_ba_seen} = 1; |
308
|
|
|
|
|
|
|
|
309
|
0
|
0
|
|
|
|
|
if ($verbose) { |
310
|
0
|
|
|
|
|
|
print STDERR "Truncating leading data before first BA delimiter.\n"; |
311
|
0
|
|
|
|
|
|
print STDERR "Read buffer was: $read_buffer\n"; |
312
|
0
|
|
|
|
|
|
print STDERR "Now : $self->{read_buffer}\n"; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# Reset buffer var and first index. |
316
|
0
|
|
|
|
|
|
$read_buffer = $self->{read_buffer}; |
317
|
0
|
|
|
|
|
|
$ba_index_0 = index($read_buffer, BA_DELIM); |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# Find second BA delim, if it exists. |
321
|
|
|
|
|
|
|
# This would indicate that a complete BA packet exists in the buffer. |
322
|
0
|
|
|
|
|
|
$ba_index_1 = index($read_buffer, BA_DELIM, ($ba_index_0 + 1)); |
323
|
|
|
|
|
|
|
|
324
|
0
|
0
|
|
|
|
|
if (not $ba_index_1 > 0) { |
325
|
0
|
|
|
|
|
|
return; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
} elsif ($br_index >= 0) { |
328
|
0
|
0
|
|
|
|
|
if ($debug) { |
329
|
0
|
|
|
|
|
|
print "Found BR packet: $read_buffer\n"; |
330
|
0
|
|
|
|
|
|
print "-> " . sprintf("%vd", $read_buffer) . "\n"; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
} elsif ($bs_index >= 0) { |
333
|
|
|
|
|
|
|
# Have not seen a BS packet so far during development. |
334
|
0
|
0
|
|
|
|
|
if ($debug) { |
335
|
0
|
|
|
|
|
|
print "Found BS packet: $read_buffer\n"; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
# Fetch the packet string and truncate at the same time. |
340
|
0
|
0
|
|
|
|
|
print STDERR "BA found packet in buffer at byte positions $ba_index_0 and $ba_index_1\n" |
341
|
|
|
|
|
|
|
if $verbose; |
342
|
|
|
|
|
|
|
|
343
|
0
|
|
|
|
|
|
my $length = $ba_index_1 - $ba_index_0; |
344
|
0
|
|
|
|
|
|
my $p_data = substr($self->{read_buffer}, $ba_index_0, $length, ''); |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# Truncate any leading unused data to avoid bloat of the buffer. |
347
|
0
|
|
|
|
|
|
substr($self->{read_buffer}, 0, $ba_index_0, ''); |
348
|
|
|
|
|
|
|
|
349
|
0
|
|
|
|
|
|
my $packet = $self->parse_packet($p_data); |
350
|
|
|
|
|
|
|
|
351
|
0
|
|
|
|
|
|
$self->{packet_count}++; |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# Return on the first packet from the parts. |
354
|
0
|
|
|
|
|
|
return $packet; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
# Parse and process a packet string. |
358
|
|
|
|
|
|
|
# Must be a complete paket with header bytes but the delimiter may be optional. |
359
|
|
|
|
|
|
|
sub parse_packet { |
360
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
361
|
|
|
|
|
|
|
|
362
|
0
|
|
|
|
|
|
my $packet = shift; |
363
|
|
|
|
|
|
|
|
364
|
0
|
|
|
|
|
|
my $verbose = $self->{verbose}; |
365
|
0
|
|
|
|
|
|
my $debug = $self->{debug}; |
366
|
|
|
|
|
|
|
|
367
|
0
|
|
|
|
|
|
my $raw_packet = $packet; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
# Strip and fetch any packet type delimiters. |
370
|
0
|
|
|
|
|
|
my $ba_str = BA_DELIM; |
371
|
0
|
|
|
|
|
|
my $br_str = BR_DELIM; |
372
|
0
|
|
|
|
|
|
my $bs_str = BS_DELIM; |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
# Strip the packet delimiters. |
375
|
0
|
|
|
|
|
|
$packet =~ s/^($ba_str|$br_str|$bs_str)(.*)/$2/; |
376
|
0
|
|
|
|
|
|
my $packet_type = _identify_packet_type($1); |
377
|
|
|
|
|
|
|
|
378
|
0
|
0
|
|
|
|
|
print "Parsed Packet Type: $packet_type\n" |
379
|
|
|
|
|
|
|
if $verbose; |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
# For now, strip off any non-BA packets that may have snuck in. |
382
|
0
|
|
|
|
|
|
my @non_ba_str = $packet =~ s/($br_str|$bs_str).*$//; |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# Split into individual bytes. |
385
|
|
|
|
|
|
|
# Note: Would it be faster to sprintf() first and then split? |
386
|
0
|
|
|
|
|
|
my @bytes = split('', $packet); |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# Fetch the data section, leaving the headers in @bytes. |
389
|
0
|
|
|
|
|
|
my @trace = map { sprintf("%vd", $_) } splice(@bytes, 6); |
|
0
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
# Time. |
392
|
|
|
|
|
|
|
# Fix x-axis to 256 samples per screen, as described in the serial port protocol. |
393
|
|
|
|
|
|
|
# This will keep the trace display consistent and not vary based on length of @trace. |
394
|
0
|
|
|
|
|
|
my @time = (0 .. 255); |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# Convert the header bytes into decimals. |
397
|
0
|
|
|
|
|
|
my @header = map { sprintf("%vd", $_) } @bytes; |
|
0
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
|
399
|
0
|
|
|
|
|
|
my $volts_key = $header[1]; |
400
|
|
|
|
|
|
|
|
401
|
0
|
|
|
|
|
|
my $volts_acdc; |
402
|
0
|
0
|
0
|
|
|
|
if ($volts_key >= 0 and $volts_key <= 11 or $volts_key >= 16 and $volts_key <= 27 ) { |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
403
|
0
|
|
|
|
|
|
$volts_acdc = 'ac'; |
404
|
|
|
|
|
|
|
} elsif ($volts_key >= 32 and $volts_key <= 43 or $volts_key >= 48 and $volts_key <= 59 ) { |
405
|
0
|
|
|
|
|
|
$volts_acdc = 'dc'; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
0
|
|
|
|
|
|
my $volts_10x; |
409
|
0
|
0
|
0
|
|
|
|
if ($volts_key >= 16 and $volts_key <= 27 or $volts_key >= 48 and $volts_key <= 59) { |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
410
|
0
|
|
|
|
|
|
$volts_10x = 1; |
411
|
|
|
|
|
|
|
} elsif ($volts_key >= 32 and $volts_key <= 43 or $volts_key >= 0 and $volts_key <= 11 ) { |
412
|
0
|
|
|
|
|
|
$volts_10x = 0; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
# Expect the possibility of an unknown header value for divisions. |
416
|
0
|
|
|
|
|
|
my $time_per_div = $time_divs{$header[0]}; |
417
|
0
|
0
|
|
|
|
|
my $time_per_point = $time_per_div ? ($time_per_div / POINTS_PER_TIME_DIV) : 0; |
418
|
|
|
|
|
|
|
|
419
|
0
|
|
|
|
|
|
my $volts_per_div = $volt_divs{$volts_key}; |
420
|
0
|
0
|
|
|
|
|
my $volts_per_point = $volts_per_div ? ($volts_per_div / POINTS_PER_VOLT_DIV) : 0; |
421
|
|
|
|
|
|
|
|
422
|
0
|
0
|
|
|
|
|
if ($debug) { |
423
|
0
|
0
|
|
|
|
|
print STDERR "Found unknown time/div value: " . $header[0] . "\n" |
424
|
|
|
|
|
|
|
if not $time_per_div; |
425
|
|
|
|
|
|
|
|
426
|
0
|
0
|
|
|
|
|
print STDERR "Found unknown volt/div value: " . $volts_key . "\n" |
427
|
|
|
|
|
|
|
if not $volts_per_div; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
# Complete packet data structure. |
431
|
0
|
|
|
|
|
|
my %packet = ( packet_type => $packet_type, |
432
|
|
|
|
|
|
|
raw_packet => $raw_packet, |
433
|
|
|
|
|
|
|
processed_packet => $packet, |
434
|
|
|
|
|
|
|
header => \@header, |
435
|
|
|
|
|
|
|
time_per_div => $time_per_div, |
436
|
|
|
|
|
|
|
time_per_point => $time_per_point, |
437
|
|
|
|
|
|
|
volts_per_div => $volts_per_div, |
438
|
|
|
|
|
|
|
volts_per_point => $volts_per_point, |
439
|
|
|
|
|
|
|
volts_acdc => $volts_acdc, |
440
|
|
|
|
|
|
|
volts_10x => $volts_10x, |
441
|
|
|
|
|
|
|
trace => \@trace, |
442
|
|
|
|
|
|
|
time => \@time, |
443
|
|
|
|
|
|
|
x_max => undef, # The width of the x-axis. |
444
|
|
|
|
|
|
|
y_max => undef, # The height of the y-axis above and below the 0V baseline. |
445
|
|
|
|
|
|
|
trace_scaled => undef, |
446
|
|
|
|
|
|
|
time_scaled => undef,); |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
# Scale the trace data. |
449
|
0
|
|
|
|
|
|
_format_trace(\%packet, 0); |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
# Note: Should the last processed packet persist when there should not be any current packet? |
452
|
0
|
|
|
|
|
|
$self->{current_packet} = \%packet; |
453
|
|
|
|
|
|
|
|
454
|
0
|
|
|
|
|
|
return \%packet; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
# Start saving the raw data read from the serial port to specified file. |
458
|
|
|
|
|
|
|
# Data will start being saved in the next call to read(). |
459
|
|
|
|
|
|
|
sub save_raw_data_to_file { |
460
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
461
|
|
|
|
|
|
|
|
462
|
0
|
|
|
|
|
|
my $filename = shift; |
463
|
0
|
|
|
|
|
|
my $unbuffer = shift; |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# Don't clobber an existing file handle. |
466
|
0
|
0
|
|
|
|
|
if (defined $self->{raw_out_fh}) { |
467
|
0
|
0
|
|
|
|
|
print STDERR "Open file handle exists for writing raw data. Skipping.\n" |
468
|
|
|
|
|
|
|
if $self->{verbose}; |
469
|
|
|
|
|
|
|
|
470
|
0
|
|
|
|
|
|
return 0; |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# Open or die. |
474
|
0
|
0
|
|
|
|
|
open(my $out_fh, '>', $filename) or |
475
|
|
|
|
|
|
|
die "Could not write to '$filename': $!\n"; |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
# Unbuffer this file handle if explicitly requested. |
478
|
|
|
|
|
|
|
# Unbuffering the handle results in disk activity for each read from serial port. |
479
|
0
|
0
|
|
|
|
|
if ($unbuffer) { |
480
|
0
|
|
|
|
|
|
my $old_fh = select($out_fh); $| = 1; select($old_fh); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
0
|
|
|
|
|
|
$self->{raw_out_fh} = $out_fh; |
484
|
|
|
|
|
|
|
|
485
|
0
|
|
|
|
|
|
return 1; |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
# Close the raw dump file handle. |
489
|
|
|
|
|
|
|
sub close_raw_data_file { |
490
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
491
|
|
|
|
|
|
|
|
492
|
0
|
0
|
|
|
|
|
if (defined $self->{raw_out_fh}) { |
493
|
0
|
|
|
|
|
|
print "closing\n"; |
494
|
0
|
|
|
|
|
|
close($self->{raw_out_fh}); |
495
|
0
|
|
|
|
|
|
$self->{raw_out_fh} = undef; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
0
|
|
|
|
|
|
return; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
sub DESTROY { |
502
|
0
|
|
|
0
|
|
|
my $self = shift; |
503
|
|
|
|
|
|
|
|
504
|
0
|
0
|
|
|
|
|
print STDERR "DESTROY() called\n" |
505
|
|
|
|
|
|
|
if $self->{debug}; |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
# Close any dump files that may be open. |
508
|
0
|
|
|
|
|
|
$self->close_raw_data_file; |
509
|
|
|
|
|
|
|
|
510
|
0
|
|
|
|
|
|
return; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
1; |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
__END__ |