From 8a75b96ac55f8780816d094b63c8a19326b3eb95 Mon Sep 17 00:00:00 2001 From: John Poole Date: Wed, 27 May 2026 11:11:59 -0700 Subject: [PATCH] Working rssi plotly, also saved in Subversion --- .../scripts/exercise26_ble_rssi_plotly.pl | 626 ++++++++++++++++++ 1 file changed, 626 insertions(+) create mode 100644 exercises/26_Bluetooth_discover/scripts/exercise26_ble_rssi_plotly.pl diff --git a/exercises/26_Bluetooth_discover/scripts/exercise26_ble_rssi_plotly.pl b/exercises/26_Bluetooth_discover/scripts/exercise26_ble_rssi_plotly.pl new file mode 100644 index 0000000..e9e5e79 --- /dev/null +++ b/exercises/26_Bluetooth_discover/scripts/exercise26_ble_rssi_plotly.pl @@ -0,0 +1,626 @@ +#!/usr/bin/env perl +# 20260526 ChatGPT generated +# $Id$ +# $HeadURL$ +# +# sudo ln -s /home/jlpoole/work/perl/exercise26_ble_rssi_plotly.pl /var/www/localhost/cgi-bin/exercise26_ble_rssi_plotly.pl +# chmod +x /home/jlpoole/work/perl/exercise26_ble_rssi_plotly.pl +# +# Example browser URLs: +# /cgi-bin/exercise26_ble_rssi_plotly.pl +# /cgi-bin/exercise26_ble_rssi_plotly.pl?receiver=BOB +# /cgi-bin/exercise26_ble_rssi_plotly.pl?receiver=BOB&value=avg_rssi +# /cgi-bin/exercise26_ble_rssi_plotly.pl?pairs=BOB:CY,CY:BOB,ED:FLO,FLO:ED +# /cgi-bin/exercise26_ble_rssi_plotly.pl?pairs=BOB:CY,CY:BOB,ED:FLO,FLO:ED&value=avg_rssi&gps_valid=1&clock_valid=1 +# /cgi-bin/exercise26_ble_rssi_plotly.pl?receiver=FLO&gps_max_ms=5000&bucket_s=5 +# +# Console test: +# REQUEST_METHOD=GET QUERY_STRING='receiver=BOB&value=avg_rssi' ./exercise26_ble_rssi_plotly.pl > /tmp/rssi.html +# ./exercise26_ble_rssi_plotly.pl 'receiver=BOB&value=avg_rssi' > /tmp/rssi.html +# ./exercise26_ble_rssi_plotly.pl receiver=BOB value=avg_rssi > /tmp/rssi.html +# +# Purpose: +# Emit a Plotly HTML graph from an Exercise 26 BLE Discovery SQLite database. +# X axis is receiver observation time. Y axis is RSSI or avg_rssi. +# +# Database selection: +# 1. DB_BLE_RSSI_PLOTLY environment variable +# 2. DB_BLE environment variable +# 3. hard-coded default below +# +# Required Perl modules: +# DBI +# DBD::SQLite +# JSON::PP +# + +use strict; +use warnings; + +use DBI; +use JSON::PP qw(encode_json); + +my $DEFAULT_DB_FILE = '/home/jlpoole/work/tbeam/ble/ble_fieldtest_20260526_1859.sqlite'; +my $DB_FILE = $ENV{DB_BLE_RSSI_PLOTLY} || $ENV{DB_BLE} || $DEFAULT_DB_FILE; + +# Prefer a locally staged Plotly file so the graph works without depending on a CDN. +# Override in Apache or shell with, for example: +# export PLOTLY_JS_URL=/lib/plotly-2.35.2.min.js +my $PLOTLY_JS_URL = $ENV{PLOTLY_JS_URL} || '/lib/plotly.min.js'; + +my @UNITS = qw(AMY BOB CY DAN ED FLO GUY); +my %VALID_UNIT = map { $_ => 1 } @UNITS; + +my %q = parse_query_string(); + +my $receiver = uc($q{receiver} // ''); +my $heard = uc($q{heard} // ''); +my $pairs_text = uc($q{pairs} // ''); +my $value = lc($q{value} // 'rssi'); +my $gps_max = $q{gps_max_ms}; +my $gps_valid = $q{gps_valid}; +my $clock_valid = $q{clock_valid}; +my $bucket_s = $q{bucket_s}; +my $limit = $q{limit}; + +if ($receiver ne '' && !$VALID_UNIT{$receiver}) { + emit_error(400, "Bad receiver value"); +} + +if ($heard ne '' && !$VALID_UNIT{$heard}) { + emit_error(400, "Bad heard value"); +} + +if ($value !~ /^(?:rssi|avg_rssi)$/) { + emit_error(400, "value must be rssi or avg_rssi"); +} + +if (defined $gps_max && $gps_max ne '' && $gps_max !~ /^\d+$/) { + emit_error(400, "gps_max_ms must be an integer"); +} + +for my $flag_name (qw(gps_valid clock_valid)) { + my $v = $flag_name eq 'gps_valid' ? $gps_valid : $clock_valid; + next unless defined $v && $v ne ''; + if ($v !~ /^[01]$/) { + emit_error(400, "$flag_name must be 0 or 1"); + } +} + +if (defined $bucket_s && $bucket_s ne '' && $bucket_s !~ /^\d+$/) { + emit_error(400, "bucket_s must be an integer number of seconds"); +} +$bucket_s = 0 unless defined $bucket_s && $bucket_s ne ''; +$bucket_s = int($bucket_s); +if ($bucket_s < 0 || $bucket_s > 3600) { + emit_error(400, "bucket_s must be between 0 and 3600"); +} + +if (defined $limit && $limit ne '' && $limit !~ /^\d+$/) { + emit_error(400, "limit must be an integer"); +} +$limit = 0 unless defined $limit && $limit ne ''; +$limit = int($limit); +if ($limit < 0 || $limit > 1_000_000) { + emit_error(400, "limit must be between 0 and 1000000"); +} + +my @pairs = parse_pairs($pairs_text); + +if (!-f $DB_FILE) { + emit_error(500, "Database not found: $DB_FILE"); +} + +my $dbh = DBI->connect( + "dbi:SQLite:dbname=$DB_FILE", + "", + "", + { + RaiseError => 1, + AutoCommit => 1, + sqlite_unicode => 1, + } +); + +my $traces = fetch_rssi_traces( + $dbh, + receiver => $receiver, + heard => $heard, + pairs => \@pairs, + value => $value, + gps_max => $gps_max, + gps_valid => $gps_valid, + clock_valid => $clock_valid, + bucket_s => $bucket_s, + limit => $limit, +); + +my $summary = fetch_summary( + $dbh, + receiver => $receiver, + heard => $heard, + pairs => \@pairs, + value => $value, + gps_max => $gps_max, + gps_valid => $gps_valid, + clock_valid => $clock_valid, +); + +$dbh->disconnect; + +emit_html($traces, $summary); +exit 0; + +sub fetch_rssi_traces { + my ($dbh, %arg) = @_; + + my @where = ( + 'rx_epoch_ms IS NOT NULL', + 'receiver IS NOT NULL', + 'heard IS NOT NULL', + "$arg{value} IS NOT NULL", + ); + my @bind; + + if ($arg{receiver} ne '') { + push @where, 'receiver = ?'; + push @bind, $arg{receiver}; + } + + if ($arg{heard} ne '') { + push @where, 'heard = ?'; + push @bind, $arg{heard}; + } + + if (@{ $arg{pairs} }) { + my @pair_terms; + for my $p (@{ $arg{pairs} }) { + push @pair_terms, '(receiver = ? AND heard = ?)'; + push @bind, $p->{receiver}, $p->{heard}; + } + push @where, '(' . join(' OR ', @pair_terms) . ')'; + } + + if (defined $arg{gps_max} && $arg{gps_max} ne '') { + push @where, 'gps_fix_age_ms <= ?'; + push @bind, int($arg{gps_max}); + } + + if (defined $arg{gps_valid} && $arg{gps_valid} ne '') { + push @where, 'gps_valid = ?'; + push @bind, int($arg{gps_valid}); + } + + if (defined $arg{clock_valid} && $arg{clock_valid} ne '') { + push @where, 'clock_valid = ?'; + push @bind, int($arg{clock_valid}); + } + + my $select_sql; + my $order_by; + + if ($arg{bucket_s}) { + my $bucket_ms = $arg{bucket_s} * 1000; + $select_sql = qq{ + SELECT + receiver, + heard, + CAST((rx_epoch_ms / $bucket_ms) AS INTEGER) * $bucket_ms AS plot_epoch_ms, + AVG($arg{value}) AS plot_rssi, + COUNT(*) AS row_count, + MIN(rssi) AS min_rssi, + MAX(rssi) AS max_rssi, + MIN(vbat_mv) AS min_vbat_mv, + MAX(gps_fix_age_ms) AS max_gps_fix_age_ms, + MIN(clock_valid) AS min_clock_valid, + MIN(gps_valid) AS min_gps_valid + FROM ble_observation + WHERE } . join(' AND ', @where) . qq{ + GROUP BY receiver, heard, plot_epoch_ms + }; + $order_by = ' ORDER BY receiver, heard, plot_epoch_ms'; + } + else { + # Important: do not mix aggregate functions such as COUNT/MIN/MAX with + # non-aggregate row columns here. SQLite will otherwise collapse the + # result to one arbitrary row, which looks like a single blue dot. + $select_sql = qq{ + SELECT + receiver, + heard, + rx_epoch_ms AS plot_epoch_ms, + $arg{value} AS plot_rssi, + 1 AS row_count, + rssi AS min_rssi, + rssi AS max_rssi, + vbat_mv AS min_vbat_mv, + gps_fix_age_ms AS max_gps_fix_age_ms, + clock_valid AS min_clock_valid, + gps_valid AS min_gps_valid + FROM ble_observation + WHERE } . join(' AND ', @where) . qq{ + }; + $order_by = ' ORDER BY receiver, heard, rx_epoch_ms, obs_id'; + } + + my $sql = $select_sql . $order_by; + + if ($arg{limit}) { + $sql .= ' LIMIT ?'; + push @bind, $arg{limit}; + } + + my $sth = $dbh->prepare($sql); + $sth->execute(@bind); + + my %series; + while (my $r = $sth->fetchrow_hashref) { + my $key = $r->{receiver} . ' hears ' . $r->{heard}; + + push @{ $series{$key}{x_ms} }, 0 + $r->{plot_epoch_ms}; + push @{ $series{$key}{y} }, numeric($r->{plot_rssi}); + push @{ $series{$key}{customdata} }, [ + $r->{receiver}, + $r->{heard}, + $r->{row_count}, + $r->{min_rssi}, + $r->{max_rssi}, + $r->{min_vbat_mv}, + $r->{max_gps_fix_age_ms}, + $r->{min_clock_valid}, + $r->{min_gps_valid}, + ]; + $series{$key}{receiver} = $r->{receiver}; + $series{$key}{heard} = $r->{heard}; + } + + my @traces; + for my $key (sort keys %series) { + push @traces, { + name => $key, + mode => 'lines+markers', + type => 'scatter', + x_ms => $series{$key}{x_ms}, + y => $series{$key}{y}, + customdata => $series{$key}{customdata}, + hovertemplate => join('', + '%{customdata[0]} hears %{customdata[1]}
', + 'time=%{x}
', + 'RSSI=%{y:.1f} dBm
', + 'rows=%{customdata[2]}
', + 'rssi range=%{customdata[3]} to %{customdata[4]}
', + 'min vbat=%{customdata[5]} mV
', + 'max gps age=%{customdata[6]} ms
', + 'clock_valid=%{customdata[7]} gps_valid=%{customdata[8]}', + '', + ), + }; + } + + return \@traces; +} + +sub fetch_summary { + my ($dbh, %arg) = @_; + + my @where = ( + 'rx_epoch_ms IS NOT NULL', + 'receiver IS NOT NULL', + 'heard IS NOT NULL', + "$arg{value} IS NOT NULL", + ); + my @bind; + + if ($arg{receiver} ne '') { + push @where, 'receiver = ?'; + push @bind, $arg{receiver}; + } + + if ($arg{heard} ne '') { + push @where, 'heard = ?'; + push @bind, $arg{heard}; + } + + if (@{ $arg{pairs} }) { + my @pair_terms; + for my $p (@{ $arg{pairs} }) { + push @pair_terms, '(receiver = ? AND heard = ?)'; + push @bind, $p->{receiver}, $p->{heard}; + } + push @where, '(' . join(' OR ', @pair_terms) . ')'; + } + + if (defined $arg{gps_max} && $arg{gps_max} ne '') { + push @where, 'gps_fix_age_ms <= ?'; + push @bind, int($arg{gps_max}); + } + + if (defined $arg{gps_valid} && $arg{gps_valid} ne '') { + push @where, 'gps_valid = ?'; + push @bind, int($arg{gps_valid}); + } + + if (defined $arg{clock_valid} && $arg{clock_valid} ne '') { + push @where, 'clock_valid = ?'; + push @bind, int($arg{clock_valid}); + } + + my $sql = qq{ + SELECT + COUNT(*) AS n_rows, + MIN(rx_epoch_ms) AS first_rx_epoch_ms, + MAX(rx_epoch_ms) AS last_rx_epoch_ms, + MIN($arg{value}) AS min_plot_rssi, + AVG($arg{value}) AS avg_plot_rssi, + MAX($arg{value}) AS max_plot_rssi, + MIN(vbat_mv) AS min_vbat_mv, + MAX(vbat_mv) AS max_vbat_mv, + MAX(gps_fix_age_ms) AS max_gps_fix_age_ms + FROM ble_observation + WHERE } . join(' AND ', @where); + + my $r = $dbh->selectrow_hashref($sql, undef, @bind) || {}; + $r->{db_file} = $DB_FILE; + $r->{value} = $arg{value}; + $r->{bucket_s} = $arg{bucket_s}; + $r->{receiver_filter} = $arg{receiver}; + $r->{heard_filter} = $arg{heard}; + $r->{pairs_filter} = join(',', map { $_->{receiver} . ':' . $_->{heard} } @{ $arg{pairs} }); + $r->{gps_max_ms_filter} = defined $arg{gps_max} ? $arg{gps_max} : ''; + $r->{gps_valid_filter} = defined $arg{gps_valid} ? $arg{gps_valid} : ''; + $r->{clock_valid_filter} = defined $arg{clock_valid} ? $arg{clock_valid} : ''; + + return $r; +} + +sub parse_pairs { + my ($pairs_text) = @_; + return () unless defined $pairs_text && $pairs_text ne ''; + + my @pairs; + for my $pair (split /,/, $pairs_text) { + next if $pair eq ''; + my ($receiver, $heard) = split /:/, $pair, 2; + $receiver //= ''; + $heard //= ''; + $receiver =~ s/^\s+|\s+$//g; + $heard =~ s/^\s+|\s+$//g; + + if (!$VALID_UNIT{$receiver} || !$VALID_UNIT{$heard}) { + emit_error(400, "Bad pairs value: $pair"); + } + + push @pairs, { + receiver => $receiver, + heard => $heard, + }; + } + + return @pairs; +} + +sub emit_html { + my ($traces, $summary) = @_; + + my $json = JSON::PP->new->canonical(1)->encode({ + traces => $traces, + summary => $summary, + }); + + my $title = 'Exercise 26 BLE RSSI vs Time'; + + print "Content-Type: text/html; charset=utf-8\r\n"; + print "Cache-Control: no-cache\r\n"; + print "\r\n"; + + print <<"HTML"; + + + + + +$title + + + + +
+

