exiftool_vendored 12.83.0 → 12.85.0

Sign up to get free protection for your applications and to get access to all the features.
@@ -38,7 +38,7 @@
38
38
  # 9 int16u - v1.02: 0x7fff = index in subregion (admin2), 0x8000 = high bit of time zone
39
39
  # 9 int16u - v1.03: index in subregion (admin2)
40
40
  # 11 int8u - low byte of time zone index
41
- # 12 int8u - 0x0f = feature code index (see below), v1.03: 0x80 = high bit of time zone
41
+ # 12 int8u - 0x3f = feature code index (see below), v1.03: 0x80 = high bit of time zone
42
42
  # 13 string - UTF8 City name, terminated by newline
43
43
  # "\0\0\0\0\x01"
44
44
  # Country entries:
@@ -55,10 +55,10 @@
55
55
  # 1. Time zone name, terminated by newline
56
56
  # "\0\0\0\0\x05" (feature codes added in v1.03)
57
57
  # Feature codes:
58
- # 1. Feature code, terminated by newline
58
+ # 1. Feature code, optional space-followed-by-feature-name, then newline
59
59
  # "\0\0\0\0\0"
60
60
  #
61
- # Feature Codes (v1.02): (see http://www.geonames.org/export/codes.html#P for descriptions)
61
+ # Feature Codes v1.02: (see http://www.geonames.org/export/codes.html#P for descriptions)
62
62
  #
63
63
  # 0. Other 3. PPLA2 6. PPLA5 9. PPLF 12. PPLR 15. PPLX
64
64
  # 1. PPL 4. PPLA3 7. PPLC 10. PPLG 13. PPLS
@@ -70,7 +70,7 @@ package Image::ExifTool::Geolocation;
70
70
  use strict;
71
71
  use vars qw($VERSION $geoDir $altDir $dbInfo);
72
72
 
73
- $VERSION = '1.06'; # (this is the module version number, not the database version)
73
+ $VERSION = '1.08'; # (this is the module version number, not the database version)
74
74
 
75
75
  my $debug; # set to output processing time for testing
76
76
 
@@ -78,11 +78,11 @@ sub ReadDatabase($);
78
78
  sub SortDatabase($);
79
79
  sub AddEntry(@);
80
80
  sub GetEntry($;$$);
81
- sub Geolocate($;$$$$$);
81
+ sub Geolocate($;$);
82
82
 
83
83
  my (@cityList, @countryList, @regionList, @subregionList, @timezoneList);
84
84
  my (%countryNum, %regionNum, %subregionNum, %timezoneNum); # reverse lookups
85
- my (@sortOrder, @altNames, %langLookup, $nCity, %featureCodes);
85
+ my (@sortOrder, @altNames, %langLookup, $nCity, %featureCodes, %featureTypes);
86
86
  my ($lastArgs, %lastFound, @lastByPop, @lastByLat); # cached city matches
87
87
  my $dbVer = '1.03';
88
88
  my $sortedBy = 'Latitude';
@@ -200,6 +200,7 @@ sub ReadDatabase($)
200
200
  $line = <DATFILE>;
201
201
  last if length($line) == 6 and $line =~ /\0\0\0\0/;
202
202
  chomp $line;
203
+ $featureTypes{$line} = $1 if $line =~ s/ (.*)//;
203
204
  push @featureCodes, $line;
204
205
  }
205
206
  }
@@ -242,10 +243,10 @@ sub ReadAltNames()
242
243
  # Clear last city matches cache
243
244
  sub ClearLastMatches()
244
245
  {
245
- undef $lastArgs;
246
- undef %lastFound;
247
- undef @lastByPop;
248
- undef @lastByLat;
246
+ undef $lastArgs; # arguments in last call to Geolocate
247
+ undef %lastFound; # keys are last matching city numbers, values are population codes
248
+ undef @lastByPop; # last matching city numbers ordered by population
249
+ undef @lastByLat; # last matching city numbers ordered by latitude
249
250
  }
250
251
 
251
252
  #------------------------------------------------------------------------------
@@ -287,7 +288,16 @@ sub AddEntry(@)
287
288
  my ($city, $region, $subregion, $cc, $country, $timezone, $fc, $pop, $lat, $lon, $altNames) = @_;
288
289
  @_ < 10 and warn("Too few arguments in $city definition (check for updated format)\n"), return 0;
289
290
  length($cc) != 2 and warn("Country code '${cc}' is not 2 characters\n"), return 0;
290
- $fc = $featureCodes{lc $fc} || 0;
291
+ $featureTypes{$fc} = $1 if $fc =~ s/ (.*)//;
292
+ my $fn = $featureCodes{lc $fc};
293
+ unless (defined $fn) {
294
+ if ($dbVer eq '1.02' or @featureCodes > 0x3f or not length $fc) {
295
+ $fn = 0;
296
+ } else {
297
+ push @featureCodes, uc($fc);
298
+ $featureCodes{lc $fc} = $fn = $#featureCodes;
299
+ }
300
+ }
291
301
  chomp $lon; # (just in case it was read from file)
