exiftool_vendored 12.80.0 → 12.82.0

Sign up to get free protection for your applications and to get access to all the features.
@@ -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