exiftool_vendored 12.76.1 → 12.81.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (67) hide show
  1. checksums.yaml +4 -4
  2. data/bin/Changes +105 -4
  3. data/bin/MANIFEST +29 -0
  4. data/bin/META.json +1 -1
  5. data/bin/META.yml +1 -1
  6. data/bin/README +4 -3
  7. data/bin/config_files/acdsee.config +37 -57
  8. data/bin/config_files/example.config +16 -2
  9. data/bin/exiftool +102 -31
  10. data/bin/lib/Image/ExifTool/Canon.pm +12 -9
  11. data/bin/lib/Image/ExifTool/CanonVRD.pm +8 -2
  12. data/bin/lib/Image/ExifTool/Exif.pm +52 -4
  13. data/bin/lib/Image/ExifTool/FujiFilm.pm +14 -5
  14. data/bin/lib/Image/ExifTool/GPS.pm +5 -3
  15. data/bin/lib/Image/ExifTool/GeoLang/cs.pm +978 -0
  16. data/bin/lib/Image/ExifTool/GeoLang/de.pm +1975 -0
  17. data/bin/lib/Image/ExifTool/GeoLang/en_ca.pm +44 -0
  18. data/bin/lib/Image/ExifTool/GeoLang/en_gb.pm +124 -0
  19. data/bin/lib/Image/ExifTool/GeoLang/es.pm +2921 -0
  20. data/bin/lib/Image/ExifTool/GeoLang/fi.pm +1116 -0
  21. data/bin/lib/Image/ExifTool/GeoLang/fr.pm +3171 -0
  22. data/bin/lib/Image/ExifTool/GeoLang/it.pm +2750 -0
  23. data/bin/lib/Image/ExifTool/GeoLang/ja.pm +10256 -0
  24. data/bin/lib/Image/ExifTool/GeoLang/ko.pm +4499 -0
  25. data/bin/lib/Image/ExifTool/GeoLang/nl.pm +1270 -0
  26. data/bin/lib/Image/ExifTool/GeoLang/pl.pm +3019 -0
  27. data/bin/lib/Image/ExifTool/GeoLang/ru.pm +18220 -0
  28. data/bin/lib/Image/ExifTool/GeoLang/sk.pm +441 -0
  29. data/bin/lib/Image/ExifTool/GeoLang/sv.pm +714 -0
  30. data/bin/lib/Image/ExifTool/GeoLang/tr.pm +452 -0
  31. data/bin/lib/Image/ExifTool/GeoLang/zh_cn.pm +2225 -0
  32. data/bin/lib/Image/ExifTool/GeoLang/zh_tw.pm +72 -0
  33. data/bin/lib/Image/ExifTool/Geolocation.dat +0 -0
  34. data/bin/lib/Image/ExifTool/Geolocation.pm +935 -0
  35. data/bin/lib/Image/ExifTool/Geotag.pm +14 -2
  36. data/bin/lib/Image/ExifTool/HtmlDump.pm +2 -1
  37. data/bin/lib/Image/ExifTool/Import.pm +5 -2
  38. data/bin/lib/Image/ExifTool/JSON.pm +15 -10
  39. data/bin/lib/Image/ExifTool/M2TS.pm +32 -4
  40. data/bin/lib/Image/ExifTool/MWG.pm +1 -0
  41. data/bin/lib/Image/ExifTool/MacOS.pm +19 -4
  42. data/bin/lib/Image/ExifTool/MakerNotes.pm +2 -2
  43. data/bin/lib/Image/ExifTool/Microsoft.pm +1 -1
  44. data/bin/lib/Image/ExifTool/Nikon.pm +331 -23
  45. data/bin/lib/Image/ExifTool/NikonCustom.pm +55 -1
  46. data/bin/lib/Image/ExifTool/Ogg.pm +3 -2
  47. data/bin/lib/Image/ExifTool/Olympus.pm +4 -1
  48. data/bin/lib/Image/ExifTool/OpenEXR.pm +37 -19
  49. data/bin/lib/Image/ExifTool/PDF.pm +5 -5
  50. data/bin/lib/Image/ExifTool/PNG.pm +3 -3
  51. data/bin/lib/Image/ExifTool/Pentax.pm +1 -1
  52. data/bin/lib/Image/ExifTool/QuickTime.pm +195 -12
  53. data/bin/lib/Image/ExifTool/QuickTimeStream.pl +253 -237
  54. data/bin/lib/Image/ExifTool/README +6 -5
  55. data/bin/lib/Image/ExifTool/Sony.pm +1 -1
  56. data/bin/lib/Image/ExifTool/TagLookup.pm +4871 -4752
  57. data/bin/lib/Image/ExifTool/TagNames.pod +722 -383
  58. data/bin/lib/Image/ExifTool/WriteQuickTime.pl +43 -9
  59. data/bin/lib/Image/ExifTool/WriteXMP.pl +1 -1
  60. data/bin/lib/Image/ExifTool/Writer.pl +65 -8
  61. data/bin/lib/Image/ExifTool/XMP.pm +18 -2
  62. data/bin/lib/Image/ExifTool/XMP2.pl +64 -0
  63. data/bin/lib/Image/ExifTool.pm +265 -49
  64. data/bin/lib/Image/ExifTool.pod +63 -25
  65. data/bin/perl-Image-ExifTool.spec +2 -2
  66. data/lib/exiftool_vendored/version.rb +1 -1
  67. metadata +22 -2
