[Perl] DAQ system for the FAPG.
refactor use Excel writer for xlsx exports
- replace custom OOXML and ZIP generation with Excel::Writer::XLSX - write spreadsheet timestamps and numeric values as native cells - install the Debian Excel writer package during dashboard deployment - cover pivoted and raw workbook exports
Changed files
roles/dashboard/deploy
@@ -33,6 +33,7 @@
33
33
perl \
34
34
nginx \
35
35
libdbd-sqlite3-perl \
36
Added:
libexcel-writer-xlsx-perl \
36
37
libmojolicious-perl \
37
38
libmojo-sqlite-perl
38
39
}
roles/dashboard/lib/FAPG/DAQ/Dashboard/Controller/Download.pm
@@ -3,8 +3,8 @@
3
3
package FAPG::DAQ::Dashboard::Controller::Download;
4
4
use Mojo::Base 'Mojolicious::Controller', -signatures;
5
5
6
Added:
use Excel::Writer::XLSX;
6
7
use FAPG::DAQ::Dashboard::Timeframe qw(max_series_range series_window);
7
Removed:
use IO::Compress::Zip qw($ZipError);
8
8
use POSIX qw(strftime);
9
9
use Time::Local qw(timegm);
10
10
@@ -17,10 +17,11 @@
17
17
}
18
18
19
19
sub download_readings ( $self, $format ) {
20
Removed:
return timeframe_readings( $self, $format ) if defined $self->param('timeframe');
20
Added:
return timeframe_readings( $self, $format )
21
Added:
if defined $self->param('timeframe');
21
22
22
Removed:
my $from = $self->param('from') // '';
23
Removed:
my $to = $self->param('to') // '';
23
Added:
my $from = $self->param('from') // '';
24
Added:
my $to = $self->param('to') // '';
24
25
my @probes = $self->every_param('probe')->@*;
25
26
my $from_epoch = date_epoch($from);
26
27
my $to_epoch = date_epoch($to);
@@ -41,8 +42,11 @@
41
42
text => 'Every selected probe must be a known probe type.',
42
43
) if grep { !$known{$_} } @probes;
43
44
44
Removed:
my $probe_filter = @probes ? ' AND probe IN (' . join( ',', ('?') x @probes ) . ')' : '';
45
Removed:
my $rows = raw_readings(
45
Added:
my $probe_filter
46
Added:
= @probes
47
Added:
? ' AND probe IN (' . join( ',', ('?') x @probes ) . ')'
48
Added:
: '';
49
Added:
my $rows = raw_readings(
46
50
$self,
47
51
'COALESCE(received_at, timestamp) >= ? '
48
52
. 'AND COALESCE(received_at, timestamp) < ?'
@@ -129,18 +133,19 @@
129
133
: raw_reading_table($rows);
130
134
my @timestamp_columns = $pivoted ? (0) : ( 0, 1 );
131
135
132
Removed:
return render_xlsx( $self, $headers, $table, $filename, \@timestamp_columns )
136
Added:
return render_xlsx( $self, $headers, $table, $filename,
137
Added:
\@timestamp_columns )
133
138
if $format eq 'xlsx';
134
139
135
Removed:
return render_csv( $self, $headers, $table, $filename, \@timestamp_columns );
140
Added:
return render_csv( $self, $headers, $table, $filename,
141
Added:
\@timestamp_columns );
136
142
}
137
143
138
144
sub raw_reading_table ($rows) {
139
145
my @headers = qw(timestamp received_at node probe value unit);
140
146
my @table = map {
141
147
my $reading = $_;
142
Removed:
[
143
Removed:
map {
148
Added:
[ map {
144
149
/\A(?:timestamp|received_at)\z/
145
150
? spreadsheet_timestamp( $reading->{$_} )
146
151
: $reading->{$_};
@@ -166,20 +171,22 @@
166
171
167
172
my @table = map {
168
173
my $timestamp = $_;
169
Removed:
[ spreadsheet_timestamp($timestamp), map { $values{$timestamp}{$_} } @probes ];
174
Added:
[ spreadsheet_timestamp($timestamp),
175
Added:
map { $values{$timestamp}{$_} } @probes
176
Added:
];
170
177
} sort keys %values;
171
178
172
179
return ( [ 'timestamp', @probes ], \@table );
173
180
}
174
181
175
182
sub render_csv ( $self, $headers, $table, $filename, $timestamp_columns ) {
176
Removed:
my @lines = ( join ',', $headers->@* );
183
Added:
my @lines = ( join ',', $headers->@* );
177
184
my %timestamp_column = map { $_ => 1 } $timestamp_columns->@*;
178
185
179
186
for my $row ( $table->@* ) {
180
Removed:
push @lines, join ',', map {
181
Removed:
csv_value( $row->[$_], $timestamp_column{$_} );
182
Removed:
} 0 .. $#$row;
187
Added:
push @lines, join ',',
188
Added:
map { csv_value( $row->[$_], $timestamp_column{$_} ); }
189
Added:
0 .. $#$row;
183
190
}
184
191
185
192
$self->res->headers->content_type('text/csv; charset=utf-8');
@@ -199,116 +206,58 @@
199
206
}
200
207
201
208
sub xlsx_data ( $headers, $table, $timestamp_columns = [] ) {
202
Removed:
my $sheet = worksheet_xml( [ $headers, $table->@* ], $timestamp_columns );
203
Removed:
my %parts = (
204
Removed:
'[Content_Types].xml' => <<'XML',
205
Removed:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
206
Removed:
<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/styles.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml"/><Override PartName="/xl/worksheets/sheet1.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml"/></Types>
207
Removed:
XML
208
Removed:
'_rels/.rels' => <<'XML',
209
Removed:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
210
Removed:
<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>
211
Removed:
XML
212
Removed:
'xl/workbook.xml' => <<'XML',
213
Removed:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
214
Removed:
<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>
215
Removed:
XML
216
Removed:
'xl/_rels/workbook.xml.rels' => <<'XML',
217
Removed:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
218
Removed:
<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"/><Relationship Id="rId2" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles" Target="styles.xml"/></Relationships>
219
Removed:
XML
220
Removed:
'xl/styles.xml' => <<'XML',
221
Removed:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
222
Removed:
<styleSheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main"><numFmts count="1"><numFmt numFmtId="164" formatCode="yyyy-mm-dd hh:mm:ss"/></numFmts><fonts count="1"><font><sz val="11"/><name val="Calibri"/></font></fonts><fills count="1"><fill><patternFill patternType="none"/></fill></fills><borders count="1"><border/></borders><cellStyleXfs count="1"><xf numFmtId="0" fontId="0" fillId="0" borderId="0"/></cellStyleXfs><cellXfs count="2"><xf numFmtId="0" fontId="0" fillId="0" borderId="0"/><xf numFmtId="164" fontId="0" fillId="0" borderId="0" applyNumberFormat="1"/></cellXfs></styleSheet>
223
Removed:
XML
224
Removed:
'xl/worksheets/sheet1.xml' => $sheet,
225
Removed:
);
226
209
my $data = '';
227
Removed:
my $zip = IO::Compress::Zip->new( \$data )
228
Removed:
or die "Unable to create XLSX archive: $ZipError";
210
Added:
open my $output, '>', \$data
211
Added:
or die "Unable to open in-memory XLSX output: $!";
212
Added:
binmode $output;
229
213
230
Removed:
for my $name ( sort keys %parts ) {
231
Removed:
$zip->newStream( Name => $name )
232
Removed:
or die "Unable to add XLSX archive member: $ZipError";
233
Removed:
$zip->print( $parts{$name} )
234
Removed:
or die "Unable to write XLSX archive member: $ZipError";
235
Removed:
}
236
Removed:
237
Removed:
$zip->close or die "Unable to finish XLSX archive: $ZipError";
238
Removed:
239
Removed:
return $data;
240
Removed:
}
241
Removed:
242
Removed:
sub worksheet_xml ( $rows, $timestamp_columns ) {
243
Removed:
my @rows;
214
Added:
my $workbook = Excel::Writer::XLSX->new($output)
215
Added:
or die "Unable to create XLSX workbook: $!";
216
Added:
my $worksheet = $workbook->add_worksheet('Readings');
217
Added:
my $date_format
218
Added:
= $workbook->add_format( num_format => 'yyyy-mm-dd hh:mm:ss' );
244
219
my %timestamp_column = map { $_ => 1 } $timestamp_columns->@*;
220
Added:
my @rows = ( $headers, $table->@* );
245
221
246
Removed:
for my $row_index ( 0 .. $#$rows ) {
247
Removed:
my @cells;
248
Removed:
249
Removed:
for my $column_index ( 0 .. $#{ $rows->[$row_index] } ) {
250
Removed:
my $value = $rows->[$row_index][$column_index];
222
Added:
for my $row_index ( 0 .. $#rows ) {
223
Added:
for my $column_index ( 0 .. $#{ $rows[$row_index] } ) {
224
Added:
my $value = $rows[$row_index][$column_index];
251
225
next if !defined $value;
252
226
253
Removed:
my $reference = spreadsheet_column( $column_index + 1 ) . ( $row_index + 1 );
254
Removed:
push @cells,
255
Removed:
xlsx_cell( $reference, $value,
256
Removed:
$row_index && $timestamp_column{$column_index} );
257
Removed:
}
227
Added:
my $status;
228
Added:
if ( $row_index && $timestamp_column{$column_index} ) {
229
Added:
my $date_time = $value =~ s/ /T/r;
230
Added:
$status
231
Added:
= $worksheet->write_date_time( $row_index, $column_index,
232
Added:
$date_time, $date_format );
233
Added:
}
234
Added:
elsif ( $value =~ /\A-?(?:\d+(?:\.\d*)?|\.\d+)\z/ ) {
235
Added:
$status = $worksheet->write_number( $row_index, $column_index,
236
Added:
0 + $value );
237
Added:
}
238
Added:
else {
239
Added:
$status = $worksheet->write_string( $row_index, $column_index,
240
Added:
$value );
241
Added:
}
258
242
259
Removed:
push @rows, '<row r="' . ( $row_index + 1 ) . '">' . join( '', @cells ) . '</row>';
243
Added:
die
244
Added:
"Unable to write XLSX cell at row $row_index, column $column_index"
245
Added:
if $status;
246
Added:
}
260
247
}
261
248
262
Removed:
return qq{<?xml version="1.0" encoding="UTF-8" standalone="yes"?>\n}
263
Removed:
. qq{<worksheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main"><sheetData>}
264
Removed:
. join( '', @rows ) . '</sheetData></worksheet>';
265
Removed:
}
249
Added:
$workbook->close()
250
Added:
or die "Unable to finish XLSX workbook: $!";
266
251
267
Removed:
sub xlsx_cell ( $reference, $value, $is_timestamp = 0 ) {
268
Removed:
my $serial = excel_timestamp($value);
269
Removed:
return qq{<c r="$reference" s="1"><v>$serial</v></c>}
270
Removed:
if $is_timestamp && defined $serial;
271
Removed:
272
Removed:
return qq{<c r="$reference"><v>$value</v></c>}
273
Removed:
if $value =~ /\A-?(?:\d+(?:\.\d*)?|\.\d+)\z/;
274
Removed:
275
Removed:
return qq{<c r="$reference" t="inlineStr"><is><t>} . xml_value($value)
276
Removed:
. '</t></is></c>';
252
Added:
return $data;
277
253
}
278
254
279
Removed:
sub spreadsheet_column ($number) {
280
Removed:
my $name = '';
281
Removed:
282
Removed:
while ($number) {
283
Removed:
$number--;
284
Removed:
$name = chr( 65 + ( $number % 26 ) ) . $name;
285
Removed:
$number = int( $number / 26 );
286
Removed:
}
287
Removed:
288
Removed:
return $name;
289
Removed:
}
290
Removed:
291
255
sub spreadsheet_timestamp ($timestamp) {
292
256
return undef if !defined $timestamp;
293
257
294
258
$timestamp =~ s/T/ /;
295
259
$timestamp =~ s/Z\z//;
296
260
return $timestamp;
297
Removed:
}
298
Removed:
299
Removed:
sub excel_timestamp ($timestamp) {
300
Removed:
return undef
301
Removed:
unless $timestamp =~ /\A(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})\z/;
302
Removed:
303
Removed:
my $epoch = eval { timegm( $6, $5, $4, $3, $2 - 1, $1 ) };
304
Removed:
return undef if !defined $epoch || $@;
305
Removed:
306
Removed:
my $excel_epoch = timegm( 0, 0, 0, 30, 11, 1899 );
307
Removed:
return ( $epoch - $excel_epoch ) / ( 24 * 60 * 60 );
308
Removed:
}
309
Removed:
310
Removed:
sub xml_value ($value) {
311
Removed:
$value =~ s/&/&/gr =~ s/</</gr =~ s/>/>/gr;
312
261
}
313
262
314
263
sub csv_value ( $value, $is_timestamp = 0 ) {
roles/dashboard/t/07-downloads-csv.t
@@ -23,28 +23,36 @@
23
23
24
24
$t->get_ok('/downloads/readings.xlsx?from=2026-07-05&to=2026-07-05')
25
25
->status_is(200)
26
Removed:
->header_like(
27
Removed:
'Content-Type' => qr{application/vnd\.openxmlformats-officedocument\.spreadsheetml\.sheet})
26
Added:
->header_like( 'Content-Type' =>
27
Added:
qr{application/vnd\.openxmlformats-officedocument\.spreadsheetml\.sheet}
28
Added:
)
28
29
->header_like( 'Content-Disposition' => qr/fapg-daq-readings-.*\.xlsx/ )
29
30
->content_like(qr/^PK/);
30
31
31
32
my $worksheet = xlsx_member( $t->tx->res->body, 'xl/worksheets/sheet1.xml' );
33
Added:
my $strings = xlsx_member( $t->tx->res->body, 'xl/sharedStrings.xml' );
32
34
my $styles = xlsx_member( $t->tx->res->body, 'xl/styles.xml' );
33
Removed:
like( $worksheet, qr{<c r="A1" t="inlineStr"><is><t>timestamp</t>},
35
Added:
like( $strings, qr{<t>timestamp</t>},
34
36
'XLSX worksheet has a timestamp column' );
35
Removed:
like( $worksheet, qr{<c r="B1" t="inlineStr"><is><t>ph</t>},
36
Removed:
'XLSX worksheet has a pH column' );
37
Removed:
like( $worksheet, qr{<c r="A2" s="1"><v>},
38
Removed:
'XLSX timestamps are native date-time cells' );
39
Removed:
like( $styles, qr{formatCode="yyyy-mm-dd hh:mm:ss"},
40
Removed:
'XLSX date-time cells use a spreadsheet-friendly format' );
37
Added:
like( $strings, qr{<t>ph</t>}, 'XLSX worksheet has a pH column' );
38
Added:
like(
39
Added:
$worksheet,
40
Added:
qr{<c r="A2" s="\d+"><v>},
41
Added:
'XLSX timestamps are native date-time cells'
42
Added:
);
43
Added:
like(
44
Added:
$styles,
45
Added:
qr{formatCode="yyyy-mm-dd hh:mm:ss"},
46
Added:
'XLSX date-time cells use a spreadsheet-friendly format'
47
Added:
);
41
48
42
49
$t->get_ok('/downloads/readings.csv?from=2026-07-05&to=2026-07-05&probe=ph')
43
50
->status_is(200)
44
51
->content_like(qr/2026-07-05 12:00:00/)
45
52
->content_unlike(qr/2026-07-05 12:00:15/);
46
53
47
Removed:
$t->get_ok('/downloads/readings.csv?from=2026-07-05&to=2026-07-05&probe=ph&probe=do')
54
Added:
$t->get_ok(
55
Added:
'/downloads/readings.csv?from=2026-07-05&to=2026-07-05&probe=ph&probe=do')
48
56
->status_is(200)
49
57
->content_like(qr/^timestamp,ph,do/m)
50
58
->content_unlike(qr/^timestamp,ph,do,orp,ec/m);
@@ -54,6 +62,22 @@
54
62
->header_like( 'Content-Disposition' => qr/fapg-daq-ph-hour-1\.csv/ )
55
63
->content_like(qr/,"ph",/)
56
64
->content_unlike(qr/,"do",/);
65
Added:
66
Added:
$t->get_ok('/downloads/readings.xlsx?probe=ph&timeframe=hour&range=1')
67
Added:
->status_is(200)
68
Added:
->header_like( 'Content-Disposition' => qr/fapg-daq-ph-hour-1\.xlsx/ );
69
Added:
my $raw_worksheet
70
Added:
= xlsx_member( $t->tx->res->body, 'xl/worksheets/sheet1.xml' );
71
Added:
like(
72
Added:
$raw_worksheet,
73
Added:
qr{<c r="A2" s="\d+"><v>},
74
Added:
'raw XLSX timestamps are native date-time cells'
75
Added:
);
76
Added:
like(
77
Added:
$raw_worksheet,
78
Added:
qr{<c r="B2" s="\d+"><v>},
79
Added:
'raw XLSX received times are native date-time cells'
80
Added:
);
57
81
58
82
$t->get_ok('/downloads/readings.csv?probe=unknown&timeframe=day&range=1')
59
83
->status_is(400);