diff options
author | Robert C. Helling <helling@atdotde.de> | 2021-01-22 21:38:37 +0100 |
---|---|---|
committer | Dirk Hohndel <dirk@hohndel.org> | 2021-01-23 09:47:24 -0800 |
commit | faafcd0cfc2301fd77ba2deb68619fec099ad6fd (patch) | |
tree | 80f902171b3060fdb440a40203a714b83112c8d8 | |
parent | 7cc7feb8f0bb9df254c03d8a9177ab853b0786b0 (diff) | |
download | subsurface-faafcd0cfc2301fd77ba2deb68619fec099ad6fd.tar.gz |
Add Diviac conversion to smtk converter CGI script
Plus a little bit of error reporting.
Signed-off-by: Robert C. Helling <helling@atdotde.de>
-rwxr-xr-x | scripts/diviac.pl | 119 | ||||
-rwxr-xr-x | scripts/smtk2ssrf.pl | 11 |
2 files changed, 128 insertions, 2 deletions
diff --git a/scripts/diviac.pl b/scripts/diviac.pl new file mode 100755 index 000000000..3225f4968 --- /dev/null +++ b/scripts/diviac.pl @@ -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; +} diff --git a/scripts/smtk2ssrf.pl b/scripts/smtk2ssrf.pl index ae10b6ee0..8b1fbceaa 100755 --- a/scripts/smtk2ssrf.pl +++ b/scripts/smtk2ssrf.pl @@ -6,6 +6,7 @@ $CGI::POST_MAX = 1024 * 1024 * 10; # Change this to the correct path to binary. my $smtk2ssrf = "../build/smtk2ssrf"; +my $diviac = "../scripts/diviac.pl"; my $logfile = '/tmp/smtk2ssrf.log'; my $q = CGI->new; @@ -17,6 +18,12 @@ if ($q->upload("uploaded_file")) { my $new_filename = $original_filename; $new_filename =~ s/.*[\/\\]//; $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) { @@ -40,11 +47,11 @@ if ($q->upload("uploaded_file")) { 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", -size => 50, -maxlength => 200); + print $q->popup_menu(-name => "filetype", -values => ["Smartrack", "Diviac"]); print $q->submit(); print $q->end_form(); |