292
302
  # create reverse lookups for country/region/subregion/timezone if not done already
293
303
  # (eg. if the entries are being added manually instead of via UserDefined::Geolocation)
@@ -320,7 +330,7 @@ sub AddEntry(@)
320
330
  }
321
331
  my $sn = $subregionNum{lc $subregion};
322
332
  unless (defined $sn) {
323
- my $max = $dbVer eq '1.02' ? 0x0fff : 0xffff;
333
+ my $max = $dbVer eq '1.02' ? 0x7fff : 0xffff;
324
334
  $#subregionList >= $max and warn("AddEntry: Too many subregions\n"), return 0;
325
335
  push @subregionList, $subregion;
326
336
  $sn = $subregionNum{lc $subregion} = $#subregionList;
@@ -333,13 +343,13 @@ sub AddEntry(@)
333
343
  if ($dbVer eq '1.02') {
334
344
  $sn |= 0x8000;
335
345
  } else {
336
- $fc |= 0x80;
346
+ $fn |= 0x80;
337
347
  }
338
348
  $tn -= 256;
339
349
  }
340
350
  $lat = int(($lat + 90) / 180 * 0x100000 + 0.5) & 0xfffff;
341
351
  $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff;
342
- my $hdr = pack('nCnNnCC', $lat>>4, (($lat&0x0f)<<4)|($lon&0x0f), $lon>>4, $code, $sn, $tn, $fc);
352
+ my $hdr = pack('nCnNnCC', $lat>>4, (($lat&0x0f)<<4)|($lon&0x0f), $lon>>4, $code, $sn, $tn, $fn);
343
353
  push @cityList, "$hdr$city";
344
354
  # add altNames entry if provided
