exiftool_vendored 12.80.0 → 12.82.0

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
@@ -1,9 +1,11 @@
1
1
  #------------------------------------------------------------------------------
2
2
  # File: Geolocation.pm
3
3
  #
4
- # Description: Look up geolocation information based on a GPS position
4
+ # Description: Determine geolocation from GPS and visa-versa
5
5
  #
6
6
  # Revisions: 2024-03-03 - P. Harvey Created
7
+ # 2024-03-21 - PH Significant restructuring and addition of
8
+ # several new features.
7
9
  #
8
10
  # References: https://download.geonames.org/export/
9
11
  #
@@ -11,10 +13,17 @@
11
13
  # default directory for the database file Geolocation.dat
12
14
  # and language directory GeoLang.
13
15
  #
14
- # Based on data from geonames.org Creative Commons databases,
15
- # reformatted as follows in the Geolocation.dat file:
16
+ # Set $Image::ExifTool::Geolocation::altDir to use a database
17
+ # of alternate city names. The file is called AltNames.dat
18
+ # with entries in the same order as Geolocation.dat. Each
19
+ # entry is a newline-separated list of alternate names
20
+ # terminated by a null byte.
16
21
  #
17
- # Header:
22
+ # Databases are based on data from geonames.org with a
23
+ # Creative Commons license, reformatted as follows in the
24
+ # Geolocation.dat file:
25
+ #
26
+ # Header:
18
27
  # "GeolocationV.VV\tNNNN\n" (V.VV=version, NNNN=num city entries)
19
28
  # "# <comment>\n"
20
29
  # NNNN City entries:
@@ -25,9 +34,10 @@
25
34
  # 5 int8u - index of country in country list
26
35
  # 6 int8u - 0xf0 = population E exponent (in format "N.Fe+0E"), 0x0f = population N digit
27
36
  # 7 int16u - 0xf000 = population F digit, 0x0fff = index in region list (admin1)
28
- # 9 int16u - 0x7fff = index in subregion (admin2), 0x8000 = high bit of time zone
37
+ # 9 int16u - v1.02: 0x7fff = index in subregion (admin2), 0x8000 = high bit of time zone
38
+ # 9 int16u - v1.03: index in subregion (admin2)
29
39
  # 11 int8u - low byte of time zone index
30
- # 12 int8u - 0x0f - feature code index (see below)
40
+ # 12 int8u - 0x0f = feature code index (see below), v1.03: 0x80 = high bit of time zone
31
41
  # 13 string - UTF8 City name, terminated by newline
32
42
  # "\0\0\0\0\x01"
33
43
  # Country entries:
@@ -46,7 +56,7 @@
46
56
  #
47
57
  # Feature Codes: (see http://www.geonames.org/export/codes.html#P for descriptions)
48
58
  #
49
- # 0. Other 3. PPLA2 6. PPLA5 9. PPLF 12. PPLR
59
+ # 0. Other 3. PPLA2 6. PPLA5 9. PPLF 12. PPLR 15. PPLX
50
60
  # 1. PPL 4. PPLA3 7. PPLC 10. PPLG 13. PPLS
51
61
  # 2. PPLA 5. PPLA4 8. PPLCH 11. PPLL 14. STLMT
52
62
  #------------------------------------------------------------------------------
@@ -54,26 +64,29 @@
54
64
  package Image::ExifTool::Geolocation;
55
65
 
56
66
  use strict;
57
- use vars qw($VERSION $geoDir $dbInfo);
67
+ use vars qw($VERSION $geoDir $altDir $dbInfo);
58
68
 
59
- $VERSION = '1.02';
69
+ $VERSION = '1.04'; # (this is the module version number, not the database version)
60
70
 
61
- my $databaseVersion = '1.02';
71
+ my $debug; # set to output processing time for testing
62
72
 
63
73
  sub ReadDatabase($);
64
74
  sub SortDatabase($);
65
75
  sub AddEntry(@);
66
- sub GetEntry($;$);
76
+ sub GetEntry($;$$);
67
77
  sub Geolocate($;$$$$$);
68
78
 
69
79
  my (@cityList, @countryList, @regionList, @subregionList, @timezoneList);
70
- my (%countryNum, %regionNum, %subregionNum, %timezoneNum, %langLookup);
80
+ my (%countryNum, %regionNum, %subregionNum, %timezoneNum); # reverse lookups
81
+ my (@sortOrder, @altNames, %langLookup, $nCity);
82
+ my ($lastArgs, %lastFound, @lastByPop, @lastByLat); # cached city matches
83
+ my $dbVer = '1.03';
71
84
  my $sortedBy = 'Latitude';
72
85
  my $pi = 3.1415926536;
73
86
  my $earthRadius = 6371; # earth radius in km
74
87
 
75
- my @featureCodes = qw(Other PPL PPLA PPLA2 PPLA3 PPLA4 PPLA5
76
- PPLC PPLCH PPLF PPLG PPLL PPLR PPLS STLMT ?);
88
+ my @featureCodes = qw(Other PPL PPLA PPLA2 PPLA3 PPLA4 PPLA5 PPLC
89
+ PPLCH PPLF PPLG PPLL PPLR PPLS STLMT PPLX);
77
90
  my $i = 0;
78
91
  my %featureCodes = map { lc($_) => $i++ } @featureCodes;
79
92
 
