GPST.pm

   1 package GPST;
   2
   3 #=======================================================================
   4 # GPST.pm
   5 # File ID: 5e0437a0-fafa-11dd-abd7-000475e441b9
   6 #
   7 # Character set: UTF-8
   8 # ©opyleft 2002– Øyvind A. Holm <sunny@sunbase.org>
   9 # License: GNU General Public License, see end of file for legal stuff.
  10 #=======================================================================
  11
  12 use strict;
  13 use warnings;
  14
  15 use GPSTdebug;
  16 use GPSTgeo;
  17
  18 BEGIN {
  19     use Exporter ();
  20     our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  21
  22     @ISA = qw(Exporter);
  23     @EXPORT = qw(&trackpoint &postgresql_copy_safe &num_expand);
  24     %EXPORT_TAGS = ();
  25 }
  26 our @EXPORT_OK;
  27
  28 our $Spc = " ";
  29
  30 sub trackpoint {
  31     # Receive a hash and return a trackpoint as a string {{{
  32     my %Dat = @_;
  33
  34     defined($Dat{'what'}) || return(undef);
  35     defined($Dat{'format'}) || return(undef);
  36     defined($Dat{'error'}) || return(undef);
  37
  38     defined($Dat{'year'}) || ($Dat{'year'} = 0);
  39     defined($Dat{'month'}) || ($Dat{'month'} = 0);
  40     defined($Dat{'day'}) || ($Dat{'day'} = 0);
  41     defined($Dat{'hour'}) || ($Dat{'hour'} = "");
  42     defined($Dat{'min'}) || ($Dat{'min'} = "");
  43     defined($Dat{'sec'}) || ($Dat{'sec'} = "");
  44     $Dat{'print_time'} = (
  45         !$Dat{'year'} ||
  46         !$Dat{'month'} ||
  47         !$Dat{'day'} ||
  48         !length($Dat{'hour'}) ||
  49         !length($Dat{'min'}) ||
  50         !length($Dat{'sec'})
  51     ) ? 0 : 1;
  52
  53     if (
  54         ("$Dat{'year'}$Dat{'month'}$Dat{'day'}$Dat{'hour'}$Dat{'min'}" =~
  55         /[^\d]/) || ($Dat{'sec'} =~ /[^\d\.]/)
  56     ) {
  57         ($Dat{'print_time'} = 0);
  58     }
  59     $Dat{'lat'} =~ /[^\d\.\-\+]/ &&
  60         (warn("$main::progname: Invalid value in latitude value: '$Dat{'lat'}'\n"), return(undef));
  61     $Dat{'lon'} =~ /[^\d\.\-\+]/ &&
  62         (warn("$main::progname: Invalid value in longitude value: '$Dat{'lon'}'\n"), return(undef));
  63     length($Dat{'ele'}) && $Dat{'ele'} =~ /[^\d\.\-\+]/ &&
  64         (warn("$main::progname: Invalid value in elevation value: '$Dat{'ele'}'\n"), return(undef));
  65
  66     defined($Dat{'lat'}) || ($Dat{'lat'} = "");
  67     defined($Dat{'lon'}) || ($Dat{'lon'} = "");
  68     defined($Dat{'ele'}) || ($Dat{'ele'} = "");
  69     defined($Dat{'desc'}) || ($Dat{'desc'} = "");
  70
  71     $Dat{'lat'} = num_expand($Dat{'lat'});
  72     $Dat{'lon'} = num_expand($Dat{'lon'});
  73     $Dat{'ele'} = num_expand($Dat{'ele'});
  74
  75     my $Retval = "";
  76
  77     if ($Dat{'what'} eq "tp") {
  78         if ($Dat{'format'} eq "gpsml") {
  79             $Retval .= gen_gpsml_entry(%Dat);
  80         } elsif($Dat{'format'} eq "gpx") {
  81             $Retval .= gen_gpx_entry(%Dat);
  82         } elsif($Dat{'format'} eq "clean") {
  83             $Retval .= "$Dat{'lon'}\t$Dat{'lat'}\t$Dat{'ele'}\n";
  84         } elsif($Dat{'format'} eq "xgraph") {
  85             if (length($Dat{'lat'}) && length($Dat{'lon'})) {
  86                 $Retval .= "$Dat{'lon'} $Dat{'lat'}\n";
  87             }
  88         } elsif ($Dat{'format'} eq "pgtab") {
  89             $Retval .= gen_pgtab_entry(%Dat);
  90         } elsif ($Dat{'format'} eq "gpstrans") {
  91             $Retval .= gen_gpstrans_entry(%Dat);
  92         } else {
  93             $Retval = undef;
  94         }
  95     } else {
  96         $Retval = undef;
  97     }
  98     return $Retval;
  99     # }}}
 100 } # trackpoint()
 101
 102 sub gen_gpx_entry {
 103     # {{{
 104     my %Dat = @_;
 105     my $Retval = "";
 106     $Dat{'lat'} = num_expand($Dat{'lat'});
 107     $Dat{'lon'} = num_expand($Dat{'lon'});
 108     $Dat{'ele'} = num_expand($Dat{'ele'});
 109     my $err_str = length($Dat{'error'}) ? $Dat{'error'} : "";
 110     my $lat_str = length($Dat{'lat'}) ? " lat=\"$Dat{'lat'}\"" : "";
 111     my $lon_str = length($Dat{'lon'}) ? " lon=\"$Dat{'lon'}\"" : "";
 112     my ($estr_begin, $estr_ext, $estr_end) =
 113        (         "",        "",        "");
 114     if (length($err_str)) {
 115         $estr_begin = "<!-- ";
 116         $estr_ext = "<extensions>$Spc<error>$err_str</error>$Spc</extensions>$Spc";
 117         $estr_end = " -->";
 118     }
 119     if (length("$lat_str$lon_str$Dat{'ele'}")) {
 120         $Retval .=
 121         join("",
 122             "$Spc$Spc$Spc$Spc$Spc$Spc",
 123             $estr_begin,
 124             "<trkpt$lat_str$lon_str>",
 125             "$Spc",
 126             length($Dat{'ele'})
 127                 ? "<ele>$Dat{'ele'}</ele>$Spc"
 128                 : "",
 129             $Dat{'print_time'}
 130                 ? "<time>" .
 131                   "$Dat{'year'}-$Dat{'month'}-$Dat{'day'}T" .
 132                   "$Dat{'hour'}:$Dat{'min'}:$Dat{'sec'}Z" .
 133                   "</time>$Spc"
 134                 : "",
 135                 $estr_ext,
 136             "</trkpt>$estr_end\n"
 137         );
 138     }
 139     return($Retval);
 140     # }}}
 141 } # gen_gpx_entry()
 142
 143 sub gen_gpsml_entry {
 144     # {{{
 145     my %Dat = @_;
 146     my $err_str = length($Dat{'error'}) ? $Dat{'error'} : "";
 147     my $Elem = length($err_str) ? "etp" : "tp";
 148     my $Retval = join("",
 149             $Dat{'print_time'}
 150                 ? sprintf("<time>%04u-%02u-%02uT" .
 151                           "%02u:%02u:%02gZ</time> ",
 152                            $Dat{'year'}, $Dat{'month'}, $Dat{'day'},
 153                            $Dat{'hour'}, $Dat{'min'}, $Dat{'sec'}*1.0
 154                   )
 155                 : "",
 156             (length($Dat{'lat'}))
 157                 ? "<lat>" . $Dat{'lat'}*1.0 . "</lat> "
 158                 : "",
 159             (length($Dat{'lon'}))
 160                 ? "<lon>" . $Dat{'lon'}*1.0 . "</lon> "
 161                 : "",
 162             (length($Dat{'ele'}))
 163                 ? "<ele>" . $Dat{'ele'}*1.0 . "</ele> "
 164                 : "",
 165             (length($Dat{'desc'}))
 166                 ? sprintf("<desc>%s</desc> ",
 167                           $Dat{'desc'})
 168                 : ""
 169     );
 170     length($Retval) &&
 171         ($Retval = sprintf("<%s%s> %s</%s>\n",
 172                            $Elem,
 173                            length($err_str) ? " err=\"$err_str\"" : "",
 174                            $Retval,
 175                            $Elem)
 176     );
 177     return($Retval);
 178     # }}}
 179 } # gen_gpsml_entry()
 180
 181 sub gen_pgtab_entry {
 182     # {{{
 183     my %Dat = @_;
 184     my $Retval = join("\t",
 185         $Dat{'year'}
 186             ? "$Dat{'year'}-$Dat{'month'}-$Dat{'day'}T" .
 187               "$Dat{'hour'}:$Dat{'min'}:$Dat{'sec'}Z"
 188             : '\N', # date
 189         (length($Dat{'lat'}) && length($Dat{'lon'}))
 190             ? "($Dat{'lat'},$Dat{'lon'})"
 191             : '\N', # coor
 192         length($Dat{'ele'}) ? $Dat{'ele'} : '\N', # ele
 193         '\N', # name
 194         '\N', # dist
 195         '\N'  # description
 196     ) . "\n";
 197     return($Retval);
 198     # }}}
 199 } # gen_pgtab_entry()
 200
 201 sub gen_gpstrans_entry {
 202     # {{{
 203     my %Dat = @_;
 204     my $Retval;
 205     my ($gpt_lat, $gpt_lon) =
 206        (ddd_to_dms($Dat{'lat'}), ddd_to_dms($Dat{'lon'}));
 207     if ($Dat{'print_time'}) {
 208         $Retval = "T\t$Dat{'month'}/$Dat{'day'}/$Dat{'year'} " .
 209                   "$Dat{'hour'}:$Dat{'min'}:$Dat{'sec'}\t" .
 210                   "$gpt_lat\t$gpt_lon\n";
 211     } else {
 212         $Retval = "T\t00/00/00 00:00:00\t$gpt_lat\t$gpt_lon\n";
 213     }
 214     return($Retval);
 215     # }}}
 216 } # gen_gpstrans_entry()
 217
 218 sub postgresql_copy_safe {
 219     # {{{
 220     my $Str = shift;
 221     $Str =~ s/\\/\\\\/gs;
 222     $Str =~ s/\n/\\n/gs;
 223     $Str =~ s/\r/\\r/gs;
 224     $Str =~ s/\t/\\t/gs;
 225     return($Str);
 226     # }}}
 227 } # postgresql_copy_safe()
 228
 229 sub num_expand {
 230     # Convert scientific notation to decimal notation {{{
 231     my $Retval = shift;
 232     length($Retval) || return("");
 233     if ($Retval =~ /^(.*)e([-+]?)(.*)$/) {
 234         my ($num, $sign, $exp) = ($1, $2, $3);
 235         my $sig = $sign eq '-' ? "." . ($exp - 1 + length $num) : '';
 236         $Retval = sprintf("%${sig}f", $Retval);
 237     }
 238     $Retval =~ s/^\+//;
 239     my $minus = ($Retval =~ s/^-//) ? "-" : "";
 240     if ($Retval =~ /\.\d/) {
 241         $Retval =~ s/0+$//;
 242         $Retval =~ s/^0+/0/;
 243         $Retval =~ s/^0([1-9]+)\./$1./;
 244         $Retval =~ s/\.$//;
 245     } else {
 246         $Retval =~ s/^0+//;
 247     }
 248     length($Retval) || ($Retval = 0);
 249     $Retval = $Retval ? "$minus$Retval" : 0;
 250     return($Retval);
 251     # }}}
 252 } # num_expand()
 253
 254 1;