exiftool_vendored 12.80.0 → 12.81.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:
@@ -54,20 +63,24 @@
54
63
  package Image::ExifTool::Geolocation;
55
64
 
56
65
  use strict;
57
- use vars qw($VERSION $geoDir $dbInfo);
66
+ use vars qw($VERSION $geoDir $altDir $dbInfo);
58
67
 
59
- $VERSION = '1.02';
68
+ $VERSION = '1.03';
60
69
 
61
70
  my $databaseVersion = '1.02';
62
71
 
72
+ my $debug; # set to output processing time for testing
73
+
63
74
  sub ReadDatabase($);
64
75
  sub SortDatabase($);
65
76
  sub AddEntry(@);
66
- sub GetEntry($;$);
77
+ sub GetEntry($;$$);
67
78
  sub Geolocate($;$$$$$);
68
79
 
69
80
  my (@cityList, @countryList, @regionList, @subregionList, @timezoneList);
70
- my (%countryNum, %regionNum, %subregionNum, %timezoneNum, %langLookup);
81
+ my (%countryNum, %regionNum, %subregionNum, %timezoneNum); # reverse lookups
82
+ my (@sortOrder, @altNames, %langLookup, $nCity);
83
+ my ($lastArgs, %lastFound, @lastByPop, @lastByLat); # cached city matches
71
84
  my $sortedBy = 'Latitude';
72
85
  my $pi = 3.1415926536;
73
86
  my $earthRadius = 6371; # earth radius in km
@@ -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+)/) {
@@ -129,14 +142,17 @@ sub ReadDatabase($)
129
142
  close(DATFILE);
130
143
  return 0;
131
144
  }
132
- my $ncity = $2;
145
+ $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$databaseVersion: $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,36 @@ 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)
215
271
  sub AddEntry(@)
216
272
  {
217
- my ($city, $region, $subregion, $cc, $country, $timezone, $fc, $pop, $lat, $lon) = @_;
273
+ my ($city, $region, $subregion, $cc, $country, $timezone, $fc, $pop, $lat, $lon, $altNames) = @_;
218
274
  @_ < 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
- }
275
+ length($cc) != 2 and warn("Country code '${cc}' is not 2 characters\n"), return;
223
276
  $fc = $featureCodes{lc $fc} || 0;
224
277
  chomp $lon; # (just in case it was read from file)
225
278
  # create reverse lookups for country/region/subregion/timezone if not done already
@@ -262,17 +315,32 @@ sub AddEntry(@)
262
315
  $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff;
263
316
  my $hdr = pack('nCnNnCC', $lat>>4, (($lat&0x0f)<<4)|($lon&0x0f), $lon>>4, $code, $sn, $tn, $fc);
264
317
  push @cityList, "$hdr$city";
318
+ # add altNames entry if provided
319
+ if ($altNames) {
320
+ chomp $altNames; # (just in case)
321
+ $altNames =~ tr/,/\n/;
322
+ # add any more arguments in case altNames were passed separately (undocumented)
323
+ foreach (11..$#_) {
324
+ chomp $_[$_];
325
+ $altNames .= "\n$_[$_]";
326
+ }
327
+ $altNames[$#cityList] = $altNames;
328
+ }
265
329
  $sortedBy = '';
330
+ undef $lastArgs; # (faster than ClearLastArgs)
266
331
  }
267
332
 
268
333
  #------------------------------------------------------------------------------
269
334
  # 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($;$)
335
+ # Inputs: 0) entry number or index into sorted database,
336
+ # 1) optional language code, 2) flag to use index into sorted database
337
+ # Returns: 0-10) city,region,subregion,country_code,country,timezone,
338
+ # feature_code,pop,lat,lon,altNames
339
+ sub GetEntry($;$$)
273
340
  {
274
- my ($entryNum, $lang) = @_;
341
+ my ($entryNum, $lang, $sort) = @_;
275
342
  return() if $entryNum > $#cityList;
343
+ $entryNum = $sortOrder[$entryNum] if $sort and @sortOrder > $entryNum;
276
344
  my ($lt,$f,$ln,$code,$sb,$tn,$fc) = unpack('nCnNnCC', $cityList[$entryNum]);
277
345
  my $city = substr($cityList[$entryNum],13);
278
346
  my $ctry = $countryList[$code >> 24];
@@ -325,31 +393,45 @@ sub GetEntry($;$)
325
393
  return($city,$rgn,$sub,$cc,$country,$timezoneList[$tn],$fc,$pop,$lt,$ln);
326
394
  }
327
395
 
396
+ #------------------------------------------------------------------------------
397
+ # Get alternate names for specified database entry
398
+ # Inputs: 0) entry number or index into sorted database, 1) sort flag
399
+ # Returns: comma-separated list of alternate names, or empty string if no names
400
+ # Notes: ReadAltNames() must be called before this
401
+ sub GetAltNames($;$)
402
+ {
403
+ my ($entryNum, $sort) = @_;
404
+ $entryNum = $sortOrder[$entryNum] if $sort and @sortOrder > $entryNum;
405
+ my $alt = $altNames[$entryNum] or return '';
406
+ $alt =~ tr/\n/,/;
407
+ return $alt;
408
+ }
409
+
328
410
  #------------------------------------------------------------------------------
329
411
  # Look up lat,lon or city in geolocation database
330
412
  # 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)
413
+ # 1) options hash reference (or undef for no options)
414
+ # Options: GeolocMinPop, GeolocMaxDist, GeolocMulti, GeolocFeature, GeolocAltNames
415
+ # Returns: 0) number of matching cities (0 if no matches),
416
+ # 1) index of matching city in database, or undef if no matches, or
417
+ # reference to list of indices if multiple matches were found and
418
+ # the flag to return multiple matches was set,
419
+ # 2) approx distance (km), 3) compass bearing to city
346
420
  sub Geolocate($;$$$$$)
347
421
  {
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);
422
+ my ($arg, $opts) = @_;
423
+ my ($city, @exact, %regex, @multiCity, $other, $idx, @cargs, $useLastFound);
424
+ my ($minPop, $minDistU, $minDistC, @matchParms, @coords, $fcmask, $both);
425
+ my ($pop, $maxDist, $multi, $fcodes, $altNames, @startTime);
426
+
427
+ $opts and ($pop, $maxDist, $multi, $fcodes, $altNames) =
428
+ @$opts{qw(GeolocMinPop GeolocMaxDist GeolocMulti GeolocFeature GeolocAltNames)};
351
429
 
352
- @cityList or warn('No Geolocation database'), return();
430
+ if ($debug) {
431
+ require Time::HiRes;
432
+ @startTime = Time::HiRes::gettimeofday();
433
+ }
434
+ @cityList or warn('No Geolocation database'), return 0;
353
435
  # make population code for comparing with 2 bytes at offset 6 in database
354
436
  if ($pop) {
355
437
  $pop = sprintf('%.1e', $pop);
@@ -376,23 +458,28 @@ sub Geolocate($;$$$$$)
376
458
  if (m{^(-)?(\w{2})?/(.*)/(i?)$}) {
377
459
  my $re = $4 ? qr/$3/im : qr/$3/m;
378
460
  next if not defined($idx = $ri{$2});
461
+ push @cargs, $_;
379
462
  $other = 1 if $idx < 5;
380
463
  $idx += 10 if $1; # add 10 for negative matches
464
+ $regex{$idx} or $regex{$idx} = [ ];
381
465
  push @{$regex{$idx}}, $re;
382
466
  $city = '' unless defined $city;
383
467
  } elsif (/^[-+]?\d+(\.\d+)?$/) { # coordinate format
384
468
  push @coords, $_ if @coords < 2;
385
- } elsif (lc eq 'both') {
469
+ } elsif (lc $_ eq 'both') {
386
470
  $both = 1;
387
- } elsif ($city) {
388
- push @exact, lc $_;
389
- } else {
390
- $city = lc $_;
471
+ } elsif ($_) {
472
+ push @cargs, $_;
473
+ if ($city) {
474
+ push @exact, lc $_;
475
+ } else {
476
+ $city = lc $_;
477
+ }
391
478
  }
392
479
  }
393
480
  unless (defined $city or @coords == 2) {
394
481
  warn("Insufficient information to determine geolocation\n");
395
- return();
482
+ return 0;
396
483
  }