$title

+
+
+
+ + + +HTML +} + +sub parse_query_string { + my $qs = $ENV{QUERY_STRING} // ''; + + # Console convenience: + # ./exercise26_ble_rssi_plotly.pl 'receiver=BOB&value=avg_rssi' + # ./exercise26_ble_rssi_plotly.pl receiver=BOB value=avg_rssi + # CGI still uses QUERY_STRING. + if ($qs eq '' && @ARGV) { + if (@ARGV == 1 && $ARGV[0] =~ /[&=]/) { + $qs = $ARGV[0]; + } + else { + $qs = join('&', @ARGV); + } + } + + my %out; + + for my $pair (split /&/, $qs) { + next if $pair eq ''; + + my ($k, $v) = split /=/, $pair, 2; + $k = url_decode($k // ''); + $v = url_decode($v // ''); + + next if $k eq ''; + + $out{$k} = $v; + } + + return %out; +} + +sub url_decode { + my ($s) = @_; + + $s =~ tr/+/ /; + $s =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + + return $s; +} + +sub numeric { + my ($v) = @_; + + return undef unless defined $v; + return 0 + $v; +} + +sub emit_error { + my ($status, $msg) = @_; + + my %status_text = ( + 400 => 'Bad Request', + 500 => 'Internal Server Error', + ); + + my $text = $status_text{$status} // 'Error'; + + print "Status: $status $text\r\n"; + print "Content-Type: application/json\r\n"; + print "Cache-Control: no-cache\r\n"; + print "\r\n"; + print encode_json({ + error => $text, + status => $status, + detail => $msg, + }); + print "\n"; + + exit 0; +}