345
355
  if ($altNames) {
@@ -362,30 +372,31 @@ sub AddEntry(@)
362
372
  # Inputs: 0) entry number or index into sorted database,
363
373
  # 1) optional language code, 2) flag to use index into sorted database
364
374
  # Returns: 0-10) city,region,subregion,country_code,country,timezone,
365
- # feature_code,pop,lat,lon,altNames
375
+ # feature_code,pop,lat,lon,feature_type
366
376
  sub GetEntry($;$$)
367
377
  {
368
378
  my ($entryNum, $lang, $sort) = @_;
369
379
  return() if $entryNum > $#cityList;
370
380
  $entryNum = $sortOrder[$entryNum] if $sort and @sortOrder > $entryNum;
371
- my ($lt,$f,$ln,$code,$sn,$tn,$fc) = unpack('nCnNnCC', $cityList[$entryNum]);
381
+ my ($lt,$f,$ln,$code,$sn,$tn,$fn) = unpack('nCnNnCC', $cityList[$entryNum]);
372
382
  my $city = substr($cityList[$entryNum],13);
373
383
  my $ctry = $countryList[$code >> 24];
374
384
  my $rgn = $regionList[$code & 0x0fff];
375
385
  if ($dbVer eq '1.02') {
376
386
  $sn & 0x8000 and $tn += 256, $sn &= 0x7fff;
377
387
  } else {
378
- $fc & 0x80 and $tn += 256;
388
+ $fn & 0x80 and $tn += 256;
379
389
  }
380
390
  my $sub = $subregionList[$sn];
381
391
  # convert population digits back into exponent format
382
392
  my $pop = (($code>>16 & 0x0f) . '.' . ($code>>12 & 0x0f) . 'e+' . ($code>>20 & 0x0f)) + 0;
383
393
  $lt = sprintf('%.4f', (($lt<<4)|($f >> 4)) * 180 / 0x100000 - 90);
384
394
  $ln = sprintf('%.4f', (($ln<<4)|($f & 0x0f))* 360 / 0x100000 - 180);
385
- $fc = $featureCodes[$fc & 0x1f];
395
+ my $fc = $featureCodes[$fn & 0x3f] || 'Other';
386
396
  my $cc = substr($ctry, 0, 2);
387
397
  my $country = substr($ctry, 2);
388
- if ($lang) {
398
+ my $ft = $featureTypes{$fc};
399
+ if ($lang and $lang ne 'en') {
389
400
  my $xlat = $langLookup{$lang};
390
401
  # load language lookups if not done already
391
402
  if (not defined $xlat) {
@@ -419,9 +430,10 @@ sub GetEntry($;$$)
419
430
  $sub = $$xlat{"$cc$rgn,$sub,"} || $$xlat{$sub} || $sub;
420
431
  $rgn = $$xlat{"$cc$rgn,"} || $$xlat{$rgn} || $rgn;
421
432
  $country = $$xlat{"$cc,"} || $$xlat{$country} || $country;
433
+ $ft = $$xlat{$fc} if $$xlat{$fc};
422
434
  }
423
435
  }
424
- return($city,$rgn,$sub,$cc,$country,$timezoneList[$tn],$fc,$pop,$lt,$ln);
436
+ return($city,$rgn,$sub,$cc,$country,$timezoneList[$tn],$fc,$pop,$lt,$ln,$ft);
425
437
  }
426
438
 
427
439
  #------------------------------------------------------------------------------
@@ -442,17 +454,16 @@ sub GetAltNames($;$)
442
454
  # Look up lat,lon or city in geolocation database
443
455
  # Inputs: 0) "lat,lon", "city,region,country", etc, (city must be first)
444
456
  # 1) options hash reference (or undef for no options)
445
- # Options: GeolocMinPop, GeolocMaxDist, GeolocMulti, GeolocFeature, GeolocAltNames
446
- # Returns: 0) number of matching cities (0 if no matches),
447
- # 1) index of matching city in database, or undef if no matches, or
448
- # reference to list of indices if multiple matches were found and
449
- # the flag to return multiple matches was set,
450
- # 2) approx distance (km), 3) compass bearing to city
451
- sub Geolocate($;$$$$$)
457
+ # Options: GeolocMinPop, GeolocMaxDist, GeolocMulti, GeolocFeature, GeolocAltNames,
458
+ # GeolocNearby
459
+ # Returns: List of matching city information, empty if none found.
460
+ # Each element in the list is an array with 0=index of city in database,
461
+ # 1=distance in km (or undef if no distance), 2=compass bearing (or undef)
462
+ sub Geolocate($;$)
452
463
  {
453
464
  my ($arg, $opts) = @_;
454
465
  my ($city, @exact, %regex, @multiCity, $other, $idx, @cargs, $useLastFound);
455
- my ($minPop, $minDistU, $minDistC, @matchParms, @coords, $fcmask, $both);
466
+ my ($minPop, $minDistU, $minDistC, @matchParms, @coords, %fcOK, $both);
456
467
  my ($pop, $maxDist, $multi, $fcodes, $altNames, @startTime);
457
468
 
458
469
  $opts and ($pop, $maxDist, $multi, $fcodes, $altNames) =
@@ -462,7 +473,7 @@ sub Geolocate($;$$$$$)
462
473
  require Time::HiRes;
463
474
  @startTime = Time::HiRes::gettimeofday();
464
475
  }
465
- @cityList or warn('No Geolocation database'), return 0;
476
+ @cityList or warn('No Geolocation database'), return();
466
477
  # make population code for comparing with 2 bytes at offset 6 in database
467
478
  if ($pop) {
468
479
  $pop = sprintf('%.1e', $pop);
@@ -470,17 +481,18 @@ sub Geolocate($;$$$$$)
470
481
  }
471
482
  if ($fcodes) {
472
483
  my $neg = $fcodes =~ s/^-//;
473
- my @fcodes = split /\s*,\s*/, $fcodes;
484
+ my @fcodes = split /\s*,-?\s*/, lc $fcodes; # (allow leading dash on subsequent codes)
474
485
  if ($neg) {
475
- $fcmask = 0xffff;
476
- defined $featureCodes{lc $_} and $fcmask &= ~((1 << $featureCodes{lc $_})) foreach @fcodes;
486
+ $fcOK{$_} = 1 foreach 0..$#featureCodes;
487
+ defined $featureCodes{$_} and delete $fcOK{$featureCodes{$_}} foreach @fcodes;
477
488
  } else {
478
- defined $featureCodes{lc $_} and $fcmask |= (1 << $featureCodes{lc $_}) foreach @fcodes;
489
+ defined $featureCodes{$_} and $fcOK{$featureCodes{$_}} = 1 foreach @fcodes;
479
490
  }
480
491
  }
481
492
  #
482
493
  # process input argument
483
494
  #
495
+ my $num = 1;
484
496
  $arg =~ s/^\s+//; $arg =~ s/\s+$//; # remove leading/trailing spaces
485
497
  my @args = split /\s*,\s*/, $arg;
486
498
  my %ri = ( cc => 0, co => 1, re => 2, sr => 3, ci => 8, '' => 9 );
@@ -499,6 +511,8 @@ sub Geolocate($;$$$$$)
499
511
  push @coords, $_ if @coords < 2;
500
512
  } elsif (lc $_ eq 'both') {
501
513
  $both = 1;
514
+ } elsif ($_ =~ /^num=(\d+)$/i) {
515
+ $num = $1;
502
516
  } elsif ($_) {
503
517
  push @cargs, $_;
504
518
  if ($city) {
@@ -510,7 +524,7 @@ sub Geolocate($;$$$$$)
510
524
  }
511
525
  unless (defined $city or @coords == 2) {
512
526
  warn("Insufficient information to determine geolocation\n");
513
- return 0;
527
+ return();
514
528
  }
515
529
  # sort database by logitude if finding entry based on coordinates
516
530
  SortDatabase('Latitude') if @coords == 2 and ($both or not defined $city);
@@ -564,7 +578,7 @@ Entry: for (; $i<@cityList; ++$i) {
564
578
  $str !~ $_ or next Entry foreach @{$regex{19}};
565
579
  }
566
580
  # test feature code and population
567
- next if $fcmask and not $fcmask & (1 << (ord(substr($cityList[$i],12,1)) & 0x0f));
581
+ next if $fcodes and not $fcOK{ord(substr($cityList[$i],12,1)) & 0x3f};
568
582
  my $pc = substr($cityList[$i],6,2);
569
583
  if (not defined $minPop or $pc ge $minPop) {
570
584
  $lastFound{$i} = $pc;
@@ -574,16 +588,14 @@ Entry: for (; $i<@cityList; ++$i) {
574
588
  @startTime and printf("= Processing time: %.3f sec\n", Time::HiRes::tv_interval(\@startTime));
575
589
  if (%lastFound) {
576
590
  @coords == 2 and $useLastFound = 1, last; # continue to use coords with last city matches
577
- scalar(keys %lastFound) > 200 and warn("Too many matching cities\n"), return 0;
591
+ scalar(keys %lastFound) > 200 and warn("Too many matching cities\n"), return();
578
592
  unless (@lastByPop) {
579
593
  @lastByPop = sort { $lastFound{$b} cmp $lastFound{$a} or $cityList[$a] cmp $cityList[$b] } keys %lastFound;
580
594
  }
581
- my $n = scalar @lastByPop;
582
- return($n, [ @lastByPop ]) if $n > 1 and $multi;
583
- return($n, $lastByPop[0]);
595
+ return(\@lastByPop);
584
596
  }
585
597
  warn "No such city in Geolocation database\n";
586
- return 0;
598
+ return();
587
599
  }
588
600
  #
589
601
  # determine Geolocation based on GPS coordinates
@@ -619,9 +631,11 @@ Entry: for (; $i<@cityList; ++$i) {
619
631
  my ($inc, $end, $n) = (-1, -1, $n0+1);
620
632
  my ($p0, $t0) = ($lat*$pi/0x100000 - $pi/2, $lon*$pi/0x080000 - $pi);
621
633
  my $cp0 = cos($p0);
634
+ my (@matches, @rtnList, @dist);
635
+
622
636
  for (;;) {
623
637
  if (($n += $inc) == $end) {
624
- last if $inc == 1;
638
+ last if $inc == 1 or $n0 == $n1;
625
639
  ($inc, $end, $n) = (1, $numEntries, $n1);
626
640
  }
627
641
  my $i = $sorted ? $$sorted[$n] : $n;
@@ -632,28 +646,56 @@ Entry: for (; $i<@cityList; ++$i) {
632
646
  abs($lt - $lat) > $minDistC and $n = $end - $inc, next;
633
647
  # ignore if population is below threshold
634
648
  next if defined $minPop and $minPop ge substr($cityList[$i],6,2);
635
- next if $fcmask and not $fcmask & (1 << (ord(substr($cityList[$i],12,1)) & 0x0f));
649
+ next if $fcodes and not $fcOK{ord(substr($cityList[$i],12,1)) & 0x3f};
636
650
  $ln = ($ln << 4) | ($f & 0x0f);
637
651
  # calculate great circle distance to this city on unit sphere
638
652
  my ($p1, $t1) = ($lt*$pi/0x100000 - $pi/2, $ln*$pi/0x080000 - $pi);
639
653
  my ($sp, $st) = (sin(($p1-$p0)/2), sin(($t1-$t0)/2));
640
654
  my $a = $sp * $sp + $cp0 * cos($p1) * $st * $st;
641
- my $distU = atan2(sqrt($a), sqrt(1-$a));
655
+ my $distU = atan2(sqrt($a), sqrt(1-$a)); # distance on unit sphere
642
656
  next if $distU > $minDistU;
643
- $minDistU = $distU;
644
- $minDistC = $minDistU * 0x200000 / $pi;
645
657
  @matchParms = ($i, $p1, $t1, $distU);
658
+ if ($num <= 1) {
659
+ $minDistU = $distU;
660
+ } else {
661
+ my $j;
662
+ # add this entry into list of matching cities ordered by closest first
663
+ for ($j=0; $j<@matches; ++$j) {
664
+ last if $distU < $matches[$j][3];
665
+ }
666
+ if ($j < $#matches) {
667
+ splice @matches, $j, 0, [ @matchParms ];
668
+ } else {
669
+ $matches[$j] = [ @matchParms ];
670
+ }
671
+ # restrict list to the specified number of nearest cities
672
+ pop @matches if @matches > $num;
673
+ # update minimum distance with furthest match if we satisfied our quota
674
+ $minDistU = $matches[-1][3] if @matches >= $num;
675
+ }
676
+ $minDistC = $minDistU * 0x200000 / $pi; # distance in scaled coordinate units
646
677
  }
647
- @matchParms or warn("No suitable location in Geolocation database\n"), return 0;
648
-
649
- # calculate distance in km and bearing to matching city
650
- my ($ii, $p1, $t1, $distU) = @matchParms;
651
- my $km = sprintf('%.2f', 2 * $earthRadius * $distU);
652
- my $be = atan2(sin($t1-$t0)*cos($p1-$p0), $cp0*sin($p1)-sin($p0)*cos($p1)*cos($t1-$t0));
653
- $be = int($be * 180 / $pi + 360.5) % 360; # convert from radians to integer degrees
678
+ @matchParms or warn("No suitable location in Geolocation database\n"), return();
679
+ $num = @matches;
654
680
 
655
681
  @startTime and printf("- Processing time: %.3f sec\n", Time::HiRes::tv_interval(\@startTime));
656
- return(1, $ii, $km, $be)
682
+
683
+ for (;;) {
684
+ if ($num > 1) {
685
+ last unless @matches;
686
+ @matchParms = @{$matches[0]};
687
+ shift @matches;
688
+ }
689
+ # calculate distance in km and bearing to matching city
690
+ my ($ii, $p1, $t1, $distU) = @matchParms;
691
+ my $km = sprintf('%.2f', 2 * $earthRadius * $distU);
692
+ my $be = atan2(sin($t1-$t0)*cos($p1-$p0), $cp0*sin($p1)-sin($p0)*cos($p1)*cos($t1-$t0));
693
+ $be = int($be * 180 / $pi + 360.5) % 360; # convert from radians to integer degrees
694
+ push @rtnList, $ii;
695
+ push @dist, [ $km, $be ];
696
+ last if $num <= 1;
697
+ }
698
+ return(\@rtnList, \@dist);
657
699
  }
658
700
 
659
701
  1; #end
@@ -823,6 +865,8 @@ item Return Values:
823
865
 
824
866
  9) GPS longitude
825
867
 
868
+ 10) Feature type, or undef
869
+
826
870
  =back
827
871
 
828
872
  =head2 GetAltNames
@@ -866,37 +910,46 @@ zero or more of the following in any order, separated by commas: region
866
910
  name, subregion name, country code, and/or country name. Regular
867
911
  expressions in C</expr/> format are also allowed, optionally prefixed by
868
912
  "ci", "re", "sr", "cc" or "co" to specifically match City, Region,
869
- Subregion, CountryCode or Country name. See
870
- L<https://exiftool.org/geolocation.html#Read> for details.
913
+ Subregion, CountryCode or Country name. Two special controls may be added
914
+ to the argument list:
871
915
 
872
- 1) Optional reference to hash of options:
916
+ 'both' - When search input includes both name and GPS coordinates, use
917
+ both to determine the closest city matching the specified
918
+ name(s) instead of using GPS only.
873
919
 
874
- GeolocMinPop - minimum population of cities to consider in search
920
+ 'num=##' - When the search includes GPS coordinates, return the nearest
921
+ ## cities instead of just the closest one. Returned cities
922
+ are in the order from nearest to farthest.
875
923
 
876
- GeolocMaxDist - maximum distance (km) to search for cities when an input
877
- GPS position is used
924
+ See L<https://exiftool.org/geolocation.html#Read> for more details.
878
925
 
879
- GeolocMulti - flag to return multiple cities if there is more than one
880
- match. In this case the return value is a list of city
881
- information lists.
926
+ 1) Optional reference to hash of options:
882
927
 
