blob: d41854658d8bc5768e2de861544a0008265fb9ce (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
#!/usr/bin/perl
use CGI;
my $q = CGI->new;
print $q->header('text/html');
print $q->img({src => 'https://subsurface-divelog.org/wp-content/uploads/2015/10/subsurface-icon1.png'});
print $q->h1("Subsurface");
my %dcs;
&load_supported_dcs;
print $q->start_form();
if ($q->param("Manufacturer")) {
print $q->hidden(-name => "Manufacturer", -default => $q->param("Manufacturer"));
if ($q->param("Product")) {
print $q->hidden(-name => "Product", -default => $q->param("Product"));
opendir DIR, "/dev";
my @devices = map {"/dev/$_"} (grep {!/^\./} (readdir DIR));
closedir DIR;
print "Select mount point:";
print $q->popup_menu("Mount point", \@devices);
} else {
print "Select ",$q->param("Manufacturer")," model:";
print $q->popup_menu("Product", $dcs{$q->param("Manufacturer")});
}
} else {
print "Select dive computer manufacturer:";
print $q->popup_menu("Manufacturer", [sort keys %dcs]);
}
print $q->submit();
print $q->end_form();
sub load_supported_dcs {
open IN, "/home/pi/src/subsurface/build/subsurface-downloader --list-dc|";
while(<IN>) {
last if /Supported dive computers:/;
}
while(<IN>) {
last unless /\S/;
my ($manufacturer, $products) = /"([^:]+):\s+([^"]+)"/;
$products =~ s/\([^\)]*\)//g;
my @products = split /,\s*/, $products;
$dcs{$manufacturer} = \@products;
}
close IN;
}
|