File Coverage

blib/lib/Image/ExifTool/Geotag.pm
Criterion Covered Total %
statement 532 850 62.5
branch 345 726 47.5
condition 120 329 36.4
subroutine 15 17 88.2
pod 0 12 0.0
total 1012 1934 52.3


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: Geotag.pm
3             #
4             # Description: Geotagging utility routines
5             #
6             # Revisions: 2009/04/01 - P. Harvey Created
7             # 2009/09/27 - PH Added Geosync feature
8             # 2009/06/25 - PH Read Garmin TCX track logs
9             # 2009/09/11 - PH Read ITC GPS track logs
10             # 2012/01/08 - PH Extract orientation information from PTNTHPR
11             # 2012/05/08 - PH Read Winplus Beacon .TXT files
12             # 2015/05/30 - PH Read Bramor gEO log files
13             # 2016/07/13 - PH Added ability to geotag date/time only
14             # 2019/07/02 - PH Added ability to read IMU CSV files
15             # 2019/11/10 - PH Also write pitch to CameraElevationAngle
16             # 2020/12/01 - PH Added ability to read DJI CSV log files
17             # 2022/06/21 - PH Added ability to read Google Takeout JSON files
18             # 2024/04/23 - PH Added ability to read more OpenTracks GPS tags
19             # 2024/08/28 - PH Added support for new Google Takeout JSON format
20             # 2024/11/26 - PH Also write GPSMeasureMode and GPSDOP
21             # 2024/11/05 - PH Added support for Google Maps "Export timeline data"
22             # JSON format
23             # 2025/09/22 - PH Added ability to read Columbus CSV log files
24             # 2026/01/24 - PH Added GeoUserTag feature
25             #
26             # References: 1) http://www.topografix.com/GPX/1/1/
27             # 2) http://www.gpsinformation.org/dale/nmea.htm#GSA
28             # 3) http://code.google.com/apis/kml/documentation/kmlreference.html
29             # 4) http://www.fai.org/gliding/system/files/tech_spec_gnss.pdf
30             #------------------------------------------------------------------------------
31              
32             package Image::ExifTool::Geotag;
33              
34 3     3   7715 use strict;
  3         7  
  3         153  
35 3     3   18 use vars qw($VERSION);
  3         7  
  3         260  
36 3     3   22 use Image::ExifTool qw(:Public);
  3         6  
  3         670  
37 3     3   615 use Image::ExifTool::GPS;
  3         8  
  3         53193  
38              
39             $VERSION = '1.87';
40              
41 10     10 0 52 sub JITTER() { return 2 } # maximum time jitter
42              
43             sub GetTime($);
44             sub SetGeoValues($$;$);
45             sub PrintFixTime($);
46             sub PrintFix($@);
47             sub InitUserTags($);
48              
49             # XML tags that we recognize (keys are forced to lower case)
50             my %xmlTag = (
51             lat => 'lat', # GPX
52             latitude => 'lat', # Garmin
53             latitudedegrees => 'lat', # Garmin TCX
54             lon => 'lon', # GPX
55             longitude => 'lon', # Garmin
56             longitudedegrees => 'lon', # Garmin TCX
57             ele => 'alt', # GPX
58             elevation => 'alt', # PH
59             alt => 'alt', # PH
60             altitude => 'alt', # Garmin
61             altitudemeters => 'alt', # Garmin TCX
62             'time' => 'time', # GPX/Garmin
63             fix => 'fixtype', # GPX
64             hdop => 'hdop', # GPX
65             vdop => 'vdop', # GPX
66             pdop => 'pdop', # GPX
67             sat => 'nsats', # GPX
68             atemp => 'atemp', # GPX (Garmin 550t)
69             when => 'time', # KML
70             coordinates => 'coords', # KML
71             coord => 'coords', # KML, as written by Google Location History
72             begin => 'begin', # KML TimeSpan
73             end => 'time', # KML TimeSpan
74             course => 'dir', # (written by Arduino)
75             pitch => 'pitch', # (written by Arduino)
76             roll => 'roll', # (written by Arduino)
77             speed => 'speed', # (OpenTrack gpx)
78             accuracy_horizontal => 'err',#(OpenTrack gpx)
79             # XML containers (fix is reset at the opening tag of these properties)
80             wpt => '', # GPX
81             trkpt => '', # GPX
82             rtept => '', # GPX
83             trackpoint => '', # Garmin
84             placemark => '', # KML
85             );
86              
87             my %userTag; # user-defined XML tags
88              
89             # fix information keys which must be interpolated around a circle
90             my %cyclical = (lon => 1, track => 1, dir => 1, pitch => 1, roll => 1);
91             my %cyc180 = (lon => 1, pitch => 1, roll => 1); # wraps from 180 to -180
92              
93             # fix information keys for each of our general categories
94             my %fixInfoKeys = (
95             'pos' => [ 'lat', 'lon' ],
96             track => [ 'track', 'speed' ],
97             alt => [ 'alt' ],
98             orient => [ 'dir', 'pitch', 'roll' ],
99             atemp => [ 'atemp' ],
100             err => [ 'err' ],
101             dop => [ 'hdop', 'vdop', 'pdop' ],
102             );
103              
104             # category for select keys
105             my %keyCategory = (
106             dir => 'orient',
107             pitch => 'orient',
108             roll => 'orient',
109             hdop => 'dop',
110             pdop => 'dop',
111             vdop => 'dop',
112             );
113              
114             # tags which may exist separately in some formats (eg. CSV)
115             my %sepTags = (
116             dir => 1, pitch => 1, roll => 1, track => 1, speed => 1,
117             # (plus other tags we don't want to scan outwards for)
118             hdop => 1, pdop => 1, vdop => 1,
119             );
120              
121             # conversion factors for GPSSpeed (standard EXIF units only)
122             my %speedConv = (
123             'K' => 1.852, # km/h per knot
124             'M' => 1.150779448, # mph per knot
125             'k' => 'K', # (allow lower case)
126             'm' => 'M',
127             'km/h' => 'K', # (allow other formats)
128             'mph' => 'M',
129             );
130              
131             # all recognized speed conversion factors (non-EXIF included)
132             my %otherConv = (
133             'km/h' => 1.852,
134             'mph' => 1.150779448,
135             'm/s' => 0.514444,
136             );
137              
138             my $secPerDay = 24 * 3600; # a useful constant
139              
140             #------------------------------------------------------------------------------
141             # Split a line of CSV
142             # Inputs: 0) line to split, 1) delimiter
143             # Returns: list of items
144             sub SplitCSV($$)
145             {
146 94     94 0 244 my ($line, $delim) = @_;
147 94         880 my @toks = split /\Q$delim/, $line;
148 94         190 my (@vals, $v);
149 94         237 while (@toks) {
150 465         844 ($v = shift @toks) =~ s/^ +//; # remove leading spaces
151 465 50       1002 if ($v =~ s/^"//) {
152             # quoted value must end in an odd number of quotes
153 0   0     0 while ($v !~ /("+)\s*$/ or not length($1) & 1) {
154 0 0       0 last unless @toks;
155 0         0 $v .= $delim . shift @toks;
156             }
157 0         0 $v =~ s/"\s*$//; # remove trailing quote and whitespace
158 0         0 $v =~ s/""/"/g; # un-escape quotes
159             }
160 465         1051 push @vals, $v;
161             }
162 94         582 return @vals;
163             }
164              
165             #------------------------------------------------------------------------------
166             # Load GPS track log file
167             # Inputs: 0) ExifTool ref, 1) track log data or file name
168             # Returns: geotag hash data reference or error string
169             # - the geotag hash has the following members:
170             # Points - hash of GPS fix information hashes keyed by Unix time
171             # Times - list of sorted Unix times (keys of Points hash)
172             # NoDate - flag if some points have no date (ie. referenced to 1970:01:01)
173             # IsDate - flag if some points have date
174             # Has - hash of flags for available information (track, orient, alt)
175             # - the fix information hash may contain:
176             # lat - signed latitude (required)
177             # lon - signed longitude (required)
178             # alt - signed altitude
179             # time - fix time in UTC as XML string
180             # fixtype- type of fix ('none'|'2d'|'3d'|'dgps'|'pps')
181             # pdop - dilution of precision
182             # hdop - horizontal DOP
183             # vdop - vertical DOP
184             # sats - comma-separated list of active satellites
185             # nsats - number of active satellites
186             # track - track heading (deg true)
187             # dir - image direction (deg true)
188             # pitch - pitch angle (deg)
189             # roll - roll angle (deg)
190             # speed - speed (knots)
191             # first - flag set for first fix of track
192             # - concatenates new data with existing track data stored in ExifTool NEW_VALUE
193             # for the Geotag tag
194             sub LoadTrackLog($$;$)
195             {
196 10     10 0 95 local ($_, $/, *EXIFTOOL_TRKFILE);
197 10         42 my ($et, $val) = @_;
198 10         116 my ($raf, $from, $time, $isDate, $noDate, $noDateChanged, $lastDate, $dateFlarm);
199 10         0 my ($nmeaStart, $fixSecs, @fixTimes, $lastFix, %nmea, @csvHeadings, $sortFixes);
200 10         0 my ($canCut, $cutPDOP, $cutHDOP, $cutSats, $e0, $e1, @tmp, $trackFile, $trackTime);
201 10         0 my ($scaleSpeed, $startTime);
202              
203 10 50       29 unless (eval { require Time::Local }) {
  10         841  
204 0         0 return 'Geotag feature requires Time::Local installed';
205             }
206 10         2397 InitUserTags($et);
207              
208             # add data to existing track
209 10   100     82 my $geotag = $et->GetNewValue('Geotag') || { };
210              
211             # initialize track points lookup
212 10         36 my $points = $$geotag{Points};
213 10 100       48 $points or $points = $$geotag{Points} = { };
214              
215             # get lookup for available information types
216 10         32 my $has = $$geotag{Has};
217 10 100       70 $has or $has = $$geotag{Has} = { 'pos' => 1 };
218              
219 10         25 my $format = '';
220             # is $val track log data?
221 10 50       107 if ($val =~ /^(\xef\xbb\xbf)?<(\?xml|gpx)[\s>]/) {
    50          
222 0         0 $format = 'XML';
223 0         0 $/ = '>'; # set input record separator to '>' for XML/GPX data
224             } elsif ($val =~ /(\x0d\x0a|\x0d|\x0a)/) {
225 0         0 $/ = $1;
226             } else {
227             # $val is track file name
228 10 100       123 if ($et->Open(\*EXIFTOOL_TRKFILE, $val)) {
    50          
229 9         38 $trackFile = $val;
230 9         145 $raf = File::RandomAccess->new(\*EXIFTOOL_TRKFILE);
231 9 50       56 unless ($raf->Read($_, 256)) {
232 0         0 close EXIFTOOL_TRKFILE;
233 0         0 return "Empty track file '${val}'";
234             }
235             # look for XML or GPX header (might as well allow UTF-8 BOM)
236 9 100       143 if (/^(\xef\xbb\xbf)?<(\?xml|gpx)[\s>]/) {
    50          
237 4         12 $format = 'XML';
238 4         21 $/ = '>'; # set input record separator to '>' for XML/GPX data
239             } elsif (/(\x0d\x0a|\x0d|\x0a)/) {
240 5         71 $/ = $1;
241             } else {
242 0         0 close EXIFTOOL_TRKFILE;
243 0         0 return "Invalid track file '${val}'";
244             }
245 9         65 $raf->Seek(0,0);
246 9         33 $from = "file '${val}'";
247             } elsif ($val eq 'DATETIMEONLY') {
248 1         7 $$geotag{DateTimeOnly} = 1;
249 1         5 $$geotag{IsDate} = 1;
250 1         11 $et->VPrint(0, 'Geotagging date/time only');
251 1         48 return $geotag;
252             } else {
253 0         0 return "Error opening GPS file '${val}'";
254             }
255             }
256 9 50       39 unless ($from) {
257             # set up RAF for reading log file in memory
258 0         0 $raf = File::RandomAccess->new(\$val);
259 0         0 $from = 'data';
260             }
261              
262             # initialize cuts
263 9         73 my $maxHDOP = $et->Options('GeoMaxHDOP');
264 9         40 my $maxPDOP = $et->Options('GeoMaxPDOP');
265 9         37 my $minSats = $et->Options('GeoMinSats');
266 9   33     98 my $isCut = $maxHDOP || $maxPDOP || $minSats;
267              
268 9         30 my $numPoints = 0;
269 9         20 my $skipped = 0;
270 9         21 my $lastSecs = 0;
271 9         23 my $fix = { };
272 9         30 my $csvDelim = $et->Options('CSVDelim');
273 9 50       39 $csvDelim = ',' unless defined $csvDelim;
274 9         26 my (@saveFix, @saveTime, $timeSpan);
275 9         18 for (;;) {
276 397 100       1436 $raf->ReadLine($_) or last;
277             # determine file format
278 388 100       1030 if (not $format) {
279 7         25 s/^\xef\xbb\xbf//; # remove leading BOM if it exists
280 7 50       166 if (/^\xff\xfe|\xfe\xff/) {
281 0         0 return "ExifTool doesn't yet read UTF16-format track logs";
282             }
283 7 50 33     349 if (/^<(\?xml|gpx)[\s>]/) { # look for XML or GPX header
    100 66        
    50 66        
    100 66        
    50          
    50          
    100          
    100          
    50          
    50          
284 0         0 $format = 'XML';
285             # check for NMEA sentence
286             # (must ONLY start with ones that have timestamps! eg. not GSA or PTNTHPR!)
287             } elsif (/^.*\$([A-Z]{2}(RMC|GGA|GLL|ZDA)|PMGNTRK),/) {
288 2         8 $format = 'NMEA';
289 2   66     23 $nmeaStart = $2 || $1; # save type of first sentence
290             } elsif (/^A(FLA|XSY|FIL)/) {
291             # (don't set format yet because we want to read HFDTE first)
292 0         0 $nmeaStart = 'B' ;
293 0         0 next;
294             } elsif (/^HFDTE(?:DATE:)?(\d{2})(\d{2})(\d{2})/) {
295 1 50       11 my $year = $3 + ($3 >= 70 ? 1900 : 2000);
296 1         10 $dateFlarm = Time::Local::timegm(0,0,0,$1,$2-1,$year);
297 1         66 $nmeaStart = 'B' ;
298 1         5 $format = 'IGC';
299 1         3 next;
300             } elsif ($nmeaStart and /^B/) {
301             # parse IGC fixes without a date
302 0         0 $format = 'IGC';
303             } elsif (/^TP,D,/) {
304 0         0 $format = 'Winplus';
305             } elsif (/^\s*\d+\s+.*\sypr\s*$/ and (@tmp=split) == 12) {
306 1         4 $format = 'Bramor';
307             } elsif (((/\b(GPS)?Date/i and /\b(GPS)?(Date)?Time/i) or /\bTime\(seconds\)/i) and /\Q$csvDelim/) {
308 1         5 chomp;
309 1         7 @csvHeadings = SplitCSV($_, $csvDelim);
310 1   33     10 my $isColumbus = ($csvHeadings[0] and $csvHeadings[0] eq 'INDEX'); # (Columbus GPS logger)
311 1         3 $format = 'CSV';
312             # convert recognized headings to our parameter names
313 1         4 foreach (@csvHeadings) {
314 5         9 my $head = $_;
315 5         10 my $param;
316 5         8 my $xtra = '';
317 5         11 s/^GPS ?//; # remove leading "GPS" to simplify regex patterns
318 5 100 33     86 if (/^Time ?\(seconds\)$/i) { # DJI
    50          
    50          
    50          
    100          
    100          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
319             # DJI CSV log files have a column "Time(seconds)" which is seconds since
320             # the start of the flight. The date/time is obtained from the file name.
321 1         3 $param = 'runtime';
322 1 50 33     19 if ($trackFile and $trackFile =~ /(\d{4})-(\d{2})-(\d{2})[^\/]+(\d{2})-(\d{2})-(\d{2})[^\/]*$/) {
323 1         17 $trackTime = Image::ExifTool::TimeLocal($6,$5,$4,$3,$2-1,$1);
324 1         7 my $utc = PrintFixTime($trackTime);
325 1         11 my $tzs = Image::ExifTool::TimeZoneString([$6,$5,$4,$3,$2-1,$1-1900],$trackTime);
326 1         10 $et->VPrint(2, " DJI start time: $utc (local timezone is $tzs)\n");
327             } else {
328 0         0 return 'Error getting start time from file name for DJI CSV track file';
329             }
330             } elsif (/^Date ?Time/i) { # ExifTool addition
331 0         0 $param = 'datetime';
332             } elsif (/^Date/i) {
333 0         0 $param = 'date';
334             } elsif (/^Time(?! ?\(text\))/i) { # (ignore DJI "Time(text)" column)
335 0         0 $param = 'time';
336             } elsif (/^(Pos)?Lat/i) {
337 1         4 $param = 'lat';
338 1 50       5 /ref$/i and $param .= 'ref';
339             } elsif (/^(Pos)?Lon/i) {
340 1         3 $param = 'lon';
341 1 50       5 /ref$/i and $param .= 'ref';
342             } elsif (/^(Pos)?(Alt|Height)/i) {
343 0         0 $param = 'alt';
344             } elsif (/^Speed/i) {
345 0         0 $param = 'speed';
346             # (recognize units in brackets)
347 0 0       0 if (m{\((mph|km/h|m/s)\)}) {
    0          
348 0         0 $scaleSpeed = $otherConv{$1};
349 0         0 $xtra = " in $1";
350             } elsif ($isColumbus) { # (Columbus GPS logger)
351 0         0 $scaleSpeed = $otherConv{'km/h'};
352 0         0 $xtra = " in km/h";
353             } else {
354 0         0 $xtra = ' in knots';
355             }
356             } elsif (/^(Angle)?(Heading|Track|Bearing)/i) {
357 0         0 $param = 'track';
358             } elsif (/^(Angle)?Pitch/i or /^Camera ?Elevation ?Angle/i) {
359 0         0 $param = 'pitch';
360             } elsif (/^(Angle)?Roll/i) {
361 0         0 $param = 'roll';
362             } elsif (/^Img ?Dir/i) {
363 0         0 $param = 'dir';
364             } elsif ($userTag{lc $_}) {
365 0         0 $param = $userTag{lc $_};
366             }
367 5 100       14 if ($param) {
368 3         14 $et->VPrint(2, "CSV column '${head}' is $param$xtra\n");
369 3         8 $_ = $param;
370             } else {
371 2         18 $et->VPrint(2, "CSV column '${head}' ignored\n");
372 2         7 $_ = ''; # ignore this column
373             }
374             }
375 1         4 next;
376             } elsif (/"(timelineObjects|placeVisit|activitySegment|latitudeE7)"\s*:/) {
377             # Google Takeout JSON format
378 0         0 $format = 'JSON';
379 0         0 $sortFixes = 1; # (fixes are not all in order for this format)
380             } elsif (/"(durationMinutesOffsetFromStartTime|startTime)"\s*:/) {
381 0         0 $format = 'JSON'; # new Google Takeout JSON format (fixes seem to be in order)
382 0         0 $raf->Seek(0,0); # rewind to start of file
383             } else {
384             # search only first 50 lines of file for a valid fix
385 2 50       14 last if ++$skipped > 50;
386 2         8 next;
387             }
388             }
389             #
390             # XML format (GPX, KML, Garmin XML/TCX etc)
391             #
392 384 100       1216 if ($format eq 'XML') {
    50          
    100          
    100          
    50          
393 243         472 my (@args, $arg, $tok, $td, $value);
394 243 100       728 if (/^([^<]+<\/[^>]+>)/) {
395             # handle simple property
396 99         312 s/^\s+
397             # Workaround for KML generated by Google Location History:
398             # lat/lon/alt are space-separated; we want commas.
399 99         243 s{(\S+)\s+(\S+)\s+(\S+)()}{$1,$2,$3$4};
400 99         222 push @args, $_;
401             } else {
402             # handle property with attributes
403 144         755 s/\s*=\s*(['"])\s*/=$1/g; # remove unnecessary white space in attributes
404 144         463 push @args, split;
405             }
406 243         482 foreach $arg (@args) {
407             # parse attributes (eg. GPX 'lat' and 'lon')
408             # (note: ignore namespace prefixes if they exist)
409 319 100       1047 if ($arg =~ /^(\w+:)?(\w+)=(['"])(.*?)\3/g) {
410 63         195 my $tag = $xmlTag{lc $2};
411 63 100       157 $tag = $userTag{lc $2} unless defined $tag;
412 63 100       152 if ($tag) {
413 36         147 $$fix{$tag} = $4;
414 36 50 33     253 if ($keyCategory{$tag}) {
    50 33        
    50          
415 0         0 $$has{$keyCategory{$tag}} = 1;
416             } elsif ($tag eq 'alt') {
417             # validate altitude
418 0 0 0     0 undef $$fix{alt} if defined $$fix{alt} and $$fix{alt} !~ /^[+-]?\d+\.?\d*/;
419 0 0       0 $$has{alt} = 1 if $$fix{alt}; # set "has altitude" flag if appropriate
420             } elsif ($tag eq 'atemp' or $tag eq 'speed' or $tag eq 'err') {
421 0         0 $$has{$tag} = 1;
422             }
423             }
424             }
425             # loop through XML elements
426 319         1524 while ($arg =~ m{([^<>]*)<(/)?(\w+:)?(\w+)(>|$)}g) {
427 234         589 $tok = lc $4;
428 234         479 my $tag = $xmlTag{$tok};
429 234 100       534 $tag = $userTag{$tok} unless defined $tag;
430             # parse as a simple property if this element has a value
431 234 100 100     771 if (defined $tag and not $tag) {
432             # a containing property was opened or closed
433 42 100 33     238 if (not $2) {
    100 66        
434             # opened: start a new fix
435 21         46 $lastFix = $fix = { };
436 21         53 undef @saveFix;
437 21         73 next;
438             } elsif ($fix and $lastFix and %$fix) {
439             # closed: transfer additional tags from current fix
440 20         92 foreach (keys %$fix) {
441 80 50       203 $$lastFix{$_} = $$fix{$_} unless defined $$lastFix{$_};
442             }
443 20         53 undef $lastFix;
444             }
445             }
446 213 100       660 if (length $1) {
    50          
447 71 100       152 if ($tag) {
448 50 100       121 if ($tag eq 'coords') {
449             # save other fixes if there are more than one
450 3 0 33     13 if (defined $$fix{lon} and defined $$fix{lat} and defined $$fix{alt}) {
      33        
451 0         0 push @saveFix, [ @$fix{'lon','lat','alt'} ];
452             }
453             # read KML "Point" coordinates
454 3         18 @$fix{'lon','lat','alt'} = split ',', $1;
455 3 50       12 $$has{alt} = 1 if $$fix{alt};
456             } else {
457 47 50 66     157 if ($tok eq 'when' and $$fix{'time'}) {
458 0         0 push @saveTime, $1; # flightaware KML stores times in array
459             } else {
460 47         174 $$fix{$tag} = $1;
461             }
462 47 50 33     342 if ($keyCategory{$tag}) {
    100 33        
    50          
463 0         0 $$has{$keyCategory{$tag}} = 1;
464             } elsif ($tag eq 'alt') {
465             # validate altitude
466 20 50 33     152 undef $$fix{alt} if defined $$fix{alt} and $$fix{alt} !~ /^[+-]?\d+\.?\d*/;
467 20 50       82 $$has{alt} = 1 if $$fix{alt}; # set "has altitude" flag if appropriate
468             } elsif ($tag eq 'atemp' or $tag eq 'speed' or $tag eq 'err') {
469 0         0 $$has{$tag} = 1;
470             }
471             }
472             }
473 71         228 next;
474             } elsif ($tok eq 'td') {
475 0         0 $td = 1;
476             }
477             # validate and store GPS fix
478 142 100 100     571 next unless defined $$fix{lat} and defined $$fix{lon};
479 65 100       181 unless (defined $$fix{'time'}) {
480 42 50       170 next unless @saveTime;
481 0         0 $$fix{'time'} = shift @saveTime; # get next time in flightaware KML list
482             }
483 23 50 33     200 unless ($$fix{lat} =~ /^[+-]?\d+\.?\d*/ and $$fix{lon} =~ /^[+-]?\d+\.?\d*/) {
484 0 0       0 $e0 or $et->VPrint(0, "Coordinate format error in $from\n"), $e0 = 1;
485 0         0 next;
486             }
487 23 50       83 unless (defined($time = GetTime($$fix{'time'}))) {
488 0 0       0 $e1 or $et->VPrint(0, "Timestamp format error in $from\n"), $e1 = 1;
489 0         0 next;
490             }
491 23         41 $isDate = 1;
492 23 50 33     224 $canCut= 1 if defined $$fix{pdop} or defined $$fix{hdop} or defined $$fix{nsats};
      33        
493             # generate extra fixes assuming an equally spaced track
494 23 50       70 if ($$fix{begin}) {
495 0         0 my $begin = GetTime($$fix{begin});
496 0         0 undef $$fix{begin};
497 0 0 0     0 if (defined $begin and $begin < $time) {
498 0   0     0 $$fix{span} = $timeSpan = ($timeSpan || 0) + 1;
499 0         0 my $i;
500             # duplicate the fix if there is only one so we will have
501             # a fix and the start and end of the TimeSpan
502 0 0       0 @saveFix or push @saveFix, [ @$fix{'lon','lat','alt'} ];
503 0         0 for ($i=0; $i<@saveFix; ++$i) {
504 0         0 my $t = $begin + ($time - $begin) * ($i / scalar(@saveFix));
505 0         0 my %f;
506 0         0 @f{'lon','lat','alt'} = @{$saveFix[$i]};
  0         0  
507 0 0 0     0 $t += 0.001 if not $i and $$points{$t}; # (avoid dupicates)
508 0         0 $f{span} = $timeSpan;
509 0         0 $$points{$t} = \%f;
510 0         0 push @fixTimes, $t;
511             }
512             }
513             }
514 23         139 $$points{$time} = $fix;
515 23         80 push @fixTimes, $time; # save times of all fixes in order
516 23         76 $fix = { };
517 23         51 undef @saveFix;
518 23         97 ++$numPoints;
519             }
520             }
521             # last ditch check KML description for timestamp (assume it is UTC)
522 243 0 33     572 $$fix{'time'} = "$1T$2Z" if $td and not $$fix{'time'} and
      33        
523             /[\s>](\d{4}-\d{2}-\d{2})[T ](\d{2}:\d{2}:\d{2}(\.\d+)?)/;
524 243         573 next;
525             #
526             # Winplus Beacon text file
527             #
528             } elsif ($format eq 'Winplus') {
529             # TP,D, 44.933666667, -93.186555556, 10/26/2011, 19:07:28, 0
530             # latitude longitude date time
531 0 0       0 /^TP,D,\s*([-+]?\d+\.\d*),\s*([-+]?\d+\.\d*),\s*(\d+)\/(\d+)\/(\d{4}),\s*(\d+):(\d+):(\d+)/ or next;
532 0         0 $$fix{lat} = $1;
533 0         0 $$fix{lon} = $2;
534 0         0 $time = Time::Local::timegm($8,$7,$6,$4,$3-1,$5);
535 96         177 DoneFix: $isDate = 1;
536 96         713 $$points{$time} = $fix;
537 96         277 push @fixTimes, $time;
538 96         211 $fix = { };
539 96         155 ++$numPoints;
540 96         285 next;
541             #
542             # Bramor gEO log file
543             #
544             } elsif ($format eq 'Bramor') {
545             # 1 0015 18.723675 50.672752 149 169.31 22/04/2015 07:06:55 169.31 8.88 28.07 ypr
546             # ? index latitude longitude alt track date time dir pitch roll
547 7         36 my @parts = split ' ', $_;
548 7 100 66     42 next unless @parts == 12 and $parts[11] eq 'ypr';
549 4         17 my @d = split m{/}, $parts[6]; # date (dd/mm/YYYY)
550 4         26 my @t = split m{:}, $parts[7]; # time (HH:MM:SS)
551 4 50 33     23 next unless @d == 3 and @t == 3;
552 4         71 @$fix{qw(lat lon alt track dir pitch roll)} = @parts[2,3,4,5,8,9,10];
553             # (add the seconds afterwards in case some models have decimal seconds)
554 4         41 $time = Time::Local::timegm(0,$t[1],$t[0],$d[0],$d[1]-1,$d[2]) + $t[2];
555             # set necessary flags for extra available information
556 4         220 @$has{qw(alt track orient)} = (1,1,1);
557 4         273 goto DoneFix; # save this fix
558             } elsif ($format eq 'CSV') {
559 93         187 chomp;
560 93         299 my @vals = SplitCSV($_, $csvDelim);
561             #
562             # CSV format output of GPS/IMU POS system
563             # Date* - date in DD/MM/YYYY format
564             # Time* - time in HH:MM:SS.SSS format
565             # [Pos]Lat* - latitude in decimal degrees
566             # [Pos]Lon* - longitude in decimal degrees
567             # [Pos]Alt* - altitude in m relative to sea level
568             # [Angle]Heading* - GPSTrack in degrees true
569             # [Angle]Pitch* - pitch angle in degrees
570             # [Angle]Roll* - roll angle in degrees
571             # (ExifTool enhancements allow for standard tag names or descriptions as the column headings,
572             # add support for time zones and flexible coordinates, and allow new DateTime and Shift columns)
573             #
574 93         202 my ($param, $date, $secs, %neg);
575 93         193 foreach $param (@csvHeadings) {
576 461         781 my $val = shift @vals;
577 461 100 66     1546 last unless defined $val and length($val);
578 460 100       965 next unless $param;
579 276 50 100     1684 if ($param eq 'datetime') {
    50          
    50          
    100          
    50          
    50          
    50          
    0          
580             # (fix formats like "24.07.2016 13:47:30")
581 0         0 $val =~ s/^(\d{2})[^\d](\d{2})[^\d](\d{4}) /$3:$2:$1 /;
582 0     0   0 local $SIG{'__WARN__'} = sub { };
583 0         0 my $dateTime = $et->InverseDateTime($val);
584 0 0       0 if ($dateTime) {
585 0         0 $date = Image::ExifTool::GetUnixTime($val, 2);
586 0         0 $secs = 0;
587             }
588             } elsif ($param eq 'date') {
589 0 0       0 if ($val =~ m{^(\d{2})/(\d{2})/(\d{4})$}) {
    0          
    0          
590 0         0 $date = Time::Local::timegm(0,0,0,$1,$2-1,$3);
591             } elsif ($val =~ /(\d{4}).*?(\d{2}).*?(\d{2})/) {
592 0         0 $date = Time::Local::timegm(0,0,0,$3,$2-1,$1);
593             } elsif ($val =~ /^(\d{2})(\d{2})(\d{2})$/) { # (Columbus GPS logger)
594 0         0 $date = Time::Local::timegm(0,0,0,$3,$2-1,$1+2000);
595             }
596             } elsif ($param eq 'time') {
597 0 0       0 if ($val =~ /^(\d{1,2}):(\d{2}):(\d{2}(\.\d+)?).*?(([-+])(\d{1,2}):?(\d{2}))?/) {
    0          
598 0         0 $secs = (($1 * 60) + $2) * 60 + $3;
599             # adjust for time zone if specified
600 0 0       0 $secs += ($7 * 60 + $8) * ($6 eq '-' ? 60 : -60) if $5;
    0          
601             } elsif ($val =~ /^(\d{2})(\d{2})(\d{2})$/) { # (Columbus GPS logger)
602 0         0 $secs = (($1 * 60) + $2) * 60 + $3;
603             }
604             } elsif ($param eq 'lat' or $param eq 'lon') {
605 184         568 $$fix{$param} = Image::ExifTool::GPS::ToDegrees($val, 1);
606             } elsif ($param eq 'latref') {
607 0 0       0 $neg{lat} = 1 if $val =~ /^S/i;
608             } elsif ($param eq 'lonref') {
609 0 0       0 $neg{lon} = 1 if $val =~ /^W/i;
610             } elsif ($param eq 'runtime') {
611 92         165 $date = $trackTime;
612 92         176 $secs = $val;
613             } elsif ($param =~ /^_/) {
614 0         0 $$fix{$param} = $val;
615             } else {
616 0 0 0     0 $val /= $scaleSpeed if $scaleSpeed and $param eq 'speed';
617 0         0 $$fix{$param} = $val;
618 0 0       0 $$has{$param} = 1 if $sepTags{$param};
619             }
620             }
621             # make coordinate negative according to reference direction if necessary
622 93         265 foreach $param (keys %neg) {
623 0 0       0 next unless defined $$fix{$param};
624 0         0 $$fix{$param} = -abs($$fix{$param});
625             }
626 93 50 66     869 if ($date and defined $secs and defined $$fix{lat} and defined $$fix{lon}) {
      66        
      33        
627 92         238 $time = $date + $secs;
628 92 50       243 $$has{alt} = 1 if defined $$fix{alt};
629 92 50       262 $$has{track} = 1 if defined $$fix{track};
630 92 50       266 $$has{orient} = 1 if defined $$fix{pitch};
631 92         3329 goto DoneFix;
632             }
633 1         3 next;
634             } elsif ($format eq 'JSON') {
635             # Google Takeout JSON format
636 0 0       0 if (/"(latitudeE7|longitudeE7|latE7|lngE7|timestamp|startTime|point|durationMinutesOffsetFromStartTime|time)"\s*:\s*"?(.*?)"?,?\s*[\x0d\x0a]/) {
637 0 0 0     0 if ($1 eq 'timestamp' or $1 eq 'time') {
    0 0        
    0 0        
    0 0        
    0          
    0          
638 0         0 $time = GetTime($2);
639 0 0 0     0 goto DoneFix if $time and $$fix{lat} and $$fix{lon};
      0        
640             } elsif ($1 eq 'startTime') { # (new format)
641 0         0 $startTime = GetTime($2);
642             } elsif ($1 eq 'latitudeE7' or $1 eq 'latE7') {
643 0         0 $$fix{lat} = $2 * 1e-7;
644             } elsif ($1 eq 'longitudeE7' or $1 eq 'lngE7') {
645 0         0 $$fix{lon} = $2 * 1e-7;
646             } elsif ($1 eq 'point') { # (new format)
647 0         0 my $point = $2;
648 0         0 my @coords = $point =~ /[-+]?\d+\.\d+/g;
649 0 0       0 @$fix{'lat','lon'} = @coords[0,1] if @coords == 2;
650             } elsif ($1 eq 'durationMinutesOffsetFromStartTime' and defined $startTime) { # (new format)
651 0         0 $time = $startTime + $2 * 60;
652             # note: this assumes that "point" comes first, which it does in my sample
653 0 0 0     0 goto DoneFix if $time and $$fix{lat} and $$fix{lon};
      0        
654             }
655             }
656 0         0 next;
657             }
658 41         89 my (%fix, $secs, $date, $nmea);
659 41 100       117 if ($format eq 'NMEA') {
660             # ignore unrecognized NMEA sentences
661             # (first 2 characters: GP=GPS, GL=GLONASS, GA=Gallileo, GN=combined, BD=Beidou)
662 19 100       159 next unless /^(.*)\$([A-Z]{2}(RMC|GGA|GLL|GSA|ZDA)|PMGNTRK|PTNTHPR),/;
663 18   66     99 $nmea = $3 || $2;
664 18 50       54 $_ = substr($_, length($1)) if length($1);
665             }
666             #
667             # IGC (flarm) (ref 4)
668             #
669 40 100       184 if ($format eq 'IGC') {
    100          
    50          
    50          
    50          
    50          
    100          
    50          
670             # B0939564531208N00557021EA007670089100207
671             # BHHMMSSDDMMmmmNDDDMMmmmEAaaaaaAAAAAxxyy
672             # HH MM SS DD MM mmm DDD MM mmm aaaaa AAAAA
673             # 1 2 3 4 5 6 7 8 9 10 11 12 13 14
674 22 100       124 /^B(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\d{3})([NS])(\d{3})(\d{2})(\d{3})([EW])([AV])(\d{5})(\d{5})/ or next;
675 10 50       111 $fix{lat} = ($4 + ($5 + $6/1000)/60) * ($7 eq 'N' ? 1 : -1);
676 10 50       97 $fix{lon} = ($8 + ($9 +$10/1000)/60) * ($11 eq 'E' ? 1 : -1);
677 10 50       63 $fix{alt} = $12 eq 'A' ? $14 : undef;
678 10         40 $secs = (($1 * 60) + $2) * 60 + $3;
679             # wrap to next day if necessary
680 10 50       37 if ($dateFlarm) {
681 10 50       35 $dateFlarm += $secPerDay if $secs < $lastSecs - JITTER();
682 10         21 $date = $dateFlarm;
683             }
684 10         22 $nmea = 'B';
685             #
686             # NMEA RMC sentence (contains date)
687             #
688             } elsif ($nmea eq 'RMC') {
689             # $GPRMC,092204.999,A,4250.5589,S,14718.5084,E,0.00,89.68,211200,,*25
690             # $GPRMC,093657.007,,3652.835020,N,01053.104094,E,1.642,,290913,,,A*0F
691             # $GPRMC,hhmmss.sss,A/V,ddmm.mmmm,N/S,dddmm.mmmm,E/W,spd(knots),dir(deg),DDMMYY,,*cs
692 3 50       32 /^\$[A-Z]{2}RMC,(\d{2})(\d{2})(\d+(\.\d*)?),A?,(\d*?)(\d{1,2}\.\d+),([NS]),(\d*?)(\d{1,2}\.\d+),([EW]),(\d*\.?\d*),(\d*\.?\d*),(\d{2})(\d{2})(\d+)/ or next;
693 3 50 33     26 next if $13 > 31 or $14 > 12 or $15 > 99; # validate day/month/year
      33        
694 3 50 50     65 $fix{lat} = (($5 || 0) + $6/60) * ($7 eq 'N' ? 1 : -1);
695 3 50 50     24 $fix{lon} = (($8 || 0) + $9/60) * ($10 eq 'E' ? 1 : -1);
696 3 50       13 $fix{speed} = $11 if length $11;
697 3 50       15 $fix{track} = $12 if length $12;
698 3 50       9 my $year = $15 + ($15 >= 70 ? 1900 : 2000);
699 3         13 $secs = (($1 * 60) + $2) * 60 + $3;
700 3         19 $date = Time::Local::timegm(0,0,0,$13,$14-1,$year);
701             #
702             # NMEA GGA sentence (no date)
703             #
704             } elsif ($nmea eq 'GGA') {
705             # $GPGGA,092204.999,4250.5589,S,14718.5084,E,1,04,24.4,19.7,M,,,,0000*1F
706             # $GPGGA,093657.000,3652.835020,N,01053.104094,E,,8,,166.924,M,40.9,M,,*77
707             # $GPGGA,hhmmss.sss,ddmm.mmmm,N/S,dddmm.mmmm,E/W,0=invalid,sats,hdop,alt,M,...
708 0 0       0 /^\$[A-Z]{2}GGA,(\d{2})(\d{2})(\d+(\.\d*)?),(\d*?)(\d{1,2}\.\d+),([NS]),(\d*?)(\d{1,2}\.\d+),([EW]),[1-6]?,(\d+)?,(\.\d+|\d+\.?\d*)?,(-?\d+\.?\d*)?,M?/ or next;
709 0 0 0     0 $fix{lat} = (($5 || 0) + $6/60) * ($7 eq 'N' ? 1 : -1);
710 0 0 0     0 $fix{lon} = (($8 || 0) + $9/60) * ($10 eq 'E' ? 1 : -1);
711 0         0 @fix{qw(nsats hdop alt)} = ($11,$12,$13);
712 0         0 $secs = (($1 * 60) + $2) * 60 + $3;
713 0         0 $canCut = 1;
714             #
715             # NMEA GLL sentence (no date)
716             #
717             } elsif ($nmea eq 'GLL') {
718             # $GPGLL,4250.5589,S,14718.5084,E,092204.999,A*2D
719             # $GPGLL,ddmm.mmmm,N/S,dddmm.mmmm,E/W,hhmmss.sss,A/V*cs
720 0 0       0 /^\$[A-Z]{2}GLL,(\d*?)(\d{1,2}\.\d+),([NS]),(\d*?)(\d{1,2}\.\d+),([EW]),(\d{2})(\d{2})(\d+(\.\d*)?),A/ or next;
721 0 0 0     0 $fix{lat} = (($1 || 0) + $2/60) * ($3 eq 'N' ? 1 : -1);
722 0 0 0     0 $fix{lon} = (($4 || 0) + $5/60) * ($6 eq 'E' ? 1 : -1);
723 0         0 $secs = (($7 * 60) + $8) * 60 + $9;
724             #
725             # NMEA GSA sentence (satellite status, no date)
726             #
727             } elsif ($nmea eq 'GSA') {
728             # $GPGSA,A,3,04,05,,,,,,,,,,,pdop,hdop,vdop*HH
729 0 0       0 /^\$[A-Z]{2}GSA,[AM],([23]),((?:\d*,){11}(?:\d*)),(\d+\.?\d*|\.\d+)?,(\d+\.?\d*|\.\d+)?,(\d+\.?\d*|\.\d+)?\*/ or next;
730 0         0 @fix{qw(fixtype sats pdop hdop vdop)} = ($1.'d',$2,$3,$4,$5);
731             # count the number of acquired satellites
732 0         0 my @a = ($fix{sats} =~ /\d+/g);
733 0         0 $fix{nsats} = scalar @a;
734 0         0 $canCut = 1;
735             #
736             # NMEA ZDA sentence (date/time, contains date)
737             #
738             } elsif ($nmea eq 'ZDA') {
739             # $GPZDA,093655.000,29,09,2013,,*58
740             # $GPZDA,hhmmss.ss,DD,MM,YYYY,tzh,tzm (hhmmss in UTC)
741 0 0       0 /^\$[A-Z]{2}ZDA,(\d{2})(\d{2})(\d{2}(\.\d*)?),(\d+),(\d+),(\d+)/ or next;
742 0         0 $secs = (($1 * 60) + $2) * 60 + $3;
743 0         0 $date = Time::Local::timegm(0,0,0,$5,$6-1,$7);
744             #
745             # Magellan eXplorist PMGNTRK (Proprietary MaGellaN TRacK) sentence (optional date)
746             #
747             } elsif ($nmea eq 'PMGNTRK') {
748             # $PMGNTRK,4415.026,N,07631.091,W,00092,M,185031.06,A,,020409*65
749             # $PMGNTRK,ddmm.mmm,N/S,dddmm.mmm,E/W,alt,F/M,hhmmss.ss,A/V,trkname,DDMMYY*cs
750 12 50       170 /^\$PMGNTRK,(\d+)(\d{2}\.\d+),([NS]),(\d+)(\d{2}\.\d+),([EW]),(-?\d+\.?\d*),([MF]),(\d{2})(\d{2})(\d+(\.\d*)?),A,(?:[^,]*,(\d{2})(\d{2})(\d+))?/ or next;
751 12 50       137 $fix{lat} = ($1 + $2/60) * ($3 eq 'N' ? 1 : -1);
752 12 50       86 $fix{lon} = ($4 + $5/60) * ($6 eq 'E' ? 1 : -1);
753 12 50       65 $fix{alt} = $8 eq 'M' ? $7 : $7 * 12 * 0.0254;
754 12         55 $secs = (($9 * 60) + $10) * 60 + $11;
755 12 50       178 if (defined $15) {
756 12 50 33     100 next if $13 > 31 or $14 > 12 or $15 > 99; # validate day/month/year
      33        
757             # optional date is available in PMGNTRK sentence
758 12 50       47 my $year = $15 + ($15 >= 70 ? 1900 : 2000);
759 12         63 $date = Time::Local::timegm(0,0,0,$13,$14-1,$year);
760             }
761             #
762             # Honeywell HMR3000 PTNTHPR (Heading Pitch Roll) sentence (no date)
763             # (ref http://www.gpsarea.com/uploadfile/download/introduce/hmr3000_manual.pdf)
764             #
765             } elsif ($nmea eq 'PTNTHPR') {
766             # $PTNTHPR,85.9,N,-0.9,N,0.8,N*HH
767             # $PTNTHPR,heading,heading status,pitch,pitch status,roll,roll status,*cs
768             # status: L=low alarm, M=low warning, N=normal, O=high warning
769             # P=high alarm, C=tuning analog circuit
770             # (ignore this information on any alarm status)
771 3 50       23 /^\$PTNTHPR,(-?[\d.]+),[MNO],(-?[\d.]+),[MNO],(-?[\d.]+),[MNO]/ or next;
772 3         22 @fix{qw(dir pitch roll)} = ($1,$2,$3);
773              
774             } else {
775 0         0 next; # this shouldn't happen
776             }
777             # remember the NMEA formats we successfully read
778 28         720 $nmea{$nmea} = 1;
779             # use last date if necessary (and appropriate)
780 28 50 66     143 if (defined $secs and not defined $date and defined $lastDate) {
      33        
781             # wrap to next day if necessary
782 0 0       0 if ($secs < $lastSecs - JITTER()) {
783 0         0 $lastSecs -= $secPerDay;
784 0         0 $lastDate += $secPerDay;
785             }
786             # use earlier date only if we are within 10 seconds
787 0 0       0 if ($secs - $lastSecs < 10) {
788             # last date is close, use it for this fix
789 0         0 $date = $lastDate;
790             } else {
791             # last date is old, discard it
792 0         0 undef $lastDate;
793 0         0 undef $lastSecs;
794             }
795             }
796             # save our last date/time
797 28 100       77 if (defined $date) {
798 25         41 $lastDate = $date;
799 25         80 $lastSecs = $secs;
800             }
801             #
802             # Add NMEA/IGC fix to our lookup
803             # (this is much more complicated than it needs to be because
804             # the stupid NMEA format provides no end-of-fix indication)
805             #
806             # assumptions for each NMEA sentence:
807             # - we only parse a time if we get a lat/lon
808             # - we always get a time if we have a date
809 28 100 0     123 if ($nmea eq $nmeaStart or (defined $secs and (not defined $fixSecs or
      33        
      66        
810             # don't combine sentences that are outside 10 seconds apart
811             ($secs >= $fixSecs and $secs - $fixSecs >= 10) or
812             ($secs < $fixSecs and $secs + $secPerDay - $fixSecs >= 10))))
813             {
814             # start a new fix
815 25         55 $fix = \%fix;
816 25         48 $fixSecs = $secs;
817 25         46 undef $noDateChanged;
818             # does this fix have a date/time or time stamp?
819 25 50       53 if (defined $date) {
    0          
820 25         65 $fix{isDate} = $isDate = 1;
821 25         136 $time = $date + $secs;
822             } elsif (defined $secs) {
823 0         0 $time = $secs;
824 0         0 $noDate = $noDateChanged = 1;
825             } else {
826 0         0 next; # wait until we have a time before adding to lookup
827             }
828             } else {
829             # add new data to existing fix (but don't overwrite earlier values to
830             # keep the coordinates in sync with the fix time)
831 3         36 foreach (keys %fix) {
832 9 50       49 $$fix{$_} = $fix{$_} unless defined $$fix{$_};
833             }
834 3 50 33     16 if (defined $date) {
    50          
835 0 0       0 next if $$fix{isDate};
836             # move this fix to the proper date
837 0 0       0 if (defined $fixSecs) {
838 0         0 delete $$points{$fixSecs};
839 0 0 0     0 pop @fixTimes if @fixTimes and $fixTimes[-1] == $fixSecs;
840 0         0 --$numPoints;
841             # if we wrapped to the next day since the start of this fix,
842             # we must shift the date back to the day of $fixSecs
843 0 0       0 $date -= $secPerDay if $secs < $fixSecs;
844             } else {
845 0         0 $fixSecs = $secs;
846             }
847 0         0 $time = $date + $fixSecs;
848 0         0 $$fix{isDate} = $isDate = 1;
849             # revert noDate flag if it was set for this fix
850 0 0       0 $noDate = 0 if $noDateChanged;
851             } elsif (defined $secs and not defined $fixSecs) {
852 0         0 $time = $fixSecs = $secs;
853 0         0 $noDate = $noDateChanged = 1;
854             } else {
855 3         11 next; # wait until we have a time
856             }
857             }
858             # add fix to our lookup
859 25         165 $$points{$time} = $fix;
860 25         64 push @fixTimes, $time; # save time of all fixes in order
861 25         88 ++$numPoints;
862             }
863 9         73 $raf->Close();
864              
865             # set date flags
866 9 50 33     51 if ($noDate and not $$geotag{NoDate}) {
867 0 0       0 if ($isDate) {
868 0         0 $et->Warn('Fixes are date-less -- will use time-only interpolation');
869             } else {
870 0         0 $et->Warn('Some fixes are date-less -- may use time-only interpolation');
871             }
872 0         0 $$geotag{NoDate} = 1;
873             }
874 9 50       57 $$geotag{IsDate} = 1 if $isDate;
875              
876             # cut bad fixes if necessary
877 9 50 33     56 if ($isCut and $canCut) {
878 0         0 $cutPDOP = $cutHDOP = $cutSats = 0;
879 0         0 my @goodTimes;
880 0         0 foreach (@fixTimes) {
881 0 0       0 $fix = $$points{$_} or next;
882 0 0 0     0 if ($maxPDOP and $$fix{pdop} and $$fix{pdop} > $maxPDOP) {
    0 0        
    0 0        
      0        
      0        
      0        
      0        
883 0         0 delete $$points{$_};
884 0         0 ++$cutPDOP;
885             } elsif ($maxHDOP and $$fix{hdop} and $$fix{hdop} > $maxHDOP) {
886 0         0 delete $$points{$_};
887 0         0 ++$cutHDOP;
888             } elsif ($minSats and defined $$fix{nsats} and $$fix{nsats} ne '' and
889             $$fix{nsats} < $minSats)
890             {
891 0         0 delete $$points{$_};
892 0         0 ++$cutSats;
893             } else {
894 0         0 push @goodTimes, $_;
895             }
896             }
897 0         0 @fixTimes = @goodTimes; # update fix times
898 0         0 $numPoints -= $cutPDOP;
899 0         0 $numPoints -= $cutHDOP;
900 0         0 $numPoints -= $cutSats;
901             }
902             # sort fixes if necessary
903 9 50       43 @fixTimes = sort { $a <=> $b } @fixTimes if $sortFixes;
  0         0  
904             # mark first fix of the track
905 9         37 while (@fixTimes) {
906 9 50       80 $fix = $$points{$fixTimes[0]} or shift(@fixTimes), next;
907 9         46 $$fix{first} = 1;
908 9         20 last;
909             }
910 9         81 my $verbose = $et->Options('Verbose');
911 9 100       39 if ($verbose) {
912 1         7 my $out = $et->Options('TextOut');
913 1 50       10 $format or $format = 'unknown';
914 1         8 print $out "Loaded $numPoints points from $format-format GPS track log $from\n";
915 1 50       7 print $out "Ignored $cutPDOP points due to GeoMaxPDOP cut\n" if $cutPDOP;
916 1 50       7 print $out "Ignored $cutHDOP points due to GeoMaxHDOP cut\n" if $cutHDOP;
917 1 50       6 print $out "Ignored $cutSats points due to GeoMinSats cut\n" if $cutSats;
918 1 50 33     14 if ($numPoints and $verbose > 1) {
919 1         9110 my @lbl = ('start:', 'end: ');
920             # (fixes may be in reverse order in GPX files)
921 1 50       15 @lbl = reverse @lbl if $fixTimes[0] > $fixTimes[-1];
922 1         15 print $out " GPS track $lbl[0] " . PrintFixTime($fixTimes[0]) . "\n";
923 1 50       7 if ($verbose > 3) {
924 0         0 print $out PrintFix($points, $_) foreach @fixTimes;
925             }
926 1         7 print $out " GPS track $lbl[1] " . PrintFixTime($fixTimes[-1]) . "\n";
927             }
928             }
929 9 50       38 if ($numPoints) {
930             # reset timestamp list to force it to be regenerated
931 9         34 delete $$geotag{Times};
932             # set flags for available information
933 9 100 66     114 $$has{alt} = 1 if $nmea{GGA} or $nmea{PMGNTRK} or $nmea{B}; # alt
      100        
934 9 100       66 $$has{track} = 1 if $nmea{RMC}; # track, speed
935 9 100       42 $$has{orient} = 1 if $nmea{PTNTHPR}; # dir, pitch, roll
936 9         763 return $geotag; # success!
937             }
938 0         0 return "No track points found in GPS $from";
939             }
940              
941              
942             #------------------------------------------------------------------------------
943             # Get floating point UTC time
944             # Inputs: 0) XML time string
945             # Returns: floating point time or undef on error
946             sub GetTime($)
947             {
948 23     23 0 51 my $timeStr = shift;
949 23 50       155 $timeStr =~ /^(\d{4})-(\d+)-(\d+)T(\d+):(\d+):(\d+)(\.\d+)?(.*)/ or return undef;
950 23         183 my $time = Time::Local::timegm($6,$5,$4,$3,$2-1,$1);
951 23 100       1364 $time += $7 if $7; # add fractional seconds
952 23         61 my $tz = $8;
953             # adjust for time zone (otherwise assume UTC)
954             # - allow timezone of +-HH:MM, +-H:MM, +-HHMM or +-HH since
955             # the spec is unclear about timezone format
956 23 100 66     113 if ($tz =~ /^([-+])(\d+):(\d{2})\b/ or $tz =~ /^([-+])(\d{2})(\d{2})?\b/) {
957 3   50     15 $tz = ($2 * 60 + ($3 || 0)) * 60;
958 3 50       13 $tz *= -1 if $1 eq '+'; # opposite sign to change back to UTC
959 3         7 $time += $tz;
960             }
961 23         84 return $time;
962             }
963              
964             #------------------------------------------------------------------------------
965             # Apply Geosync time correction
966             # Inputs: 0) ExifTool ref, 1) Unix UTC time value
967             # Returns: sync time difference (and updates input time), or undef if no sync
968             sub ApplySyncCorr($$)
969             {
970 11     11 0 47 my ($et, $time) = @_;
971 11         56 my $sync = $et->GetNewValue('Geosync');
972 11 100       48 if (ref $sync eq 'HASH') {
973 3         14 my $syncTimes = $$sync{Times};
974 3 100       25 if ($syncTimes) {
975             # find the nearest 2 sync points
976 2         10 my ($i0, $i1) = (0, scalar(@$syncTimes) - 1);
977 2         11 while ($i1 > $i0 + 1) {
978 0         0 my $pt = int(($i0 + $i1) / 2);
979 0 0       0 ($time < $$syncTimes[$pt] ? $i1 : $i0) = $pt;
980             }
981 2         11 my ($t0, $t1) = ($$syncTimes[$i0], $$syncTimes[$i1]);
982             # interpolate/extrapolate to account for linear camera clock drift
983 2         8 my $syncPoints = $$sync{Points};
984 2 50       11 my $f = $t1 == $t0 ? 0 : ($time - $t0) / ($t1 - $t0);
985 2         16 $sync = $$syncPoints{$t1} * $f + $$syncPoints{$t0} * (1 - $f);
986             } else {
987 1         4 $sync = $$sync{Offset}; # use fixed time offset
988             }
989 3         10 $_[1] += $sync;
990             } else {
991 8         36 undef $sync;
992             }
993 11         37 return $sync;
994             }
995              
996             #------------------------------------------------------------------------------
997             # Scan outwards for a fix containing the requested parameter
998             # Inputs: 0) name of fix parameter, 1) reference to list of fix times,
999             # 2) reference to fix points hash, 3) index of starting time,
1000             # 4) direction to scan (-1 or +1), 5) maximum time difference
1001             # Returns: 0) time for fix containing requested information (or undef)
1002             # 1) the corresponding fix, 2) the value of the requested fix parameter
1003             sub ScanOutwards($$$$$$)
1004             {
1005 4     4 0 10 my ($key, $times, $points, $i, $dir, $maxSecs) = @_;
1006 4         10 my $t0 = $$times[$i];
1007 4         6 for (;;) {
1008 8         11 $i += $dir;
1009 8 100 66     28 last if $i < 0 or $i >= scalar @$times;
1010 6         14 my $t = $$times[$i];
1011 6 100       16 last if abs($t - $t0) > $maxSecs; # don't look too far
1012 4         13 my $p = $$points{$t};
1013 4         10 my $v = $$p{$key};
1014 4 50       12 return($t,$p,$v) if defined $v;
1015             }
1016 4         13 return();
1017             }
1018              
1019             #------------------------------------------------------------------------------
1020             # Find nearest fix containing the specified parameter
1021             # Inputs: 0) ExifTool ref, 1) name of fix parameter, 2) reference to list of fix times,
1022             # 3) reference to fix points hash, 4) index of starting time,
1023             # 5) direction to scan (-1, +1 or undef), 6) maximum time difference
1024             # Returns: reference to fix hash or undef
1025             sub FindFix($$$$$$$)
1026             {
1027 2     2 0 9 my ($et, $key, $times, $points, $i, $dir, $maxSecs) = @_;
1028 2         4 my ($t,$p);
1029 2 50       6 if ($dir) {
1030 0         0 ($t,$p) = ScanOutwards($key, $times, $points, $i, $dir, $maxSecs);
1031             } else {
1032 2         9 my ($t1, $p1) = ScanOutwards($key, $times, $points, $i, -1, $maxSecs);
1033 2         10 my ($t2, $p2) = ScanOutwards($key, $times, $points, $i, 1, $maxSecs);
1034 2 50       12 if (defined $t1) {
    50          
1035 0 0       0 if (defined $t2) {
1036             # both surrounding points are valid, so take the closest one
1037 0 0       0 ($t, $p) = ($t - $t1 < $t2 - $t) ? ($t1, $p1) : ($t2, $p2);
1038             } else {
1039 0         0 ($t, $p) = ($t1, $p1);
1040             }
1041             } elsif (defined $t2) {
1042 0         0 ($t, $p) = ($t2, $p2);
1043             }
1044             }
1045 2 50 33     12 if (defined $p and $$et{OPTIONS}{Verbose} > 2) {
1046 0         0 $et->VPrint(2, " Taking $key from fix:\n", PrintFix($points, $t))
1047             }
1048 2         6 return $p;
1049             }
1050              
1051             #------------------------------------------------------------------------------
1052             # Set new geotagging values according to date/time
1053             # Inputs: 0) ExifTool object ref, 1) date/time value (or undef to delete tags)
1054             # 2) optional write group
1055             # Returns: error string, or '' on success
1056             # Notes: Uses track data stored in ExifTool NEW_VALUE for Geotag tag
1057             sub SetGeoValues($$;$)
1058             {
1059 14     14 0 47 local $_;
1060 14         51 my ($et, $val, $writeGroup) = @_;
1061 14         133 my $geotag = $et->GetNewValue('Geotag');
1062 14         131 my $verbose = $et->Options('Verbose');
1063 14         40 my ($fix, $time, $fsec, $noDate, $secondTry, $iExt, $iDir);
1064              
1065             # remove date if none of our fixes had date information
1066 14 50 66     151 $val =~ s/^\S+\s+// if $val and $geotag and not $$geotag{IsDate};
      66        
1067              
1068             # maximum time (sec) from nearest GPS fix when position is still considered valid
1069 14         55 my $geoMaxIntSecs = $et->Options('GeoMaxIntSecs');
1070 14         57 my $geoMaxExtSecs = $et->Options('GeoMaxExtSecs');
1071              
1072             # use 30 minutes for a default
1073 14 50       50 defined $geoMaxIntSecs or $geoMaxIntSecs = 1800;
1074 14 50       56 defined $geoMaxExtSecs or $geoMaxExtSecs = 1800;
1075              
1076 14         59 my $times = $$geotag{Times};
1077 14         42 my $points = $$geotag{Points};
1078 14         41 my $has = $$geotag{Has};
1079 14         44 my $err = '';
1080             # loop to try date/time value first, then time-only value
1081 14         53 while (defined $val) {
1082 11 50       43 unless (defined $geotag) {
1083 0         0 $err = 'No GPS track loaded';
1084 0         0 last;
1085             }
1086 11 100       47 unless ($times) {
1087             # generate sorted timestamp list for binary search
1088 10         153 my @times = sort { $a <=> $b } keys %$points;
  622         1196  
1089 10         61 $times = $$geotag{Times} = \@times;
1090             }
1091 11 50 66     83 unless ($times and @$times or $$geotag{DateTimeOnly}) {
      66        
1092 0         0 $err = 'GPS track is empty';
1093 0         0 last;
1094             }
1095 11 50       34 unless (eval { require Time::Local }) {
  11         174  
1096 0         0 $err = 'Geotag feature requires Time::Local installed';
1097 0         0 last;
1098             }
1099             # convert date/time to UTC
1100 11         47 my ($year,$mon,$day,$hr,$min,$sec,$fs,$tz,$t0,$t1,$t2);
1101 11 50       166 if ($val =~ /^(\d{4}):(\d+):(\d+)\s+(\d+):(\d+):(\d+)(\.\d*)?(Z|([-+])(\d+):(\d+))?/) {
    0          
1102             # valid date/time value
1103 11         194 ($year,$mon,$day,$hr,$min,$sec,$fs,$tz,$t0,$t1,$t2) = ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11);
1104             } elsif ($val =~ /^(\d{2}):(\d+):(\d+)(\.\d*)?(Z|([-+])(\d+):(\d+))?/) {
1105             # valid time-only value
1106 0         0 ($hr,$min,$sec,$fs,$tz,$t0,$t1,$t2) = ($1,$2,$3,$4,$5,$6,$7,$8);
1107             # use Jan. 2 to avoid going negative after tz adjustment
1108 0         0 ($year,$mon,$day) = (1970,1,2);
1109 0         0 $noDate = 1;
1110             } else {
1111 0         0 $err = 'Invalid date/time (use YYYY:mm:dd HH:MM:SS[.ss][+/-HH:MM|Z])';
1112 0         0 last;
1113             }
1114 11 100       49 if ($tz) {
1115 10         87 $time = Time::Local::timegm($sec,$min,$hr,$day,$mon-1,$year);
1116             # use timezone from date/time value
1117 10 100       588 if ($tz ne 'Z') {
1118 5         21 my $tzmin = $t1 * 60 + $t2;
1119 5 100       31 $time -= ($t0 eq '-' ? -$tzmin : $tzmin) * 60;
1120             }
1121             } else {
1122             # assume local timezone
1123 1         10 $time = Image::ExifTool::TimeLocal($sec,$min,$hr,$day,$mon-1,$year);
1124             }
1125             # add fractional seconds
1126 11 100 66     69 $time += $fs if $fs and $fs ne '.';
1127              
1128             # bring UTC time back to Jan. 1 if no date is given
1129             # (don't use '%' operator here because it drops fractional seconds)
1130 11 50       43 $time -= int($time / $secPerDay) * $secPerDay if $noDate;
1131              
1132             # apply time synchronization if available
1133 11         59 my $sync = ApplySyncCorr($et, $time);
1134              
1135             # save fractional seconds string
1136 11 100       94 $fsec = ($time =~ /(\.\d+)$/) ? $1 : '';
1137              
1138 11 100 66     62 if ($et->Options('Verbose') > 1 and not $secondTry) {
1139 1         8 my $out = $et->Options('TextOut');
1140 1         3 my $str = '';
1141 1 50       19 $str .= sprintf(" (incl. Geosync offset of %+.3f sec)", $sync) if defined $sync;
1142 1 50       6 unless ($tz) {
1143 0         0 my $tzs = Image::ExifTool::TimeZoneString([$sec,$min,$hr,$day,$mon-1,$year-1900],$time);
1144 0         0 $str .= " (local timezone is $tzs)";
1145             }
1146 1         8 print $out ' Geotime value: ' . PrintFixTime($time) . "$str\n";
1147             }
1148 11 100 66     129 if (not $times or not @$times) {
    50          
    100          
1149 1         5 $fix = { }; # dummy fix to geotag date/time only
1150             # interpolate GPS track at $time
1151             } elsif ($time < $$times[0]) {
1152 0 0       0 if ($time < $$times[0] - $geoMaxExtSecs) {
1153 0 0       0 $err or $err = 'Time is too far before track';
1154 0 0       0 $et->VPrint(2, ' Track start: ', PrintFixTime($$times[0]), "\n") if $verbose > 2;
1155 0 0       0 $fix = { } if $$geotag{DateTimeOnly};
1156             } else {
1157 0         0 $fix = $$points{$$times[0]};
1158 0         0 $iExt = 0; $iDir = 1;
  0         0  
1159 0 0       0 $et->VPrint(2, " Taking pos from fix:\n",
1160             PrintFix($points, $$times[0])) if $verbose > 2;
1161             }
1162             } elsif ($time > $$times[-1]) {
1163 1 50       9 if ($time > $$times[-1] + $geoMaxExtSecs) {
1164 1 50       8 $err or $err = 'Time is too far beyond track';
1165 1 50       7 $et->VPrint(2, ' Track end: ', PrintFixTime($$times[-1]), "\n") if $verbose > 2;
1166 1 50       7 $fix = { } if $$geotag{DateTimeOnly};
1167             } else {
1168 0         0 $fix = $$points{$$times[-1]};
1169 0         0 $iExt = $#$times; $iDir = -1;
  0         0  
1170 0 0       0 $et->VPrint(2, " Taking pos from fix:\n",
1171             PrintFix($points, $$times[-1])) if $verbose > 2;
1172             }
1173             } else {
1174             # find nearest 2 points in time
1175 9         44 my ($i0, $i1) = (0, scalar(@$times) - 1);
1176 9         52 while ($i1 > $i0 + 1) {
1177 27         70 my $pt = int(($i0 + $i1) / 2);
1178 27 100       92 ($time < $$times[$pt] ? $i1 : $i0) = $pt;
1179             }
1180             # do linear interpolation for position
1181 9         25 my $t0 = $$times[$i0];
1182 9         21 my $t1 = $$times[$i1];
1183 9         22 my $p1 = $$points{$t1};
1184             # check to see if we are extrapolating before the first entry in a track
1185 9 50 33     53 my $maxSecs = ($$p1{first} and $geoMaxIntSecs) ? $geoMaxExtSecs : $geoMaxIntSecs;
1186 9         18 my $tn; # find time of nearest fix
1187 9 100       47 if ($time - $t0 < $t1 - $time) {
1188 7         14 $tn = $t0;
1189 7         15 $iExt = $i0;
1190             } else {
1191 2         6 $tn = $t1;
1192 2         6 $iExt = $i1;
1193             }
1194             # don't interpolate if fixes are too far apart
1195             # (but always interpolate fixes inside the same TimeSpan)
1196 9 50 0     57 if ($t1 - $t0 > $maxSecs and (not $$p1{span} or not $$points{$t0}{span} or
      33        
1197             $$p1{span} != $$points{$t0}{span}))
1198             {
1199             # treat as an extrapolation -- use nearest fix if close enough
1200 0 0       0 if (abs($time - $tn) > $geoMaxExtSecs) {
1201 0 0       0 $err or $err = 'Time is too far from nearest GPS fix';
1202 0 0       0 $et->VPrint(2, ' Nearest fix: ', PrintFixTime($tn), ' (',
1203             int(abs $time-$tn), " sec away)\n") if $verbose > 2;
1204 0 0       0 $fix = { } if $$geotag{DateTimeOnly};
1205             } else {
1206 0         0 $fix = $$points{$tn};
1207 0 0       0 $et->VPrint(2, " Taking pos from fix:\n",
1208             PrintFix($points, $tn)) if $verbose > 2;
1209             }
1210             } else {
1211 9 50       47 my $f0 = $t1 == $t0 ? 0 : ($time - $t0) / ($t1 - $t0);
1212 9         24 my $p0 = $$points{$t0};
1213 9 50       31 $et->VPrint(2, " Interpolating between fixes (f=$f0):\n",
1214             PrintFix($points, $t0, $t1)) if $verbose > 2;
1215 9         19 $fix = { };
1216             # copy user-defined tags from nearest fix
1217 9         38 $$fix{$_} = $$points{$tn}{$_} foreach values %userTag;
1218             # loop through available fix information categories
1219             # (pos, track, alt, orient)
1220 9         21 my ($category, $key);
1221 9         31 Category: foreach $category (qw{pos track alt orient atemp err dop}) {
1222 63 100       180 next unless $$has{$category};
1223 21         42 my ($f, $p0b, $p1b, $f0b);
1224             # loop through specific fix information keys
1225             # (lat, lon, alt, track, speed, dir, pitch, roll)
1226 21         30 foreach $key (@{$fixInfoKeys{$category}}) {
  21         75  
1227 39         124 my $v0 = $$p0{$key};
1228 39         79 my $v1 = $$p1{$key};
1229 39 100 66     147 if (defined $v0 and defined $v1) {
    50          
1230 33         56 $f = $f0;
1231             } elsif (defined $f0b) {
1232 0         0 $v0 = $$p0b{$key};
1233 0         0 $v1 = $$p1b{$key};
1234 0 0 0     0 next unless defined $v0 and defined $v1;
1235 0         0 $f = $f0b;
1236             } else {
1237 6 50       18 next if $sepTags{$key}; # (don't scan outwards for some formats, eg. CSV)
1238             # scan outwards looking for fixes with the required information
1239             # (NOTE: SHOULD EVENTUALLY DO THIS FOR EXTRAPOLATION TOO!)
1240 0         0 my ($t0b, $t1b);
1241 0 0       0 if (defined $v0) {
1242 0         0 $t0b = $t0; $p0b = $p0;
  0         0  
1243             } else {
1244 0         0 ($t0b,$p0b,$v0) = ScanOutwards($key,$times,$points,$i0,-1,$maxSecs);
1245 0 0       0 next Category unless defined $t0b;
1246             }
1247 0 0       0 if (defined $v1) {
1248 0         0 $t1b = $t1; $p1b = $p1;
  0         0  
1249             } else {
1250 0         0 ($t1b,$p1b,$v1) = ScanOutwards($key,$times,$points,$i1,1,$maxSecs);
1251 0 0       0 next Category unless defined $t1b;
1252             }
1253             # re-calculate the interpolation factor
1254 0 0       0 $f = $f0b = $t1b == $t0b ? 0 : ($time - $t0b) / ($t1b - $t0b);
1255 0 0       0 $et->VPrint(2, " Interpolating $category between fixes (f=$f):\n",
1256             PrintFix($points, $t0b, $t1b)) if $verbose > 2;
1257             }
1258             # must interpolate cyclical values differently
1259 33 50 66     184 if ($cyclical{$key} and abs($v1 - $v0) > 180) {
1260             # the acute angle spans the discontinuity, so add
1261             # 360 degrees to the smaller angle before interpolating
1262 0 0       0 $v0 < $v1 ? $v0 += 360 : $v1 += 360;
1263 0         0 $$fix{$key} = $v1 * $f + $v0 * (1 - $f);
1264             # some ranges are -180 to 180, others are 0 to 360
1265 0 0       0 my $max = $cyc180{$key} ? 180 : 360;
1266 0 0       0 $$fix{$key} -= 360 if $$fix{$key} >= $max;
1267             } else {
1268             # simple linear interpolation
1269 33         177 $$fix{$key} = $v1 * $f + $v0 * (1 - $f);
1270             }
1271             }
1272             }
1273             }
1274             }
1275 11 100 33     48 if ($fix) {
    50 33        
1276 10         30 $err = ''; # success!
1277             } elsif ($$geotag{NoDate} and not $noDate and $val =~ s/^\S+\s+//) {
1278             # try again with no date since some of our track points are date-less
1279 0         0 $secondTry = 1;
1280 0         0 next;
1281             }
1282 11         55 last;
1283             }
1284 14 100       79 if ($fix) {
1285 10         30 my ($gpsDate, $gpsAlt, $gpsAltRef);
1286 10         85 my @t = gmtime(int $time);
1287 10         70 my $gpsTime = sprintf('%.2d:%.2d:%.2d', $t[2], $t[1], $t[0]) . $fsec;
1288             # write GPSDateStamp if date included in track log, otherwise delete it
1289 10 50       113 $gpsDate = sprintf('%.2d:%.2d:%.2d', $t[5]+1900, $t[4]+1, $t[3]) unless $noDate;
1290             # write GPSAltitude tags if altitude included in track log, otherwise delete them
1291 10         26 my $alt = $$fix{alt};
1292 10 50 66     121 if (not defined $alt and $$has{alt} and defined $iExt) {
      33        
1293 0         0 my $tFix = FindFix($et,'alt',$times,$points,$iExt,$iDir,$geoMaxExtSecs);
1294 0 0       0 $alt = $$tFix{alt} if $tFix;
1295             }
1296             # set new GPS tag values (EXIF, or XMP if write group is 'xmp')
1297 10         25 my ($xmp, $exif, $qt, @r);
1298 10         56 my %opts = ( Type => 'ValueConv' ); # write ValueConv values
1299 10 100       40 if ($writeGroup) {
1300 1         6 $opts{Group} = $writeGroup;
1301 1         9 $xmp = ($writeGroup =~ /xmp/i);
1302 1         7 $exif = ($writeGroup =~ /^(exif|gps)$/i);
1303 1         4 $qt = $writeGroup =~ /^(quicktime|keys|itemlist|userdata)$/i;
1304             }
1305             # set QuickTime GPSCoordinates
1306 10         158 my $coords = "$$fix{lat} $$fix{lon}";
1307 10 100       37 if (defined $alt) {
1308 6         14 $gpsAlt = abs $alt;
1309 6 50       28 $gpsAltRef = ($alt < 0 ? 1 : 0);
1310 6         42 $coords .= " $alt";
1311             }
1312 10         302 @r = $et->SetNewValue(GPSCoordinates => $coords, %opts);
1313             # also Geolocate if specified
1314 10         33 my $nvHash;
1315 10         91 my $geoloc = $et->GetNewValue('Geolocate', \$nvHash);
1316 10 100 66     102 if ($geoloc and $geoloc =~ /\bgeotag\b/i) {
1317 1 50       9 my $tag = ($$nvHash{WantGroup} ? "$$nvHash{WantGroup}:" : '') . 'Geolocate';
1318             # pass along any regular expressions to qualify geolocation search
1319 1         8 my $parms = join ',', grep m(/), split /\s*,\s*/, $geoloc;
1320 1 50       21 $parms and $parms = ",$parms,both";
1321 1         16 $et->SetNewValue($tag => "$$fix{lat},$$fix{lon}$parms");
1322             # (the Geolocate tag will be restored to its original value
1323             # by RestoreNewValues before the next file in batch processing)
1324             }
1325 10 50       314 return $err if $qt; # all done if writing to QuickTime only
1326             # (capture error messages by calling SetNewValue in list context)
1327 10         104 @r = $et->SetNewValue(GPSLatitude => $$fix{lat}, %opts);
1328 10         100 @r = $et->SetNewValue(GPSLongitude => $$fix{lon}, %opts);
1329 10         86 @r = $et->SetNewValue(GPSAltitude => $gpsAlt, %opts);
1330 10         77 @r = $et->SetNewValue(GPSAltitudeRef => $gpsAltRef, %opts);
1331 10 100 66     103 if ($$has{track} or $$has{speed}) {
1332 3 50       17 my $type = $$has{track} ? 'track' : 'speed';
1333 3         10 my $tFix = $fix;
1334 3 100 66     25 if (not defined $$fix{$type} and defined $iExt) {
1335 1         6 my $p = FindFix($et,$type,$times,$points,$iExt,$iDir,$geoMaxExtSecs);
1336 1 50       4 $tFix = $p if $p;
1337             }
1338 3         25 @r = $et->SetNewValue(GPSTrack => $$tFix{track}, %opts);
1339 3 100       29 @r = $et->SetNewValue(GPSTrackRef => (defined $$tFix{track} ? 'T' : undef), %opts);
1340 3         11 my ($spd, $ref);
1341 3 100       21 if (defined($spd = $$tFix{speed})) {
1342             # convert to specified units if necessary
1343 1         4 $ref = $$et{OPTIONS}{GeoSpeedRef};
1344 1 50 33     6 if ($ref and defined $speedConv{$ref}) {
1345 0 0       0 $ref = $speedConv{$ref} if $speedConv{$speedConv{$ref}};
1346 0         0 $spd *= $speedConv{$ref};
1347             } else {
1348 1         2 $ref = 'N'; # knots by default
1349             }
1350             }
1351 3         18 @r = $et->SetNewValue(GPSSpeed => $spd, %opts);
1352 3         19 @r = $et->SetNewValue(GPSSpeedRef => $ref, %opts);
1353             }
1354 10 100       53 if ($$has{orient}) {
1355 3         9 my $tFix = $fix;
1356 3 100 66     28 if (not defined $$fix{dir} and defined $iExt) {
1357 1         6 my $p = FindFix($et,'dir',$times,$points,$iExt,$iDir,$geoMaxExtSecs);
1358 1 50       3 $tFix = $p if $p;
1359             }
1360 3         20 @r = $et->SetNewValue(GPSImgDirection => $$tFix{dir}, %opts);
1361 3 100       30 @r = $et->SetNewValue(GPSImgDirectionRef => (defined $$tFix{dir} ? 'T' : undef), %opts);
1362 3         24 @r = $et->SetNewValue(CameraElevationAngle => $$tFix{pitch}, %opts);
1363             # Note: GPSPitch and GPSRoll are non-standard, and must be user-defined
1364 3         27 @r = $et->SetNewValue(GPSPitch => $$tFix{pitch}, %opts);
1365 3         31 @r = $et->SetNewValue(GPSRoll => $$tFix{roll}, %opts);
1366             }
1367 10 50       53 if ($$has{atemp}) {
1368 0         0 my $tFix = $fix;
1369 0 0 0     0 if (not defined $$fix{atemp} and defined $iExt) {
1370             # (not all fixes have atemp, so try interpolating specifically for this)
1371 0         0 my $p = FindFix($et,'atemp',$times,$points,$iExt,$iDir,$geoMaxExtSecs);
1372 0 0       0 $tFix = $p if $p;
1373             }
1374 0         0 @r = $et->SetNewValue(AmbientTemperature => $$tFix{atemp}, %opts);
1375             }
1376 10 50       48 if ($$has{err}) {
1377 0         0 @r = $et->SetNewValue(GPSHPositioningError => $$fix{err}, %opts);
1378             }
1379 10 50       53 if ($$has{dop}) {
1380 0         0 my ($dop, $mm);
1381 0 0       0 if (defined $$fix{pdop}) {
    0          
1382 0         0 $dop = $$fix{pdop};
1383 0         0 $mm = 3;
1384             } elsif (defined $$fix{hdop}) {
1385 0 0       0 if (defined $$fix{vdop}) {
1386 0         0 $dop = sqrt($$fix{hdop} * $$fix{hdop} + $$fix{vdop} * $$fix{vdop});
1387 0         0 $mm = 3;
1388             } else {
1389 0         0 $dop = $$fix{hdop};
1390 0         0 $mm = 2;
1391             }
1392             }
1393 0 0       0 if (defined $dop) {
1394 0         0 $et->SetNewValue(GPSMeasureMode => $mm, %opts);
1395 0         0 $et->SetNewValue(GPSDOP => $dop, %opts);
1396             # also set GPSHPositioningError if specified
1397 0         0 my $hposErr = $$et{OPTIONS}{GeoHPosErr};
1398 0 0       0 if ($hposErr) {
1399 0         0 $hposErr =~ s/gpsdop/GPSDOP/i;
1400 0         0 my $GPSDOP = $dop;
1401 0         0 local $SIG{'__WARN__'} = \&Image::ExifTool::SetWarning;
1402 0         0 undef $Image::ExifTool::evalWarning;
1403             #### eval GeoHPosErr ($GPSDOP)
1404 0         0 $hposErr = eval $hposErr;
1405 0   0     0 my $err = Image::ExifTool::GetWarning() || $@;
1406 0 0       0 if ($err) {
1407 0         0 $err = Image::ExifTool::CleanWarning($err);
1408 0         0 $et->Warn("Error calculating GPSHPositioningError: $err", 1);
1409             } else {
1410 0         0 $et->SetNewValue(GPSHPositioningError => $hposErr, %opts);
1411             }
1412             }
1413             }
1414             }
1415 10 100       36 unless ($xmp) {
1416 9         25 my ($latRef, $lonRef);
1417 9 100       87 $latRef = ($$fix{lat} > 0 ? 'N' : 'S') if defined $$fix{lat};
    100          
1418 9 100       54 $lonRef = ($$fix{lon} > 0 ? 'E' : 'W') if defined $$fix{lon};
    100          
1419 9         57 @r = $et->SetNewValue(GPSLatitudeRef => $latRef, %opts);
1420 9         72 @r = $et->SetNewValue(GPSLongitudeRef => $lonRef, %opts);
1421 9         62 @r = $et->SetNewValue(GPSDateStamp => $gpsDate, %opts);
1422 9         139 @r = $et->SetNewValue(GPSTimeStamp => $gpsTime, %opts);
1423             # set options to edit XMP:GPSDateTime only if it already exists
1424 9         38 $opts{EditOnly} = 1;
1425 9         36 $opts{Group} = 'XMP';
1426             }
1427 10 50       50 unless ($exif) {
1428 10         118 @r = $et->SetNewValue(GPSDateTime => "$gpsDate $gpsTime", %opts);
1429             }
1430             # set user-defined tags
1431 10         205 foreach (sort values %userTag) {
1432 0 0       0 @r = $et->SetNewValue(substr($_, 1) => $$fix{$_}) if defined $$fix{$_};
1433             }
1434             } else {
1435 4         42 my %opts = ( IgnorePermanent => 1 );
1436 4 100       20 $opts{Replace} = 2 if defined $val; # remove existing new values
1437             # reset user-defined GPX tags
1438 4         22 InitUserTags($et); # (won't be set yet because we didn't read a GPX file)
1439 4         15 foreach (values %userTag) {
1440 0         0 my @r = $et->SetNewValue(substr($_, 1), undef, %opts);
1441             }
1442 4 100       14 $opts{Group} = $writeGroup if $writeGroup;
1443             # reset any GPS values we might have already set
1444 4         14 foreach (qw(GPSLatitude GPSLatitudeRef GPSLongitude GPSLongitudeRef
1445             GPSAltitude GPSAltitudeRef GPSDateStamp GPSTimeStamp GPSDateTime
1446             GPSTrack GPSTrackRef GPSSpeed GPSSpeedRef GPSImgDirection
1447             GPSImgDirectionRef GPSPitch GPSRoll CameraElevationAngle
1448             AmbientTemperature GPSHPositioningError GPSCoordinates
1449             GPSMeasureMode GPSDOP))
1450             {
1451 92         410 my @r = $et->SetNewValue($_, undef, %opts);
1452             }
1453             }
1454 14         336 return $err;
1455             }
1456              
1457             #------------------------------------------------------------------------------
1458             # Convert Geotagging time synchronization value
1459             # Inputs: 0) exiftool object ref,
1460             # 1) time difference string ("[+-]DD MM:HH:SS.ss"), geosync'd file name,
1461             # "GPSTIME@IMAGETIME", or "GPSTIME@FILENAME"
1462             # Returns: geosync hash:
1463             # Offset = Offset in seconds for latest synchronization (GPS - image time)
1464             # Points = hash of all sync offsets keyed by image times in seconds
1465             # Times = sorted list of image synchronization times (keys in Points hash)
1466             # Notes: calling this routine with more than one geosync'd file causes time drift
1467             # correction to be implemented
1468             sub ConvertGeosync($$)
1469             {
1470 5     5 0 25 my ($et, $val) = @_;
1471 5   100     45 my $sync = $et->GetNewValue('Geosync') || { };
1472 5         17 my ($syncFile, $gpsTime, $imgTime);
1473              
1474 5 100 33     64 if ($val =~ /(.*?)\@(.*)/) {
    50          
1475 4         22 $gpsTime = $1;
1476 4 50       366 (-f $2 ? $syncFile : $imgTime) = $2;
1477             # (take care because "-f '1:30'" crashes ActivePerl 5.10)
1478             } elsif ($val !~ /^\d/ or $val !~ /:/) {
1479 0 0       0 $syncFile = $val if -f $val;
1480             }
1481 5 100 66     40 if ($gpsTime or defined $syncFile) {
1482             # (this is a time synchronization vector)
1483 4 50       18 if (defined $syncFile) {
1484             # check the following tags in order to obtain the image timestamp
1485 0         0 my @timeTags = qw(SubSecDateTimeOriginal SubSecCreateDate SubSecModifyDate
1486             DateTimeOriginal CreateDate ModifyDate FileModifyDate);
1487 0         0 my $info = ImageInfo($syncFile, { PrintConv => 0 }, @timeTags,
1488             'GPSDateTime', 'GPSTimeStamp');
1489 0 0       0 $$info{Error} and warn("$$info{Err}\n"), return undef;
1490 0 0       0 unless ($gpsTime) {
1491 0   0     0 $gpsTime = $$info{GPSDateTime} || $$info{GPSTimeStamp};
1492 0 0 0     0 $gpsTime .= 'Z' if $gpsTime and not $$info{GPSDateTime};
1493             }
1494 0 0       0 $gpsTime or warn("No GPSTimeStamp in '$syncFile\n"), return undef;
1495 0         0 my $tag;
1496 0         0 foreach $tag (@timeTags) {
1497 0 0       0 if ($$info{$tag}) {
1498 0         0 $imgTime = $$info{$tag};
1499 0         0 $et->VPrint(2, "Geosyncing with $tag from '${syncFile}'\n");
1500 0         0 last;
1501             }
1502             }
1503 0 0       0 $imgTime or warn("No image timestamp in '${syncFile}'\n"), return undef;
1504             }
1505             # add date to date-less timestamps
1506 4         13 my ($imgDateTime, $gpsDateTime, $noDate);
1507 4 50       41 if ($imgTime =~ /^(\d+:\d+:\d+)\s+\d+/) {
    0          
1508 4         9 $imgDateTime = $imgTime;
1509 4         13 my $date = $1;
1510 4 50       27 if ($gpsTime =~ /^\d+:\d+:\d+\s+\d+/) {
1511 4         10 $gpsDateTime = $gpsTime;
1512             } else {
1513 0         0 $gpsDateTime = "$date $gpsTime";
1514             }
1515             } elsif ($gpsTime =~ /^(\d+:\d+:\d+)\s+\d+/) {
1516 0         0 $imgDateTime = "$1 $imgTime";
1517 0         0 $gpsDateTime = $gpsTime;
1518             } else {
1519             # use a today's date (so hopefully the DST setting will be intuitive)
1520 0         0 my @tm = localtime;
1521 0         0 my $date = sprintf('%.4d:%.2d:%.2d', $tm[5]+1900, $tm[4]+1, $tm[3]);
1522 0         0 $gpsDateTime = "$date $gpsTime";
1523 0         0 $imgDateTime = "$date $imgTime";
1524 0         0 $noDate = 1;
1525             }
1526             # calculate Unix seconds since the epoch
1527 4         31 my $imgSecs = Image::ExifTool::GetUnixTime($imgDateTime, 1);
1528 4 50       19 defined $imgSecs or warn("Invalid image time '${imgTime}'\n"), return undef;
1529 4         14 my $gpsSecs = Image::ExifTool::GetUnixTime($gpsDateTime, 1);
1530 4 50       18 defined $gpsSecs or warn("Invalid GPS time '${gpsTime}'\n"), return undef;
1531             # add fractional seconds
1532 4 50       20 $gpsSecs += $1 if $gpsTime =~ /(\.\d+)/;
1533 4 50       21 $imgSecs += $1 if $imgTime =~ /(\.\d+)/;
1534             # shift dates within 12 hours of each other if either timestamp was date-less
1535 4 50 33     33 if ($gpsDateTime ne $gpsTime or $imgDateTime ne $imgTime) {
1536 0         0 my $diff = ($imgSecs - $gpsSecs) % (24 * 3600);
1537 0 0       0 $diff -= 24 * 3600 if $diff > 12 * 3600;
1538 0 0       0 $diff += 24 * 3600 if $diff < -12 * 3600;
1539 0 0       0 if ($gpsDateTime ne $gpsTime) {
1540 0         0 $gpsSecs = $imgSecs - $diff;
1541             } else {
1542 0         0 $imgSecs = $gpsSecs + $diff;
1543             }
1544             }
1545             # save the synchronization offset
1546 4         22 $$sync{Offset} = $gpsSecs - $imgSecs;
1547             # save this synchronization point if either timestamp had a date
1548 4 50       21 unless ($noDate) {
1549 4 100       23 $$sync{Points} or $$sync{Points} = { };
1550 4         21 $$sync{Points}{$imgSecs} = $$sync{Offset};
1551             # print verbose output
1552 4 100       26 if ($et->Options('Verbose') > 1) {
1553             # print GPS and image timestamps in UTC
1554 2         12 $et->VPrint(1, "Added Geosync point:\n",
1555             ' GPS time stamp: ', PrintFixTime($gpsSecs), "\n",
1556             ' Image date/time: ', PrintFixTime($imgSecs), "\n");
1557             }
1558             # save sorted list of image sync times if we have more than one
1559 4         12 my @times = keys %{$$sync{Points}};
  4         25  
1560 4 100       49 if (@times > 1) {
1561 2         25 @times = sort { $a <=> $b } @times;
  2         14  
1562 2         12 $$sync{Times} = \@times;
1563             }
1564             }
1565             } else {
1566             # (this is a simple time difference)
1567 1         15 my @vals = $val =~ /(?=\d|\.\d)\d*(?:\.\d*)?/g; # (allow decimal values too)
1568 1 50       5 @vals or warn("Invalid value (please refer to geotag documentation)\n"), return undef;
1569 1         5 my $secs = 0;
1570 1         2 my $mult;
1571 1         5 foreach $mult (1, 60, 3600, $secPerDay) {
1572 2         7 $secs += $mult * pop(@vals);
1573 2 100       9 last unless @vals;
1574             }
1575             # set constant sync offset
1576 1 50       9 $$sync{Offset} = $val =~ /^\s*-/ ? -$secs : $secs;
1577             }
1578 5         121 return $sync;
1579             }
1580              
1581             #------------------------------------------------------------------------------
1582             # Print fix time
1583             # Inputs: 0) time since the epoch
1584             # Returns: UTC time string with fractional seconds
1585             sub PrintFixTime($)
1586             {
1587 8     8 0 24 my $time = shift;
1588 8         44 return Image::ExifTool::ConvertUnixTime($time, undef, 3) . ' UTC';
1589             }
1590              
1591             #------------------------------------------------------------------------------
1592             # Print fix information
1593             # Inputs: 0) lookup for all fix points, 1-n) list of fix times
1594             # Returns: fix string (including leading indent and trailing newline)
1595             sub PrintFix($@)
1596             {
1597 0     0 0 0 local $_;
1598 0         0 my $points = shift;
1599 0         0 my $str = '';
1600 0         0 while (@_) {
1601 0         0 my $time = shift;
1602 0         0 $str .= ' ' . PrintFixTime($time) . ' -';
1603 0         0 my $fix = $$points{$time};
1604 0 0       0 if ($fix) {
1605 0         0 foreach (sort keys %$fix) {
1606 0 0 0     0 $str .= " $_=$$fix{$_}" unless $_ eq 'time' or not defined $$fix{$_};
1607             }
1608             }
1609 0         0 $str .= "\n";
1610             }
1611 0         0 return $str;
1612             }
1613              
1614             #------------------------------------------------------------------------------
1615             # Initialize %userTag for reading user-defined GPX tags
1616             # Inputs: 0) ExifTool ref
1617             sub InitUserTags($)
1618             {
1619 14     14 0 35 my $et = shift;
1620 14         62 %userTag = ( );
1621 14 50       92 if ($$et{OPTIONS}{GeoUserTag}) {
1622 0           foreach (split /\s*,\s*/, $$et{OPTIONS}{GeoUserTag}) {
1623 0 0         next unless /^(.+)=(.+)$/;
1624 0 0         $xmlTag{lc $2} and $et->Warn("User-defined GPX tag '${2}' conflicts with existing tag"), next;
1625 0           $userTag{lc $2} = "_$1"; # (leading underline prevents conflicts)
1626             }
1627             }
1628             }
1629              
1630             #------------------------------------------------------------------------------
1631             1; # end
1632              
1633             __END__