mirror of
				https://github.com/subsurface/subsurface.git
				synced 2025-02-19 22:16:15 +00:00 
			
		
		
		
	Add Diviac conversion to smtk converter CGI script
Plus a little bit of error reporting. Signed-off-by: Robert C. Helling <helling@atdotde.de>
This commit is contained in:
		
							parent
							
								
									7cc7feb8f0
								
							
						
					
					
						commit
						faafcd0cfc
					
				
					 2 changed files with 128 additions and 2 deletions
				
			
		
							
								
								
									
										119
									
								
								scripts/diviac.pl
									
										
									
									
									
										Executable file
									
								
							
							
						
						
									
										119
									
								
								scripts/diviac.pl
									
										
									
									
									
										Executable file
									
								
							| 
						 | 
					@ -0,0 +1,119 @@
 | 
				
			||||||
 | 
					#!/usr/bin/perl
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					use Data::Dumper;
 | 
				
			||||||
 | 
					use JSON;
 | 
				
			||||||
 | 
					use Text::CSV;
 | 
				
			||||||
 | 
					use utf8;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					binmode STDOUT, ":encoding(UTF-8)";
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					my $csv = Text::CSV->new ( { binary => 1 } )  # should set binary attribute.
 | 
				
			||||||
 | 
					                 or die "Cannot use CSV: ".Text::CSV->error_diag ();
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					open my $fh, "<:encoding(utf8)", $ARGV[0] or die "$ARGV[0]: $!";
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					@fields = @{$csv->getline($fh)};
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					$csv->column_names(@fields);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					print "<divelog program='Diviac' version='42'>\n<dives>\n";
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					while(my $dive = $csv->getline_hr($fh)) {
 | 
				
			||||||
 | 
					#  print STDERR "Dive number " . $dive->{"Dive #"} . "\n";
 | 
				
			||||||
 | 
					  my ($month, $day, $year) = split /\-/, $dive->{"Date"};
 | 
				
			||||||
 | 
					  print "<dive number='".$dive->{"Dive #"}."' date='$year-$month-$day' time='".$dive->{"Time in"}.":00' duration='".$dive->{"Duration"}.":00 min'>\n";
 | 
				
			||||||
 | 
					  
 | 
				
			||||||
 | 
					  print "<depth max='".&fix_feet($dive->{"Max depth"})."' mean='".&fix_feet($dive->{"Avg depth"})."' />\n";
 | 
				
			||||||
 | 
					  print "<buddy>" . $dive->{"Dive buddy"} . "</buddy>\n";
 | 
				
			||||||
 | 
					  print "<temperature air='" . $dive->{"Surface temp"} . "' water='" . $dive->{"Bottom temp"} . "' />\n";
 | 
				
			||||||
 | 
					  print "<location>" . &fix_amp($dive->{"Dive Site"}) .", $dive->{Location}</location>\n";
 | 
				
			||||||
 | 
					  print "<gps>$dive->{lat} $dive->{lng}</gps>\n";
 | 
				
			||||||
 | 
					  print "<notes>$dive->{Notes}\n\n" . $dive->{"Marine life sighting"} . "\n</notes>\n";
 | 
				
			||||||
 | 
					  print "<cylinder size='" . &fix_cuft($dive->{"Tank volume"}, $dive->{"Working pressure"}) . "' start='" . &fix_psi($dive->{"Pressure in"}) ."' end='" . &fix_psi($dive->{"Pressure out"}) . "' description='" . $dive->{"Tank type"} . "' />\n";
 | 
				
			||||||
 | 
					  print "<weightsystem weight='" . &fix_lb($dive->{"Weight"})  ."' description='unknown' />";
 | 
				
			||||||
 | 
					  print "<divecomputer model='Diviac import'>\n";
 | 
				
			||||||
 | 
					  &samples($dive->{"Dive profile data"});
 | 
				
			||||||
 | 
					  print "</divecomputer>\n</dive>\n";
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					print "</dives>\n</divelog>\n";
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					sub samples {
 | 
				
			||||||
 | 
					  my $diviac = shift;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					#  print STDERR $diviac;
 | 
				
			||||||
 | 
					  my $p = eval {decode_json($diviac)};
 | 
				
			||||||
 | 
					#  print STDERR Dumper($p);
 | 
				
			||||||
 | 
					  my $dive, $events;
 | 
				
			||||||
 | 
					  $events = '';
 | 
				
			||||||
 | 
					  
 | 
				
			||||||
 | 
					  foreach $line (@$p){
 | 
				
			||||||
 | 
					    my ($a, $b, $c, $d, $e) = @$line;
 | 
				
			||||||
 | 
					    my $min = int($a / 60);
 | 
				
			||||||
 | 
					    my $sec = int($a) - 60 * $min;
 | 
				
			||||||
 | 
					    my $temp = $c ? "temp = '$c C' " : "";
 | 
				
			||||||
 | 
					    $dive .=  "<sample time='$min:$sec min' $temp depth='$b m' />\n";
 | 
				
			||||||
 | 
					    
 | 
				
			||||||
 | 
					    if (@$d) {
 | 
				
			||||||
 | 
					 #     print STDERR "Event at $a: ", (join '|', @$d), "\n";
 | 
				
			||||||
 | 
					      my $ev = join(' ', @$d);
 | 
				
			||||||
 | 
					      $events .= "<event time ='$min:$sec min' name = '$ev' value='' />\n";
 | 
				
			||||||
 | 
					    }
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
 | 
					  
 | 
				
			||||||
 | 
					  print "$events $dive\n";
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					sub fix_feet {
 | 
				
			||||||
 | 
					  my $d = shift;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  if ($d =~ /([\d\.]+)\s*ft/) {
 | 
				
			||||||
 | 
					    return ($1 * 0.3048) . ' m';
 | 
				
			||||||
 | 
					  } else {
 | 
				
			||||||
 | 
					    return $d;
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					sub fix_lb {
 | 
				
			||||||
 | 
					  my $d = shift;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  if ($d =~ /([\d\.]+)\s*lb/) {
 | 
				
			||||||
 | 
					    return ($1 * 0.453592) . ' kg';
 | 
				
			||||||
 | 
					  } else {
 | 
				
			||||||
 | 
					    return $d;
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					sub fix_psi {
 | 
				
			||||||
 | 
					  my $d = shift;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  if ($d =~ /([\d\.]+)\s*psi/) {
 | 
				
			||||||
 | 
					    return ($1 * 0.0689476) . ' bar';
 | 
				
			||||||
 | 
					  } else {
 | 
				
			||||||
 | 
					    return $d;
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					sub fix_cuft {
 | 
				
			||||||
 | 
					  my ($d, $w) = @_;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  my $p;
 | 
				
			||||||
 | 
					  
 | 
				
			||||||
 | 
					  if ($w =~ /([\d\.]+)\s*psi/) {
 | 
				
			||||||
 | 
					    $p = $1 * 0.0689476;
 | 
				
			||||||
 | 
					    if ($d =~ /([\d\.]+)\s*ft/) {
 | 
				
			||||||
 | 
					      return ($1 * 28.3168 / $p) . ' l';
 | 
				
			||||||
 | 
					    } else {
 | 
				
			||||||
 | 
					      return $d;
 | 
				
			||||||
 | 
					    }
 | 
				
			||||||
 | 
					  } else {
 | 
				
			||||||
 | 
					    return '';
 | 
				
			||||||
 | 
					  }
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					sub fix_amp {
 | 
				
			||||||
 | 
					  my $s = shift;
 | 
				
			||||||
 | 
					  $s =~ s/\&/\&/g;
 | 
				
			||||||
 | 
					  return $s;
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -6,6 +6,7 @@ $CGI::POST_MAX = 1024 * 1024 * 10;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
# Change this to the correct path to binary.
 | 
					# Change this to the correct path to binary.
 | 
				
			||||||
my $smtk2ssrf = "../build/smtk2ssrf";
 | 
					my $smtk2ssrf = "../build/smtk2ssrf";
 | 
				
			||||||
 | 
					my $diviac = "../scripts/diviac.pl";
 | 
				
			||||||
my $logfile = '/tmp/smtk2ssrf.log';
 | 
					my $logfile = '/tmp/smtk2ssrf.log';
 | 
				
			||||||
 | 
					
 | 
				
			||||||
my $q = CGI->new;
 | 
					my $q = CGI->new;
 | 
				
			||||||
| 
						 | 
					@ -17,6 +18,12 @@ if ($q->upload("uploaded_file")) {
 | 
				
			||||||
        my $new_filename = $original_filename;
 | 
					        my $new_filename = $original_filename;
 | 
				
			||||||
        $new_filename =~ s/.*[\/\\]//;
 | 
					        $new_filename =~ s/.*[\/\\]//;
 | 
				
			||||||
        $new_filename =~ s/\..*$/.ssrf/;
 | 
					        $new_filename =~ s/\..*$/.ssrf/;
 | 
				
			||||||
 | 
						my $converted;
 | 
				
			||||||
 | 
						if ($q->param('filetype') eq "Diviac") {
 | 
				
			||||||
 | 
							$converted = `$diviac $tmp_filename`;
 | 
				
			||||||
 | 
						} else {
 | 
				
			||||||
 | 
							$converted = `$smtk2ssrf $tmp_filename -`;
 | 
				
			||||||
 | 
						}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
	if (length($converted) > 5) {
 | 
						if (length($converted) > 5) {
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -40,11 +47,11 @@ if ($q->upload("uploaded_file")) {
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        print $q->start_multipart_form();
 | 
					        print $q->start_multipart_form();
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        print $q->h1("Convert Smartrack files to Subsurface");
 | 
					        print $q->h1("Convert Smartrack and Diviac files to Subsurface");
 | 
				
			||||||
 | 
					 | 
				
			||||||
        print $q->filefield( -name => "uploaded_file",
 | 
					        print $q->filefield( -name => "uploaded_file",
 | 
				
			||||||
                             -size => 50,
 | 
					                             -size => 50,
 | 
				
			||||||
                             -maxlength => 200);
 | 
					                             -maxlength => 200);
 | 
				
			||||||
 | 
						print $q->popup_menu(-name => "filetype", -values => ["Smartrack", "Diviac"]);
 | 
				
			||||||
        print $q->submit();
 | 
					        print $q->submit();
 | 
				
			||||||
        print $q->end_form();
 | 
					        print $q->end_form();
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue