File Coverage

blib/lib/Image/ExifTool/Geotag.pm
Criterion Covered Total %
statement 462 760 60.7
branch 311 658 47.2
condition 106 284 37.3
subroutine 11 15 73.3
pod 0 10 0.0
total 890 1727 51.5


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