mirror of
https://github.com/subsurface/subsurface.git
synced 2025-02-19 22:16:15 +00:00
downloader: add first downloader CGI script
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:
parent
d73c70181f
commit
f0a512b0b8
1 changed files with 53 additions and 0 deletions
53
scripts/downloader.pl
Normal file
53
scripts/downloader.pl
Normal 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;
|
||||||
|
}
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue