1#!/usr/bin/perl -w 2# -*- perl -*- 3 4# 5# Author: Slaven Rezic 6# 7# Copyright (C) 2002,2012 Slaven Rezic. All rights reserved. 8# This program is free software; you can redistribute it and/or 9# modify it under the same terms as Perl itself. 10# 11# Mail: slaven@rezic.de 12# WWW: http://bbbike.sourceforge.net 13# 14 15# package to connect to a GPS receiver and up/download data in the 16# gpsman format 17 18package GPS::GpsmanConn; 19use strict; 20use vars qw($VERSION); 21$VERSION = '1.17'; 22use Config; 23 24# XXX should go away some day... 25BEGIN { 26 SEARCH_FOR_BBBIKE_DIRS: { 27 foreach my $dir (@INC) { 28 if (-r "$dir/Karte/Polar.pm") { 29 last SEARCH_FOR_BBBIKE_DIRS; 30 } 31 } 32 if (!caller(2)) { 33 require FindBin; 34 eval 'use lib ("$FindBin::RealBin/..", 35 "$FindBin::RealBin/../lib", 36 "$FindBin::RealBin/../data", 37 )'; 38 } 39 eval 'use lib qw(/home/e/eserte/src/bbbike 40 /home/e/eserte/src/bbbike/lib 41 /home/e/eserte/src/bbbike/data)'; 42 eval 'use lib qw(/usr/local/bbbike 43 /usr/local/bbbike/lib 44 /usr/local/bbbike/data)'; 45 } 46 SEARCH_FOR_GARMIN: { 47 # Debugging only: 48 if (-e "/home/e/eserte/work/perl-GPS/blib") { 49 # Use the new perl-GPS repository. If upload/downloads fail, 50 # comment this line to get the old prod.perl-GPS 51 eval 'use blib "/home/e/eserte/work/perl-GPS"'; 52 if ($@) { 53 warn $@; 54 } else { 55 last SEARCH_FOR_GARMIN; 56 } 57 } 58 foreach my $dir (@INC) { 59 if (-r "$dir/GPS/Garmin.pm") { 60 last SEARCH_FOR_GARMIN; 61 } 62 } 63 if (-e "/tmp/prod.perl-GPS") { 64 eval 'use blib "/tmp/prod.perl-GPS"'; warn $@ if $@; 65 } elsif (-e "/usr/local/prod.perl-GPS") { 66 eval 'use blib "/usr/local/prod.perl-GPS"'; warn $@ if $@; 67 } else { 68 eval 'use blib "/home/e/eserte/work/prod.perl-GPS"'; 69 } 70 } 71 require Config; 72#XXX if ($Config::Config{archname} eq 'arm-linux') { 73# eval 'use GPS::GarminX'; die $@ if $@; 74# } else { 75 eval 'use GPS::Garmin'; die $@ if $@; # 0.12 plus 76# } 77} 78use GPS::Garmin::Handler; 79 80use constant MIN_TIME => 633826800; # 1990-01-01, see also GPS::Garmin::Constant::GRMN_UTC_DIFF 81 82use vars qw(%garminsymbol_to_id %id_to_garminsymbol $default_garminsymbol 83 %id_to_garmindisplay); 84 85$default_garminsymbol = 'WP_dot'; 86 87# List taken from gpsman's garmin_symbols.tcl 88%garminsymbol_to_id = qw( 89 anchor 0 90 bell 1 91 diamond_green 2 92 diamond_red 3 93 diver_down_1 4 94 diver_down_2 5 95 dollar 6 96 fish 7 97 fuel 8 98 horn 9 99 house 10 100 knife_fork 11 101 light 12 102 mug 13 103 skull 14 104 square_green 15 105 square_red 16 106 WP_buoy_white 17 107 WP_dot 18 108 wreck 19 109 null 20 110 MOB 21 111 buoy_amber 22 112 buoy_black 23 113 buoy_blue 24 114 buoy_green 25 115 buoy_green_red 26 116 buoy_green_white 27 117 buoy_orange 28 118 buoy_red 29 119 buoy_red_green 30 120 buoy_red_white 31 121 buoy_violet 32 122 buoy_white 33 123 buoy_white_green 34 124 buoy_white_red 35 125 dot 36 126 radio_beacon 37 127 boat_ramp 150 128 camping 151 129 restrooms 152 130 showers 153 131 drinking_water 154 132 phone 155 133 1st_aid 156 134 info 157 135 parking 158 136 park 159 137 picnic 160 138 scenic 161 139 skiing 162 140 swimming 163 141 dam 164 142 controlled 165 143 danger 166 144 restricted 167 145 null_2 168 146 ball 169 147 car 170 148 deer 171 149 shopping_cart 172 150 lodging 173 151 mine 174 152 trail_head 175 153 truck_stop 176 154 exit 177 155 flag 178 156 circle_x 179 157 is_highway 8192 158 us_highway 8193 159 st_highway 8194 160 mile_marker 8195 161 traceback 8196 162 golf 8197 163 small_city 8198 164 medium_city 8199 165 large_city 8200 166 freeway 8201 167 ntl_highway 8202 168 capitol_city 8203 169 amusement_park 8204 170 bowling 8205 171 car_rental 8206 172 car_repair 8207 173 fastfood 8208 174 fitness 8209 175 movie 8210 176 museum 8211 177 pharmacy 8212 178 pizza 8213 179 post_office 8214 180 RV_park 8215 181 school 8216 182 stadium 8217 183 store 8218 184 zoo 8219 185 fuel_store 8220 186 theater 8221 187 ramp_int 8222 188 street_int 8223 189 weight_station 8226 190 toll 8227 191 elevation 8228 192 exit_no_serv 8229 193 geo_name_man 8230 194 geo_name_water 8231 195 geo_name_land 8232 196 bridge 8233 197 building 8234 198 cemetery 8235 199 church 8236 200 civil 8237 201 crossing 8238 202 monument 8239 203 levee 8240 204 military 8241 205 oil_field 8242 206 tunnel 8243 207 beach 8244 208 tree 8245 209 summit 8246 210 large_ramp_int 8247 211 large_exit_ns 8248 212 police 8249 213 casino 8250 214 snow_skiing 8251 215 ice_skating 8252 216 tow_truck 8253 217 border 8254 218 geocache 8255 219 geocache_fnd 8256 220 airport 16384 221 intersection 16385 222 avn_ndb 16386 223 avn_vor 16387 224 heliport 16388 225 private 16389 226 soft_field 16390 227 tall_tower 16391 228 short_tower 16392 229 glider 16393 230 ultralight 16394 231 parachute 16395 232 avn_vortac 16396 233 avn_vordme 16397 234 avn_faf 16398 235 avn_lom 16399 236 avn_map 16400 237 avn_tacan 16401 238 seaplane 16402 239); 240 241%id_to_garmindisplay = qw(0 s_name 242 1 symbol 243 2 s_comment); 244 245use Karte::Polar; 246 247{ 248 package GPS::Test; 249 sub new { bless {}, shift } 250 sub prepare_transfer { 251 my($w, $type) = @_; 252 $w->{Type} = $type; 253 $w->{Records} = 50; 254 $w->{_First} = 1; 255 $w->{WaypointIndex} = 0; 256 $w->{Desc} = ""; 257 @{$w}{qw(Lat Lon Time Alt Depth IsFirst)} 258 = (52.663844, 13.548460, time, 30, 0, 0); 259 } 260 sub get_reply { } 261 sub records { shift->{Records} } 262 sub grab { 263 my $w = shift; 264 # XXX check type 265 $w->{Records}--; 266 $w->{Lat} += rand(0.0001)-0.00002; 267 $w->{Lon} += rand(0.0001)-0.00002; 268 if ($w->{Type} eq 'trk') { 269 $w->{Time} = int($w->{Time} + rand(60)); 270 $w->{Alt} += rand(2)-1; 271 if ($w->{_First}) { 272 $w->{IsFirst} = 1; 273 $w->{_First} = 0; 274 } else { 275 $w->{IsFirst} = (rand(100) <= 2 ? 1 : 0); 276 } 277 @{$w}{qw(Lat Lon Time Alt Depth IsFirst)}; 278 } elsif ($w->{Type} eq 'wpt') { 279 $w->{WaypointIndex}++; 280 @{$w}{qw(WaypointIndex Lat Lon Desc)}; 281 } else { 282 die "Unknown type $w->{Type}"; 283 } 284 } 285} 286 287sub new { 288 my($class, %args) = @_; 289 my $self = {}; 290 $self->{GPS} = $args{GPS}; 291 if (!$self->{GPS}) { 292 #XXX require GPS::Garmin; 293 GPS::Garmin->VERSION(0.14); # extended return 294 # XXX Windows? HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM 295 # XXX Linux: /dev/ttyS0 or ttyS1 296 my $port = $args{Port} || ($Config::Config{archname} eq 'arm-linux' ? '/dev/ttySA0' : 297 $Config::Config{archname} =~ /^i.86-linux/ ? '/dev/ttyS0' : 298 $^O eq 'MSWin32' ? 'COM1:' : 299 '/dev/cuaa0'); # more distinctions 300 my $baud = $args{Baud} || 9600; 301 $self->{GPS} = new GPS::Garmin('Port' => $port, 302 'Baud' => $baud, 303 verbose => ($args{Verbose}||0) > 1, 304 Return => 'hash', 305 ); 306 die "Can't create GPS object" if !$self->{GPS}; 307 } 308 $self->{Verbose} = $args{Verbose}; 309 bless $self, $class; 310} 311 312# XXX Shouldn't be necessary, but it seems it is... 313sub DESTROY { 314 my($self) = @_; 315 warn "Calling Destructor of $self"; 316 if ($self->{GPS}) { 317 if ($self->{GPS}->{serial}) { 318 warn "close serial"; 319 $self->{GPS}->{serial}->close; 320 } 321 } 322} 323 324sub _time_to_gpsman { 325 my $time = shift; 326 $time = MIN_TIME if $time < MIN_TIME; 327 my @l = localtime $time; 328 sprintf "%02d-%s-%04d %02d:%02d:%02d", 329 $l[3], 330 [qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)]->[$l[4]], 331 $l[5]+1900, 332 @l[2,1,0]; 333} 334 335sub _ddd_to_dms { 336 my($ddd, $is_lat) = @_; 337 my($d,$m,$s) = Karte::Polar::ddd2dms($ddd); 338 if ($s >= 59.95) { 339 $s = 0; 340 $m++; 341 if ($m >= 60) { 342 $m = 0; 343 if ($d > 0) { 344 $d++; 345 } else { 346 $d--; 347 } 348 } 349 } 350 my $prefix; 351 if ($is_lat) { 352 if ($d > 0) { 353 $prefix = 'N'; 354 } else { 355 $prefix = 'S'; 356 $d = -$d; 357 } 358 } else { 359 if ($d > 0) { 360 $prefix = 'E'; 361 } else { 362 $prefix = 'W'; 363 $d = -$d; 364 } 365 } 366 sprintf "%s%02d %02d %04.1f", 367 $prefix, 368 $d, $m, $s; 369} 370 371sub header { 372 my $self = shift; 373 <<EOF; 374% Written by @{[ __PACKAGE__ ]}/$VERSION @{[scalar localtime]} 375 376!Format: DMS 1 WGS 84 377 378EOF 379} 380 381sub get_tracks { 382 my($self) = @_; 383 my $gps = $self->{GPS}; 384 $gps->prepare_transfer("trk"); 385 my @r; 386 my $r = ""; 387 388 my $write_header = sub { 389 $r .= $self->header . <<EOF; 390!T: ACTIVE LOG 391EOF 392 }; 393 394 $write_header->(); 395 396 my $numr = $gps->records; 397 warn "records to read: $numr\n" if $self->{Verbose}; 398 $gps->get_reply; # overread header --- XXX valuable info here! (name etc?) 399 my $r_i = 0; 400 while ($gps->records) { 401 my(%res) = $gps->grab; 402 #XXX use Hash::Util qw(lock_keys); lock_keys %res; # XXX 403 my($lat,$lon,$time,$alt,$depth,$isfirst) = @res{qw{lat lon time alt depth new_trk}}; 404 if (0 && $isfirst) { # XXX ignore isfirst 405 if ($r ne "") { 406 push @r, $r; 407 $r = ""; 408 } 409 $write_header->(); 410 } 411 #XXX ? $r .= "!TS:\n" if $isfirst; 412 $r .= join("\t", 413 "", 414 _time_to_gpsman($time), 415 _ddd_to_dms($lat, 1), 416 _ddd_to_dms($lon, 0), 417 $alt 418 ) . "\n"; 419 $r_i++; 420 printf STDERR "Records read: %d%% (%d/%d) \r", $r_i/$numr*100, $r_i, $numr 421 if $self->{Verbose}; 422 } 423 printf STDERR "\n" if $self->{Verbose}; 424 push @r, $r; 425 @r; 426} 427 428sub write_tracks { 429 my($self, $tracks_ref, $directory, %opt) = @_; 430 if (!-d $directory || !-w $directory) { 431 die "Non-existing or non-writable directory $directory"; 432 } 433 foreach my $track (@$tracks_ref) { 434 # hack: search for first date 435 my $date; 436 my($Y,$M,$D,$h,$m,$s); 437 foreach my $l (split /\n/, $track) { 438 if ($l =~ /^\t(\d{2})-([^-]+)-(\d{4})\s+(\d{2}):(\d{2}):(\d{2})/) { 439 ($D,$M,$Y,$h,$m,$s) = ($1,sprintf("%02d", monthabbrev_number($2)),$3,$4,$5,$6); 440 last; 441 } 442 } 443 if (!defined $Y || !defined $M) { 444 die "Can't parse track for date"; 445 } 446 my $out; 447 if (!$opt{-filefmt}) { 448 $out = "$directory/$Y-$M-$D"."_$h:$m:$s.trk"; 449 } else { 450 my %d = (Y=>$Y,M=>$M,D=>$D,h=>$h,m=>$m,s=>$s); 451 my $replace = sub { 452 my $out; 453 ($out = $opt{-filefmt}) =~ s/%([YMDhmsc])/$d{$1}/g; 454 $out; 455 }; 456 my $c = ""; # extra character 457 while (1) { 458 $d{c} = $c; 459 $out = $replace->(); 460 $out = "$directory/$out"; 461 if (-e $out) { 462 if ($opt{-filefmt} =~ /%c/) { 463 if ($c eq '') { 464 $c = "b"; 465 } elsif ($c eq 'z') { 466 warn "Won't overwrite $out with -filefmt option, write to $out~"; 467 $out = "$out~"; 468 last; 469 } else { 470 $c = chr(ord($c)+1); 471 } 472 } else { 473 warn "Won't overwrite $out with -filefmt option, write to $out~"; 474 $out = "$out~"; 475 last; 476 } 477 } else { 478 last; 479 } 480 } 481 } 482 open my $F, "> $out" 483 or die "Can't write to $out: $!"; 484 print $F $track; 485 close $F 486 or die "Error writing to $out: $!"; 487 } 488} 489 490sub get_waypoints { 491 my($self) = @_; 492 my $gps = $self->{GPS}; 493 my $r = $self->header . <<EOF; 494!W: 495EOF 496 $gps->prepare_transfer("wpt"); 497 my $numr = $gps->records; 498 warn "records to read: $numr\n" if $self->{Verbose}; 499 my $r_i = 0; 500 while ($gps->records) { 501 my(%res) = $gps->grab; 502 #XXX use Hash::Util qw(lock_keys); lock_keys %res; # XXX 503 #require Data::Dumper; print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" . Data::Dumper->new([\%res],[])->Indent(1)->Useqq(1)->Dump; # XXX 504 my($title,$lat,$lon,$desc) = @res{qw{ident lat lon comment}}; 505 506 my @extra; 507 if (defined $res{alt}) { 508 push @extra, "alt=$res{alt}"; 509 } 510 if (defined $res{dspl}) { 511 my $displayname = $id_to_garmindisplay{$res{dspl}}; 512 if (defined $displayname) { 513 push @extra, "dispopt=$displayname"; 514 } 515 } 516 if (defined $res{smbl}) { 517 my $symbolname = id_to_garminsymbol($res{smbl}); 518 if (defined $symbolname) { 519 if ($symbolname ne $default_garminsymbol) { 520 push @extra, "symbol=$symbolname"; 521 } 522 } else { 523 push @extra, "symbol=$res{smbl}"; # use id instead 524 } 525 } 526 527 $r .= join("\t", 528 ($title||""), 529 ($desc||""), 530 _ddd_to_dms($lat, 1), 531 _ddd_to_dms($lon, 0), 532 @extra, 533 ) . "\n"; 534 $r_i++; 535 printf STDERR "Records read: %d%% (%d/%d) \r", $r_i/$numr*100, $r_i, $numr 536 if $self->{Verbose}; 537 } 538 printf STDERR "\n" if $self->{Verbose}; 539 $r; 540} 541 542sub write_waypoints { 543 my($self, $w, $file) = @_; 544 open my $F, "> $file" 545 or die "Can't write to $file: $!"; 546 print $F $w; 547 close $F 548 or die "Error writing to $file: $!"; 549} 550 551sub put_route_from_bbd { 552 my($self, $bbd_file, %args) = @_; 553 my $gps = $self->{GPS}; 554 my $number = $args{-number}; 555 if (!defined $number) { $number = 1 } 556 my $comment = $args{-comment}; 557 if (!defined $comment) { $comment = "Route $number" } 558 require Strassen; 559 require Karte; 560 require Karte::Standard; 561 my @d; 562 my $handler = $gps->can("handler") ? $gps->handler : $gps; 563 push @d, 564 [$gps->GRMN_RTE_HDR, $handler->pack_Rte_hdr({nmbr => $number, cmnt => $comment})]; 565 my $s = new Strassen $bbd_file or die "Can't open $bbd_file: $!"; 566 $s->init; 567 my $r = $s->next; 568 my $first = 1; 569 my $i=0; 570 foreach my $p (@{ $r->[Strassen::COORDS()] }) { 571 my($lon,$lat) = split /,/, $p; 572 ($lon,$lat) = $Karte::map{'polar'}->standard2map($lon,$lat); 573 unless ($first) { 574 push @d, [$gps->GRMN_RTE_LINK_DATA, $handler->pack_Rte_link_data]; 575 } 576 push @d, [$gps->GRMN_RTE_WPT_DATA, $handler->pack_Rte_wpt_data({lat => $lat, lon => $lon, ident => "I".(++$i)})]; 577 $first = 0; 578 } 579 if ($gps->can("upload_data2")) { 580 $gps->upload_data2(\@d); 581 } else { 582 $gps->upload_data(\@d); 583 } 584} 585 586# REPO BEGIN 587# REPO NAME monthabbrev_number /home/e/eserte/src/repository 588# REPO MD5 5dc25284d4ffb9a61c486e35e84f0662 589sub monthabbrev_number { 590 my $mon = shift; 591 +{'Jan' => 1, 592 'Feb' => 2, 593 'Mar' => 3, 594 'Apr' => 4, 595 'May' => 5, 596 'Jun' => 6, 597 'Jul' => 7, 598 'Aug' => 8, 599 'Sep' => 9, 600 'Oct' => 10, 601 'Nov' => 11, 602 'Dec' => 12, 603 }->{$mon}; 604} 605# REPO END 606 607BEGIN { 608 if ($GPS::Garmin::Handler::VERSION < 0.13) { 609 eval q{ 610# XXX should be moved to prod code, but is already in "new" code... 611package GPS::Garmin::Handler; 612 613sub Trk_data { 614 my $self = shift; 615 $self->{records}--; 616 my ($data) = $self->read_packet; 617 my (@ident,@comm,$lt,$ln); 618 619 # D300 Track Point Datatype 620# my ($lat,$lon,$time,$is_first) = unpack('llLb',$data); 621 # D301 Track Point Datatype 622 my ($lat,$lon,$time,$alt,$dpth,$is_first) = unpack('llLffb',$data); 623 $lat = $self->semicirc_deg($lat); 624 $lon = $self->semicirc_deg($lon); 625#warn "$lat $lon $alt $dpth $time @{[ scalar localtime $time ]}\n"; 626 if ($time == 0xffffffff) { # XXX check 627 undef $time; 628 } else { 629 $time += GPS::Garmin::Constant::GRMN_UTC_DIFF(); 630 } 631#warn "$time @{[ scalar localtime $time ]}\n"; 632 633#XXX $res = new GPS::Garmin::D301_Trk_data_Type; 634 635 $self->send_packet(GPS::Garmin::Constant::GRMN_ACK()); 636 if($self->{records} == 0) { $self->get_reply; } 637 return($lat,$lon,$time,$alt,$dpth,$is_first); 638} 639 640sub pack_Trk_hdr { 641 my $self = shift; 642 my $d = shift || {}; 643 my %d = %$d; 644 $d{dspl} = 0 unless defined $d{dspl}; 645 $d{color} = 255 unless defined $d{color}; 646 if (!defined $d{ident}) { 647 die "ident is required"; 648 } 649 # D310 650 my $s = pack("cC", $d{dspl}, $d{color}); 651 $s .= $d{ident}."\0"; 652 $s; 653} 654 655sub pack_Trk_data { 656 my $self = shift; 657 my $d = shift || {}; 658 my %d = %$d; 659 if (!exists $d{lat} || !exists $d{lon}) { 660 die "lat and lon required!"; 661 } 662 $d{lat} = $self->deg_semicirc($d{lat}); 663 $d{lon} = $self->deg_semicirc($d{lon}); 664 $d{'time'} = 0 unless defined $d{'time'}; # XXX can't upload anyway 665 $d{'alt'} = 0 unless defined $d{'alt'}; # XXX set to undef? 666 $d{'dpth'} = 0 unless defined $d{'dpth'}; # XXX set to undef? 667 $d{'is_first'} = 0 unless defined $d{'is_first'}; 668 # D301 669 my $s = pack("llLffb", $d{lat}, $d{lon}, $d{'time'}, $d{'alt'}, 670 $d{'dpth'}, $d{'is_first'}); 671 $s; 672} 673 674}; 675 die $@ if $@; 676 } 677} 678 679return 1 if caller; 680 681# XXX command line 682 683my %opt; 684require Getopt::Long; 685if (!Getopt::Long::GetOptions(\%opt, 686 "v+", 687 "test!", "dir|directory=s", "file=s", 688 "filefmt=s")) { 689 usage(); 690} 691my $action = shift or usage(); 692 693my $gpsconn; 694if ($opt{test}) { 695 $gpsconn = GPS::GpsmanConn->new(Verbose => $opt{'v'}, 696 GPS => GPS::Test->new); 697} else { 698 $gpsconn = GPS::GpsmanConn->new(Verbose => $opt{'v'}, 699 ); 700} 701 702if ($action eq 'gettrk') { 703 if (defined $opt{file}) { 704 die "-file option is meaningless with gettrk, use -dir instead"; 705 } 706 my @t = $gpsconn->get_tracks; 707 if (@t && $opt{dir}) { 708 $gpsconn->write_tracks(\@t, $opt{dir}, -filefmt => $opt{filefmt}); 709 } else { 710 print join("\n", @t); 711 } 712} elsif ($action eq 'getwpt') { 713 if (defined $opt{dir}) { 714 die "-dir option is meaningless with getwpt, use -file instead"; 715 } 716 my $w = $gpsconn->get_waypoints; 717 if ($opt{file}) { 718 $gpsconn->write_waypoints($w, $opt{file}); 719 } else { 720 print $w; 721 } 722} else { 723 warn "Unknown action $action"; 724 usage(); 725} 726 727sub usage { 728 die <<EOF 729usage: $0 [-test] [-file file] [-filefmt fmt] [-dir directory] action 730 731where action is one of: 732gettrk getwpt 733 734EOF 735} 736 737sub id_to_garminsymbol { 738 my($id) = @_; 739 if (!keys %id_to_garminsymbol) { 740 while(my($symbol,$id) = each %garminsymbol_to_id) { 741 $id_to_garminsymbol{$id} = $symbol; 742 } 743 } 744 $id_to_garminsymbol{$id}; 745} 746 747__END__ 748