883
- GeolocFeature - comma-separated list of feature codes to include in
884
- search, or exclude if the list starts with a dash (-)
928
+ GeolocMinPop - Minimum population of cities to consider in search.
929
+ Default 0.
885
930
 
886
- GeolocAltNames - flag to search alternate names database if available
887
- for matching city name (see ALTERNATE DATABASES below)
931
+ GeolocMaxDist - Maximum distance (km) to search for cities when an
932
+ input GPS position is used. Default infinity.
888
933
 
889
- =item Return Value:
934
+ GeolocMulti - Flag to return multiple cities if there is more than
935
+ one match. Used in the case where no input GPS
936
+ coordinates are provided. Default 0.
937
+
938
+ GeolocFeature - Comma-separated list of feature codes to include in
939
+ search, or exclude if the list starts with a dash (-).
940
+ Default undef.
890
941
 
891
- 0) Number of matching entries, or 0 if no matches
942
+ GeolocAltNames - Flag to search alternate names database if available
943
+ for matching city name (see ALTERNATE DATABASES below).
944
+ Default undef.
892
945
 
893
- 1) Entry number for matching city in database, or undef if no matches, or a
894
- reference to a list of entry numbers of matching cities if multiple matches
895
- were found and the flag was set to return multiple matches
946
+ =item Return Values:
896
947
 
