[Perl] DAQ system for the FAPG.
feat add spreadsheet downloads
Pivot all-probe CSV downloads into timestamp rows with one column per probe. Add an XLSX download endpoint and Downloads-page button.
Changed files
roles/dashboard/lib/FAPG/DAQ/Dashboard.pm
@@ -76,6 +76,7 @@
76
76
$r->get('/probes')->to('dashboard#probe_list');
77
77
$r->get('/downloads')->to('dashboard#downloads');
78
78
$r->get('/downloads/readings.csv')->to('Download#readings');
79
Added:
$r->get('/downloads/readings.xlsx')->to('Download#spreadsheet');
79
80
$r->get('/probes/:probe')->to('dashboard#graph');
80
81
81
82
$r->get('/api/readings/:probe/series')->to('Reading#series');
roles/dashboard/lib/FAPG/DAQ/Dashboard/Controller/Download.pm
@@ -4,12 +4,21 @@
4
4
use Mojo::Base 'Mojolicious::Controller', -signatures;
5
5
6
6
use FAPG::DAQ::Dashboard::Timeframe qw(max_series_range series_window);
7
Added:
use IO::Compress::Zip qw($ZipError);
7
8
use POSIX qw(strftime);
8
9
use Time::Local qw(timegm);
9
10
10
11
sub readings ($self) {
11
Removed:
return timeframe_readings($self) if defined $self->param('timeframe');
12
Added:
return download_readings( $self, 'csv' );
13
Added:
}
12
14
15
Added:
sub spreadsheet ($self) {
16
Added:
return download_readings( $self, 'xlsx' );
17
Added:
}
18
Added:
19
Added:
sub download_readings ( $self, $format ) {
20
Added:
return timeframe_readings( $self, $format ) if defined $self->param('timeframe');
21
Added:
13
22
my $from = $self->param('from') // '';
14
23
my $to = $self->param('to') // '';
15
24
my $probe = $self->param('probe') // '';
@@ -46,13 +55,13 @@
46
55
);
47
56
my $filename
48
57
= $probe eq ''
49
Removed:
? "fapg-daq-readings-$from-to-$to.csv"
50
Removed:
: "fapg-daq-readings-$probe-$from-to-$to.csv";
58
Added:
? "fapg-daq-readings-$from-to-$to.$format"
59
Added:
: "fapg-daq-readings-$probe-$from-to-$to.$format";
51
60
52
Removed:
render_csv( $self, $rows, $filename );
61
Added:
render_download( $self, $rows, $filename, $format, $probe eq '' );
53
62
}
54
63
55
Removed:
sub timeframe_readings ($self) {
64
Added:
sub timeframe_readings ( $self, $format ) {
56
65
my $probe = $self->param('probe') // '';
57
66
my $timeframe = $self->param('timeframe') // '';
58
67
my $range = $self->param('range') // 1;
@@ -87,9 +96,9 @@
87
96
$window->{start_iso},
88
97
$window->{end_iso},
89
98
);
90
Removed:
my $filename = "fapg-daq-$probe-$timeframe-$range.csv";
99
Added:
my $filename = "fapg-daq-$probe-$timeframe-$range.$format";
91
100
92
Removed:
render_csv( $self, $rows, $filename );
101
Added:
render_download( $self, $rows, $filename, $format, 0 );
93
102
}
94
103
95
104
sub raw_readings ( $self, $where, $order_by, @bind ) {
@@ -112,19 +121,148 @@
112
121
)->hashes->to_array;
113
122
}
114
123
115
Removed:
sub render_csv ( $self, $rows, $filename ) {
116
Removed:
my @lines = ('timestamp,received_at,node,probe,value,unit');
124
Added:
sub render_download ( $self, $rows, $filename, $format, $all_probes ) {
125
Added:
my ( $headers, $table )
126
Added:
= $all_probes ? pivoted_readings( $self, $rows ) : raw_reading_table($rows);
117
127
128
Added:
return render_xlsx( $self, $headers, $table, $filename ) if $format eq 'xlsx';
129
Added:
130
Added:
return render_csv( $self, $headers, $table, $filename );
131
Added:
}
132
Added:
133
Added:
sub raw_reading_table ($rows) {
134
Added:
my @headers = qw(timestamp received_at node probe value unit);
135
Added:
my @table = map {
136
Added:
my $reading = $_;
137
Added:
[ map { $reading->{$_} } @headers ];
138
Added:
} $rows->@*;
139
Added:
140
Added:
return ( \@headers, \@table );
141
Added:
}
142
Added:
143
Added:
sub pivoted_readings ( $self, $rows ) {
144
Added:
my @probes = map { $_->{key} } $self->probes->@*;
145
Added:
my %values;
146
Added:
118
147
for my $row ( $rows->@* ) {
119
Removed:
push @lines, join ',',
120
Removed:
map { csv_value( $row->{$_} ) }
121
Removed:
qw(timestamp received_at node probe value unit);
148
Added:
my $timestamp = $row->{timestamp} // $row->{received_at};
149
Added:
next if !defined $timestamp;
150
Added:
151
Added:
$values{$timestamp}{ $row->{probe} } = $row->{value};
122
152
}
123
153
154
Added:
my @table = map {
155
Added:
my $timestamp = $_;
156
Added:
[ $timestamp, map { $values{$timestamp}{$_} } @probes ];
157
Added:
} sort keys %values;
158
Added:
159
Added:
return ( [ 'timestamp', @probes ], \@table );
160
Added:
}
161
Added:
162
Added:
sub render_csv ( $self, $headers, $table, $filename ) {
163
Added:
my @lines = ( join ',', $headers->@* );
164
Added:
165
Added:
for my $row ( $table->@* ) {
166
Added:
push @lines, join ',', map { csv_value($_) } $row->@*;
167
Added:
}
168
Added:
124
169
$self->res->headers->content_type('text/csv; charset=utf-8');
125
170
$self->res->headers->content_disposition(
126
171
qq{attachment; filename="$filename"});
127
172
$self->render( data => join( "\n", @lines ) . "\n" );
173
Added:
}
174
Added:
175
Added:
sub render_xlsx ( $self, $headers, $table, $filename ) {
176
Added:
my $data = xlsx_data( $headers, $table );
177
Added:
178
Added:
$self->res->headers->content_type(
179
Added:
'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet');
180
Added:
$self->res->headers->content_disposition(
181
Added:
qq{attachment; filename="$filename"});
182
Added:
$self->render( data => $data );
183
Added:
}
184
Added:
185
Added:
sub xlsx_data ( $headers, $table ) {
186
Added:
my $sheet = worksheet_xml( [ $headers, $table->@* ] );
187
Added:
my %parts = (
188
Added:
'[Content_Types].xml' => <<'XML',
189
Added:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
190
Added:
<Types xmlns="http://schemas.openxmlformats.org/package/2006/content-types"><Default Extension="rels" ContentType="application/vnd.openxmlformats-package.relationships+xml"/><Default Extension="xml" ContentType="application/xml"/><Override PartName="/xl/workbook.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml"/><Override PartName="/xl/worksheets/sheet1.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml"/></Types>
191
Added:
XML
192
Added:
'_rels/.rels' => <<'XML',
193
Added:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
194
Added:
<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships"><Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/></Relationships>
195
Added:
XML
196
Added:
'xl/workbook.xml' => <<'XML',
197
Added:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
198
Added:
<workbook xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships"><sheets><sheet name="Readings" sheetId="1" r:id="rId1"/></sheets></workbook>
199
Added:
XML
200
Added:
'xl/_rels/workbook.xml.rels' => <<'XML',
201
Added:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
202
Added:
<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships"><Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet" Target="worksheets/sheet1.xml"/></Relationships>
203
Added:
XML
204
Added:
'xl/worksheets/sheet1.xml' => $sheet,
205
Added:
);
206
Added:
my $data = '';
207
Added:
my $zip = IO::Compress::Zip->new( \$data )
208
Added:
or die "Unable to create XLSX archive: $ZipError";
209
Added:
210
Added:
for my $name ( sort keys %parts ) {
211
Added:
$zip->newStream( Name => $name )
212
Added:
or die "Unable to add XLSX archive member: $ZipError";
213
Added:
$zip->print( $parts{$name} )
214
Added:
or die "Unable to write XLSX archive member: $ZipError";
215
Added:
}
216
Added:
217
Added:
$zip->close or die "Unable to finish XLSX archive: $ZipError";
218
Added:
219
Added:
return $data;
220
Added:
}
221
Added:
222
Added:
sub worksheet_xml ($rows) {
223
Added:
my @rows;
224
Added:
225
Added:
for my $row_index ( 0 .. $#$rows ) {
226
Added:
my @cells;
227
Added:
228
Added:
for my $column_index ( 0 .. $#{ $rows->[$row_index] } ) {
229
Added:
my $value = $rows->[$row_index][$column_index];
230
Added:
next if !defined $value;
231
Added:
232
Added:
my $reference = spreadsheet_column( $column_index + 1 ) . ( $row_index + 1 );
233
Added:
push @cells, xlsx_cell( $reference, $value );
234
Added:
}
235
Added:
236
Added:
push @rows, '<row r="' . ( $row_index + 1 ) . '">' . join( '', @cells ) . '</row>';
237
Added:
}
238
Added:
239
Added:
return qq{<?xml version="1.0" encoding="UTF-8" standalone="yes"?>\n}
240
Added:
. qq{<worksheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main"><sheetData>}
241
Added:
. join( '', @rows ) . '</sheetData></worksheet>';
242
Added:
}
243
Added:
244
Added:
sub xlsx_cell ( $reference, $value ) {
245
Added:
return qq{<c r="$reference"><v>$value</v></c>}
246
Added:
if $value =~ /\A-?(?:\d+(?:\.\d*)?|\.\d+)\z/;
247
Added:
248
Added:
return qq{<c r="$reference" t="inlineStr"><is><t>} . xml_value($value)
249
Added:
. '</t></is></c>';
250
Added:
}
251
Added:
252
Added:
sub spreadsheet_column ($number) {
253
Added:
my $name = '';
254
Added:
255
Added:
while ($number) {
256
Added:
$number--;
257
Added:
$name = chr( 65 + ( $number % 26 ) ) . $name;
258
Added:
$number = int( $number / 26 );
259
Added:
}
260
Added:
261
Added:
return $name;
262
Added:
}
263
Added:
264
Added:
sub xml_value ($value) {
265
Added:
$value =~ s/&/&/gr =~ s/</</gr =~ s/>/>/gr;
128
266
}
129
267
130
268
sub csv_value ($value) {
roles/dashboard/t/06-downloads.t
@@ -29,7 +29,10 @@
29
29
'[data-custom-date-fields][hidden] input[name="from"][type="date"]')
30
30
->element_exists(
31
31
'[data-custom-date-fields][hidden] input[name="to"][type="date"]')
32
Removed:
->text_is( 'button.downloads-button[type="submit"]', 'Download CSV' );
32
Added:
->text_is( 'button.downloads-button[type="submit"]', 'Download CSV' )
33
Added:
->text_is(
34
Added:
'button.downloads-button[type="submit"][formaction="/downloads/readings.xlsx"]',
35
Added:
'Download .xlsx' );
33
36
34
37
for my $probe (qw(ph do orp ec)) {
35
38
$t->element_exists(qq{select#download-probe option[value="$probe"]});
roles/dashboard/t/07-downloads-csv.t
@@ -2,6 +2,7 @@
2
2
3
3
use Mojo::Base -strict;
4
4
5
Added:
use IO::Uncompress::Unzip qw($UnzipError);
5
6
use Test2::V0;
6
7
7
8
use FindBin;
@@ -16,10 +17,23 @@
16
17
->status_is(200)
17
18
->header_like( 'Content-Type' => qr{text/csv} )
18
19
->header_like( 'Content-Disposition' => qr{attachment} )
19
Removed:
->content_like(qr/^timestamp,received_at,node,probe,value,unit/m)
20
Added:
->content_like(qr/^timestamp,ph,do,orp,ec/m)
20
21
->content_like(qr/2026-07-05T12:00:00Z/)
21
22
->content_like(qr/2026-07-05T12:00:15Z/);
22
23
24
Added:
$t->get_ok('/downloads/readings.xlsx?from=2026-07-05&to=2026-07-05')
25
Added:
->status_is(200)
26
Added:
->header_like(
27
Added:
'Content-Type' => qr{application/vnd\.openxmlformats-officedocument\.spreadsheetml\.sheet})
28
Added:
->header_like( 'Content-Disposition' => qr/fapg-daq-readings-.*\.xlsx/ )
29
Added:
->content_like(qr/^PK/);
30
Added:
31
Added:
my $worksheet = xlsx_member( $t->tx->res->body, 'xl/worksheets/sheet1.xml' );
32
Added:
like( $worksheet, qr{<c r="A1" t="inlineStr"><is><t>timestamp</t>},
33
Added:
'XLSX worksheet has a timestamp column' );
34
Added:
like( $worksheet, qr{<c r="B1" t="inlineStr"><is><t>ph</t>},
35
Added:
'XLSX worksheet has a pH column' );
36
Added:
23
37
$t->get_ok('/downloads/readings.csv?from=2026-07-05&to=2026-07-05&probe=ph')
24
38
->status_is(200)
25
39
->content_like(qr/2026-07-05T12:00:00Z/)
@@ -46,7 +60,7 @@
46
60
47
61
$empty_t->get_ok('/downloads/readings.csv?from=2026-07-05&to=2026-07-05')
48
62
->status_is(200)
49
Removed:
->content_is("timestamp,received_at,node,probe,value,unit\n");
63
Added:
->content_is("timestamp,ph,do,orp,ec\n");
50
64
51
65
done_testing;
52
66
@@ -78,4 +92,31 @@
78
92
my ($epoch) = @_;
79
93
require POSIX;
80
94
return POSIX::strftime( '%Y-%m-%dT%H:%M:%SZ', gmtime $epoch );
95
Added:
}
96
Added:
97
Added:
sub xlsx_member {
98
Added:
my ( $data, $name ) = @_;
99
Added:
my $zip = IO::Uncompress::Unzip->new( \$data )
100
Added:
or die "Unable to read XLSX archive: $UnzipError";
101
Added:
102
Added:
while (1) {
103
Added:
if ( ( $zip->getHeaderInfo->{Name} // '' ) eq $name ) {
104
Added:
my $content = '';
105
Added:
my $buffer;
106
Added:
107
Added:
while (1) {
108
Added:
my $status = $zip->read($buffer);
109
Added:
die "Unable to read XLSX archive member: $UnzipError"
110
Added:
if !defined $status;
111
Added:
$content .= $buffer;
112
Added:
last if !$status;
113
Added:
}
114
Added:
115
Added:
return $content;
116
Added:
}
117
Added:
118
Added:
last unless $zip->nextStream();
119
Added:
}
120
Added:
121
Added:
die "XLSX archive member not found: $name";
81
122
}
roles/dashboard/templates/dashboard/downloads.html.ep
@@ -6,7 +6,7 @@
6
6
<div class="card">
7
7
<div class="card-header">
8
8
<h1 class="h5 mb-0">Downloads</h1>
9
Removed:
<p class="text-muted small mb-0 mt-1">Download recorded DAQ readings as a CSV file.</p>
9
Added:
<p class="text-muted small mb-0 mt-1">Download recorded DAQ readings as a CSV or Excel file.</p>
10
10
</div>
11
11
12
12
<div class="card-body">
@@ -56,6 +56,7 @@
56
56
57
57
<div>
58
58
<button class="btn btn-success downloads-button" type="submit">Download CSV</button>
59
Added:
<button class="btn btn-outline-success downloads-button" type="submit" formaction="/downloads/readings.xlsx">Download .xlsx</button>
59
60
</div>
60
61
61
62
</form>