line
stmt
bran
cond
sub
pod
time
code
1
#!/usr/bin/env perl
2
3
3
11914
use strict;
3
4
3
129
3
3
3
13
use warnings;
3
4
3
225
4
5
3
711988
our $VERSION = '1.13';
6
7
=encoding utf-8
8
9
=head1 NAME
10
11
locations2gpx.pl - script to convert a FIT locations file to gpx format
12
13
=head1 SYNOPSIS
14
15
locations2gpx.pl --help
16
locations2gpx.pl [ --outfile=$filename --force --indent=# --time_offset=# ] $fit_locations_file
17
18
=head1 DESCRIPTION
19
20
C reads the contents of a FIT file containing the locations saved on a GPS device and converts it to a GPX file as waypoints.
21
22
The converted file will have the same basename as the I<$fit_locations_file> but with a I<*.gpx> extension. The name of the converted file may be overriden with with option C<--outfile>.
23
24
=cut
25
26
3
3
5661
use Geo::FIT;
3
24
3
2102
27
3
3
2904
use Getopt::Long;
3
47686
3
18
28
3
3
2633
use HTML::Entities qw( encode_entities encode_entities_numeric );
3
27829
3
12346
29
30
3
14
my ($force, $time_offset, $indent_n, $indent, $outfile, $help) = (0, 0, 2);
31
0
0
0
sub usage { "Usage: $0 [ --help --outfile= --force --indent=# --time_offset=# ] fit_locations_file\n" }
32
33
3
50
31
GetOptions( "outfile=s" => \$outfile,
34
"indent=i" => \$indent_n,
35
"force" => \$force,
36
"time_offset=i" => \$time_offset,
37
"help" => \$help,
38
) or die usage();
39
40
3
50
4976
die usage() if $help;
41
3
13
$indent = " " x $indent_n;
42
43
3
9
my $unsafe_chars_default = '<>&"';
44
3
6
my $uc = $unsafe_chars_default; # a lexical with a shorter name to use as argument in calls to _enc() and encode_entities_numeric()
45
# consider an option to change the default but tricky since 'undef' is the setting to encode all chars in HTML::Entities
46
47
3
9
my ($file, $gpx_file);
48
3
12
for (@ARGV) {
49
3
50
26
$file = $_ if /(?i:\.fit)$/;
50
3
50
29
die "No FIT input file provided" unless $file;
51
3
50
111
die "No file named $file found" unless -f $file
52
}
53
54
3
100
13
if (defined $outfile) {
55
2
5
$gpx_file = $outfile
56
} else {
57
1
9
($gpx_file = $file) =~ s/(?i:.fit)$/.gpx/i
58
}
59
3
50
66
60
die "File $gpx_file already exists\n" if -f $gpx_file and !$force;
60
61
=head2 Options
62
63
=over 4
64
65
=item C<< --outfile=I<$filename> >>
66
67
specifies the name of the converted file instead of the default to simply change the extension to I<*.gpx>.
68
69
=item C<< --force >>
70
71
overwrites an existing file if true.
72
73
=item C<< --indent=# >>
74
75
specifies the number of spaces to use for indentation of the XML in the GPX file. The default is 2.
76
77
=item C<< --time_offset=I<#> >>
78
79
adds a time offset to the timestamp of waypoints, where I<#> refers to the number of seconds by which to offset by.
80
81
=back
82
83
=cut
84
85
3
8
my ($fit, @id, @locations);
86
87
3
39
$fit = Geo::FIT->new();
88
3
18
$fit->file($file);
89
90
3
12
$fit->use_gmtime(1);
91
3
15
$fit->numeric_date_time(1);
92
3
10
$fit->semicircles_to_degree(1);
93
3
14
$fit->mps_to_kph(1);
94
3
14
$fit->without_unit(1);
95
3
13
$fit->maybe_chained(0);
96
3
15
$fit->drop_developer_data(1);
97
$fit->data_message_callback_by_name('',
98
sub {
99
15
15
63
my ($msg, $name) = _message(@_);
100
15
50
48
if ($msg) {
101
15
100
54
push @id, $msg if $name eq "file_id";
102
15
100
68
push @locations, $msg if $name eq "location"
103
}
104
15
49
return 1
105
}
106
3
33
);
107
3
50
21
$fit->open() or die $fit->error();
108
109
3
16
my ($f_size) = $fit->fetch_header();
110
3
50
41
unless (defined $f_size) {
111
0
0
0
$fit->error("can't read FIT header") unless defined $fit->error();
112
0
0
die $fit->error()
113
}
114
3
19
1 while $fit->fetch();
115
116
3
9
my (%device, $oem, $prod, $desc);
117
3
5
%device = %{$id[0]};
3
24
118
3
50
15
$oem = defined $device{manufacturer} ? $device{manufacturer} : "Unknown OEM";
119
3
50
11
$prod = defined $device{garmin_product} ? $device{garmin_product} : "unknown";
120
3
13
$desc = ucfirst "recorded on a $oem $prod device";
121
122
3
50
9
if (@locations) {
123
3
50
641
open (my $fh, ">", $gpx_file) or die "cannot open $gpx_file: $!";
124
3
20
select $fh;
125
3
61
printf "\n", 'version="1.0" encoding="UTF-8"';
126
3
18
_write_header();
127
3
12
_write_meta();
128
3
23
_write_waypoints();
129
3
7
printf "\n";
130
3
11
select STDOUT
131
}
132
133
sub _message {
134
15
15
33
my ($fit, $desc, $v) = @_;
135
136
15
29
my $m_name = $desc->{message_name};
137
15
50
35
return undef unless $m_name;
138
139
15
29
my $msg = {};
140
141
15
248
for my $i_name (keys %$desc) {
142
1188
100
2496
next if $i_name !~ /^i_/;
143
111
192
my $name = $i_name;
144
111
355
$name =~ s/^i_//;
145
146
111
255
my $attr = $desc->{'a_' . $name};
147
111
224
my $tname = $desc->{'t_' . $name};
148
111
161
my $pname = $name;
149
150
111
100
332
if (ref $attr->{switch} eq 'HASH') {
151
3
18
my $t_attr = $fit->switched($desc, $v, $attr->{switch});
152
153
3
50
27
if (ref $t_attr eq 'HASH') {
154
3
8
$attr = $t_attr;
155
3
8
$tname = $attr->{type_name};
156
$pname = $attr->{name}
157
3
8
}
158
}
159
160
111
189
my $i = $desc->{$i_name};
161
111
224
my $c = $desc->{'c_' . $name};
162
111
210
my $type = $desc->{'T_' . $name};
163
111
207
my $invalid = $desc->{'I_' . $name};
164
111
150
my $j;
165
166
111
153
my $len = @$v;
167
111
243
for ($j = 0 ; $j < $c ; $j++) {
168
609
804
my $ij = $i + $j;
169
609
50
1081
$ij >= $len && next;
170
609
50
1335
Geo::FIT->isnan($v->[$ij]) && next;
171
609
100
1517
$v->[$ij] != $invalid && last
172
}
173
111
100
249
if ($j < $c) { # skip invalid
174
75
100
142
if ($type == FIT_STRING) {
175
9
46
$msg->{$pname} = Geo::FIT::_string_value($v, $i, $c)
176
}
177
else {
178
# return only the first value if array
179
66
184
$msg->{$pname} = $fit->value_cooked($tname, $attr, $invalid, $v->[$i])
180
}
181
}
182
}
183
15
134
return ($msg, $m_name)
184
}
185
186
sub _enc {
187
15
15
57
return encode_entities_numeric( @_ ) # 2nd positional arg can either be undef or the string of unsafe chars to encode
188
}
189
190
# https://www.topografix.com/GPX/1/1/#element_gpx
191
sub _write_header {
192
3
3
10
printf "
193
3
7
my $loc = 'xsi:schemaLocation="';
194
3
10
$loc = $loc . "http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd";
195
3
8
$loc = $loc . " http://www.garmin.com/xmlschemas/GpxExtensions/v3 http://www8.garmin.com/xmlschemas/GpxExtensionsv3.xsd";
196
3
9
$loc = $loc . " http://www.garmin.com/xmlschemas/TrackPointExtension/v1 http://www8.garmin.com/xmlschemas/TrackPointExtensionv1.xsd";
197
3
9
$loc = $loc . " http://www.garmin.com/xmlschemas/WaypointExtension/v1 http://www8.garmin.com/xmlschemas/WaypointExtensionv1.xsd";
198
3
6
$loc = $loc . " http://www.cluetrust.com/XML/GPXDATA/1/0 http://www.cluetrust.com/Schemas/gpxdata10.xsd";
199
3
8
$loc = $loc . '"';
200
3
10
printf " %s", $loc;
201
3
11
printf " %s", 'xmlns="http://www.topografix.com/GPX/1/1"';
202
3
17
printf " %s", 'xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"';
203
# garmin_ext
204
3
18
printf " %s", 'xmlns:gpxx="http://www.garmin.com/xmlschemas/GpxExtensions/v3"';
205
3
19
printf " %s", 'xmlns:gpxtrx="http://www.garmin.com/xmlschemas/GpxExtensions/v3"';
206
3
17
printf " %s", 'xmlns:gpxtpx="http://www.garmin.com/xmlschemas/TrackPointExtension/v1"';
207
3
15
printf " %s", 'xmlns:gpxwpx="http://www.garmin.com/xmlschemas/WaypointExtension/v1"';
208
3
11
printf ">\n";
209
}
210
211
# https://www.topografix.com/GPX/1/1/#type_metadataType
212
sub _write_meta {
213
3
3
5
my $name; # none for now but declaring so it can be easily assigned
214
3
11
printf "%s\n", $indent;
215
3
50
12
printf "%s%s \n", $indent x 2, _enc( $name, $uc ) if defined $name;
216
3
17
printf "%s%s \n", $indent x 2, _enc( $desc, $uc );
217
218
3
303
my $author_name = 'Converted from Locations.fit by locations2gpx.pl';
219
3
12
printf "%s\n", $indent x 2;
220
3
14
printf "%s%s \n", $indent x 3, _enc( $author_name, $uc );
221
3
86
printf "%s\n", $indent x 2;
222
223
3
8
my ($url, $text, $type); # none for now but declaring so they can be easily assigned
224
3
50
14
if (defined $url) {
225
0
0
printf "%s \n", $indent x 2, _enc( $url ) ;
226
0
0
0
printf "%s%s \n", $indent x 3, _enc( $text, $uc ) if defined $text;
227
0
0
0
printf "%s%s \n", $indent x 3, $type if defined $type;
228
0
0
printf "%s\n", $indent x 2;
229
}
230
3
10
printf "%s\n", $indent
231
}
232
233
sub _write_waypoints {
234
3
50
3
23
if (@locations) {
235
3
7
my $ai = 0; # alt index
236
3
10
for (@locations) {
237
9
28
_print_wpt(\%$_, $ai);
238
9
42
$ai++
239
}
240
}
241
}
242
243
sub _print_wpt {
244
9
9
43
my ($m, $alt_index) = @_; # alt_index is not used
245
246
# https://www.topografix.com/GPX/1/1/#type_wptType
247
248
9
37
my ($time, $lon, $lat, $ele, $name, $desc);
249
9
148
while (my ($key, $val) = each %{$m}) {
69
254
250
# print "\$key is: $key, \$val is $val \n";
251
60
100
33
215
if ($key eq "timestamp") { $time = $val + $time_offset } # + $timeoffs;
9
100
18
100
50
50
100
50
252
9
17
elsif ($key eq "position_long") { $lon = $val }
253
9
18
elsif ($key eq "position_lat") { $lat = $val }
254
0
0
elsif ($key eq "altitude" and !defined $ele) { $ele = $val }
255
elsif ($key eq "enhanced_altitude") {
256
0
0
0
if (defined $val) { $ele = $val } # only if valid
0
0
257
}
258
9
18
elsif ($key eq "name") { $name = $val }
259
0
0
elsif ($key eq "unknown6") { $desc = $val }
260
}
261
# TODO: dump other unknown\d keys to STDERR
262
263
9
116
printf "%s\n", $indent, $lat, $lon;
264
9
50
28
printf "%s%s \n", $indent x 2, $ele if defined $ele;
265
9
50
21
if (defined $time) {
266
9
44
printf "%s%s \n", $indent x 2, $fit->date_string($time);
267
}
268
9
50
43
printf "%s%s \n", $indent x 2, _enc( $name, $uc ) if defined $name;
269
9
50
263
printf "%s%s \n", $indent x 2, _enc( $desc, $uc ) if defined $desc;
270
9
24
printf "%s\n", $indent
271
}
272
273
=head1 DEPENDENCIES
274
275
L
276
277
=head1 SEE ALSO
278
279
L
280
281
=head1 BUGS AND LIMITATIONS
282
283
No bugs have been reported.
284
285
Please report any bugs or feature requests to C, or through the web interface at L.
286
287
=head1 AUTHOR
288
289
Patrick Joly
290
291
=head1 VERSION
292
293
1.13
294
295
=head1 LICENSE AND COPYRIGHT
296
297
Copyright 2022, Patrick Joly C<< patjol@cpan.org >>. All rights reserved.
298
299
This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L.
300
301
=head1 DISCLAIMER OF WARRANTY
302
303
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
304
305
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
306
307
=cut
308
309
1;