897
- 2) Distance to closest city in km if "lat,lon" specified
948
+ 0) Reference to list of database entry numbers for matching cities, or undef
949
+ if no matches were found.
898
950
 
899
- 3) Compass bearing for direction to closest city if "lat,lon" specified
951
+ 1) Reference to list of distance/bearing pairs for each matching city, or
952
+ undef if the search didn't provide GPS coordinates.
900
953
 
901
954
  =back
902
955
 
@@ -909,11 +962,11 @@ language translations. The $geoDir variable may be set to an empty string
909
962
  to disable loading of a database.
910
963
 
911
964
  When searching for a city by name, AltNames.dat is checked to provide
912
- additional possibilities for matches if the GeolocAltNames option is set.
913
- The package $altDir variable may be set to specify a different directory for
914
- AltNames.dat, otherwise the Geolocation.dat directory is assumed. The
915
- entries in AltNames.dat must match those in the currently loaded version of
916
- Geolocation.dat.
965
+ additional possibilities for matches if the GeolocAltNames option is set and
966
+ an AltNames.dat database exists. The package $altDir variable may be set to
967
+ specify a different directory for AltNames.dat, otherwise the
968
+ Geolocation.dat directory is assumed. The entries in AltNames.dat must
969
+ match those in the currently loaded version of Geolocation.dat.
917
970
 