@@ -115,7 +128,7 @@ sub ReadDatabase($)
115
128
  {
116
129
  my $datfile = shift;
117
130
  # open geolocation database and verify header
118
- open DATFILE, "<$datfile" or warn("Error reading $datfile\n"), return 0;
131
+ open DATFILE, "< $datfile" or warn("Error reading $datfile\n"), return 0;
119
132
  binmode DATFILE;
120
133
  my $line = <DATFILE>;
121
134
  unless ($line =~ /^Geolocation(\d+\.\d+)\t(\d+)/) {
@@ -123,20 +136,23 @@ sub ReadDatabase($)
123
136
  close(DATFILE);
124
137
  return 0;
125
138
  }
126
- if ($1 != $databaseVersion) {
127
- my $which = $1 < $databaseVersion ? 'database' : 'ExifTool';
139
+ ($dbVer, $nCity) = ($1, $2);
140
+ if ($dbVer !~ /^1\.0[23]$/) {
141
+ my $which = $dbVer < 1.03 ? 'database' : 'ExifTool';
128
142
  warn("Incompatible Geolocation database (update your $which)\n");
129
143
  close(DATFILE);
130
144
  return 0;
131
145
  }
132
- my $ncity = $2;
133
146
  my $comment = <DATFILE>;
134
147
  defined $comment and $comment =~ /(\d+)/ or close(DATFILE), return 0;
135
- $dbInfo = "$datfile v$databaseVersion: $ncity cities with population > $1";
148
+ $dbInfo = "$datfile v$dbVer: $nCity cities with population > $1";
136
149
  my $isUserDefined = @Image::ExifTool::UserDefined::Geolocation;
137
-
150
+
151
+ undef @altNames; # reset altNames
152
+
138
153
  # read city database
139
154
  undef @cityList;
155
+ my $i = 0;
140
156
  for (;;) {
141
157
  $line = <DATFILE>;
142
158
  last if length($line) == 6 and $line =~ /\0\0\0\0/;
@@ -144,7 +160,7 @@ sub ReadDatabase($)
144
160
  chomp $line;
145
161
  push @cityList, $line;
146
162
  }
147
- @cityList == $ncity or warn("Bad number of entries in Geolocation database\n"), return 0;
163
+ @cityList == $nCity or warn("Bad number of entries in Geolocation database\n"), return 0;
148
164
  # read countries
149
165
  for (;;) {
150
166
  $line = <DATFILE>;
@@ -181,6 +197,44 @@ sub ReadDatabase($)
181
197
  return 1;
182
198
  }
183
199
 
200
+ #------------------------------------------------------------------------------
201
+ # Read alternate-names database
202
+ # Returns: True on success
203
+ # Notes: Must be called after ReadDatabase(). Resets $altDir on exit.
204
+ sub ReadAltNames()
205
+ {
206
+ my $success;
207
+ if ($altDir and $nCity) {
208
+ if (open ALTFILE, "< $altDir/AltNames.dat") {
209
+ binmode ALTFILE;
210
+ local $/ = "\0";
211
+ my $i = 0;
212
+ while (<ALTFILE>) { chop; $altNames[$i++] = $_; }
213
+ close ALTFILE;
214
+ if ($i == $nCity) {
215
+ $success = 1;
216
+ } else {
217
+ warn("Bad number of entries in AltNames database\n");
218
+ undef @altNames;
219
+ }
220
+ } else {
221
+ warn "Error reading $altDir/AltNames.dat\n";
222
+ }
223
+ undef $altDir;
224
+ }
225
+ return $success;
226
+ }
227
+
228
+ #------------------------------------------------------------------------------
229
+ # Clear last city matches cache
230
+ sub ClearLastMatches()
231
+ {
232
+ undef $lastArgs;
233
+ undef %lastFound;
234
+ undef @lastByPop;
235
+ undef @lastByLat;
236
+ }
237
+
184
238
  #------------------------------------------------------------------------------
185
239
  # Sort database by specified field
186
240
  # Inputs: 0) Field name to sort (Latitude,City,Country)
@@ -189,37 +243,37 @@ sub SortDatabase($)
189
243
  {
190
244
  my $field = shift;
191
245
  return 1 if $field eq $sortedBy; # already sorted?
246
+ undef @sortOrder;
192
247
  if ($field eq 'Latitude') {
193
- @cityList = sort { $a cmp $b } @cityList;
248
+ @sortOrder = sort { $cityList[$a] cmp $cityList[$b] } 0..$#cityList;
194
249
  } elsif ($field eq 'City') {
195
- @cityList = sort { substr($a,13) cmp substr($b,13) } @cityList;
250
+ @sortOrder = sort { substr($cityList[$a],13) cmp substr($cityList[$b],13) } 0..$#cityList;
196
251
  } elsif ($field eq 'Country') {
197
252
  my %lkup;
198
- foreach (@cityList) {
199
- my $city = substr($_,13);
200
- my $ctry = substr($countryList[ord substr($_,5,1)], 2);
253
+ foreach (0..$#cityList) {
254
+ my $city = substr($cityList[$_],13);
255
+ my $ctry = substr($countryList[ord substr($cityList[$_],5,1)], 2);
201
256
  $lkup{$_} = "$ctry $city";
202
257
  }
203
- @cityList = sort { $lkup{$a} cmp $lkup{$b} } @cityList;
258
+ @sortOrder = sort { $lkup{$a} cmp $lkup{$b} } 0..$#cityList;
204
259
  } else {
205
260
  return 0;
206
261
  }
207
262
  $sortedBy = $field;
263
+ ClearLastMatches();
208
264
  return 1;
209
265
  }
210
266
 
211
267
  #------------------------------------------------------------------------------
212
268
  # Add cities to the Geolocation database
213
- # Inputs: 0-8) city,region,subregion,country_code,country,timezone,feature_code,population,lat,lon
269
+ # Inputs: 0-8) city,region,subregion,country_code,country,timezone,feature_code,population,lat,lon,altNames
214
270
  # eg. AddEntry('Sinemorets','Burgas','Obshtina Tsarevo','BG','Bulgaria','Europe/Sofia','',400,42.06115,27.97833)
271
+ # Returns: true on success, otherwise issues warning
215
272
  sub AddEntry(@)
216
273
  {
217
- my ($city, $region, $subregion, $cc, $country, $timezone, $fc, $pop, $lat, $lon) = @_;
218
- @_ < 10 and warn("Too few arguments in $city definition (check for updated format)\n"), return;
219
- if (@_ != 10 or length($cc) != 2) {
220
- warn "Country code '${cc}' in UserDefined::Geolocation is not 2 characters\n";
221
- return;
222
- }
274
+ my ($city, $region, $subregion, $cc, $country, $timezone, $fc, $pop, $lat, $lon, $altNames) = @_;
275
+ @_ < 10 and warn("Too few arguments in $city definition (check for updated format)\n"), return 0;
276
+ length($cc) != 2 and warn("Country code '${cc}' is not 2 characters\n"), return 0;
223
277
  $fc = $featureCodes{lc $fc} || 0;
224
278
  chomp $lon; # (just in case it was read from file)
225
279
  # create reverse lookups for country/region/subregion/timezone if not done already
@@ -233,6 +287,7 @@ sub AddEntry(@)
233
287
  }
234
288
  my $cn = $countryNum{lc $cc};
235
289
  unless (defined $cn) {
290
+ $#countryList >= 0xff and warn("AddEntry: Too many countries\n"), return 0;
236
291
  push @countryList, "$cc$country";
237
292
  $cn = $countryNum{lc $cc} = $#countryList;
238
293
  } elsif ($country) {
@@ -240,16 +295,20 @@ sub AddEntry(@)
240
295
  }
241
296
  my $tn = $timezoneNum{lc $timezone};
242
297
  unless (defined $tn) {
298
+ $#timezoneList >= 0x1ff and warn("AddEntry: Too many time zones\n"), return 0;
243
299
  push @timezoneList, $timezone;
244
300
  $tn = $timezoneNum{lc $timezone} = $#timezoneList;
245
301
  }
246
302
  my $rn = $regionNum{lc $region};
247
303
  unless (defined $rn) {
304
+ $#regionList >= 0xfff and warn("AddEntry: Too many regions\n"), return 0;
248
305
  push @regionList, $region;
249
306
  $rn = $regionNum{lc $region} = $#regionList;
250
307
  }
251
308
  my $sn = $subregionNum{lc $subregion};
252
309
  unless (defined $sn) {
310
+ my $max = $dbVer eq '1.02' ? 0x0fff : 0xffff;
311
+ $#subregionList >= $max and warn("AddEntry: Too many subregions\n"), return 0;
253
312
  push @subregionList, $subregion;
254
313
  $sn = $subregionNum{lc $subregion} = $#subregionList;
255
314
  }
@@ -257,30 +316,57 @@ sub AddEntry(@)
257
316
  # pack CC index, population and region index into a 32-bit integer
258
317
  my $code = ($cn << 24) | (substr($pop,-1,1)<<20) | (substr($pop,0,1)<<16) | (substr($pop,2,1)<<12) | $rn;
259
318
  # store high bit of timezone index
260
- $tn > 255 and $sn |= 0x8000, $tn -= 256;
319
+ if ($tn > 255) {
320
+ if ($dbVer eq '1.02') {
321
+ $sn |= 0x8000;
322
+ } else {
323
+ $fc |= 0x80;
324
+ }
325
+ $tn -= 256;
326
+ }
261
327
  $lat = int(($lat + 90) / 180 * 0x100000 + 0.5) & 0xfffff;
262
328
  $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff;
263
329
  my $hdr = pack('nCnNnCC', $lat>>4, (($lat&0x0f)<<4)|($lon&0x0f), $lon>>4, $code, $sn, $tn, $fc);
264
330
  push @cityList, "$hdr$city";
331
+ # add altNames entry if provided
332
+ if ($altNames) {
333
+ chomp $altNames; # (just in case)
334
+ $altNames =~ tr/,/\n/;
335
+ # add any more arguments in case altNames were passed separately (undocumented)
336
+ foreach (11..$#_) {
337
+ chomp $_[$_];
338
+ $altNames .= "\n$_[$_]";
339
+ }
340
+ $altNames[$#cityList] = $altNames;
341
+ }
265
342
  $sortedBy = '';
343
+ undef $lastArgs; # (faster than ClearLastArgs)
344
+ return 1;
266
345
  }
267
346
 
268
347
  #------------------------------------------------------------------------------
269
348
  # Unpack entry in database
270
- # Inputs: 0) entry number, 1) optional language code
271
- # Returns: 0-9) city,region,subregion,country_code,country,timezone,feature_code,pop,lat,lon
272
- sub GetEntry($;$)
349
+ # Inputs: 0) entry number or index into sorted database,
350
+ # 1) optional language code, 2) flag to use index into sorted database
351
+ # Returns: 0-10) city,region,subregion,country_code,country,timezone,
352
+ # feature_code,pop,lat,lon,altNames
353
+ sub GetEntry($;$$)
273
354
  {
274
- my ($entryNum, $lang) = @_;
355
+ my ($entryNum, $lang, $sort) = @_;
275
356
  return() if $entryNum > $#cityList;
276
- my ($lt,$f,$ln,$code,$sb,$tn,$fc) = unpack('nCnNnCC', $cityList[$entryNum]);
357
+ $entryNum = $sortOrder[$entryNum] if $sort and @sortOrder > $entryNum;
358
+ my ($lt,$f,$ln,$code,$sn,$tn,$fc) = unpack('nCnNnCC', $cityList[$entryNum]);
277
359
  my $city = substr($cityList[$entryNum],13);
278
360
  my $ctry = $countryList[$code >> 24];
279
361
  my $rgn = $regionList[$code & 0x0fff];
280
- my $sub = $subregionList[$sb & 0x7fff];
362
+ if ($dbVer eq '1.02') {
363
+ $sn & 0x8000 and $tn += 256, $sn &= 0x7fff;
364
+ } else {
365
+ $fc & 0x80 and $tn += 256;
366
+ }
367
+ my $sub = $subregionList[$sn];
281
368
  # convert population digits back into exponent format
282
369
  my $pop = (($code>>16 & 0x0f) . '.' . ($code>>12 & 0x0f) . 'e+' . ($code>>20 & 0x0f)) + 0;
283
- $tn += 256 if $sb & 0x8000;
284
370
  $lt = sprintf('%.4f', (($lt<<4)|($f >> 4)) * 180 / 0x100000 - 90);
285
371
  $ln = sprintf('%.4f', (($ln<<4)|($f & 0x0f))* 360 / 0x100000 - 180);
286
372
  $fc = $featureCodes[$fc & 0x0f];
@@ -325,31 +411,45 @@ sub GetEntry($;$)
325
411
  return($city,$rgn,$sub,$cc,$country,$timezoneList[$tn],$fc,$pop,$lt,$ln);
326
412
  }
327
413
 
414
+ #------------------------------------------------------------------------------
415
+ # Get alternate names for specified database entry
416
+ # Inputs: 0) entry number or index into sorted database, 1) sort flag
417
+ # Returns: comma-separated list of alternate names, or empty string if no names
418
+ # Notes: ReadAltNames() must be called before this
419
+ sub GetAltNames($;$)
420
+ {
421
+ my ($entryNum, $sort) = @_;
422
+ $entryNum = $sortOrder[$entryNum] if $sort and @sortOrder > $entryNum;
423
+ my $alt = $altNames[$entryNum] or return '';
424
+ $alt =~ tr/\n/,/;
425
+ return $alt;
426
+ }
427
+
328
428
  #------------------------------------------------------------------------------
329
429
  # Look up lat,lon or city in geolocation database
330
430
  # Inputs: 0) "lat,lon", "city,region,country", etc, (city must be first)
331
- # 1) optional min population, 2) optional max distance (km)
332
- # 3) optional language code, 4) flag to return multiple cities
333
- # 5) comma-separated list of feature codes to match (or ignore if leading "-")
334
- # Returns: Reference to list of city information, or list of city information
335
- # lists if returning multiple cities.
336
- # City information list elements:
337
- # 0) UTF8 city name (or undef if geolocation is unsuccessful),
338
- # 1) UTF8 state, province or region (or empty),
339
- # 2) UTF8 subregion (or empty)
340
- # 3) country code, 4) country name,
341
- # 5) time zone name (empty string possible), 6) feature code, 7) population,
342
- # 8/9) approx lat/lon (or undef if geolocation is unsuccessful,
343
- # 10) approx distance (km), 11) compass bearing to city,
344
- # 12) non-zero if multiple matches were possible (and city with
345
- # the largest population is returned)
431
+ # 1) options hash reference (or undef for no options)
432
+ # Options: GeolocMinPop, GeolocMaxDist, GeolocMulti, GeolocFeature, GeolocAltNames
433
+ # Returns: 0) number of matching cities (0 if no matches),
434
+ # 1) index of matching city in database, or undef if no matches, or
435
+ # reference to list of indices if multiple matches were found and
436
+ # the flag to return multiple matches was set,
437
+ # 2) approx distance (km), 3) compass bearing to city
346
438
  sub Geolocate($;$$$$$)
347
439
  {
348
- my ($arg, $pop, $maxDist, $lang, $multi, $fcodes) = @_;
349
- my ($city, $i, %found, @exact, %regex, @multiCity, $other, $idx);
350
- my ($minPop, $minDistU, $minDistC, @matchParms, @matches, @coords, $fcmask, $both);
440
+ my ($arg, $opts) = @_;
441
+ my ($city, @exact, %regex, @multiCity, $other, $idx, @cargs, $useLastFound);
442
+ my ($minPop, $minDistU, $minDistC, @matchParms, @coords, $fcmask, $both);
443
+ my ($pop, $maxDist, $multi, $fcodes, $altNames, @startTime);
444
+
445
+ $opts and ($pop, $maxDist, $multi, $fcodes, $altNames) =
446
+ @$opts{qw(GeolocMinPop GeolocMaxDist GeolocMulti GeolocFeature GeolocAltNames)};
351
447
 
352
- @cityList or warn('No Geolocation database'), return();
448
+ if ($debug) {
449
+ require Time::HiRes;
450
+ @startTime = Time::HiRes::gettimeofday();
451
+ }
452
+ @cityList or warn('No Geolocation database'), return 0;
353
453
  # make population code for comparing with 2 bytes at offset 6 in database
354
454
  if ($pop) {
355
455
  $pop = sprintf('%.1e', $pop);
@@ -376,23 +476,28 @@ sub Geolocate($;$$$$$)
376
476
  if (m{^(-)?(\w{2})?/(.*)/(i?)$}) {
377
477
  my $re = $4 ? qr/$3/im : qr/$3/m;
378
478
  next if not defined($idx = $ri{$2});
479
+ push @cargs, $_;
379
480
  $other = 1 if $idx < 5;
380
481
  $idx += 10 if $1; # add 10 for negative matches
482
+ $regex{$idx} or $regex{$idx} = [ ];
381
483
  push @{$regex{$idx}}, $re;
382
484
  $city = '' unless defined $city;
383
485
  } elsif (/^[-+]?\d+(\.\d+)?$/) { # coordinate format
384
486
  push @coords, $_ if @coords < 2;
385
- } elsif (lc eq 'both') {
487
+ } elsif (lc $_ eq 'both') {
386
488
  $both = 1;
387
- } elsif ($city) {
388
- push @exact, lc $_;
389
- } else {
390
- $city = lc $_;
489
+ } elsif ($_) {
490
+ push @cargs, $_;
491
+ if ($city) {
492
+ push @exact, lc $_;
493
+ } else {
494
+ $city = lc $_;
495
+ }
391
496
  }
392
497
  }
393
498
  unless (defined $city or @coords == 2) {
394
499
  warn("Insufficient information to determine geolocation\n");
395
- return();
500
+ return 0;
396
501
  }
397
502
  # sort database by logitude if finding entry based on coordinates
398
503
  SortDatabase('Latitude') if @coords == 2 and ($both or not defined $city);
@@ -400,16 +505,34 @@ sub Geolocate($;$$$$$)
400
505
  # perform reverse Geolocation lookup to determine GPS based on city, country, etc.
401
506
  #
402
507
  while (defined $city and (@coords != 2 or $both)) {
403
- Entry: for ($i=0; $i<@cityList; ++$i) {
508
+ my $cargs = join(',', @cargs, $pop||'', $maxDist||'', $fcodes||'');
509
+ my $i = 0;
510
+ if ($lastArgs and $lastArgs eq $cargs) {
511
+ $i = @cityList; # bypass search
512
+ } else {
513
+ ClearLastMatches();
514
+ $lastArgs = $cargs;
515
+ }
516
+ # read alternate names database if an exact city match is specified
517
+ if ($altNames) {
518
+ ReadAltNames() if $city and $altDir;
519
+ $altNames = \@altNames;
520
+ } else {
521
+ $altNames = [ ]; # (don't search alt names)
522
+ }
523
+ Entry: for (; $i<@cityList; ++$i) {
404
524
  my $cty = substr($cityList[$i],13);
405
- next if $city and $city ne lc $cty; # test exact city name first
525
+ if ($city and $city ne lc $cty) { # test exact city name first
526
+ next unless $$altNames[$i] and $$altNames[$i] =~ /^$city$/im;
527
+ }
406
528
  # test with city-specific regexes
407
529
  if ($regex{8}) { $cty =~ $_ or next Entry foreach @{$regex{8}} }
408
530
  if ($regex{18}) { $cty !~ $_ or next Entry foreach @{$regex{18}} }
409
531
  # test other arguments
410
- my ($cd,$sb) = unpack('x5Nn', $cityList[$i]);
532
+ my ($cd,$sn) = unpack('x5Nn', $cityList[$i]);
411
533
  my $ct = $countryList[$cd >> 24];
412
- my @geo = (substr($ct,0,2), substr($ct,2), $regionList[$cd & 0x0fff], $subregionList[$sb & 0x7fff]);
534
+ $sn &= 0x7fff if $dbVer eq '1.02';
535
+ my @geo = (substr($ct,0,2), substr($ct,2), $regionList[$cd & 0x0fff], $subregionList[$sn]);
413
536
  if (@exact) {
414
537
  # make quick lookup for all names at this location
415
538
  my %geoLkup;
@@ -430,23 +553,24 @@ Entry: for ($i=0; $i<@cityList; ++$i) {
430
553
  # test feature code and population
431
554
  next if $fcmask and not $fcmask & (1 << (ord(substr($cityList[$i],12,1)) & 0x0f));
432
555
  my $pc = substr($cityList[$i],6,2);
433
- $found{$i} = $pc if not defined $minPop or $pc ge $minPop;
556
+ if (not defined $minPop or $pc ge $minPop) {
557
+ $lastFound{$i} = $pc;
558
+ push @lastByLat, $i if @coords == 2;
559
+ }
434
560
  }
435
- if (%found) {
436
- @matches = keys %found;
437
- @coords == 2 and @matches = sort({ $a <=> $b } @matches), last; # continue to use coords
438
- scalar(keys %found) > 200 and warn("Too many matching cities\n"), return();
439
- @matches = sort { $found{$b} cmp $found{$a} or $cityList[$a] cmp $cityList[$b] } @matches if @matches > 1;
440
- foreach (@matches) {
441
- my @cityInfo = GetEntry($_, $lang);
442
- $cityInfo[12] = @matches if @matches > 1;
443
- return \@cityInfo unless @matches > 1 and $multi;
444
- push @multiCity, \@cityInfo;
561
+ @startTime and printf("= Processing time: %.3f sec\n", Time::HiRes::tv_interval(\@startTime));
562
+ if (%lastFound) {
563
+ @coords == 2 and $useLastFound = 1, last; # continue to use coords with last city matches
564
+ scalar(keys %lastFound) > 200 and warn("Too many matching cities\n"), return 0;
565
+ unless (@lastByPop) {
566
+ @lastByPop = sort { $lastFound{$b} cmp $lastFound{$a} or $cityList[$a] cmp $cityList[$b] } keys %lastFound;
445
567
  }
446
- return \@multiCity;
568
+ my $n = scalar @lastByPop;
569
+ return($n, [ @lastByPop ]) if $n > 1 and $multi;
570
+ return($n, $lastByPop[0]);
447
571
  }
448
572
  warn "No such city in Geolocation database\n";
449
- return();
573
+ return 0;
450
574
  }
451
575
  #
452
576
  # determine Geolocation based on GPS coordinates
@@ -465,12 +589,14 @@ Entry: for ($i=0; $i<@cityList; ++$i) {
465
589
  $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff;
466
590
  $lat or $lat = $coords[0] < 0 ? 1 : 0xfffff; # (zero latitude is a problem for our calculations)
467
591
  my $coord = pack('nCn',$lat>>4,(($lat&0x0f)<<4)|($lon&0x0f),$lon>>4);;
592
+ # start from cached city matches if also using city information
593
+ my $numEntries = @lastByLat || @cityList;
468
594
  # binary search to find closest longitude
469
- my $numEntries = @matches || @cityList;
470
595
  my ($n0, $n1) = (0, $numEntries - 1);
596
+ my $sorted = @lastByLat ? \@lastByLat : (@sortOrder ? \@sortOrder : undef);
471
597
  while ($n1 - $n0 > 1) {
472
598
  my $n = int(($n0 + $n1) / 2);
473
- if ($coord lt $cityList[@matches ? $matches[$n] : $n]) {
599
+ if ($coord lt $cityList[$sorted ? $$sorted[$n] : $n]) {
474
600
  $n1 = $n;
475
601
  } else {
476
602
  $n0 = $n;
@@ -485,15 +611,15 @@ Entry: for ($i=0; $i<@cityList; ++$i) {
485
611
  last if $inc == 1;
486
612
  ($inc, $end, $n) = (1, $numEntries, $n1);
487
613
  }
488
- my $entryNum = @matches ? $matches[$n] : $n;
614
+ my $i = $sorted ? $$sorted[$n] : $n;
489
615
  # get city latitude/longitude
490
- my ($lt,$f,$ln) = unpack('nCn', $cityList[$entryNum]);
616
+ my ($lt,$f,$ln) = unpack('nCn', $cityList[$i]);
491
617
  $lt = ($lt << 4) | ($f >> 4);
492
618
  # searched far enough if latitude alone is further than best distance
493
619
  abs($lt - $lat) > $minDistC and $n = $end - $inc, next;
494
620
  # ignore if population is below threshold
495
- next if defined $minPop and $minPop ge substr($cityList[$entryNum],6,2);
496
- next if $fcmask and not $fcmask & (1 << (ord(substr($cityList[$entryNum],12,1)) & 0x0f));
621
+ next if defined $minPop and $minPop ge substr($cityList[$i],6,2);
622
+ next if $fcmask and not $fcmask & (1 << (ord(substr($cityList[$i],12,1)) & 0x0f));
497
623
  $ln = ($ln << 4) | ($f & 0x0f);
498
624
  # calculate great circle distance to this city on unit sphere
499
625
  my ($p1, $t1) = ($lt*$pi/0x100000 - $pi/2, $ln*$pi/0x080000 - $pi);
@@ -503,20 +629,18 @@ Entry: for ($i=0; $i<@cityList; ++$i) {
503
629
  next if $distU > $minDistU;
504
630
  $minDistU = $distU;
505
631
  $minDistC = $minDistU * 0x200000 / $pi;
506
- @matchParms = ($entryNum, $p1, $t1, $distU);
632
+ @matchParms = ($i, $p1, $t1, $distU);
507
633
  }
508
- @matchParms or warn("No suitable location in Geolocation database\n"), return();
634
+ @matchParms or warn("No suitable location in Geolocation database\n"), return 0;
509
635
 
510
636
  # calculate distance in km and bearing to matching city
511
- my ($en, $p1, $t1, $distU) = @matchParms;
637
+ my ($ii, $p1, $t1, $distU) = @matchParms;
512
638
  my $km = sprintf('%.2f', 2 * $earthRadius * $distU);
513
639
  my $be = atan2(sin($t1-$t0)*cos($p1-$p0), $cp0*sin($p1)-sin($p0)*cos($p1)*cos($t1-$t0));
514
640
  $be = int($be * 180 / $pi + 360.5) % 360; # convert from radians to integer degrees
515
641
 
516
- # unpack return values from database entry
517
- my @cityInfo = GetEntry($en, $lang);
518
- @cityInfo[10,11] = ($km, $be); # add distance and heading
519
- return \@cityInfo;
642
+ @startTime and printf("- Processing time: %.3f sec\n", Time::HiRes::tv_interval(\@startTime));
643
+ return(1, $ii, $km, $be)
520
644
  }
521
645
 
522
646
  1; #end
@@ -525,11 +649,13 @@ __END__
525
649
 
526
650
  =head1 NAME
527
651
 
528
- Image::ExifTool::Geolocation - Look up geolocation based on GPS position
652
+ Image::ExifTool::Geolocation - Determine geolocation from GPS and visa-versa
529
653
 
530
654
  =head1 SYNOPSIS
531
655
 
532
- This module is used by the Image::ExifTool Geolocation feature.
656
+ Look up geolocation information (city, region, subregion, country, etc)
657
+ based on input GPS coordinates, or determine GPS coordinates based on city
658
+ name, etc.
533
659
 
534
660
  =head1 DESCRIPTION
535
661
 
@@ -562,6 +688,29 @@ True on success.
562
688
 
563
689
  =back
564
690
 
691
+ =head2 ReadAltNames
692
+
693
+ Load the alternate names database. Before calling this method the $altDir
694
+ package variable must be set to a directory containing the AltNames.dat
695
+ database that matches the current Geolocation.dat. This method is called
696
+ automatically by L</Geolocate> if $altDir is set and the GeolocAltNames
697
+ option is used and an input city name is provided.
698
+
699
+ Image::ExifTool::Geolocation::ReadAltNames();
700
+
701
+ =over 4
702
+
703
+ =item Inputs:
704
+
705
+ (none)
706
+
707
+ =item Return Value:
708
+
709
+ True on success. Resets the value of $altDir to prevent further attempts at
710
+ re-loading the same database.
711
+
712
+ =back
713
+
565
714
  =head2 SortDatabase
566
715
 
567
716
  Sort database in specified order.
@@ -585,8 +734,8 @@ Sort database in specified order.
585
734
  Add entry to Geolocation database.
586
735
 
587
736
  Image::ExifTool::Geolocation::AddEntry($city, $region,
588
- $countryCode, $country, $timezone, $featureCode
589
- $population, $lat, $lon);
737
+ $subregion, $countryCode, $country, $timezone,
738
+ $featureCode, $population, $lat, $lon, $altNames);
590
739
 
591
740
  =over 4
592
741
 
@@ -614,23 +763,32 @@ database, then the database entry is updated with the new country name.
614
763
 
615
764
  9) GPS longitude
616
765
 
766
+ 10) Optional comma-separated list of alternate names for the city
767
+
768
+ =item Return Value:
769
+
770
+ 1 on success, otherwise sends a warning message to stderr
771
+
617
772
  =back
618
773
 
619
774
  =head2 GetEntry
620
775
 
621
776
  Get entry from Geolocation database.
622
777
 
623
- my @vals = Image::ExifTool::Geolocation::GetEntry($num,$lang);
778
+ my @vals = Image::ExifTool::Geolocation::GetEntry($num,$lang,$sort);
624
779
 
625
780
  =over 4
626
781
 
627
782
  =item Inputs:
628
783
 
629
- 0) Entry number in database
784
+ 0) Entry number in database, or index into sorted database
630
785
 
631
786
  1) Optional language code
632
787
 
633
- =item Return Values:
788
+ 2) Optional flag to treat first argument as an index into the sorted
789
+ database
790
+
791
+ item Return Values:
634
792
 
635
793
  0) City name, or undef if the entry didn't exist
636
794
 
@@ -652,11 +810,31 @@ Get entry from Geolocation database.
652
810
 
653
811
  9) GPS longitude
654
812
 
813
+ =back
814
+
815
+ =head2 GetAltNames
816
+
817
+ Get alternate names for specified city.
818
+
819
+ my $str = Image::ExifTool::Geolocation::GetAltNames($num,$sort);
820
+
821
+ =over 4
822
+
823
+ =item Inputs:
824
+
825
+ 0) Entry number in database or index into the sorted database
826
+
827
+ 1) Optional flag to treat first argument as an index into the sorted
828
+ database
829
+
830
+ =item Return value:
831
+
832
+ Comma-separated string of alternate names for this city.
833
+
655
834
  =item Notes:
656
835
 
657
- The alternate-language feature of this method (and of L</Geolocate>)
658
- requires the installation of optional GeoLang modules. See
659
- L<https://exiftool.org/geolocation.html> for more information.
836
+ Must set the $altDir package variable and call L</ReadAltNames> before
837
+ calling this routine.
660
838
 
661
839
  =back
662
840
 
@@ -664,8 +842,7 @@ L<https://exiftool.org/geolocation.html> for more information.
664
842
 
665
843
  Return geolocation information for specified GPS coordinates or city name.
666
844
 
667
- my @cityInfo =
668
- Image::ExifTool::Geolocation::Geolocate($arg,$pop,$dist,$lang,$multi,$codes);
845
+ my @rtnInfo = Image::ExifTool::Geolocation::Geolocate($arg,$opts);
669
846
 
670
847
  =over 4
671
848
 
@@ -680,54 +857,67 @@ expressions in C</expr/> format are also allowed, optionally prefixed by
680
857
  Subregion, CountryCode or Country name. See
681
858
  L<https://exiftool.org/geolocation.html#Read> for details.
682
859
 
683
- 1) Minimum city population (cities smaller than this are ignored)
684
-
685
- 2) Maximum distance to city (farther cities are not considered)
860
+ 1) Optional reference to hash of options:
686
861
 
