mifr/subsurface
1
0
Fork 0
mirror of https://github.com/subsurface/subsurface.git synced 2025-02-19 22:16:15 +00:00
Code Issues Projects Releases Packages Wiki Activity

downloader: add first downloader CGI script

Browse source 
This script will function as glue between a web server
and the downloader command line app.

Signed-off-by: Robert C. Helling <helling@atdotde.de>
This commit is contained in:
Robert C. Helling 2020-11-16 14:08:31 +01:00 • committed by Dirk Hohndel
parent d73c70181f
commit f0a512b0b8
1 changed files with 53 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
scripts/downloader.pl Normal file
View file

@ -0,0 +1,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;
}