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