Working rssi plotly, also saved in Subversion
This commit is contained in:
parent
fe46db2b3c
commit
8a75b96ac5
1 changed files with 626 additions and 0 deletions
|
|
@ -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('',
|
||||
'<b>%{customdata[0]} hears %{customdata[1]}</b><br>',
|
||||
'time=%{x}<br>',
|
||||
'RSSI=%{y:.1f} dBm<br>',
|
||||
'rows=%{customdata[2]}<br>',
|
||||
'rssi range=%{customdata[3]} to %{customdata[4]}<br>',
|
||||
'min vbat=%{customdata[5]} mV<br>',
|
||||
'max gps age=%{customdata[6]} ms<br>',
|
||||
'clock_valid=%{customdata[7]} gps_valid=%{customdata[8]}',
|
||||
'<extra></extra>',
|
||||
),
|
||||
};
|
||||
}
|
||||
|
||||
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";
|
||||
<!DOCTYPE html>
|
||||
<!--
|
||||
Generated by exercise26_ble_rssi_plotly.pl
|
||||
20260526 ChatGPT
|
||||
\$Id\$
|
||||
\$HeadURL\$
|
||||
-->
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<title>$title</title>
|
||||
<script src="$PLOTLY_JS_URL"></script>
|
||||
<style>
|
||||
body {
|
||||
font-family: sans-serif;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
}
|
||||
header {
|
||||
padding: 0.75rem 1rem;
|
||||
border-bottom: 1px solid #ccc;
|
||||
}
|
||||
h1 {
|
||||
font-size: 1.2rem;
|
||||
margin: 0 0 0.35rem 0;
|
||||
}
|
||||
.meta {
|
||||
font-size: 0.85rem;
|
||||
line-height: 1.35;
|
||||
}
|
||||
#chart {
|
||||
width: 100vw;
|
||||
height: calc(100vh - 7rem);
|
||||
}
|
||||
code {
|
||||
white-space: nowrap;
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<header>
|
||||
<h1>$title</h1>
|
||||
<div class="meta" id="summary"></div>
|
||||
</header>
|
||||
<div id="chart"></div>
|
||||
<script>
|
||||
const DATA = $json;
|
||||
|
||||
function msToDateArray(xs) {
|
||||
return xs.map(ms => new Date(ms));
|
||||
}
|
||||
|
||||
const traces = DATA.traces.map(t => ({
|
||||
type: t.type,
|
||||
mode: t.mode,
|
||||
name: t.name,
|
||||
x: msToDateArray(t.x_ms),
|
||||
y: t.y,
|
||||
customdata: t.customdata,
|
||||
hovertemplate: t.hovertemplate,
|
||||
connectgaps: false
|
||||
}));
|
||||
|
||||
const s = DATA.summary;
|
||||
document.getElementById('summary').innerHTML = [
|
||||
'<b>Database:</b> <code>' + escapeHtml(s.db_file || '') + '</code>',
|
||||
'<b>Rows:</b> ' + (s.n_rows || 0),
|
||||
'<b>Y value:</b> ' + escapeHtml(s.value || ''),
|
||||
'<b>Bucket seconds:</b> ' + (s.bucket_s || 0),
|
||||
'<b>Receiver:</b> ' + escapeHtml(s.receiver_filter || 'all'),
|
||||
'<b>Heard:</b> ' + escapeHtml(s.heard_filter || 'all'),
|
||||
'<b>Pairs:</b> ' + escapeHtml(s.pairs_filter || 'auto'),
|
||||
'<b>Filters:</b> gps_max_ms=' + escapeHtml(s.gps_max_ms_filter || 'none') +
|
||||
' gps_valid=' + escapeHtml(s.gps_valid_filter || 'any') +
|
||||
' clock_valid=' + escapeHtml(s.clock_valid_filter || 'any')
|
||||
].join(' ');
|
||||
|
||||
const layout = {
|
||||
title: {
|
||||
text: 'BLE RSSI over time',
|
||||
x: 0.02
|
||||
},
|
||||
xaxis: {
|
||||
title: 'Receiver observation time',
|
||||
type: 'date'
|
||||
},
|
||||
yaxis: {
|
||||
title: 'RSSI dBm. Higher, less negative, is stronger.',
|
||||
autorange: true
|
||||
},
|
||||
hovermode: 'closest',
|
||||
legend: {
|
||||
orientation: 'h',
|
||||
y: -0.22
|
||||
},
|
||||
margin: {
|
||||
l: 70,
|
||||
r: 30,
|
||||
t: 50,
|
||||
b: 90
|
||||
}
|
||||
};
|
||||
|
||||
const config = {
|
||||
responsive: true,
|
||||
displaylogo: false,
|
||||
toImageButtonOptions: {
|
||||
filename: 'exercise26_ble_rssi_' + timestampForFilename(),
|
||||
format: 'png',
|
||||
width: 1600,
|
||||
height: 900,
|
||||
scale: 1
|
||||
}
|
||||
};
|
||||
|
||||
Plotly.newPlot('chart', traces, layout, config);
|
||||
|
||||
function escapeHtml(s) {
|
||||
return String(s)
|
||||
.replace(/&/g, '&')
|
||||
.replace(/</g, '<')
|
||||
.replace(/>/g, '>')
|
||||
.replace(/"/g, '"')
|
||||
.replace(/'/g, ''');
|
||||
}
|
||||
|
||||
function timestampForFilename() {
|
||||
const d = new Date();
|
||||
const pad = n => String(n).padStart(2, '0');
|
||||
return d.getFullYear() + pad(d.getMonth() + 1) + pad(d.getDate()) + '_' +
|
||||
pad(d.getHours()) + pad(d.getMinutes()) + pad(d.getSeconds());
|
||||
}
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
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;
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue