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>

1 files changed, 53 insertions, 0 deletions

diff --git a/scripts/downloader.pl b/scripts/downloader.pl
new file mode 100644
index 000000000..d41854658
--- /dev/null
+++ b/scripts/downloader.pl
@@ -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;
+}
+