source: main/trunk/greenstone2/perllib/cpan/Image/ExifTool/Geotag.pm@ 24107

Last change on this file since 24107 was 24107, checked in by sjm84, 13 years ago

Updating the ExifTool perl modules
  • Property svn:executable set to *
File size: 37.2 KB
Line 
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#
9# References: 1) http://www.topografix.com/GPX/1/1/
10# 2) http://www.gpsinformation.org/dale/nmea.htm#GSA
11# 3) http://code.google.com/apis/kml/documentation/kmlreference.html
12# 4) http://www.fai.org/gliding/system/files/tech_spec_gnss.pdf
13#------------------------------------------------------------------------------
14
15package Image::ExifTool::Geotag;
16
17use strict;
18use vars qw($VERSION);
19use Image::ExifTool qw(:Public);
20
21$VERSION = '1.24';
22
23sub SetGeoValues($$;$);
24
25# XML tags that we recognize (keys are forced to lower case)
26my %xmlTag = (
27 lat => 'lat', # GPX
28 latitude => 'lat', # Garmin
29 latitudedegrees => 'lat', # Garmin TCX
30 lon => 'lon', # GPX
31 longitude => 'lon', # Garmin
32 longitudedegrees => 'lon', # Garmin TCX
33 ele => 'alt', # GPX
34 elevation => 'alt', # PH
35 alt => 'alt', # PH
36 altitude => 'alt', # Garmin
37 altitudemeters => 'alt', # Garmin TCX
38 'time' => 'time', # GPX/Garmin
39 fix => 'fixtype', # GPX
40 hdop => 'hdop', # GPX
41 vdop => 'vdop', # GPX
42 pdop => 'pdop', # GPX
43 sat => 'nsats', # GPX
44 when => 'time', # KML
45 coordinates => 'coords', # KML
46 # XML containers (fix is reset at the opening tag of these properties)
47 wpt => '', # GPX
48 trkpt => '', # GPX
49 rtept => '', # GPX
50 trackpoint => '', # Garmin
51 placemark => '', # KML
52);
53
54my $secPerDay = 24 * 3600; # a useful constant
55
56#------------------------------------------------------------------------------
57# Load GPS track log file
58# Inputs: 0) ExifTool ref, 1) track log data or file name
59# Returns: geotag hash data reference or error string
60# - the geotag hash has the following members:
61# Points - hash of GPS fix information hashes keyed by Unix time
62# Times - list of sorted Unix times (keys of Points hash)
63# NoDate - flag if some points have no date (ie. referenced to 1970:01:01)
64# IsDate - flag if some points have date
65# - the fix information hash may contain:
66# lat - signed latitude (required)
67# lon - signed longitude (required)
68# alt - signed altitude
69# time - fix time in UTC as XML string
70# fixtype- type of fix ('none'|'2d'|'3d'|'dgps'|'pps')
71# pdop - dilution of precision
72# hdop - horizontal DOP
73# vdop - vertical DOP
74# sats - comma-separated list of active satellites
75# nsats - number of active satellites
76# first - flag set for first fix of track
77# - concatenates new data with existing track data stored in ExifTool NEW_VALUE
78# for the Geotag tag
79sub LoadTrackLog($$;$)
80{
81 local ($_, $/, *EXIFTOOL_TRKFILE);
82 my ($exifTool, $val) = @_;
83 my ($raf, $from, $time, $isDate, $noDate, $noDateChanged, $lastDate, $dateFlarm);
84 my ($nmeaStart, $fixSecs, @fixTimes, $canCut, $cutPDOP, $cutHDOP, $cutSats, $lastFix);
85
86 unless (eval 'require Time::Local') {
87 return 'Geotag feature requires Time::Local installed';
88 }
89 # add data to existing track
90 my $geotag = $exifTool->GetNewValues('Geotag') || { };
91 my $format = '';
92 # is $val track log data?
93 if ($val =~ /^(\xef\xbb\xbf)?<(\?xml|gpx)\s/) {
94 $format = 'XML';
95 $/ = '>'; # set input record separator to '>' for XML/GPX data
96 } elsif ($val =~ /(\x0d\x0a|\x0d|\x0a)/) {
97 $/ = $1;
98 } else {
99 # $val is track file name
100 open EXIFTOOL_TRKFILE, $val or return "Error opening GPS file '$val'";
101 $raf = new File::RandomAccess(\*EXIFTOOL_TRKFILE);
102 unless ($raf->Read($_, 256)) {
103 close EXIFTOOL_TRKFILE;
104 return "Empty track file '$val'";
105 }
106 # look for XML or GPX header (might as well allow UTF-8 BOM)
107 if (/^(\xef\xbb\xbf)?<(\?xml|gpx)\s/) {
108 $format = 'XML';
109 $/ = '>'; # set input record separator to '>' for XML/GPX data
110 } elsif (/(\x0d\x0a|\x0d|\x0a)/) {
111 $/ = $1;
112 } else {
113 close EXIFTOOL_TRKFILE;
114 return "Invalid track file '$val'";
115 }
116 $raf->Seek(0,0);
117 $from = "file '$val'";
118 }
119 unless ($from) {
120 # set up RAF for reading log file in memory
121 $raf = new File::RandomAccess(\$val);
122 $from = 'data';
123 }
124 # initialize track points lookup
125 my $points = $$geotag{Points};
126 $points or $points = $$geotag{Points} = { };
127
128 # initialize cuts
129 my $maxHDOP = $exifTool->Options('GeoMaxHDOP');
130 my $maxPDOP = $exifTool->Options('GeoMaxPDOP');
131 my $minSats = $exifTool->Options('GeoMinSats');
132 my $isCut = $maxHDOP || $maxPDOP || $minSats;
133
134 my $numPoints = 0;
135 my $skipped = 0;
136 my $lastSecs = 0;
137 my $fix = { };
138 for (;;) {
139 $raf->ReadLine($_) or last;
140 # determine file format
141 if (not $format) {
142 if (/^<(\?xml|gpx)\s/) { # look for XML or GPX header
143 $format = 'XML';
144 } elsif (/^\$(PMGNTRK|GP(RMC|GGA|GLL|GSA)),/) {
145 $format = 'NMEA';
146 $nmeaStart = $2 || $1; # save type of first sentence
147 } elsif (/^A(FLA|XSY|FIL)/) {
148 # (don't set format yet because we want to read HFDTE first)
149 $nmeaStart = 'B' ;
150 next;
151 } elsif (/^HFDTE(\d{2})(\d{2})(\d{2})/) {
152 my $year = $3 + ($3 >= 70 ? 1900 : 2000);
153 $dateFlarm = Time::Local::timegm(0,0,0,$1,$2-1,$year-1900);
154 $nmeaStart = 'B' ;
155 $format = 'IGC';
156 next;
157 } elsif ($nmeaStart and /^B/) {
158 # parse IGC fixes without a date
159 $format = 'IGC';
160 } else {
161 # search only first 50 lines of file for a valid fix
162 last if ++$skipped > 50;
163 next;
164 }
165 }
166#
167# XML format (GPX, KML, Garmin XML/TCX etc)
168#
169 if ($format eq 'XML') {
170 my ($arg, $tok, $td);
171 s/\s*=\s*(['"])\s*/=$1/g; # remove unnecessary white space in attributes
172 foreach $arg (split) {
173 # parse attributes (ie. GPX 'lat' and 'lon')
174 # (note: ignore namespace prefixes if they exist)
175 if ($arg =~ /^(\w+:)?(\w+)=(['"])(.*?)\3/g) {
176 my $tag = $xmlTag{lc $2};
177 $$fix{$tag} = $4 if $tag;
178 }
179 # loop through XML elements
180 while ($arg =~ m{([^<>]*)<(/)?(\w+:)?(\w+)(>|$)}g) {
181 my $tag = $xmlTag{$tok = lc $4};
182 # parse as a simple property if this element has a value
183 if (defined $tag and not $tag) {
184 # a containing property was opened or closed
185 if (not $2) {
186 # opened: start a new fix
187 $lastFix = $fix = { };
188 next;
189 } elsif ($fix and $lastFix and %$fix) {
190 # closed: transfer additional tags from current fix
191 foreach (keys %$fix) {
192 $$lastFix{$_} = $$fix{$_} unless defined $$lastFix{$_};
193 }
194 undef $lastFix;
195 }
196 }
197 if (length $1) {
198 if ($tag) {
199 if ($tag eq 'coords') {
200 # read KML "Point" coordinates
201 @$fix{'lon','lat','alt'} = split ',', $1;
202 } else {
203 $$fix{$tag} = $1;
204 }
205 }
206 next;
207 } elsif ($tok eq 'td') {
208 $td = 1;
209 }
210 # validate and store GPS fix
211 if (defined $$fix{lat} and defined $$fix{lon} and $$fix{'time'} and
212 $$fix{lat} =~ /^[+-]?\d+\.?\d*/ and
213 $$fix{lon} =~ /^[+-]?\d+\.?\d*/ and
214 $$fix{'time'} =~ /^(\d{4})-(\d+)-(\d+)T(\d+):(\d+):(\d+)(\.\d+)?(.*)/)
215 {
216 $time = Time::Local::timegm($6,$5,$4,$3,$2-1,$1-1900);
217 $time += $7 if $7; # add fractional seconds
218 my $tz = $8;
219 # adjust for time zone (otherwise assume UTC)
220 # - allow timezone of +-HH:MM, +-H:MM, +-HHMM or +-HH since
221 # the spec is unclear about timezone format
222 if ($tz =~ /^([-+])(\d+):(\d{2})\b/ or $tz =~ /^([-+])(\d{2})(\d{2})?\b/) {
223 $tz = ($2 * 60 + ($3 || 0)) * 60;
224 $tz *= -1 if $1 eq '+'; # opposite sign to change back to UTC
225 $time += $tz;
226 }
227 # validate altitude
228 undef $$fix{alt} if defined $$fix{alt} and $$fix{alt} !~ /^[+-]?\d+\.?\d*/;
229 $isDate = 1;
230 $canCut= 1 if defined $$fix{pdop} or defined $$fix{hdop} or defined $$fix{nsats};
231 $$points{$time} = $fix;
232 push @fixTimes, $time; # save times of all fixes in order
233 $fix = { };
234 ++$numPoints;
235 }
236 }
237 }
238 # last ditch check KML description for timestamp (assume it is UTC)
239 $$fix{'time'} = "$1T$2Z" if $td and not $$fix{'time'} and
240 /[\s>](\d{4}-\d{2}-\d{2})[T ](\d{2}:\d{2}:\d{2}(\.\d+)?)/;
241 next;
242 }
243 my (%fix, $secs, $date, $nmea);
244 if ($format eq 'NMEA') {
245 # ignore unrecognized NMEA sentences
246 next unless /^\$(PMGNTRK|GP(RMC|GGA|GLL|GSA)),/;
247 $nmea = $2 || $1;
248 }
249#
250# IGC (flarm) (ref 4)
251#
252 if ( $format eq 'IGC' ) {
253 # B0939564531208N00557021EA007670089100207
254 # BHHMMSSDDMMmmmNDDDMMmmmEAaaaaaAAAAAxxyy
255 # HH MM SS DD MM mmm DDD MM mmm aaaaa AAAAA
256 # 1 2 3 4 5 6 7 8 9 10 11 12 13 14
257 /^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;
258 $fix{lat} = ($4 + ($5 + $6/1000)/60) * ($7 eq 'N' ? 1 : -1);
259 $fix{lon} = ($8 + ($9 +$10/1000)/60) * ($11 eq 'E' ? 1 : -1);
260 $fix{alt} = $12 eq 'A' ? $14 : undef;
261 $secs = (($1 * 60) + $2) * 60 + $3;
262 # wrap to next day if necessary
263 if ($dateFlarm) {
264 $dateFlarm += $secPerDay if $secs < $lastSecs;
265 $date = $dateFlarm;
266 }
267 $nmea = 'B';
268#
269# Magellan eXplorist NMEA-like PMGNTRK sentence (optionally contains date)
270#
271 } elsif ($nmea eq 'PMGNTRK') {
272 # $PMGNTRK,4415.026,N,07631.091,W,00092,M,185031.06,A,,020409*65
273 # $PMGNTRK,ddmm.mmm,N/S,dddmm.mmm,E/W,alt,F/M,hhmmss.ss,A/V,trkname,DDMMYY*cs
274 /^\$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;
275 $fix{lat} = ($1 + $2/60) * ($3 eq 'N' ? 1 : -1);
276 $fix{lon} = ($4 + $5/60) * ($6 eq 'E' ? 1 : -1);
277 $fix{alt} = $8 eq 'M' ? $7 : $7 * 12 * 0.0254;
278 $secs = (($9 * 60) + $10) * 60 + $11;
279 $secs += $12 if $12; # add fractional seconds
280 if (defined $15) {
281 # optional date is available in PMGNTRK sentence
282 my $year = $15 + ($15 >= 70 ? 1900 : 2000);
283 $date = Time::Local::timegm(0,0,0,$13,$14-1,$year-1900);
284 }
285#
286# NMEA RMC sentence (contains date)
287#
288 } elsif ($nmea eq 'RMC') {
289 # $GPRMC,092204.999,A,4250.5589,S,14718.5084,E,0.00,89.68,211200,,*25
290 # $GPRMC,hhmmss.sss,A/V,ddmm.mmmm,N/S,ddmmm.mmmm,E/W,spd(knots),dir(deg),DDMMYY,,*cs
291 /^\$GPRMC,(\d{2})(\d{2})(\d+)(\.\d+)?,A,(\d+)(\d{2}\.\d+),([NS]),(\d+)(\d{2}\.\d+),([EW]),[^,]*,[^,]*,(\d{2})(\d{2})(\d+)/ or next;
292 $fix{lat} = ($5 + $6/60) * ($7 eq 'N' ? 1 : -1);
293 $fix{lon} = ($8 + $9/60) * ($10 eq 'E' ? 1 : -1);
294 my $year = $13 + ($13 >= 70 ? 1900 : 2000);
295 $secs = (($1 * 60) + $2) * 60 + $3;
296 $secs += $4 if $4; # add fractional seconds
297 $date = Time::Local::timegm(0,0,0,$11,$12-1,$year-1900);
298#
299# NMEA GGA sentence (no date)
300#
301 } elsif ($nmea eq 'GGA') {
302 # $GPGGA,092204.999,4250.5589,S,14718.5084,E,1,04,24.4,19.7,M,,,,0000*1F
303 # $GPGGA,hhmmss.sss,ddmm.mmmm,N/S,dddmm.mmmm,E/W,0=invalid,sats,hdop,alt,M,...
304 /^\$GPGGA,(\d{2})(\d{2})(\d+)(\.\d+)?,(\d+)(\d{2}\.\d+),([NS]),(\d+)(\d{2}\.\d+),([EW]),[1-6],(\d+)?,(\.\d+|\d+\.?\d*)?,(-?\d+\.?\d*)?,M?,/ or next;
305 $fix{lat} = ($5 + $6/60) * ($7 eq 'N' ? 1 : -1);
306 $fix{lon} = ($8 + $9/60) * ($10 eq 'E' ? 1 : -1);
307 $fix{nsats} = $11;
308 $fix{hdop} = $12;
309 $fix{alt} = $13;
310 $secs = (($1 * 60) + $2) * 60 + $3;
311 $secs += $4 if $4; # add fractional seconds
312 $canCut = 1;
313#
314# NMEA GLL sentence (no date)
315#
316 } elsif ($nmea eq 'GLL') {
317 # $GPGLL,4250.5589,S,14718.5084,E,092204.999,A*2D
318 # $GPGLL,ddmm.mmmm,N/S,dddmm.mmmm,E/W,hhmmss.sss,A/V*cs
319 /^\$GPGLL,(\d+)(\d{2}\.\d+),([NS]),(\d+)(\d{2}\.\d+),([EW]),(\d{2})(\d{2})(\d+)(\.\d+),A/ or next;
320 $fix{lat} = ($1 + $2/60) * ($3 eq 'N' ? 1 : -1);
321 $fix{lon} = ($4 + $5/60) * ($6 eq 'E' ? 1 : -1);
322 $secs = (($7 * 60) + $8) * 60 + $9;
323 $secs += $10 if $10; # add fractional seconds
324#
325# NMEA GSA sentence (satellite status, no date)
326#
327 } elsif ($nmea eq 'GSA') {
328 # $GPGSA,A,3,04,05,,,,,,,,,,,pdop,hdop,vdop*HH
329 /^\$GPGSA,[AM],([23]),((?:\d*,){11}(?:\d*)),(\d+\.?\d*|\.\d+)?,(\d+\.?\d*|\.\d+)?,(\d+\.?\d*|\.\d+)?\*/ or next;
330 @fix{qw(fixtype sats pdop hdop vdop)} = ($1.'d',$2,$3,$4,$5);
331 # count the number of acquired satellites
332 my @a = ($fix{sats} =~ /\d+/g);
333 $fix{nsats} = scalar @a;
334 $canCut = 1;
335
336 } else {
337 next; # this shouldn't happen
338 }
339 # use last date if necessary (and appropriate)
340 if (defined $secs and not defined $date and defined $lastDate) {
341 # wrap to next day if necessary
342 if ($secs < $lastSecs) {
343 $lastSecs -= $secPerDay;
344 $lastDate += $secPerDay;
345 }
346 # use earlier date only if we are within 10 seconds
347 if ($secs - $lastSecs < 10) {
348 # last date is close, use it for this fix
349 $date = $lastDate;
350 } else {
351 # last date is old, discard it
352 undef $lastDate;
353 undef $lastSecs;
354 }
355 }
356 # save our last date/time
357 if (defined $date) {
358 $lastDate = $date;
359 $lastSecs = $secs;
360 }
361#
362# Add NMEA fix to our lookup
363# (this is much more complicated than it needs to be because
364# the stupid NMEA format provides no end-of-fix indication)
365#
366 # assumptions for each NMEA sentence:
367 # - we only parse a time if we get a lat/lon
368 # - we always get a time if we have a date
369 if ($nmea eq $nmeaStart or (defined $secs and (not defined $fixSecs or
370 # don't combine sentences that are outside 10 seconds apart
371 ($secs >= $fixSecs and $secs - $fixSecs >= 10) or
372 ($secs < $fixSecs and $secs + $secPerDay - $fixSecs >= 10))))
373 {
374 # start a new fix
375 $fix = \%fix;
376 $fixSecs = $secs;
377 undef $noDateChanged;
378 # does this fix have a date/time or time stamp?
379 if (defined $date) {
380 $fix{isDate} = $isDate = 1;
381 $time = $date + $secs;
382 } elsif (defined $secs) {
383 $time = $secs;
384 $noDate = $noDateChanged = 1;
385 } else {
386 next; # wait until we have a time before adding to lookup
387 }
388 } else {
389 # add new data to existing fix (but don't overwrite earlier values to
390 # keep the coordinates in sync with the fix time)
391 foreach (keys %fix) {
392 $$fix{$_} = $fix{$_} unless defined $$fix{$_};
393 }
394 if (defined $date) {
395 next if $$fix{isDate};
396 # move this fix to the proper date
397 if (defined $fixSecs) {
398 delete $$points{$fixSecs};
399 pop @fixTimes if @fixTimes and $fixTimes[-1] == $fixSecs;
400 --$numPoints;
401 # if we wrapped to the next day since the start of this fix,
402 # we must shift the date back to the day of $fixSecs
403 $date -= $secPerDay if $secs < $fixSecs;
404 } else {
405 $fixSecs = $secs;
406 }
407 $time = $date + $fixSecs;
408 $$fix{isDate} = $isDate = 1;
409 # revert noDate flag if it was set for this fix
410 $noDate = 0 if $noDateChanged;
411 } elsif (defined $secs and not defined $fixSecs) {
412 $time = $fixSecs = $secs;
413 $noDate = $noDateChanged = 1;
414 } else {
415 next; # wait until we have a time
416 }
417 }
418 # add fix to our lookup
419 $$points{$time} = $fix;
420 push @fixTimes, $time; # save time of all fixes in order
421 ++$numPoints;
422 }
423 $raf->Close();
424
425 # set date flags
426 if ($noDate and not $$geotag{NoDate}) {
427 if ($isDate) {
428 $exifTool->Warn('Fixes are date-less -- will use time-only interpolation');
429 } else {
430 $exifTool->Warn('Some fixes are date-less -- may use time-only interpolation');
431 }
432 $$geotag{NoDate} = 1;
433 }
434 $$geotag{IsDate} = 1 if $isDate;
435
436 # cut bad fixes if necessary
437 if ($isCut and $canCut) {
438 $cutPDOP = $cutHDOP = $cutSats = 0;
439 my @goodTimes;
440 foreach (@fixTimes) {
441 $fix = $$points{$_} or next;
442 if ($maxPDOP and $$fix{pdop} and $$fix{pdop} > $maxPDOP) {
443 delete $$points{$_};
444 ++$cutPDOP;
445 } elsif ($maxHDOP and $$fix{hdop} and $$fix{hdop} > $maxHDOP) {
446 delete $$points{$_};
447 ++$cutHDOP;
448 } elsif ($minSats and defined $$fix{nsats} and $$fix{nsats} ne '' and
449 $$fix{nsats} < $minSats)
450 {
451 delete $$points{$_};
452 ++$cutSats;
453 } else {
454 push @goodTimes, $_;
455 }
456 }
457 @fixTimes = @goodTimes; # update fix times
458 $numPoints -= $cutPDOP;
459 $numPoints -= $cutHDOP;
460 $numPoints -= $cutSats;
461 }
462 # mark first fix of the track
463 while (@fixTimes) {
464 $fix = $$points{$fixTimes[0]} or shift(@fixTimes), next;
465 $$fix{first} = 1;
466 last;
467 }
468 my $verbose = $exifTool->Options('Verbose');
469 if ($verbose) {
470 my $out = $exifTool->Options('TextOut');
471 print $out "Loaded $numPoints points from GPS track log $from\n";
472 print $out "Ignored $cutPDOP points due to GeoMaxPDOP cut\n" if $cutPDOP;
473 print $out "Ignored $cutHDOP points due to GeoMaxHDOP cut\n" if $cutHDOP;
474 print $out "Ignored $cutSats points due to GeoMinSats cut\n" if $cutSats;
475 if ($numPoints and $verbose > 1) {
476 print $out ' GPS track start: ' . Image::ExifTool::ConvertUnixTime($fixTimes[0]) . " UTC\n";
477 if ($verbose > 3) {
478 foreach $time (@fixTimes) {
479 $fix = $$points{$time} or next;
480 print $out ' ',Image::ExifTool::ConvertUnixTime($time),' UTC -';
481 foreach (sort keys %$fix) {
482 print $out " $_=$$fix{$_}" unless $_ eq 'time';
483 }
484 print $out "\n";
485 }
486 }
487 print $out ' GPS track end: ' . Image::ExifTool::ConvertUnixTime($fixTimes[-1]) . " UTC\n";
488 }
489 }
490 if ($numPoints) {
491 # reset timestamp list to force it to be regenerated
492 delete $$geotag{Times};
493 return $geotag; # success!
494 }
495 return "No track points found in GPS $from";
496}
497
498#------------------------------------------------------------------------------
499# Apply Geosync time correction
500# Inputs: 0) ExifTool ref, 1) Unix UTC time value
501# Returns: sync time difference (and updates input time), or undef if no sync
502sub ApplySyncCorr($$)
503{
504 my ($exifTool, $time) = @_;
505 my $sync = $exifTool->GetNewValues('Geosync');
506 if (ref $sync eq 'HASH') {
507 my $syncTimes = $$sync{Times};
508 if ($syncTimes) {
509 # find the nearest 2 sync points
510 my ($i0, $i1) = (0, scalar(@$syncTimes) - 1);
511 while ($i1 > $i0 + 1) {
512 my $pt = int(($i0 + $i1) / 2);
513 if ($time < $$syncTimes[$pt]) {
514 $i1 = $pt;
515 } else {
516 $i0 = $pt;
517 }
518 }
519 my ($t0, $t1) = ($$syncTimes[$i0], $$syncTimes[$i1]);
520 # interpolate/extrapolate to account for linear camera clock drift
521 my $syncPoints = $$sync{Points};
522 my $f = $t1 == $t0 ? 0 : ($time - $t0) / ($t1 - $t0);
523 $sync = $$syncPoints{$t1} * $f + $$syncPoints{$t0} * (1 - $f);
524 } else {
525 $sync = $$sync{Offset}; # use fixed time offset
526 }
527 $_[1] += $sync;
528 } else {
529 undef $sync;
530 }
531 return $sync;
532}
533
534#------------------------------------------------------------------------------
535# Set new geotagging values according to date/time
536# Inputs: 0) ExifTool object ref, 1) date/time value (or undef to delete tags)
537# 2) optional write group
538# Returns: error string, or '' on success
539# Notes: Uses track data stored in ExifTool NEW_VALUE for Geotag tag
540sub SetGeoValues($$;$)
541{
542 local $_;
543 my ($exifTool, $val, $writeGroup) = @_;
544 my $geotag = $exifTool->GetNewValues('Geotag');
545 my ($fix, $time, $fsec, $noDate, $secondTry);
546
547 # remove date if none of our fixes had date information
548 $val =~ s/^\S+\s+// if $val and $geotag and not $$geotag{IsDate};
549
550 # maximum time (sec) from nearest GPS fix when position is still considered valid
551 my $geoMaxIntSecs = $exifTool->Options('GeoMaxIntSecs');
552 my $geoMaxExtSecs = $exifTool->Options('GeoMaxExtSecs');
553 # use 30 minutes for a default
554 defined $geoMaxIntSecs or $geoMaxIntSecs = 1800;
555 defined $geoMaxExtSecs or $geoMaxExtSecs = 1800;
556
557 my $points = $$geotag{Points};
558 my $err = '';
559 # loop to try date/time value first, then time-only value
560 while (defined $val) {
561 unless (defined $geotag) {
562 $err = 'No GPS track loaded';
563 last;
564 }
565 my $times = $$geotag{Times};
566 unless ($times) {
567 # generate sorted timestamp list for binary search
568 my @times = sort { $a <=> $b } keys %$points;
569 $times = $$geotag{Times} = \@times;
570 }
571 unless ($times and @$times) {
572 $err = 'GPS track is empty';
573 last;
574 }
575 unless (eval 'require Time::Local') {
576 $err = 'Geotag feature requires Time::Local installed';
577 last;
578 }
579 # convert date/time to UTC
580 my ($year,$mon,$day,$hr,$min,$sec,$fs,$tz,$t0,$t1,$t2);
581 if ($val =~ /^(\d{4}):(\d+):(\d+)\s+(\d+):(\d+):(\d+)(\.\d*)?(Z|([-+])(\d+):(\d+))?/) {
582 # valid date/time value
583 ($year,$mon,$day,$hr,$min,$sec,$fs,$tz,$t0,$t1,$t2) = ($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11);
584 } elsif ($val =~ /^(\d{2}):(\d+):(\d+)(\.\d*)?(Z|([-+])(\d+):(\d+))?/) {
585 # valid time-only value
586 ($hr,$min,$sec,$fs,$tz,$t0,$t1,$t2) = ($1,$2,$3,$4,$5,$6,$7,$8);
587 # use Jan. 2 to avoid going negative after tz adjustment
588 ($year,$mon,$day) = (1970,1,2);
589 $noDate = 1;
590 } else {
591 $err = 'Invalid date/time (use YYYY:mm:dd HH:MM:SS[.ss][+/-HH:MM|Z])';
592 last;
593 }
594 if ($tz) {
595 $time = Time::Local::timegm($sec,$min,$hr,$day,$mon-1,$year-1900);
596 # use timezone from date/time value
597 if ($tz ne 'Z') {
598 my $tzmin = $t1 * 60 + $t2;
599 $time -= ($t0 eq '-' ? -$tzmin : $tzmin) * 60;
600 }
601 } else {
602 # assume local timezone
603 $time = Image::ExifTool::TimeLocal($sec,$min,$hr,$day,$mon-1,$year-1900);
604 }
605 # add fractional seconds
606 $time += $fs if $fs and $fs ne '.';
607
608 # bring UTC time back to Jan. 1 if no date is given
609 $time %= $secPerDay if $noDate;
610
611 # apply time synchronization if available
612 my $sync = ApplySyncCorr($exifTool, $time);
613
614 # save fractional seconds string
615 $fsec = ($time =~ /(\.\d+)$/) ? $1 : '';
616
617 if ($exifTool->Options('Verbose') > 1 and not $secondTry) {
618 my $out = $exifTool->Options('TextOut');
619 my $str = "$fsec UTC";
620 $str .= sprintf(" (incl. Geosync offset of %+.3f sec)", $sync) if defined $sync;
621 print $out ' Geotime value: ' . Image::ExifTool::ConvertUnixTime(int $time) . "$str\n";
622 }
623 # interpolate GPS track at $time
624 if ($time < $$times[0]) {
625 if ($time < $$times[0] - $geoMaxExtSecs) {
626 $err or $err = 'Time is too far before track';
627 } else {
628 $fix = $$points{$$times[0]};
629 }
630 } elsif ($time > $$times[-1]) {
631 if ($time > $$times[-1] + $geoMaxExtSecs) {
632 $err or $err = 'Time is too far beyond track';
633 } else {
634 $fix = $$points{$$times[-1]};
635 }
636 } else {
637 # find nearest 2 points in time
638 my ($i0, $i1) = (0, scalar(@$times) - 1);
639 while ($i1 > $i0 + 1) {
640 my $pt = int(($i0 + $i1) / 2);
641 if ($time < $$times[$pt]) {
642 $i1 = $pt;
643 } else {
644 $i0 = $pt;
645 }
646 }
647 # do linear interpolation for position
648 my $t0 = $$times[$i0];
649 my $t1 = $$times[$i1];
650 my $p1 = $$points{$t1};
651 # check to see if we are extrapolating before the first entry in a track
652 my $maxSecs = $$p1{first} ? $geoMaxExtSecs : $geoMaxIntSecs;
653 # don't interpolate if fixes are too far apart
654 if ($t1 - $t0 > $maxSecs) {
655 # treat as an extrapolation -- use nearest fix if close enough
656 my $tn = ($time - $t0 < $t1 - $time) ? $t0 : $t1;
657 if (abs($time - $tn) > $geoMaxExtSecs) {
658 $err or $err = 'Time is too far from nearest GPS fix';
659 } else {
660 $fix = $$points{$tn};
661 }
662 } else {
663 my $f = $t1 == $t0 ? 0 : ($time - $t0) / ($t1 - $t0);
664 my $p0 = $$points{$t0};
665 $fix = { };
666 # loop through latitude, longitude, and altitude if available
667 foreach (qw(lat lon alt)) {
668 next unless defined $$p0{$_} and defined $$p1{$_};
669 $$fix{$_} = $$p1{$_} * $f + $$p0{$_} * (1 - $f);
670 }
671 }
672 }
673 if ($fix) {
674 $err = ''; # success!
675 } elsif ($$geotag{NoDate} and not $noDate and $val =~ s/^\S+\s+//) {
676 # try again with no date since some of our track points are date-less
677 $secondTry = 1;
678 next;
679 }
680 last;
681 }
682 if ($fix) {
683 my ($gpsDate, $gpsAlt, $gpsAltRef);
684 my @t = gmtime(int $time);
685 my $gpsTime = sprintf('%.2d:%.2d:%.2d', $t[2], $t[1], $t[0]) . $fsec;
686 # write GPSDateStamp if date included in track log, otherwise delete it
687 $gpsDate = sprintf('%.2d:%.2d:%.2d', $t[5]+1900, $t[4]+1, $t[3]) unless $noDate;
688 # write GPSAltitude tags if altitude included in track log, otherwise delete them
689 if (defined $$fix{alt}) {
690 $gpsAlt = abs $$fix{alt};
691 $gpsAltRef = ($$fix{alt} < 0 ? 1 : 0);
692 }
693 # set new GPS tag values (EXIF, or XMP if write group is 'xmp')
694 my ($xmp, $exif, @r);
695 my %opts = ( Type => 'ValueConv' ); # write ValueConv values
696 if ($writeGroup) {
697 $opts{Group} = $writeGroup;
698 $xmp = ($writeGroup =~ /xmp/i);
699 $exif = ($writeGroup =~ /^(exif|gps)$/i);
700 }
701 # (capture error messages by calling SetNewValue in list context)
702 @r = $exifTool->SetNewValue(GPSLatitude => $$fix{lat}, %opts);
703 @r = $exifTool->SetNewValue(GPSLongitude => $$fix{lon}, %opts);
704 @r = $exifTool->SetNewValue(GPSAltitude => $gpsAlt, %opts);
705 @r = $exifTool->SetNewValue(GPSAltitudeRef => $gpsAltRef, %opts);
706 unless ($xmp) {
707 @r = $exifTool->SetNewValue(GPSLatitudeRef => ($$fix{lat} > 0 ? 'N' : 'S'), %opts);
708 @r = $exifTool->SetNewValue(GPSLongitudeRef => ($$fix{lon} > 0 ? 'E' : 'W'), %opts);
709 @r = $exifTool->SetNewValue(GPSDateStamp => $gpsDate, %opts);
710 @r = $exifTool->SetNewValue(GPSTimeStamp => $gpsTime, %opts);
711 # set options to edit XMP:GPSDateTime only if it already exists
712 $opts{EditOnly} = 1;
713 $opts{Group} = 'XMP';
714 }
715 unless ($exif) {
716 @r = $exifTool->SetNewValue(GPSDateTime => "$gpsDate $gpsTime", %opts);
717 }
718 } else {
719 my %opts;
720 $opts{Replace} = 2 if defined $val; # remove existing new values
721 $opts{Group} = $writeGroup if $writeGroup;
722 # reset any GPS values we might have already set
723 foreach (qw(GPSLatitude GPSLatitudeRef GPSLongitude GPSLongitudeRef
724 GPSAltitude GPSAltitudeRef GPSDateStamp GPSTimeStamp GPSDateTime))
725 {
726 my @r = $exifTool->SetNewValue($_, undef, %opts);
727 }
728 }
729 return $err;
730}
731
732#------------------------------------------------------------------------------
733# Convert Geotagging time synchronization value
734# Inputs: 0) exiftool object ref,
735# 1) time difference string ("[+-]DD MM:HH:SS.ss"), geosync'd file name,
736# "GPSTIME@IMAGETIME", or "GPSTIME@FILENAME"
737# Returns: geosync hash
738# Notes: calling this routine with more than one geosync'd file causes time drift
739# correction to be implemented
740sub ConvertGeosync($$)
741{
742 my ($exifTool, $val) = @_;
743 my $sync = $exifTool->GetNewValues('Geosync') || { };
744 my ($syncFile, $gpsTime, $imgTime);
745
746 if ($val =~ /(.*?)\@(.*)/) {
747 $gpsTime = $1;
748 if (-f $2) {
749 $syncFile = $2;
750 } else {
751 $imgTime = $2;
752 }
753 # (take care because "-f '1:30'" crashes ActivePerl 5.10)
754 } elsif ($val !~ /^\d/ or $val !~ /:/) {
755 $syncFile = $val if -f $val;
756 }
757 if ($gpsTime or defined $syncFile) {
758 # (this is a time synchronization vector)
759 if (defined $syncFile) {
760 # check the following tags in order to obtain the image timestamp
761 my @timeTags = qw(SubSecDateTimeOriginal SubSecCreateDate SubSecModifyDate
762 DateTimeOriginal CreateDate ModifyDate FileModifyDate);
763 my $info = ImageInfo($syncFile, { PrintConv => 0 }, @timeTags,
764 'GPSDateTime', 'GPSTimeStamp');
765 $$info{Error} and warn("$$info{Err}\n"), return undef;
766 $gpsTime or $gpsTime = $$info{GPSDateTime} || $$info{GPSTimeStamp};
767 my $tag;
768 foreach $tag (@timeTags) {
769 if ($$info{$tag}) {
770 $imgTime = $$info{$tag};
771 $exifTool->VPrint(2, "Geosyncing with $tag from '$syncFile'\n");
772 last;
773 }
774 }
775 $gpsTime or warn("No GPSTimeStamp in '$syncFile\n"), return undef;
776 $imgTime or warn("No image timestamp in '$syncFile'\n"), return undef;
777 }
778 # add date to date-less timestamps
779 my ($imgDateTime, $gpsDateTime, $noDate);
780 if ($imgTime =~ /^(\d+:\d+:\d+)\s+\d+/) {
781 $imgDateTime = $imgTime;
782 my $date = $1;
783 if ($gpsTime =~ /^\d+:\d+:\d+\s+\d+/) {
784 $gpsDateTime = $gpsTime;
785 } else {
786 $gpsDateTime = "$date $gpsTime";
787 }
788 } elsif ($gpsTime =~ /^(\d+:\d+:\d+)\s+\d+/) {
789 $imgDateTime = "$1 $imgTime";
790 $gpsDateTime = $gpsTime;
791 } else {
792 # use a today's date (so hopefully the DST setting will be intuitive)
793 my @tm = localtime;
794 my $date = sprintf('%.4d:%.2d:%.2d', $tm[5]+1900, $tm[4]+1, $tm[3]);
795 $gpsDateTime = "$date $gpsTime";
796 $imgDateTime = "$date $imgTime";
797 $noDate = 1;
798 }
799 # calculate Unix seconds since the epoch
800 my $imgSecs = Image::ExifTool::GetUnixTime($imgDateTime, 1);
801 defined $imgSecs or warn("Invalid image time '$imgTime'\n"), return undef;
802 my $gpsSecs = Image::ExifTool::GetUnixTime($gpsDateTime, 1);
803 defined $gpsSecs or warn("Invalid GPS time '$gpsTime'\n"), return undef;
804 # add fractional seconds
805 $gpsSecs += $1 if $gpsTime =~ /(\.\d+)/;
806 $imgSecs += $1 if $imgTime =~ /(\.\d+)/;
807 # shift dates within 12 hours of each other if either timestamp was date-less
808 if ($gpsDateTime ne $gpsTime or $imgDateTime ne $imgTime) {
809 my $diff = ($imgSecs - $gpsSecs) % (24 * 3600);
810 $diff -= 24 * 3600 if $diff > 12 * 3600;
811 $diff += 24 * 3600 if $diff < -12 * 3600;
812 if ($gpsDateTime ne $gpsTime) {
813 $gpsSecs = $imgSecs - $diff;
814 } else {
815 $imgSecs = $gpsSecs + $diff;
816 }
817 }
818 # save the synchronization offset
819 $$sync{Offset} = $gpsSecs - $imgSecs;
820 # save this synchronization point if either timestamp had a date
821 unless ($noDate) {
822 $$sync{Points} or $$sync{Points} = { };
823 $$sync{Points}{$imgSecs} = $$sync{Offset};
824 # print verbose output
825 if ($exifTool->Options('Verbose') > 1) {
826 # print GPS and image timestamps in UTC
827 my $gps = Image::ExifTool::ConvertUnixTime($gpsSecs);
828 my $img = Image::ExifTool::ConvertUnixTime($imgSecs);
829 $gps .= $1 if $gpsTime =~ /(\.\d+)/;
830 $img .= $1 if $imgTime =~ /(\.\d+)/;
831 $exifTool->VPrint(1, "Added Geosync point:\n",
832 " GPS time stamp: $gps UTC\n",
833 " Image date/time: $img UTC\n");
834 }
835 # save sorted list of image sync times if we have more than one
836 my @times = keys %{$$sync{Points}};
837 if (@times > 1) {
838 @times = sort { $a <=> $b } @times;
839 $$sync{Times} = \@times;
840 }
841 }
842 } else {
843 # (this is a simple time difference)
844 my @vals = $val =~ /(?=\d|\.\d)\d*(?:\.\d*)?/g; # (allow decimal values too)
845 @vals or warn("Invalid value (please refer to geotag documentation)\n"), return undef;
846 my $secs = 0;
847 my $mult;
848 foreach $mult (1, 60, 3600, $secPerDay) {
849 $secs += $mult * pop(@vals);
850 last unless @vals;
851 }
852 # set constant sync offset
853 $$sync{Offset} = $val =~ /^\s*-/ ? -$secs : $secs;
854 }
855 return $sync;
856}
857
858#------------------------------------------------------------------------------
8591; # end
860
861__END__
862
863=head1 NAME
864
865Image::ExifTool::Geotag - Geotagging utility routines
866
867=head1 SYNOPSIS
868
869This module is used by Image::ExifTool
870
871=head1 DESCRIPTION
872
873This module loads GPS track logs, interpolates to determine position based
874on time, and sets new GPS values for geotagging images. Currently supported
875formats are GPX, NMEA RMC/GGA/GLL, KML, IGC, Garmin XML and TCX, and
876Magellan PMGNTRK.
877
878Methods in this module should not be called directly. Instead, the Geotag
879feature is accessed by writing the values of the ExifTool Geotag, Geosync
880and Geotime tags (see the L<Extra Tags|Image::ExifTool::TagNames/Extra Tags>
881in the tag name documentation).
882
883=head1 AUTHOR
884
885Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
886
887This library is free software; you can redistribute it and/or modify it
888under the same terms as Perl itself.
889
890=head1 REFERENCES
891
892=over 4
893
894=item L<http://www.topografix.com/GPX/1/1/>
895
896=item L<http://www.gpsinformation.org/dale/nmea.htm#GSA>
897
898=item L<http://code.google.com/apis/kml/documentation/kmlreference.html>
899
900=item L<http://www.fai.org/gliding/system/files/tech_spec_gnss.pdf>
901
902=back
903
904=head1 ACKNOWLEDGEMENTS
905
906Thanks to Lionel Genet for the ability to read IGC format track logs.
907
908=head1 SEE ALSO
909
910L<Image::ExifTool::TagNames/Extra Tags>,
911L<Image::ExifTool(3pm)|Image::ExifTool>
912
913=cut
914
Note: See TracBrowser for help on using the repository browser.