687
- 3) Language code
862
+ GeolocMinPop - minimum population of cities to consider in search
688
863
 
689
- 4) Flag to return multiple cities if there is more than one match. In this
690
- case the return value is a list of city information lists.
864
+ GeolocMaxDist - maximum distance (km) to search for cities when an input
865
+ GPS position is used
691
866
 
692
- 5) Comma-separated list of feature codes to include in search, or to exclude
693
- if the list starts with a dash (-).
867
+ GeolocMulti - flag to return multiple cities if there is more than one
868
+ match. In this case the return value is a list of city
869
+ information lists.
694
870
 
695
- =item Return Value:
696
-
697
- Reference to list of information about the matching city. If multiple
698
- matches were found, the city with the highest population is returned unless
699
- the flag is set to allow multiple cities to be returned, in which case all
700
- cities are turned as a list of city lists in order of decreasing population.
701
-
702
- The city information list contains the following entries:
871
+ GeolocFeature - comma-separated list of feature codes to include in
872
+ search, or exclude if the list starts with a dash (-)
703
873
 
704
- 0) Name of matching city (UTF8), or undef if no match
874
+ GeolocAltNames - flag to search alternate names database if available
875
+ for matching city name (see ALTERNATE DATABASES below)
705
876
 
706
- 1) Region, state or province name (UTF8), or "" if no region
877
+ =item Return Value:
707
878
 
