File Coverage

blib/lib/Image/ExifTool/Geotag.pm
Criterion Covered Total %
statement 468 730 64.1
branch 306 624 49.0
condition 106 272 38.9
subroutine 12 15 80.0
pod 0 10 0.0
total 892 1651 54.0


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