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