397
484
  # sort database by logitude if finding entry based on coordinates
398
485
  SortDatabase('Latitude') if @coords == 2 and ($both or not defined $city);
@@ -400,9 +487,26 @@ sub Geolocate($;$$$$$)
400
487
  # perform reverse Geolocation lookup to determine GPS based on city, country, etc.
401
488
  #
402
489
  while (defined $city and (@coords != 2 or $both)) {
403
- Entry: for ($i=0; $i<@cityList; ++$i) {
490
+ my $cargs = join(',', @cargs, $pop||'', $maxDist||'', $fcodes||'');
491
+ my $i = 0;
492
+ if ($lastArgs and $lastArgs eq $cargs) {
493
+ $i = @cityList; # bypass search
494
+ } else {
495
+ ClearLastMatches();
496
+ $lastArgs = $cargs;
497
+ }
498
+ # read alternate names database if an exact city match is specified
499
+ if ($altNames) {
500
+ ReadAltNames() if $city and $altDir;
501
+ $altNames = \@altNames;
502
+ } else {
503
+ $altNames = [ ]; # (don't search alt names)
504
+ }
505
+ Entry: for (; $i<@cityList; ++$i) {
404
506
  my $cty = substr($cityList[$i],13);
405
- next if $city and $city ne lc $cty; # test exact city name first
507
+ if ($city and $city ne lc $cty) { # test exact city name first
508
+ next unless $$altNames[$i] and $$altNames[$i] =~ /^$city$/im;
509
+ }
406
510
  # test with city-specific regexes
407
511
  if ($regex{8}) { $cty =~ $_ or next Entry foreach @{$regex{8}} }
408
512
  if ($regex{18}) { $cty !~ $_ or next Entry foreach @{$regex{18}} }
@@ -430,23 +534,24 @@ Entry: for ($i=0; $i<@cityList; ++$i) {
430
534
  # test feature code and population
431
535
  next if $fcmask and not $fcmask & (1 << (ord(substr($cityList[$i],12,1)) & 0x0f));
432
536
  my $pc = substr($cityList[$i],6,2);
433
- $found{$i} = $pc if not defined $minPop or $pc ge $minPop;
537
+ if (not defined $minPop or $pc ge $minPop) {
538
+ $lastFound{$i} = $pc;
539
+ push @lastByLat, $i if @coords == 2;
540
+ }
434
541
  }
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;
542
+ @startTime and printf("= Processing time: %.3f sec\n", Time::HiRes::tv_interval(\@startTime));
543
+ if (%lastFound) {
544
+ @coords == 2 and $useLastFound = 1, last; # continue to use coords with last city matches
545
+ scalar(keys %lastFound) > 200 and warn("Too many matching cities\n"), return 0;
546
+ unless (@lastByPop) {
547
+ @lastByPop = sort { $lastFound{$b} cmp $lastFound{$a} or $cityList[$a] cmp $cityList[$b] } keys %lastFound;
445
548
  }
446
- return \@multiCity;
549
+ my $n = scalar @lastByPop;
550
+ return($n, [ @lastByPop ]) if $n > 1 and $multi;
551
+ return($n, $lastByPop[0]);
447
552
  }
448
553
  warn "No such city in Geolocation database\n";
449
- return();
554
+ return 0;
450
555
  }
451
556
  #
452
557
  # determine Geolocation based on GPS coordinates
@@ -465,12 +570,14 @@ Entry: for ($i=0; $i<@cityList; ++$i) {
465
570
  $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff;
466
571
  $lat or $lat = $coords[0] < 0 ? 1 : 0xfffff; # (zero latitude is a problem for our calculations)
467
572
  my $coord = pack('nCn',$lat>>4,(($lat&0x0f)<<4)|($lon&0x0f),$lon>>4);;
573
+ # start from cached city matches if also using city information
574
+ my $numEntries = @lastByLat || @cityList;
468
575
  # binary search to find closest longitude
469
- my $numEntries = @matches || @cityList;
470
576
  my ($n0, $n1) = (0, $numEntries - 1);
577
+ my $sorted = @lastByLat ? \@lastByLat : (@sortOrder ? \@sortOrder : undef);
471
578
  while ($n1 - $n0 > 1) {
472
579
  my $n = int(($n0 + $n1) / 2);
473
- if ($coord lt $cityList[@matches ? $matches[$n] : $n]) {
580
+ if ($coord lt $cityList[$sorted ? $$sorted[$n] : $n]) {
474
581
  $n1 = $n;
475
582
  } else {
476
583
  $n0 = $n;
@@ -485,15 +592,15 @@ Entry: for ($i=0; $i<@cityList; ++$i) {
485
592
  last if $inc == 1;
486
593
  ($inc, $end, $n) = (1, $numEntries, $n1);
487
594
  }
488
- my $entryNum = @matches ? $matches[$n] : $n;
595
+ my $i = $sorted ? $$sorted[$n] : $n;
489
596
  # get city latitude/longitude
490
- my ($lt,$f,$ln) = unpack('nCn', $cityList[$entryNum]);
597
+ my ($lt,$f,$ln) = unpack('nCn', $cityList[$i]);
491
598
  $lt = ($lt << 4) | ($f >> 4);
492
599
  # searched far enough if latitude alone is further than best distance
493
600
  abs($lt - $lat) > $minDistC and $n = $end - $inc, next;
494
601
  # 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));
602
+ next if defined $minPop and $minPop ge substr($cityList[$i],6,2);
603
+ next if $fcmask and not $fcmask & (1 << (ord(substr($cityList[$i],12,1)) & 0x0f));
497
604
  $ln = ($ln << 4) | ($f & 0x0f);
498
605
  # calculate great circle distance to this city on unit sphere
499
606
  my ($p1, $t1) = ($lt*$pi/0x100000 - $pi/2, $ln*$pi/0x080000 - $pi);
@@ -503,20 +610,18 @@ Entry: for ($i=0; $i<@cityList; ++$i) {
503
610
  next if $distU > $minDistU;
504
611
  $minDistU = $distU;
505
612
  $minDistC = $minDistU * 0x200000 / $pi;
506
- @matchParms = ($entryNum, $p1, $t1, $distU);
613
+ @matchParms = ($i, $p1, $t1, $distU);
507
614
  }
508
- @matchParms or warn("No suitable location in Geolocation database\n"), return();
615
+ @matchParms or warn("No suitable location in Geolocation database\n"), return 0;
509
616
 
510
617
  # calculate distance in km and bearing to matching city
511
- my ($en, $p1, $t1, $distU) = @matchParms;
618
+ my ($ii, $p1, $t1, $distU) = @matchParms;
512
619
  my $km = sprintf('%.2f', 2 * $earthRadius * $distU);
513
620
  my $be = atan2(sin($t1-$t0)*cos($p1-$p0), $cp0*sin($p1)-sin($p0)*cos($p1)*cos($t1-$t0));
514
621
  $be = int($be * 180 / $pi + 360.5) % 360; # convert from radians to integer degrees
515
622
 
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;
623
+ @startTime and printf("- Processing time: %.3f sec\n", Time::HiRes::tv_interval(\@startTime));
624
+ return(1, $ii, $km, $be)
520
625
  }
521
626
 
522
627
  1; #end
@@ -525,11 +630,13 @@ __END__
525
630
 
526
631
  =head1 NAME
527
632
 
528
- Image::ExifTool::Geolocation - Look up geolocation based on GPS position
633
+ Image::ExifTool::Geolocation - Determine geolocation from GPS and visa-versa
529
634
 
530
635
  =head1 SYNOPSIS
531
636
 
532
- This module is used by the Image::ExifTool Geolocation feature.
637
+ Look up geolocation information (city, region, subregion, country, etc)
638
+ based on input GPS coordinates, or determine GPS coordinates based on city
639
+ name, etc.
533
640
 
534
641
  =head1 DESCRIPTION
535
642
 
@@ -562,6 +669,29 @@ True on success.
562
669
 
563
670
  =back
564
671
 
672
+ =head2 ReadAltNames
673
+
674
+ Load the alternate names database. Before calling this method the $altDir
675
+ package variable must be set to a directory containing the AltNames.dat
676
+ database that matches the current Geolocation.dat. This method is called
677
+ automatically by L</Geolocate> if $altDir is set and the GeolocAltNames
678
+ option is used and an input city name is provided.
679
+
680
+ Image::ExifTool::Geolocation::ReadAltNames();
681
+
682
+ =over 4
683
+
684
+ =item Inputs:
685
+
686
+ (none)
687
+
688
+ =item Return Value:
689
+
690
+ True on success. Resets the value of $altDir to prevent further attempts at
691
+ re-loading the same database.
692
+
693
+ =back
694
+
565
695
  =head2 SortDatabase
566
696
 
567
697
  Sort database in specified order.
@@ -585,8 +715,8 @@ Sort database in specified order.
585
715
  Add entry to Geolocation database.
586
716
 
587
717
  Image::ExifTool::Geolocation::AddEntry($city, $region,
588
- $countryCode, $country, $timezone, $featureCode
589
- $population, $lat, $lon);
718
+ $subregion, $countryCode, $country, $timezone,
719
+ $featureCode, $population, $lat, $lon, $altNames);
590
720
 
591
721
  =over 4
592
722
 
@@ -614,23 +744,28 @@ database, then the database entry is updated with the new country name.
614
744
 
615
745
  9) GPS longitude
616
746
 
747
+ 10) Optional comma-separated list of alternate names for the city
748
+
617
749
  =back
618
750
 
619
751
  =head2 GetEntry
620
752
 
621
753
  Get entry from Geolocation database.
622
754
 
623
- my @vals = Image::ExifTool::Geolocation::GetEntry($num,$lang);
755
+ my @vals = Image::ExifTool::Geolocation::GetEntry($num,$lang,$sort);
624
756
 
625
757
  =over 4
626
758
 
627
759
  =item Inputs:
628
760
 
629
- 0) Entry number in database
761
+ 0) Entry number in database, or index into sorted database
630
762
 