@@ -0,0 +1,935 @@
1
+ #------------------------------------------------------------------------------
2
+ # File: Geolocation.pm
3
+ #
4
+ # Description: Determine geolocation from GPS and visa-versa
5
+ #
6
+ # Revisions: 2024-03-03 - P. Harvey Created
7
+ # 2024-03-21 - PH Significant restructuring and addition of
8
+ # several new features.
9
+ #
10
+ # References: https://download.geonames.org/export/
11
+ #
12
+ # Notes: Set $Image::ExifTool::Geolocation::geoDir to override
13
+ # default directory for the database file Geolocation.dat
14
+ # and language directory GeoLang.
15
+ #
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.
21
+ #
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:
27
+ # "GeolocationV.VV\tNNNN\n" (V.VV=version, NNNN=num city entries)
28
+ # "# <comment>\n"
29
+ # NNNN City entries:
30
+ # Offset Format Description
31
+ # 0 int16u - latitude high 16 bits (converted to 0-0x100000 range)
32
+ # 2 int8u - latitude low 4 bits, longitude low 4 bits
33
+ # 3 int16u - longitude high 16 bits
34
+ # 5 int8u - index of country in country list
35
+ # 6 int8u - 0xf0 = population E exponent (in format "N.Fe+0E"), 0x0f = population N digit
36
+ # 7 int16u - 0xf000 = population F digit, 0x0fff = index in region list (admin1)
37
+ # 9 int16u - 0x7fff = index in subregion (admin2), 0x8000 = high bit of time zone
38
+ # 11 int8u - low byte of time zone index
39
+ # 12 int8u - 0x0f - feature code index (see below)
40
+ # 13 string - UTF8 City name, terminated by newline
41
+ # "\0\0\0\0\x01"
42
+ # Country entries:
43
+ # 1. 2-character country code
44
+ # 2. Country name, terminated by newline
45
+ # "\0\0\0\0\x02"
46
+ # Region entries:
47
+ # 1. Region name, terminated by newline
48
+ # "\0\0\0\0\x03"
49
+ # Subregion entries:
50
+ # 1. Subregion name, terminated by newline
51
+ # "\0\0\0\0\x04"
52
+ # Time zone entries:
53
+ # 1. Time zone name, terminated by newline
54
+ # "\0\0\0\0\0"
55
+ #
56
+ # Feature Codes: (see http://www.geonames.org/export/codes.html#P for descriptions)
57
+ #
58
+ # 0. Other 3. PPLA2 6. PPLA5 9. PPLF 12. PPLR
59
+ # 1. PPL 4. PPLA3 7. PPLC 10. PPLG 13. PPLS
60
+ # 2. PPLA 5. PPLA4 8. PPLCH 11. PPLL 14. STLMT
61
+ #------------------------------------------------------------------------------
62
+
63
+ package Image::ExifTool::Geolocation;
64
+
65
+ use strict;
66
+ use vars qw($VERSION $geoDir $altDir $dbInfo);
67
+
68
+ $VERSION = '1.03';
69
+
70
+ my $databaseVersion = '1.02';
71
+
72
+ my $debug; # set to output processing time for testing
73
+
74
+ sub ReadDatabase($);
75
+ sub SortDatabase($);
76
+ sub AddEntry(@);
77
+ sub GetEntry($;$$);
78
+ sub Geolocate($;$$$$$);
79
+
80
+ my (@cityList, @countryList, @regionList, @subregionList, @timezoneList);
81
+ my (%countryNum, %regionNum, %subregionNum, %timezoneNum); # reverse lookups
82
+ my (@sortOrder, @altNames, %langLookup, $nCity);
83
+ my ($lastArgs, %lastFound, @lastByPop, @lastByLat); # cached city matches
84
+ my $sortedBy = 'Latitude';
85
+ my $pi = 3.1415926536;
86
+ my $earthRadius = 6371; # earth radius in km
87
+
88
+ my @featureCodes = qw(Other PPL PPLA PPLA2 PPLA3 PPLA4 PPLA5
89
+ PPLC PPLCH PPLF PPLG PPLL PPLR PPLS STLMT ?);
90
+ my $i = 0;
91
+ my %featureCodes = map { lc($_) => $i++ } @featureCodes;
92
+
93
+ # get path name for database file from lib/Image/ExifTool/Geolocation.dat by default,
94
+ # or according to $Image::ExifTool::Geolocation::directory if specified
95
+ my $defaultDir = $INC{'Image/ExifTool/Geolocation.pm'};
96
+ if ($defaultDir) {
97
+ $defaultDir =~ s(/Geolocation\.pm$)();
98
+ } else {
99
+ $defaultDir = '.';
100
+ warn("Error getting Geolocation.pm directory\n");
101
+ }
102
+
103
+ # read the Geolocation database unless $geoDir set to empty string
104
+ unless (defined $geoDir and not $geoDir) {
105
+ unless ($geoDir and ReadDatabase("$geoDir/Geolocation.dat")) {
106
+ ReadDatabase("$defaultDir/Geolocation.dat");
107
+ }
108
+ }
109
+
110
+ # set directory for language files
111
+ my $geoLang;
112
+ if ($geoDir and -d "$geoDir/GeoLang") {
113
+ $geoLang = "$geoDir/GeoLang";
114
+ } elsif ($geoDir or not defined $geoDir) {
115
+ $geoLang = "$defaultDir/GeoLang";
116
+ }
117
+
118
+ # add user-defined entries to the database
119
+ if (@Image::ExifTool::UserDefined::Geolocation) {
120
+ AddEntry(@$_) foreach @Image::ExifTool::UserDefined::Geolocation;
121
+ }
122
+
123
+ #------------------------------------------------------------------------------
124
+ # Read Geolocation database
125
+ # Inputs: 0) database file name
126
+ # Returns: true on success
127
+ sub ReadDatabase($)
128
+ {
129
+ my $datfile = shift;
130
+ # open geolocation database and verify header
131
+ open DATFILE, "< $datfile" or warn("Error reading $datfile\n"), return 0;
132
+ binmode DATFILE;
133
+ my $line = <DATFILE>;
134
+ unless ($line =~ /^Geolocation(\d+\.\d+)\t(\d+)/) {
135
+ warn("Bad format Geolocation database\n");
136
+ close(DATFILE);
137
+ return 0;
138
+ }
139
+ if ($1 != $databaseVersion) {
140
+ my $which = $1 < $databaseVersion ? 'database' : 'ExifTool';
141
+ warn("Incompatible Geolocation database (update your $which)\n");
142
+ close(DATFILE);
143
+ return 0;
144
+ }
145
+ $nCity = $2;
146
+ my $comment = <DATFILE>;
147
+ defined $comment and $comment =~ /(\d+)/ or close(DATFILE), return 0;
148
+ $dbInfo = "$datfile v$databaseVersion: $nCity cities with population > $1";
149
+ my $isUserDefined = @Image::ExifTool::UserDefined::Geolocation;
150
+
151
+ undef @altNames; # reset altNames
152
+
153
+ # read city database
154
+ undef @cityList;
155
+ my $i = 0;
156
+ for (;;) {
157
+ $line = <DATFILE>;
158
+ last if length($line) == 6 and $line =~ /\0\0\0\0/;
159
+ $line .= <DATFILE> while length($line) < 14;
160
+ chomp $line;
161
+ push @cityList, $line;
162
+ }
163
+ @cityList == $nCity or warn("Bad number of entries in Geolocation database\n"), return 0;
164
+ # read countries
165
+ for (;;) {
166
+ $line = <DATFILE>;
167
+ last if length($line) == 6 and $line =~ /\0\0\0\0/;
168
+ chomp $line;
169
+ push @countryList, $line;
170
+ $countryNum{lc substr($line,0,2)} = $#countryList if $isUserDefined;
171
+ }
172
+ # read regions
173
+ for (;;) {
174
+ $line = <DATFILE>;
175
+ last if length($line) == 6 and $line =~ /\0\0\0\0/;
176
+ chomp $line;
177
+ push @regionList, $line;
178
+ $regionNum{lc $line} = $#regionList if $isUserDefined;
179
+ }
180
+ # read subregions
181
+ for (;;) {
182
+ $line = <DATFILE>;
183
+ last if length($line) == 6 and $line =~ /\0\0\0\0/;
184
+ chomp $line;
185
+ push @subregionList, $line;
186
+ $subregionNum{lc $line} = $#subregionList if $isUserDefined;
187
+ }
188
+ # read time zones
189
+ for (;;) {
190
+ $line = <DATFILE>;
191
+ last if length($line) == 6 and $line =~ /\0\0\0\0/;
192
+ chomp $line;
193
+ push @timezoneList, $line;
194
+ $timezoneNum{lc $line} = $#timezoneList if $isUserDefined;
195
+ }
196
+ close DATFILE;
197
+ return 1;
198
+ }
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
+
238
+ #------------------------------------------------------------------------------
239
+ # Sort database by specified field
240
+ # Inputs: 0) Field name to sort (Latitude,City,Country)
241
+ # Returns: 1 on success
242
+ sub SortDatabase($)
243
+ {
244
+ my $field = shift;
245
+ return 1 if $field eq $sortedBy; # already sorted?
246
+ undef @sortOrder;
247
+ if ($field eq 'Latitude') {
248
+ @sortOrder = sort { $cityList[$a] cmp $cityList[$b] } 0..$#cityList;
249
+ } elsif ($field eq 'City') {
250
+ @sortOrder = sort { substr($cityList[$a],13) cmp substr($cityList[$b],13) } 0..$#cityList;
251
+ } elsif ($field eq 'Country') {
252
+ my %lkup;
253
+ foreach (0..$#cityList) {
254
+ my $city = substr($cityList[$_],13);
255
+ my $ctry = substr($countryList[ord substr($cityList[$_],5,1)], 2);
256
+ $lkup{$_} = "$ctry $city";
257
+ }
258
+ @sortOrder = sort { $lkup{$a} cmp $lkup{$b} } 0..$#cityList;
259
+ } else {
260
+ return 0;
261
+ }
262
+ $sortedBy = $field;
263
+ ClearLastMatches();
264
+ return 1;
265
+ }
266
+
267
+ #------------------------------------------------------------------------------
268
+ # Add cities to the Geolocation database
269
+ # Inputs: 0-8) city,region,subregion,country_code,country,timezone,feature_code,population,lat,lon,altNames
270
+ # eg. AddEntry('Sinemorets','Burgas','Obshtina Tsarevo','BG','Bulgaria','Europe/Sofia','',400,42.06115,27.97833)
271
+ sub AddEntry(@)
272
+ {
273
+ my ($city, $region, $subregion, $cc, $country, $timezone, $fc, $pop, $lat, $lon, $altNames) = @_;
274
+ @_ < 10 and warn("Too few arguments in $city definition (check for updated format)\n"), return;
275
+ length($cc) != 2 and warn("Country code '${cc}' is not 2 characters\n"), return;
276
+ $fc = $featureCodes{lc $fc} || 0;
277
+ chomp $lon; # (just in case it was read from file)
278
+ # create reverse lookups for country/region/subregion/timezone if not done already
279
+ # (eg. if the entries are being added manually instead of via UserDefined::Geolocation)
280
+ unless (%countryNum) {
281
+ my $i;
282
+ $i = 0; $countryNum{lc substr($_,0,2)} = $i++ foreach @countryList;
283
+ $i = 0; $regionNum{lc $_} = $i++ foreach @regionList;
284
+ $i = 0; $subregionNum{lc $_} = $i++ foreach @subregionList;
285
+ $i = 0; $timezoneNum{lc $_} = $i++ foreach @timezoneList;
286
+ }
287
+ my $cn = $countryNum{lc $cc};
288
+ unless (defined $cn) {
289
+ push @countryList, "$cc$country";
290
+ $cn = $countryNum{lc $cc} = $#countryList;
291
+ } elsif ($country) {
292
+ $countryList[$cn] = "$cc$country"; # (override existing country name)
293
+ }
294
+ my $tn = $timezoneNum{lc $timezone};
295
+ unless (defined $tn) {
296
+ push @timezoneList, $timezone;
297
+ $tn = $timezoneNum{lc $timezone} = $#timezoneList;
298
+ }
299
+ my $rn = $regionNum{lc $region};
300
+ unless (defined $rn) {
301
+ push @regionList, $region;
302
+ $rn = $regionNum{lc $region} = $#regionList;
303
+ }
304
+ my $sn = $subregionNum{lc $subregion};
305
+ unless (defined $sn) {
306
+ push @subregionList, $subregion;
307
+ $sn = $subregionNum{lc $subregion} = $#subregionList;
308
+ }
309
+ $pop = sprintf('%.1e',$pop); # format: "3.1e+04" or "3.1e+004"
310
+ # pack CC index, population and region index into a 32-bit integer
311
+ my $code = ($cn << 24) | (substr($pop,-1,1)<<20) | (substr($pop,0,1)<<16) | (substr($pop,2,1)<<12) | $rn;
312
+ # store high bit of timezone index
313
+ $tn > 255 and $sn |= 0x8000, $tn -= 256;
314
+ $lat = int(($lat + 90) / 180 * 0x100000 + 0.5) & 0xfffff;
315
+ $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff;
316
+ my $hdr = pack('nCnNnCC', $lat>>4, (($lat&0x0f)<<4)|($lon&0x0f), $lon>>4, $code, $sn, $tn, $fc);
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
+ }
329
+ $sortedBy = '';
330
+ undef $lastArgs; # (faster than ClearLastArgs)
331
+ }
332
+
333
+ #------------------------------------------------------------------------------
334
+ # Unpack entry in database
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($;$$)
340
+ {
341
+ my ($entryNum, $lang, $sort) = @_;
342
+ return() if $entryNum > $#cityList;
343
+ $entryNum = $sortOrder[$entryNum] if $sort and @sortOrder > $entryNum;
344
+ my ($lt,$f,$ln,$code,$sb,$tn,$fc) = unpack('nCnNnCC', $cityList[$entryNum]);
345
+ my $city = substr($cityList[$entryNum],13);
346
+ my $ctry = $countryList[$code >> 24];
347
+ my $rgn = $regionList[$code & 0x0fff];
348
+ my $sub = $subregionList[$sb & 0x7fff];
349
+ # convert population digits back into exponent format
350
+ my $pop = (($code>>16 & 0x0f) . '.' . ($code>>12 & 0x0f) . 'e+' . ($code>>20 & 0x0f)) + 0;
351
+ $tn += 256 if $sb & 0x8000;
352
+ $lt = sprintf('%.4f', (($lt<<4)|($f >> 4)) * 180 / 0x100000 - 90);
353
+ $ln = sprintf('%.4f', (($ln<<4)|($f & 0x0f))* 360 / 0x100000 - 180);
354
+ $fc = $featureCodes[$fc & 0x0f];
355
+ my $cc = substr($ctry, 0, 2);
356
+ my $country = substr($ctry, 2);
357
+ if ($lang) {
358
+ my $xlat = $langLookup{$lang};
359
+ # load language lookups if not done already
360
+ if (not defined $xlat) {
361
+ if (eval "require '$geoLang/$lang.pm'") {
362
+ my $trans = "Image::ExifTool::GeoLang::${lang}::Translate";
363
+ no strict 'refs';
364
+ $xlat = \%$trans if %$trans;
365
+ }
366
+ # read user-defined language translations
367
+ if (%Image::ExifTool::Geolocation::geoLang) {
368
+ my $userLang = $Image::ExifTool::Geolocation::geoLang{$lang};
369
+ if ($userLang and ref($userLang) eq 'HASH') {
370
+ if ($xlat) {
371
+ # add user-defined entries to main lookup
372
+ $$xlat{$_} = $$userLang{$_} foreach keys %$userLang;
373
+ } else {
374
+ $xlat = $userLang;
375
+ }
376
+ }
377
+ }
378
+ $langLookup{$lang} = $xlat || 0;
379
+ }
380
+ if ($xlat) {
381
+ my $r2 = $rgn;
382
+ # City-specific: "CCRgn,Sub,City", "CCRgn,City", "CC,City", ",City"
383
+ # Subregion-specific: "CCRgn,Sub,"
384
+ # Region-specific: "CCRgn,"
385
+ # Country-specific: "CC,"
386
+ $city = $$xlat{"$cc$r2,$sub,$city"} || $$xlat{"$cc$r2,$city"} ||
387
+ $$xlat{"$cc,$city"} || $$xlat{",$city"} || $$xlat{$city} || $city;
388
+ $sub = $$xlat{"$cc$rgn,$sub,"} || $$xlat{$sub} || $sub;
389
+ $rgn = $$xlat{"$cc$rgn,"} || $$xlat{$rgn} || $rgn;
390
+ $country = $$xlat{"$cc,"} || $$xlat{$country} || $country;
391
+ }
392
+ }
393
+ return($city,$rgn,$sub,$cc,$country,$timezoneList[$tn],$fc,$pop,$lt,$ln);
394
+ }
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
+
410
+ #------------------------------------------------------------------------------
411
+ # Look up lat,lon or city in geolocation database
412
+ # Inputs: 0) "lat,lon", "city,region,country", etc, (city must be first)
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
420
+ sub Geolocate($;$$$$$)
421
+ {
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)};
429
+
430
+ if ($debug) {
431
+ require Time::HiRes;
432
+ @startTime = Time::HiRes::gettimeofday();
433
+ }
434
+ @cityList or warn('No Geolocation database'), return 0;
435
+ # make population code for comparing with 2 bytes at offset 6 in database
436
+ if ($pop) {
437
+ $pop = sprintf('%.1e', $pop);
438
+ $minPop = chr((substr($pop,-1,1)<<4) | (substr($pop,0,1))) . chr(substr($pop,2,1)<<4);
439
+ }
440
+ if ($fcodes) {
441
+ my $neg = $fcodes =~ s/^-//;
442
+ my @fcodes = split /\s*,\s*/, $fcodes;
443
+ if ($neg) {
444
+ $fcmask = 0xffff;
445
+ defined $featureCodes{lc $_} and $fcmask &= ~((1 << $featureCodes{lc $_})) foreach @fcodes;
446
+ } else {
447
+ defined $featureCodes{lc $_} and $fcmask |= (1 << $featureCodes{lc $_}) foreach @fcodes;
448
+ }
449
+ }
450
+ #
451
+ # process input argument
452
+ #
453
+ $arg =~ s/^\s+//; $arg =~ s/\s+$//; # remove leading/trailing spaces
454
+ my @args = split /\s*,\s*/, $arg;
455
+ my %ri = ( cc => 0, co => 1, re => 2, sr => 3, ci => 8, '' => 9 );
456
+ foreach (@args) {
457
+ # allow regular expressions optionally prefixed by "ci", "cc", "co", "re" or "sr"
458
+ if (m{^(-)?(\w{2})?/(.*)/(i?)$}) {
459
+ my $re = $4 ? qr/$3/im : qr/$3/m;
460
+ next if not defined($idx = $ri{$2});
461
+ push @cargs, $_;
462
+ $other = 1 if $idx < 5;
463
+ $idx += 10 if $1; # add 10 for negative matches
464
+ $regex{$idx} or $regex{$idx} = [ ];
465
+ push @{$regex{$idx}}, $re;
466
+ $city = '' unless defined $city;
467
+ } elsif (/^[-+]?\d+(\.\d+)?$/) { # coordinate format
468
+ push @coords, $_ if @coords < 2;
469
+ } elsif (lc $_ eq 'both') {
470
+ $both = 1;
471
+ } elsif ($_) {
472
+ push @cargs, $_;
473
+ if ($city) {
474
+ push @exact, lc $_;
475
+ } else {
476
+ $city = lc $_;
477
+ }
478
+ }
479
+ }
480
+ unless (defined $city or @coords == 2) {
481
+ warn("Insufficient information to determine geolocation\n");
482
+ return 0;
483
+ }
484
+ # sort database by logitude if finding entry based on coordinates
485
+ SortDatabase('Latitude') if @coords == 2 and ($both or not defined $city);
486
+ #
487
+ # perform reverse Geolocation lookup to determine GPS based on city, country, etc.
488
+ #
489
+ while (defined $city and (@coords != 2 or $both)) {
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) {
506
+ my $cty = substr($cityList[$i],13);
507
+ if ($city and $city ne lc $cty) { # test exact city name first
508
+ next unless $$altNames[$i] and $$altNames[$i] =~ /^$city$/im;
509
+ }
510
+ # test with city-specific regexes
511
+ if ($regex{8}) { $cty =~ $_ or next Entry foreach @{$regex{8}} }
512
+ if ($regex{18}) { $cty !~ $_ or next Entry foreach @{$regex{18}} }
513
+ # test other arguments
514
+ my ($cd,$sb) = unpack('x5Nn', $cityList[$i]);
515
+ my $ct = $countryList[$cd >> 24];
516
+ my @geo = (substr($ct,0,2), substr($ct,2), $regionList[$cd & 0x0fff], $subregionList[$sb & 0x7fff]);
517
+ if (@exact) {
518
+ # make quick lookup for all names at this location
519
+ my %geoLkup;
520
+ $_ and $geoLkup{lc $_} = 1 foreach @geo;
521
+ $geoLkup{$_} or next Entry foreach @exact;
522
+ }
523
+ # test with cc, co, re and sr regexes
524
+ if ($other) { foreach $idx (0..3) {
525
+ if ($regex{$idx}) { $geo[$idx] =~ $_ or next Entry foreach @{$regex{$idx}} }
526
+ if ($regex{$idx+10}) { $geo[$idx] !~ $_ or next Entry foreach @{$regex{$idx+10}} }
527
+ } }
528
+ # test regexes for any place name
529
+ if ($regex{9} or $regex{19}) {
530
+ my $str = join "\n", $cty, @geo;
531
+ $str =~ $_ or next Entry foreach @{$regex{9}};
532
+ $str !~ $_ or next Entry foreach @{$regex{19}};
533
+ }
534
+ # test feature code and population
535
+ next if $fcmask and not $fcmask & (1 << (ord(substr($cityList[$i],12,1)) & 0x0f));
536
+ my $pc = substr($cityList[$i],6,2);
537
+ if (not defined $minPop or $pc ge $minPop) {
538
+ $lastFound{$i} = $pc;
539
+ push @lastByLat, $i if @coords == 2;
540
+ }
541
+ }
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;
548
+ }
549
+ my $n = scalar @lastByPop;
550
+ return($n, [ @lastByPop ]) if $n > 1 and $multi;
551
+ return($n, $lastByPop[0]);
552
+ }
553
+ warn "No such city in Geolocation database\n";
554
+ return 0;
555
+ }
556
+ #
557
+ # determine Geolocation based on GPS coordinates
558
+ #
559
+ my ($lat, $lon) = @coords;
560
+ if ($maxDist) {
561
+ $minDistU = $maxDist / (2 * $earthRadius); # min distance on unit sphere
562
+ $minDistC = $maxDist * 0x100000 / ($pi * $earthRadius); # min distance in coordinate units
563
+ } else {
564
+ $minDistU = $pi;
565
+ $minDistC = 0x200000;
566
+ }
567
+ my $cos = cos($lat * $pi / 180); # cosine factor for longitude distances
568
+ # reduce lat/lon to the range 0-0x100000
569
+ $lat = int(($lat + 90) / 180 * 0x100000 + 0.5) & 0xfffff;
570
+ $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff;
571
+ $lat or $lat = $coords[0] < 0 ? 1 : 0xfffff; # (zero latitude is a problem for our calculations)
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;
575
+ # binary search to find closest longitude
576
+ my ($n0, $n1) = (0, $numEntries - 1);
577
+ my $sorted = @lastByLat ? \@lastByLat : (@sortOrder ? \@sortOrder : undef);
578
+ while ($n1 - $n0 > 1) {
579
+ my $n = int(($n0 + $n1) / 2);
580
+ if ($coord lt $cityList[$sorted ? $$sorted[$n] : $n]) {
581
+ $n1 = $n;
582
+ } else {
583
+ $n0 = $n;
584
+ }
585
+ }
586
+ # step backward then forward through database to find nearest city
587
+ my ($inc, $end, $n) = (-1, -1, $n0+1);
588
+ my ($p0, $t0) = ($lat*$pi/0x100000 - $pi/2, $lon*$pi/0x080000 - $pi);
589
+ my $cp0 = cos($p0);
590
+ for (;;) {
591
+ if (($n += $inc) == $end) {
592
+ last if $inc == 1;
593
+ ($inc, $end, $n) = (1, $numEntries, $n1);
594
+ }
595
+ my $i = $sorted ? $$sorted[$n] : $n;
596
+ # get city latitude/longitude
597
+ my ($lt,$f,$ln) = unpack('nCn', $cityList[$i]);
598
+ $lt = ($lt << 4) | ($f >> 4);
599
+ # searched far enough if latitude alone is further than best distance
600
+ abs($lt - $lat) > $minDistC and $n = $end - $inc, next;
601
+ # ignore if population is below threshold
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));
604
+ $ln = ($ln << 4) | ($f & 0x0f);
605
+ # calculate great circle distance to this city on unit sphere
606
+ my ($p1, $t1) = ($lt*$pi/0x100000 - $pi/2, $ln*$pi/0x080000 - $pi);
607
+ my ($sp, $st) = (sin(($p1-$p0)/2), sin(($t1-$t0)/2));
608
+ my $a = $sp * $sp + $cp0 * cos($p1) * $st * $st;
609
+ my $distU = atan2(sqrt($a), sqrt(1-$a));
610
+ next if $distU > $minDistU;
611
+ $minDistU = $distU;
612
+ $minDistC = $minDistU * 0x200000 / $pi;
613
+ @matchParms = ($i, $p1, $t1, $distU);
614
+ }
615
+ @matchParms or warn("No suitable location in Geolocation database\n"), return 0;
616
+
617
+ # calculate distance in km and bearing to matching city
618
+ my ($ii, $p1, $t1, $distU) = @matchParms;
619
+ my $km = sprintf('%.2f', 2 * $earthRadius * $distU);
620
+ my $be = atan2(sin($t1-$t0)*cos($p1-$p0), $cp0*sin($p1)-sin($p0)*cos($p1)*cos($t1-$t0));
621
+ $be = int($be * 180 / $pi + 360.5) % 360; # convert from radians to integer degrees
622
+
623
+ @startTime and printf("- Processing time: %.3f sec\n", Time::HiRes::tv_interval(\@startTime));
624
+ return(1, $ii, $km, $be)
625
+ }
626
+
627
+ 1; #end
628
+
629
+ __END__
630
+
631
+ =head1 NAME
632
+
633
+ Image::ExifTool::Geolocation - Determine geolocation from GPS and visa-versa
634
+
635
+ =head1 SYNOPSIS
636
+
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.
640
+
641
+ =head1 DESCRIPTION
642
+
643
+ This module contains the code to convert GPS coordinates to city, region,
644
+ subregion, country, time zone, etc. It uses a database derived from
645
+ geonames.org, modified to reduce the size as much as possible.
646
+
647
+ =head1 METHODS
648
+
649
+ =head2 ReadDatabase
650
+
651
+ Load Geolocation database from file. This method is called automatically
652
+ when this module is loaded. By default, the database is loaded from
653
+ "Geolocation.dat" in the same directory as this module, but a different
654
+ directory may be used by setting $Image::ExifTool::Geolocation::geoDir
655
+ before loading this module. Setting this to an empty string avoids loading
656
+ any database. A warning is generated if the file can't be read.
657
+
658
+ Image::ExifTool::Geolocation::ReadDatabase($filename);
659
+
660
+ =over 4
661
+
662
+ =item Inputs:
663
+
664
+ 0) Database file name
665
+
666
+ =item Return Value:
667
+
668
+ True on success.
669
+
670
+ =back
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
+
695
+ =head2 SortDatabase
696
+
697
+ Sort database in specified order.
698
+
699
+ Image::ExifTool::Geolocation::ReadDatabase('City');
700
+
701
+ =over 4
702
+
703
+ =item Inputs:
704
+
705
+ 0) Sort order: 'Latitude', 'City' or 'Country'
706
+
707
+ =item Return Value:
708
+
709
+ 1 on success, 0 on failure (bad sort order specified).
710
+
711
+ =back
712
+
713
+ =head2 AddEntry
714
+
715
+ Add entry to Geolocation database.
716
+
717
+ Image::ExifTool::Geolocation::AddEntry($city, $region,
718
+ $subregion, $countryCode, $country, $timezone,
719
+ $featureCode, $population, $lat, $lon, $altNames);
720
+
721
+ =over 4
722
+
723
+ =item Inputs:
724
+
725
+ 0) City name (UTF8)
726
+
727
+ 1) Region, state or province name (UTF8), or empty string if unknown
728
+
729
+ 2) Subregion name (UTF8), or empty string if unknown
730
+
731
+ 3) 2-character ISO 3166 country code
732
+
733
+ 4) Country name (UTF8), or empty string to use existing definition. If the
734
+ country name is provided for a country code that already exists in the
735
+ database, then the database entry is updated with the new country name.
736
+
737
+ 5) Time zone identifier (eg. "America/New_York")
738
+
739
+ 6) Feature code (eg. "PPL"), or empty if not known
740
+
741
+ 7) City population
742
+
743
+ 8) GPS latitude (signed floating point degrees)
744
+
745
+ 9) GPS longitude
746
+
747
+ 10) Optional comma-separated list of alternate names for the city
748
+
749
+ =back
750
+
751
+ =head2 GetEntry
752
+
753
+ Get entry from Geolocation database.
754
+
755
+ my @vals = Image::ExifTool::Geolocation::GetEntry($num,$lang,$sort);
756
+
757
+ =over 4
758
+
759
+ =item Inputs:
760
+
761
+ 0) Entry number in database, or index into sorted database
762
+
763
+ 1) Optional language code
764
+
765
+ 2) Optional flag to treat first argument as an index into the sorted
766
+ database
767
+
768
+ item Return Values:
769
+
770
+ 0) City name, or undef if the entry didn't exist
771
+
772
+ 1) Region name, or "" if no region
773
+
774
+ 2) Subregion name, or "" if no subregion
775
+
776
+ 3) Country code
777
+
778
+ 4) Country name
779
+
780
+ 5) Time zone
781
+
782
+ 6) Feature code
783
+
784
+ 7) City population
785
+
786
+ 8) GPS latitude
787
+
788
+ 9) GPS longitude
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
+
811
+ =item Notes:
812
+
813
+ Must set the $altDir package variable and call L</ReadAltNames> before
814
+ calling this routine.
815
+
816
+ =back
817
+
818
+ =head2 Geolocate
819
+
820
+ Return geolocation information for specified GPS coordinates or city name.
821
+
822
+ my @rtnInfo = Image::ExifTool::Geolocation::Geolocate($arg,$opts);
823
+
824
+ =over 4
825
+
826
+ =item Inputs:
827
+
828
+ 0) Input argument ("lat,lon", "city", "city,country", "city,region,country",
829
+ etc). When specifying a city, the city name must come first, followed by
830
+ zero or more of the following in any order, separated by commas: region
831
+ name, subregion name, country code, and/or country name. Regular
832
+ expressions in C</expr/> format are also allowed, optionally prefixed by
833
+ "ci", "re", "sr", "cc" or "co" to specifically match City, Region,
834
+ Subregion, CountryCode or Country name. See
835
+ L<https://exiftool.org/geolocation.html#Read> for details.
836
+
837
+ 1) Optional reference to hash of options:
838
+
839
+ GeolocMinPop - minimum population of cities to consider in search
840
+
841
+ GeolocMaxDist - maximum distance (km) to search for cities when an input
842
+ GPS position is used
843
+
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.
847
+
848
+ GeolocFeature - comma-separated list of feature codes to include in
849
+ search, or exclude if the list starts with a dash (-)
850
+
851
+ GeolocAltNames - flag to search alternate names database if available
852
+ for matching city name (see ALTERNATE DATABASES below)
853
+
854
+ =item Return Value:
855
+
856
+ 0) Number of matching entries, or 0 if no matches
857
+
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
861
+
862
+ 2) Distance to closest city in km if "lat,lon" specified
863
+
864
+ 3) Compass bearing for direction to closest city if "lat,lon" specified
865
+
866
+ =back
867
+
868
+ =head1 ALTERNATE DATABASES
869
+
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.
875
+
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.
881
+
882
+ =head1 ADDING USER-DEFINED DATABASE ENTRIES
883
+
884
+ User-defined entries may be created by defining them using the following
885
+ technique before the Geolocation module is loaded.
886
+
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
+ );
893
+
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.
898
+
899
+ =head1 USING A CUSTOM DATABASE
900
+
901
+ This example shows how to use a custom database. In this example, the input
902
+ database file is a comma-separated text file with columns corresponding to
903
+ the input arguments of the AddEntry method.
904
+
905
+ $Image::ExifTool::Geolocation::geoDir = '';
906
+ require Image::ExifTool::Geolocation;
907
+ open DFILE, "< $filename";
908
+ Image::ExifTool::Geolocation::AddEntry(split /,/) foreach <DFILE>;
909
+ close DFILE;
910
+
911
+ =head1 AUTHOR
912
+
913
+ Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
914
+
915
+ This library is free software; you can redistribute it and/or modify it
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.
918
+
919
+ =head1 REFERENCES
920
+
921
+ =over 4
922
+
923
+ =item L<https://download.geonames.org/export/>
924
+
925
+ =item L<https://exiftool.org/geolocation.html>
926
+
927
+ =back
928
+
929
+ =head1 SEE ALSO
930
+
931
+ L<Image::ExifTool(3pm)|Image::ExifTool>
932
+
933
+ =cut
934
+
935
+ 1; #end