708
- 2) Subregion name (UTF8), or "" if no region
879
+ 0) Number of matching entries, or 0 if no matches
709
880
 
710
- 3) Country code
881
+ 1) Entry number for matching city in database, or undef if no matches, or a
882
+ reference to a list of entry numbers of matching cities if multiple matches
883
+ were found and the flag was set to return multiple matches
711
884
 
712
- 4) Country name (UTF8)
885
+ 2) Distance to closest city in km if "lat,lon" specified
713
886
 
714
- 5) Standard time zone identifier name
887
+ 3) Compass bearing for direction to closest city if "lat,lon" specified
715
888
 
716
- 6) Feature code
889
+ =back
717
890
 
718
- 7) City population rounded to 2 significant figures
891
+ =head1 ALTERNATE DATABASES
719
892
 
720
- 8) Approximate city latitude (signed degrees)
893
+ A different version of the cities database may be specified setting the
894
+ package $geoDir variable before loading this module. This directory should
895
+ contain the Geolocation.dat file, and optionally a GeoLang directory for the
896
+ language translations. The $geoDir variable may be set to an empty string
897
+ to disable loading of a database.
721
898
 
722
- 9) Approximate city longitude
899
+ A database of alternate city names may be loaded by setting the package
900
+ $altDir variable. This directory should contain the AltNames.dat database
901
+ that matches the version of Geolocation.dat being used. When searching for
902
+ a city by name, the alternate-names database is checked to provide
903
+ additional possibilities for matches.
723
904
 