918
971
  =head1 ADDING USER-DEFINED DATABASE ENTRIES
919
972
 
@@ -924,7 +977,7 @@ technique before the Geolocation module is loaded.
924
977
  # city, region, subregion, country code, country, timezone,
925
978
  ['Sinemorets','burgas','Obshtina Tsarevo','BG','','Europe/Sofia',
926
979
  # feature code, population, lat, lon
927
- '',400,42.06115,27.97833],
980
+ 'PPL',400,42.06115,27.97833],
928
981
  );
929
982
 
930
983
  Similarly, user-defined language translations may be defined, and will
@@ -15,6 +15,7 @@
15
15
  # 2019/11/10 - PH Also write pitch to CameraElevationAngle
16
16
  # 2020/12/01 - PH Added ability to read DJI CSV log files
17
17
  # 2022/06/21 - PH Added ability to read Google Takeout JSON files
18
+ # 2024/04/23 - PH Added ability to read more OpenTracks GPS tags
18
19
  #
19
20
  # References: 1) http://www.topografix.com/GPX/1/1/
20
21
  # 2) http://www.gpsinformation.org/dale/nmea.htm#GSA
@@ -29,7 +30,7 @@ use vars qw($VERSION);
29
30
  use Image::ExifTool qw(:Public);
30
31
  use Image::ExifTool::GPS;
31
32
 
32
- $VERSION = '1.75';
33
+ $VERSION = '1.76';
33
34
 
34
35
  sub JITTER() { return 2 } # maximum time jitter
35
36
 
@@ -66,6 +67,8 @@ my %xmlTag = (
66
67
  course => 'dir', # (written by Arduino)
67
68
  pitch => 'pitch', # (written by Arduino)
68
69
  roll => 'roll', # (written by Arduino)
70
+ speed => 'speed', # (OpenTrack gpx)
71
+ accuracy_horizontal => 'err',#(OpenTrack gpx)
69
72
  # XML containers (fix is reset at the opening tag of these properties)
70
73
  wpt => '', # GPX
71
74
  trkpt => '', # GPX
@@ -85,6 +88,7 @@ my %fixInfoKeys = (
85
88
  alt => [ 'alt' ],
86
89
  orient => [ 'dir', 'pitch', 'roll' ],
87
90
  atemp => [ 'atemp' ],
91
+ err => [ 'err' ],
88
92
  );
89
93
 
90
94
  my %isOrient = ( dir => 1, pitch => 1, roll => 1 ); # test for orientation key
@@ -346,8 +350,8 @@ sub LoadTrackLog($$;$)
346
350
  # validate altitude
347
351
  undef $$fix{alt} if defined $$fix{alt} and $$fix{alt} !~ /^[+-]?\d+\.?\d*/;
348
352
  $$has{alt} = 1 if $$fix{alt}; # set "has altitude" flag if appropriate
349
- } elsif ($tag eq 'atemp') {
350
- $$has{atemp} = 1;
353
+ } elsif ($tag eq 'atemp' or $tag eq 'speed' or $tag eq 'err') {
354
+ $$has{$tag} = 1;
351
355
  }
352
356
  }
353
357
  }
@@ -392,8 +396,8 @@ sub LoadTrackLog($$;$)
392
396
  # validate altitude
393
397
  undef $$fix{alt} if defined $$fix{alt} and $$fix{alt} !~ /^[+-]?\d+\.?\d*/;
394
398
  $$has{alt} = 1 if $$fix{alt}; # set "has altitude" flag if appropriate
395
- } elsif ($tag eq 'atemp') {
396
- $$has{atemp} = 1;
399
+ } elsif ($tag eq 'atemp' or $tag eq 'speed' or $tag eq 'err') {
400
+ $$has{$tag} = 1;
397
401
  }