631
763
  1) Optional language code
632
764
 
633
- =item Return Values:
765
+ 2) Optional flag to treat first argument as an index into the sorted
766
+ database
767
+
768
+ item Return Values:
634
769
 
635
770
  0) City name, or undef if the entry didn't exist
636
771
 
@@ -652,11 +787,31 @@ Get entry from Geolocation database.
652
787
 
653
788
  9) GPS longitude
654
789
 
790
+ =back
791
+
792
+ =head2 GetAltNames
793
+
794
+ Get alternate names for specified city.
795
+
796
+ my $str = Image::ExifTool::Geolocation::GetAltNames($num,$sort);
797
+
798
+ =over 4
799
+
800
+ =item Inputs:
801
+
802
+ 0) Entry number in database or index into the sorted database
803
+
804
+ 1) Optional flag to treat first argument as an index into the sorted
805
+ database
806
+
807
+ =item Return value:
808
+
809
+ Comma-separated string of alternate names for this city.
810
+
655
811
  =item Notes:
656
812
 
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.
813
+ Must set the $altDir package variable and call L</ReadAltNames> before
814
+ calling this routine.
660
815
 
661
816
  =back
662
817
 
@@ -664,8 +819,7 @@ L<https://exiftool.org/geolocation.html> for more information.
664
819
 
665
820
  Return geolocation information for specified GPS coordinates or city name.
666
821
 
667
- my @cityInfo =
668
- Image::ExifTool::Geolocation::Geolocate($arg,$pop,$dist,$lang,$multi,$codes);
822
+ my @rtnInfo = Image::ExifTool::Geolocation::Geolocate($arg,$opts);
669
823
 
670
824
  =over 4
671
825
 
@@ -680,54 +834,67 @@ expressions in C</expr/> format are also allowed, optionally prefixed by
680
834
  Subregion, CountryCode or Country name. See
681
835
  L<https://exiftool.org/geolocation.html#Read> for details.
682
836
 
683
- 1) Minimum city population (cities smaller than this are ignored)
684
-
685
- 2) Maximum distance to city (farther cities are not considered)
686
-
687
- 3) Language code
837
+ 1) Optional reference to hash of options:
688
838
 
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.
839
+ GeolocMinPop - minimum population of cities to consider in search
691
840
 
692
- 5) Comma-separated list of feature codes to include in search, or to exclude
693
- if the list starts with a dash (-).
841
+ GeolocMaxDist - maximum distance (km) to search for cities when an input
842
+ GPS position is used
694
843
 
695
- =item Return Value:
844
+ GeolocMulti - flag to return multiple cities if there is more than one
845
+ match. In this case the return value is a list of city
846
+ information lists.
696
847
 
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.
848
+ GeolocFeature - comma-separated list of feature codes to include in
849
+ search, or exclude if the list starts with a dash (-)
701
850
 
702
- The city information list contains the following entries:
851
+ GeolocAltNames - flag to search alternate names database if available
852
+ for matching city name (see ALTERNATE DATABASES below)
703
853
 
704
- 0) Name of matching city (UTF8), or undef if no match
854
+ =item Return Value:
705
855
 
706
- 1) Region, state or province name (UTF8), or "" if no region
856
+ 0) Number of matching entries, or 0 if no matches
707
857
 
708
- 2) Subregion name (UTF8), or "" if no region
858
+ 1) Entry number for matching city in database, or undef if no matches, or a
859
+ reference to a list of entry numbers of matching cities if multiple matches
860
+ were found and the flag was set to return multiple matches
709
861
 
710
- 3) Country code
862
+ 2) Distance to closest city in km if "lat,lon" specified
711
863
 
712
- 4) Country name (UTF8)
864
+ 3) Compass bearing for direction to closest city if "lat,lon" specified
713
865
 
714
- 5) Standard time zone identifier name
715
-
716
- 6) Feature code
866
+ =back
717
867
 
718
- 7) City population rounded to 2 significant figures
868
+ =head1 ALTERNATE DATABASES
719
869
 
720
- 8) Approximate city latitude (signed degrees)
870
+ A different version of the cities database may be specified setting the
871
+ package $geoDir variable before loading this module. This directory should
872
+ contain the Geolocation.dat file, and optionally a GeoLang directory for the
873
+ language translations. The $geoDir variable may be set to an empty string
874
+ to disable loading of a database.
721
875
 
722
- 9) Approximate city longitude
876
+ A database of alternate city names may be loaded by setting the package
877
+ $altDir variable. This directory should contain the AltNames.dat database
878
+ that matches the version of Geolocation.dat being used. When searching for
879
+ a city by name, the alternate-names database is checked to provide
880
+ additional possibilities for matches.
723
881
 
724
- 10) Distance to city in km if "lat,lon" specified
882
+ =head1 ADDING USER-DEFINED DATABASE ENTRIES
725
883
 
726
- 11) Compass bearing for direction to city if "lat,lon" specified
884
+ User-defined entries may be created by defining them using the following
885
+ technique before the Geolocation module is loaded.
727
886
 
728
- 12) Flag set if multiple matches were found
887
+ @Image::ExifTool::UserDefined::Geolocation = (
888
+ # city, region, subregion, country code, country, timezone,
889
+ ['Sinemorets','burgas','Obshtina Tsarevo','BG','','Europe/Sofia',
890
+ # feature code, population, lat, lon
891
+ '',400,42.06115,27.97833],
892
+ );
729
893
 
730
- =back
894
+ Similarly, user-defined language translations may be defined, and will
895
+ override any existing translations. Translations for the default 'en'
896
+ language may also be specified. See
897
+ L<https://exiftool.org/geolocation.html#Custom> for more information.
731
898
 
732
899
  =head1 USING A CUSTOM DATABASE
733
900
 
@@ -737,24 +904,17 @@ the input arguments of the AddEntry method.
737
904
 
738
905
  $Image::ExifTool::Geolocation::geoDir = '';
739
906
  require Image::ExifTool::Geolocation;
740
- open DFILE, "<$filename";
907
+ open DFILE, "< $filename";
741
908
  Image::ExifTool::Geolocation::AddEntry(split /,/) foreach <DFILE>;
742
909
  close DFILE;
743
910
 
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
911
  =head1 AUTHOR
752
912
 
753
913
  Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
754
914
 
755
915
  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.
916
+ under the same terms as Perl itself. The associated database files are
917
+ based on data from geonames.org with a Creative Commons license.
758
918
 
759
919
  =head1 REFERENCES
760
920