724
- 10) Distance to city in km if "lat,lon" specified
905
+ =head1 ADDING USER-DEFINED DATABASE ENTRIES
725
906
 
726
- 11) Compass bearing for direction to city if "lat,lon" specified
907
+ User-defined entries may be created by defining them using the following
908
+ technique before the Geolocation module is loaded.
727
909
 
728
- 12) Flag set if multiple matches were found
910
+ @Image::ExifTool::UserDefined::Geolocation = (
911
+ # city, region, subregion, country code, country, timezone,
912
+ ['Sinemorets','burgas','Obshtina Tsarevo','BG','','Europe/Sofia',
913
+ # feature code, population, lat, lon
914
+ '',400,42.06115,27.97833],
915
+ );
729
916
 
730
- =back
917
+ Similarly, user-defined language translations may be defined, and will
918
+ override any existing translations. Translations for the default 'en'
919
+ language may also be specified. See
920
+ L<https://exiftool.org/geolocation.html#Custom> for more information.
731
921
 
732
922
  =head1 USING A CUSTOM DATABASE
733
923
 
@@ -737,24 +927,17 @@ the input arguments of the AddEntry method.
737
927
 
738
928
  $Image::ExifTool::Geolocation::geoDir = '';
739
929
  require Image::ExifTool::Geolocation;
740
- open DFILE, "<$filename";
930
+ open DFILE, "< $filename";
741
931
  Image::ExifTool::Geolocation::AddEntry(split /,/) foreach <DFILE>;
742
932
  close DFILE;
743
933
 
744
- =head1 CUSTOM LANGUAGE TRANSLATIONS
745
-
746
- User-defined language translations may be added by defining
747
- %Image::ExifTool::Geolocation::geoLang before calling GetEntry() or
748
- Geolocate(). See L<http://exiftool.org/geolocation.html#Custom> for
749
- details.
750
-
751
934
  =head1 AUTHOR
752
935
 
753
936
  Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
754
937
 
755
938
  This library is free software; you can redistribute it and/or modify it
756
- under the same terms as Perl itself. Geolocation.dat is based on data
757
- from geonames.org with a Creative Commons license.
939
+ under the same terms as Perl itself. The associated database files are
940
+ based on data from geonames.org with a Creative Commons license.
758
941
 
759
942
  =head1 REFERENCES
760
943