398
402
  }
399
403
  }
@@ -1126,7 +1130,7 @@ sub SetGeoValues($$;$)
1126
1130
  # loop through available fix information categories
1127
1131
  # (pos, track, alt, orient)
1128
1132
  my ($category, $key);
1129
- Category: foreach $category (qw{pos track alt orient atemp}) {
1133
+ Category: foreach $category (qw{pos track alt orient atemp err}) {
1130
1134
  next unless $$has{$category};
1131
1135
  my ($f, $p0b, $p1b, $f0b);
1132
1136
  # loop through specific fix information keys
@@ -1236,10 +1240,11 @@ Category: foreach $category (qw{pos track alt orient atemp}) {
1236
1240
  @r = $et->SetNewValue(GPSLongitude => $$fix{lon}, %opts);
1237
1241
  @r = $et->SetNewValue(GPSAltitude => $gpsAlt, %opts);
1238
1242
  @r = $et->SetNewValue(GPSAltitudeRef => $gpsAltRef, %opts);
1239
- if ($$has{track}) {
1243
+ if ($$has{track} or $$has{speed}) {
1244
+ my $type = $$has{track} ? 'track' : 'speed';
1240
1245
  my $tFix = $fix;
1241
- if (not defined $$fix{track} and defined $iExt) {
1242
- my $p = FindFix($et,'track',$times,$points,$iExt,$iDir,$geoMaxExtSecs);
1246
+ if (not defined $$fix{$type} and defined $iExt) {
1247
+ my $p = FindFix($et,$type,$times,$points,$iExt,$iDir,$geoMaxExtSecs);
1243
1248
  $tFix = $p if $p;
1244
1249
  }
1245
1250
  @r = $et->SetNewValue(GPSTrack => $$tFix{track}, %opts);
@@ -1280,6 +1285,9 @@ Category: foreach $category (qw{pos track alt orient atemp}) {
1280
1285
  }
1281
1286
  @r = $et->SetNewValue(AmbientTemperature => $$tFix{atemp}, %opts);
1282
1287
  }
1288
+ if ($$has{err}) {
1289
+ @r = $et->SetNewValue(GPSHPositioningError => $$fix{err}, %opts);
1290
+ }
1283
1291
  unless ($xmp) {
1284
1292
  my ($latRef, $lonRef);
1285
1293
  $latRef = ($$fix{lat} > 0 ? 'N' : 'S') if defined $$fix{lat};
@@ -1305,7 +1313,7 @@ Category: foreach $category (qw{pos track alt orient atemp}) {
1305
1313
  GPSAltitude GPSAltitudeRef GPSDateStamp GPSTimeStamp GPSDateTime
1306
1314
  GPSTrack GPSTrackRef GPSSpeed GPSSpeedRef GPSImgDirection
1307
1315
  GPSImgDirectionRef GPSPitch GPSRoll CameraElevationAngle
1308
- AmbientTemperature GPSCoordinates))
1316
+ AmbientTemperature GPSHPositioningError GPSCoordinates))
1309
1317
  {
1310
1318
  my @r = $et->SetNewValue($_, undef, %opts);
1311
1319
  }
@@ -103,6 +103,14 @@ my %dateTimeConv = (
103
103
  },
104
104
  );
105
105
 
106
+ %Image::ExifTool::ID3::UserDefined = (
107
+ GROUPS => { 1 => 'UserDefined', 2 => 'Other' },
108
+ NOTES => q{
109
+ ID3 user-defined text and URL tags will be dynamically added to this table
110
+ by name when found.
111
+ },
112
+ );
113
+
106
114
  # Lyrics3 tags (ref 4)
107
115
  %Image::ExifTool::ID3::Lyrics3 = (
108
116
  GROUPS => { 1 => 'Lyrics3', 2 => 'Audio' },
@@ -493,7 +501,7 @@ my %genre = (
493
501
  TT2 => 'Title',
494
502
  TT3 => 'Subtitle',
495
503
  TXT => 'Lyricist',
496
- TXX => 'UserDefinedText',
504
+ TXX => { SubDirectory => { TagTable => 'Image::ExifTool::ID3::UserDefined' } },
497
505
  TYE => { Name => 'Year', Groups => { 2 => 'Time' } },
498
506
  ULT => 'Lyrics',
499
507
  WAF => 'FileURL',
@@ -502,7 +510,7 @@ my %genre = (
502
510
  WCM => 'CommercialURL',
503
511
  WCP => { Name => 'CopyrightURL', Groups => { 2 => 'Author' } },
504
512
  WPB => 'PublisherURL',
505
- WXX => 'UserDefinedURL',
513
+ WXX => { SubDirectory => { TagTable => 'Image::ExifTool::ID3::UserDefined' } },
506
514
  # the following written by iTunes 10.5 (ref PH)
507
515
  RVA => 'RelativeVolumeAdjustment',
508
516
  TST => 'TitleSortOrder',
@@ -605,7 +613,7 @@ my %id3v2_common = (
605
613
  TRSO => 'InternetRadioStationOwner',
606
614
  TSRC => 'ISRC', # (international standard recording code)
607
615
  TSSE => 'EncoderSettings',
608
- TXXX => 'UserDefinedText',
616
+ TXXX => { SubDirectory => { TagTable => 'Image::ExifTool::ID3::UserDefined' } },
609
617
  # UFID => 'UniqueFileID', (not extracted because it is long and nasty and not very useful)
610
618
  USER => 'TermsOfUse',
611
619
  USLT => 'Lyrics',
@@ -617,7 +625,7 @@ my %id3v2_common = (
617
625
  WORS => 'InternetRadioStationURL',
618
626
  WPAY => 'PaymentURL',
619
627
  WPUB => 'PublisherURL',
620
- WXXX => 'UserDefinedURL',
628
+ WXXX => { SubDirectory => { TagTable => 'Image::ExifTool::ID3::UserDefined' } },
621
629
  #
622
630
  # non-standard frames
623
631
  #
@@ -1247,7 +1255,14 @@ sub ProcessID3v2($$$)
1247
1255
  # two encoded strings separated by a null
1248
1256
  my @vals = DecodeString($et, $val);
1249
1257
  foreach (0..1) { $vals[$_] = '' unless defined $vals[$_]; }
1250
- ($val = "($vals[0]) $vals[1]") =~ s/^\(\) //;
1258
+ $vals[0] .= ' ' if $Image::ExifTool::specialTags{$vals[0]};
1259
+ my $tbl = GetTagTable('Image::ExifTool::ID3::UserDefined');
1260
+ unless (defined $$tbl{$vals[0]}) {
1261
+ my $name = Image::ExifTool::MakeTagName($vals[0]);
1262
+ AddTagToTable($tbl, $vals[0], $name, 1);
1263
+ }
1264
+ $et->HandleTag($tbl, $vals[0], $vals[1]);
1265
+ next;
1251
1266
  } elsif ($id =~ /^T/ or $id =~ /^(IPL|IPLS|GP1|MVI|MVN)$/) {
1252
1267
  $val = DecodeString($et, $val);
1253
1268
  } elsif ($id =~ /^(WXX|WXXX)$/) {
@@ -1265,7 +1280,14 @@ sub ProcessID3v2($$$)
1265
1280
  }
1266
1281
  $val = DecodeString($et, $val);
1267
1282
  $url =~ s/\0.*//s;
1268
- $val = length($val) ? "($val) $url" : $url;
1283
+ $val .= '_URL';
1284
+ my $tbl = GetTagTable('Image::ExifTool::ID3::UserDefined');
1285
+ unless (defined $$tbl{$val}) {
1286
+ my $name = Image::ExifTool::MakeTagName($val);
1287
+ AddTagToTable($tbl, $val, $name, 1);
1288
+ }
1289
+ $et->HandleTag($tbl, $val, $url);
1290
+ next;
1269
1291
  } elsif ($id =~ /^W/) {
1270
1292
  $val =~ s/\0.*//s; # truncate at null
1271
1293
  } elsif ($id =~ /^(COM|COMM|ULT|USLT)$/) {
@@ -65,7 +65,7 @@ use Image::ExifTool::Exif;
65
65
  use Image::ExifTool::GPS;
66
66
  use Image::ExifTool::XMP;
67
67
 
68
- $VERSION = '4.33';
68
+ $VERSION = '4.34';
69
69
 
70
70
  sub LensIDConv($$$);
71
71
  sub ProcessNikonAVI($$$);
@@ -13688,6 +13688,24 @@ sub ProcessNikonCaptureOffsets($$$)
13688
13688
  return $success;
13689
13689
  }
13690
13690
 
13691
+ #------------------------------------------------------------------------------
13692
+ # Read Nikon NKA file
13693
+ # Inputs: 0) ExifTool ref, 1) dirInfo ref
13694
+ # Returns: 1 on success
13695
+ sub ProcessNKA($$)
13696
+ {
13697
+ my ($et, $dirInfo) = @_;
13698
+ my $raf = $$et{RAF};
13699
+ my $buff;
13700
+ $raf->Read($buff, 0x35) == 0x35 or return 0;
13701
+ my $len = unpack('x49V', $buff);
13702
+ $raf->Read($buff, $len) == $len or return 0;
13703
+ $et->SetFileType('NKA', 'application/x-nikon-nxstudio');
13704
+ my %dirInfo = ( DataPt => \$buff, DataPos => 0x35 );
13705
+ my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::XML');
13706
+ return $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
13707
+ }
13708
+
13691
13709
  #------------------------------------------------------------------------------
13692
13710
  # Read/write Nikon MakerNotes directory
13693
13711
  # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref