exiftool_vendored 12.76.1 → 12.80.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (61) hide show
  1. checksums.yaml +4 -4
  2. data/bin/Changes +79 -4
  3. data/bin/MANIFEST +27 -0
  4. data/bin/META.json +1 -1
  5. data/bin/META.yml +1 -1
  6. data/bin/README +3 -3
  7. data/bin/config_files/acdsee.config +37 -57
  8. data/bin/config_files/example.config +16 -2
  9. data/bin/exiftool +84 -29
  10. data/bin/lib/Image/ExifTool/Canon.pm +12 -9
  11. data/bin/lib/Image/ExifTool/CanonVRD.pm +7 -1
  12. data/bin/lib/Image/ExifTool/Exif.pm +52 -4
  13. data/bin/lib/Image/ExifTool/FujiFilm.pm +3 -0
  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 +775 -0
  35. data/bin/lib/Image/ExifTool/Geotag.pm +8 -1
  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/MWG.pm +1 -0
  40. data/bin/lib/Image/ExifTool/MacOS.pm +19 -4
  41. data/bin/lib/Image/ExifTool/Nikon.pm +2 -2
  42. data/bin/lib/Image/ExifTool/Ogg.pm +3 -2
  43. data/bin/lib/Image/ExifTool/Olympus.pm +3 -1
  44. data/bin/lib/Image/ExifTool/OpenEXR.pm +17 -17
  45. data/bin/lib/Image/ExifTool/PDF.pm +5 -5
  46. data/bin/lib/Image/ExifTool/Pentax.pm +1 -1
  47. data/bin/lib/Image/ExifTool/QuickTime.pm +183 -11
  48. data/bin/lib/Image/ExifTool/QuickTimeStream.pl +253 -237
  49. data/bin/lib/Image/ExifTool/README +6 -5
  50. data/bin/lib/Image/ExifTool/TagLookup.pm +2624 -2520
  51. data/bin/lib/Image/ExifTool/TagNames.pod +184 -4
  52. data/bin/lib/Image/ExifTool/WriteQuickTime.pl +15 -1
  53. data/bin/lib/Image/ExifTool/WriteXMP.pl +1 -1
  54. data/bin/lib/Image/ExifTool/Writer.pl +59 -8
  55. data/bin/lib/Image/ExifTool/XMP.pm +17 -2
  56. data/bin/lib/Image/ExifTool/XMP2.pl +64 -0
  57. data/bin/lib/Image/ExifTool.pm +249 -47
  58. data/bin/lib/Image/ExifTool.pod +57 -25
  59. data/bin/perl-Image-ExifTool.spec +2 -2
  60. data/lib/exiftool_vendored/version.rb +1 -1
  61. metadata +22 -2
@@ -0,0 +1,775 @@
1
+ #------------------------------------------------------------------------------
2
+ # File: Geolocation.pm
3
+ #
4
+ # Description: Look up geolocation information based on a GPS position
5
+ #
6
+ # Revisions: 2024-03-03 - P. Harvey Created
7
+ #
8
+ # References: https://download.geonames.org/export/
9
+ #
10
+ # Notes: Set $Image::ExifTool::Geolocation::geoDir to override
11
+ # default directory for the database file Geolocation.dat
12
+ # and language directory GeoLang.
13
+ #
14
+ # Based on data from geonames.org Creative Commons databases,
15
+ # reformatted as follows in the Geolocation.dat file:
16
+ #
17
+ # Header:
18
+ # "GeolocationV.VV\tNNNN\n" (V.VV=version, NNNN=num city entries)
19
+ # "# <comment>\n"
20
+ # NNNN City entries:
21
+ # Offset Format Description
22
+ # 0 int16u - latitude high 16 bits (converted to 0-0x100000 range)
23
+ # 2 int8u - latitude low 4 bits, longitude low 4 bits
24
+ # 3 int16u - longitude high 16 bits
25
+ # 5 int8u - index of country in country list
26
+ # 6 int8u - 0xf0 = population E exponent (in format "N.Fe+0E"), 0x0f = population N digit
27
+ # 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
29
+ # 11 int8u - low byte of time zone index
30
+ # 12 int8u - 0x0f - feature code index (see below)
31
+ # 13 string - UTF8 City name, terminated by newline
32
+ # "\0\0\0\0\x01"
33
+ # Country entries:
34
+ # 1. 2-character country code
35
+ # 2. Country name, terminated by newline
36
+ # "\0\0\0\0\x02"
37
+ # Region entries:
38
+ # 1. Region name, terminated by newline
39
+ # "\0\0\0\0\x03"
40
+ # Subregion entries:
41
+ # 1. Subregion name, terminated by newline
42
+ # "\0\0\0\0\x04"
43
+ # Time zone entries:
44
+ # 1. Time zone name, terminated by newline
45
+ # "\0\0\0\0\0"
46
+ #
47
+ # Feature Codes: (see http://www.geonames.org/export/codes.html#P for descriptions)
48
+ #
49
+ # 0. Other 3. PPLA2 6. PPLA5 9. PPLF 12. PPLR
50
+ # 1. PPL 4. PPLA3 7. PPLC 10. PPLG 13. PPLS
51
+ # 2. PPLA 5. PPLA4 8. PPLCH 11. PPLL 14. STLMT
52
+ #------------------------------------------------------------------------------
53
+
54
+ package Image::ExifTool::Geolocation;
55
+
56
+ use strict;
57
+ use vars qw($VERSION $geoDir $dbInfo);
58
+
59
+ $VERSION = '1.02';
60
+
61
+ my $databaseVersion = '1.02';
62
+
63
+ sub ReadDatabase($);
64
+ sub SortDatabase($);
65
+ sub AddEntry(@);
66
+ sub GetEntry($;$);
67
+ sub Geolocate($;$$$$$);
68
+
69
+ my (@cityList, @countryList, @regionList, @subregionList, @timezoneList);
70
+ my (%countryNum, %regionNum, %subregionNum, %timezoneNum, %langLookup);
71
+ my $sortedBy = 'Latitude';
72
+ my $pi = 3.1415926536;
73
+ my $earthRadius = 6371; # earth radius in km
74
+
75
+ my @featureCodes = qw(Other PPL PPLA PPLA2 PPLA3 PPLA4 PPLA5
76
+ PPLC PPLCH PPLF PPLG PPLL PPLR PPLS STLMT ?);
77
+ my $i = 0;
78
+ my %featureCodes = map { lc($_) => $i++ } @featureCodes;
79
+
80
+ # get path name for database file from lib/Image/ExifTool/Geolocation.dat by default,
81
+ # or according to $Image::ExifTool::Geolocation::directory if specified
82
+ my $defaultDir = $INC{'Image/ExifTool/Geolocation.pm'};
83
+ if ($defaultDir) {
84
+ $defaultDir =~ s(/Geolocation\.pm$)();
85
+ } else {
86
+ $defaultDir = '.';
87
+ warn("Error getting Geolocation.pm directory\n");
88
+ }
89
+
90
+ # read the Geolocation database unless $geoDir set to empty string
91
+ unless (defined $geoDir and not $geoDir) {
92
+ unless ($geoDir and ReadDatabase("$geoDir/Geolocation.dat")) {
93
+ ReadDatabase("$defaultDir/Geolocation.dat");
94
+ }
95
+ }
96
+
97
+ # set directory for language files
98
+ my $geoLang;
99
+ if ($geoDir and -d "$geoDir/GeoLang") {
100
+ $geoLang = "$geoDir/GeoLang";
101
+ } elsif ($geoDir or not defined $geoDir) {
102
+ $geoLang = "$defaultDir/GeoLang";
103
+ }
104
+
105
+ # add user-defined entries to the database
106
+ if (@Image::ExifTool::UserDefined::Geolocation) {
107
+ AddEntry(@$_) foreach @Image::ExifTool::UserDefined::Geolocation;
108
+ }
109
+
110
+ #------------------------------------------------------------------------------
111
+ # Read Geolocation database
112
+ # Inputs: 0) database file name
113
+ # Returns: true on success
114
+ sub ReadDatabase($)
115
+ {
116
+ my $datfile = shift;
117
+ # open geolocation database and verify header
118
+ open DATFILE, "<$datfile" or warn("Error reading $datfile\n"), return 0;
119
+ binmode DATFILE;
120
+ my $line = <DATFILE>;
121
+ unless ($line =~ /^Geolocation(\d+\.\d+)\t(\d+)/) {
122
+ warn("Bad format Geolocation database\n");
123
+ close(DATFILE);
124
+ return 0;
125
+ }
126
+ if ($1 != $databaseVersion) {
127
+ my $which = $1 < $databaseVersion ? 'database' : 'ExifTool';
128
+ warn("Incompatible Geolocation database (update your $which)\n");
129
+ close(DATFILE);
130
+ return 0;
131
+ }
132
+ my $ncity = $2;
133
+ my $comment = <DATFILE>;
134
+ defined $comment and $comment =~ /(\d+)/ or close(DATFILE), return 0;
135
+ $dbInfo = "$datfile v$databaseVersion: $ncity cities with population > $1";
136
+ my $isUserDefined = @Image::ExifTool::UserDefined::Geolocation;
137
+
138
+ # read city database
139
+ undef @cityList;
140
+ for (;;) {
141
+ $line = <DATFILE>;
142
+ last if length($line) == 6 and $line =~ /\0\0\0\0/;
143
+ $line .= <DATFILE> while length($line) < 14;
144
+ chomp $line;
145
+ push @cityList, $line;
146
+ }
147
+ @cityList == $ncity or warn("Bad number of entries in Geolocation database\n"), return 0;
148
+ # read countries
149
+ for (;;) {
150
+ $line = <DATFILE>;
151
+ last if length($line) == 6 and $line =~ /\0\0\0\0/;
152
+ chomp $line;
153
+ push @countryList, $line;
154
+ $countryNum{lc substr($line,0,2)} = $#countryList if $isUserDefined;
155
+ }
156
+ # read regions
157
+ for (;;) {
158
+ $line = <DATFILE>;
159
+ last if length($line) == 6 and $line =~ /\0\0\0\0/;
160
+ chomp $line;
161
+ push @regionList, $line;
162
+ $regionNum{lc $line} = $#regionList if $isUserDefined;
163
+ }
164
+ # read subregions
165
+ for (;;) {
166
+ $line = <DATFILE>;
167
+ last if length($line) == 6 and $line =~ /\0\0\0\0/;
168
+ chomp $line;
169
+ push @subregionList, $line;
170
+ $subregionNum{lc $line} = $#subregionList if $isUserDefined;
171
+ }
172
+ # read time zones
173
+ for (;;) {
174
+ $line = <DATFILE>;
175
+ last if length($line) == 6 and $line =~ /\0\0\0\0/;
176
+ chomp $line;
177
+ push @timezoneList, $line;
178
+ $timezoneNum{lc $line} = $#timezoneList if $isUserDefined;
179
+ }
180
+ close DATFILE;
181
+ return 1;
182
+ }
183
+
184
+ #------------------------------------------------------------------------------
185
+ # Sort database by specified field
186
+ # Inputs: 0) Field name to sort (Latitude,City,Country)
187
+ # Returns: 1 on success
188
+ sub SortDatabase($)
189
+ {
190
+ my $field = shift;
191
+ return 1 if $field eq $sortedBy; # already sorted?
192
+ if ($field eq 'Latitude') {
193
+ @cityList = sort { $a cmp $b } @cityList;
194
+ } elsif ($field eq 'City') {
195
+ @cityList = sort { substr($a,13) cmp substr($b,13) } @cityList;
196
+ } elsif ($field eq 'Country') {
197
+ my %lkup;
198
+ foreach (@cityList) {
199
+ my $city = substr($_,13);
200
+ my $ctry = substr($countryList[ord substr($_,5,1)], 2);
201
+ $lkup{$_} = "$ctry $city";
202
+ }
203
+ @cityList = sort { $lkup{$a} cmp $lkup{$b} } @cityList;
204
+ } else {
205
+ return 0;
206
+ }
207
+ $sortedBy = $field;
208
+ return 1;
209
+ }
210
+
211
+ #------------------------------------------------------------------------------
212
+ # Add cities to the Geolocation database
213
+ # Inputs: 0-8) city,region,subregion,country_code,country,timezone,feature_code,population,lat,lon
214
+ # eg. AddEntry('Sinemorets','Burgas','Obshtina Tsarevo','BG','Bulgaria','Europe/Sofia','',400,42.06115,27.97833)
215
+ sub AddEntry(@)
216
+ {
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
+ }
223
+ $fc = $featureCodes{lc $fc} || 0;
224
+ chomp $lon; # (just in case it was read from file)
225
+ # create reverse lookups for country/region/subregion/timezone if not done already
226
+ # (eg. if the entries are being added manually instead of via UserDefined::Geolocation)
227
+ unless (%countryNum) {
228
+ my $i;
229
+ $i = 0; $countryNum{lc substr($_,0,2)} = $i++ foreach @countryList;
230
+ $i = 0; $regionNum{lc $_} = $i++ foreach @regionList;
231
+ $i = 0; $subregionNum{lc $_} = $i++ foreach @subregionList;
232
+ $i = 0; $timezoneNum{lc $_} = $i++ foreach @timezoneList;
233
+ }
234
+ my $cn = $countryNum{lc $cc};
235
+ unless (defined $cn) {
236
+ push @countryList, "$cc$country";
237
+ $cn = $countryNum{lc $cc} = $#countryList;
238
+ } elsif ($country) {
239
+ $countryList[$cn] = "$cc$country"; # (override existing country name)
240
+ }
241
+ my $tn = $timezoneNum{lc $timezone};
242
+ unless (defined $tn) {
243
+ push @timezoneList, $timezone;
244
+ $tn = $timezoneNum{lc $timezone} = $#timezoneList;
245
+ }
246
+ my $rn = $regionNum{lc $region};
247
+ unless (defined $rn) {
248
+ push @regionList, $region;
249
+ $rn = $regionNum{lc $region} = $#regionList;
250
+ }
251
+ my $sn = $subregionNum{lc $subregion};
252
+ unless (defined $sn) {
253
+ push @subregionList, $subregion;
254
+ $sn = $subregionNum{lc $subregion} = $#subregionList;
255
+ }
256
+ $pop = sprintf('%.1e',$pop); # format: "3.1e+04" or "3.1e+004"
257
+ # pack CC index, population and region index into a 32-bit integer
258
+ my $code = ($cn << 24) | (substr($pop,-1,1)<<20) | (substr($pop,0,1)<<16) | (substr($pop,2,1)<<12) | $rn;
259
+ # store high bit of timezone index
260
+ $tn > 255 and $sn |= 0x8000, $tn -= 256;
261
+ $lat = int(($lat + 90) / 180 * 0x100000 + 0.5) & 0xfffff;
262
+ $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff;
263
+ my $hdr = pack('nCnNnCC', $lat>>4, (($lat&0x0f)<<4)|($lon&0x0f), $lon>>4, $code, $sn, $tn, $fc);
264
+ push @cityList, "$hdr$city";
265
+ $sortedBy = '';
266
+ }
267
+
268
+ #------------------------------------------------------------------------------
269
+ # 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($;$)
273
+ {
274
+ my ($entryNum, $lang) = @_;
275
+ return() if $entryNum > $#cityList;
276
+ my ($lt,$f,$ln,$code,$sb,$tn,$fc) = unpack('nCnNnCC', $cityList[$entryNum]);
277
+ my $city = substr($cityList[$entryNum],13);
278
+ my $ctry = $countryList[$code >> 24];
279
+ my $rgn = $regionList[$code & 0x0fff];
280
+ my $sub = $subregionList[$sb & 0x7fff];
281
+ # convert population digits back into exponent format
282
+ my $pop = (($code>>16 & 0x0f) . '.' . ($code>>12 & 0x0f) . 'e+' . ($code>>20 & 0x0f)) + 0;
283
+ $tn += 256 if $sb & 0x8000;
284
+ $lt = sprintf('%.4f', (($lt<<4)|($f >> 4)) * 180 / 0x100000 - 90);
285
+ $ln = sprintf('%.4f', (($ln<<4)|($f & 0x0f))* 360 / 0x100000 - 180);
286
+ $fc = $featureCodes[$fc & 0x0f];
287
+ my $cc = substr($ctry, 0, 2);
288
+ my $country = substr($ctry, 2);
289
+ if ($lang) {
290
+ my $xlat = $langLookup{$lang};
291
+ # load language lookups if not done already
292
+ if (not defined $xlat) {
293
+ if (eval "require '$geoLang/$lang.pm'") {
294
+ my $trans = "Image::ExifTool::GeoLang::${lang}::Translate";
295
+ no strict 'refs';
296
+ $xlat = \%$trans if %$trans;
297
+ }
298
+ # read user-defined language translations
299
+ if (%Image::ExifTool::Geolocation::geoLang) {
300
+ my $userLang = $Image::ExifTool::Geolocation::geoLang{$lang};
301
+ if ($userLang and ref($userLang) eq 'HASH') {
302
+ if ($xlat) {
303
+ # add user-defined entries to main lookup
304
+ $$xlat{$_} = $$userLang{$_} foreach keys %$userLang;
305
+ } else {
306
+ $xlat = $userLang;
307
+ }
308
+ }
309
+ }
310
+ $langLookup{$lang} = $xlat || 0;
311
+ }
312
+ if ($xlat) {
313
+ my $r2 = $rgn;
314
+ # City-specific: "CCRgn,Sub,City", "CCRgn,City", "CC,City", ",City"
315
+ # Subregion-specific: "CCRgn,Sub,"
316
+ # Region-specific: "CCRgn,"
317
+ # Country-specific: "CC,"
318
+ $city = $$xlat{"$cc$r2,$sub,$city"} || $$xlat{"$cc$r2,$city"} ||
319
+ $$xlat{"$cc,$city"} || $$xlat{",$city"} || $$xlat{$city} || $city;
320
+ $sub = $$xlat{"$cc$rgn,$sub,"} || $$xlat{$sub} || $sub;
321
+ $rgn = $$xlat{"$cc$rgn,"} || $$xlat{$rgn} || $rgn;
322
+ $country = $$xlat{"$cc,"} || $$xlat{$country} || $country;
323
+ }
324
+ }
325
+ return($city,$rgn,$sub,$cc,$country,$timezoneList[$tn],$fc,$pop,$lt,$ln);
326
+ }
327
+
328
+ #------------------------------------------------------------------------------
329
+ # Look up lat,lon or city in geolocation database
330
+ # 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)
346
+ sub Geolocate($;$$$$$)
347
+ {
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);
351
+
352
+ @cityList or warn('No Geolocation database'), return();
353
+ # make population code for comparing with 2 bytes at offset 6 in database
354
+ if ($pop) {
355
+ $pop = sprintf('%.1e', $pop);
356
+ $minPop = chr((substr($pop,-1,1)<<4) | (substr($pop,0,1))) . chr(substr($pop,2,1)<<4);
357
+ }
358
+ if ($fcodes) {
359
+ my $neg = $fcodes =~ s/^-//;
360
+ my @fcodes = split /\s*,\s*/, $fcodes;
361
+ if ($neg) {
362
+ $fcmask = 0xffff;
363
+ defined $featureCodes{lc $_} and $fcmask &= ~((1 << $featureCodes{lc $_})) foreach @fcodes;
364
+ } else {
365
+ defined $featureCodes{lc $_} and $fcmask |= (1 << $featureCodes{lc $_}) foreach @fcodes;
366
+ }
367
+ }
368
+ #
369
+ # process input argument
370
+ #
371
+ $arg =~ s/^\s+//; $arg =~ s/\s+$//; # remove leading/trailing spaces
372
+ my @args = split /\s*,\s*/, $arg;
373
+ my %ri = ( cc => 0, co => 1, re => 2, sr => 3, ci => 8, '' => 9 );
374
+ foreach (@args) {
375
+ # allow regular expressions optionally prefixed by "ci", "cc", "co", "re" or "sr"
376
+ if (m{^(-)?(\w{2})?/(.*)/(i?)$}) {
377
+ my $re = $4 ? qr/$3/im : qr/$3/m;
378
+ next if not defined($idx = $ri{$2});
379
+ $other = 1 if $idx < 5;
380
+ $idx += 10 if $1; # add 10 for negative matches
381
+ push @{$regex{$idx}}, $re;
382
+ $city = '' unless defined $city;
383
+ } elsif (/^[-+]?\d+(\.\d+)?$/) { # coordinate format
384
+ push @coords, $_ if @coords < 2;
385
+ } elsif (lc eq 'both') {
386
+ $both = 1;
387
+ } elsif ($city) {
388
+ push @exact, lc $_;
389
+ } else {
390
+ $city = lc $_;
391
+ }
392
+ }
393
+ unless (defined $city or @coords == 2) {
394
+ warn("Insufficient information to determine geolocation\n");
395
+ return();
396
+ }
397
+ # sort database by logitude if finding entry based on coordinates
398
+ SortDatabase('Latitude') if @coords == 2 and ($both or not defined $city);
399
+ #
400
+ # perform reverse Geolocation lookup to determine GPS based on city, country, etc.
401
+ #
402
+ while (defined $city and (@coords != 2 or $both)) {
403
+ Entry: for ($i=0; $i<@cityList; ++$i) {
404
+ my $cty = substr($cityList[$i],13);
405
+ next if $city and $city ne lc $cty; # test exact city name first
406
+ # test with city-specific regexes
407
+ if ($regex{8}) { $cty =~ $_ or next Entry foreach @{$regex{8}} }
408
+ if ($regex{18}) { $cty !~ $_ or next Entry foreach @{$regex{18}} }
409
+ # test other arguments
410
+ my ($cd,$sb) = unpack('x5Nn', $cityList[$i]);
411
+ my $ct = $countryList[$cd >> 24];
412
+ my @geo = (substr($ct,0,2), substr($ct,2), $regionList[$cd & 0x0fff], $subregionList[$sb & 0x7fff]);
413
+ if (@exact) {
414
+ # make quick lookup for all names at this location
415
+ my %geoLkup;
416
+ $_ and $geoLkup{lc $_} = 1 foreach @geo;
417
+ $geoLkup{$_} or next Entry foreach @exact;
418
+ }
419
+ # test with cc, co, re and sr regexes
420
+ if ($other) { foreach $idx (0..3) {
421
+ if ($regex{$idx}) { $geo[$idx] =~ $_ or next Entry foreach @{$regex{$idx}} }
422
+ if ($regex{$idx+10}) { $geo[$idx] !~ $_ or next Entry foreach @{$regex{$idx+10}} }
423
+ } }
424
+ # test regexes for any place name
425
+ if ($regex{9} or $regex{19}) {
426
+ my $str = join "\n", $cty, @geo;
427
+ $str =~ $_ or next Entry foreach @{$regex{9}};
428
+ $str !~ $_ or next Entry foreach @{$regex{19}};
429
+ }
430
+ # test feature code and population
431
+ next if $fcmask and not $fcmask & (1 << (ord(substr($cityList[$i],12,1)) & 0x0f));
432
+ my $pc = substr($cityList[$i],6,2);
433
+ $found{$i} = $pc if not defined $minPop or $pc ge $minPop;
434
+ }
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;
445
+ }
446
+ return \@multiCity;
447
+ }
448
+ warn "No such city in Geolocation database\n";
449
+ return();
450
+ }
451
+ #
452
+ # determine Geolocation based on GPS coordinates
453
+ #
454
+ my ($lat, $lon) = @coords;
455
+ if ($maxDist) {
456
+ $minDistU = $maxDist / (2 * $earthRadius); # min distance on unit sphere
457
+ $minDistC = $maxDist * 0x100000 / ($pi * $earthRadius); # min distance in coordinate units
458
+ } else {
459
+ $minDistU = $pi;
460
+ $minDistC = 0x200000;
461
+ }
462
+ my $cos = cos($lat * $pi / 180); # cosine factor for longitude distances
463
+ # reduce lat/lon to the range 0-0x100000
464
+ $lat = int(($lat + 90) / 180 * 0x100000 + 0.5) & 0xfffff;
465
+ $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff;
466
+ $lat or $lat = $coords[0] < 0 ? 1 : 0xfffff; # (zero latitude is a problem for our calculations)
467
+ my $coord = pack('nCn',$lat>>4,(($lat&0x0f)<<4)|($lon&0x0f),$lon>>4);;
468
+ # binary search to find closest longitude
469
+ my $numEntries = @matches || @cityList;
470
+ my ($n0, $n1) = (0, $numEntries - 1);
471
+ while ($n1 - $n0 > 1) {
472
+ my $n = int(($n0 + $n1) / 2);
473
+ if ($coord lt $cityList[@matches ? $matches[$n] : $n]) {
474
+ $n1 = $n;
475
+ } else {
476
+ $n0 = $n;
477
+ }
478
+ }
479
+ # step backward then forward through database to find nearest city
480
+ my ($inc, $end, $n) = (-1, -1, $n0+1);
481
+ my ($p0, $t0) = ($lat*$pi/0x100000 - $pi/2, $lon*$pi/0x080000 - $pi);
482
+ my $cp0 = cos($p0);
483
+ for (;;) {
484
+ if (($n += $inc) == $end) {
485
+ last if $inc == 1;
486
+ ($inc, $end, $n) = (1, $numEntries, $n1);
487
+ }
488
+ my $entryNum = @matches ? $matches[$n] : $n;
489
+ # get city latitude/longitude
490
+ my ($lt,$f,$ln) = unpack('nCn', $cityList[$entryNum]);
491
+ $lt = ($lt << 4) | ($f >> 4);
492
+ # searched far enough if latitude alone is further than best distance
493
+ abs($lt - $lat) > $minDistC and $n = $end - $inc, next;
494
+ # 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));
497
+ $ln = ($ln << 4) | ($f & 0x0f);
498
+ # calculate great circle distance to this city on unit sphere
499
+ my ($p1, $t1) = ($lt*$pi/0x100000 - $pi/2, $ln*$pi/0x080000 - $pi);
500
+ my ($sp, $st) = (sin(($p1-$p0)/2), sin(($t1-$t0)/2));
501
+ my $a = $sp * $sp + $cp0 * cos($p1) * $st * $st;
502
+ my $distU = atan2(sqrt($a), sqrt(1-$a));
503
+ next if $distU > $minDistU;
504
+ $minDistU = $distU;
505
+ $minDistC = $minDistU * 0x200000 / $pi;
506
+ @matchParms = ($entryNum, $p1, $t1, $distU);
507
+ }
508
+ @matchParms or warn("No suitable location in Geolocation database\n"), return();
509
+
510
+ # calculate distance in km and bearing to matching city
511
+ my ($en, $p1, $t1, $distU) = @matchParms;
512
+ my $km = sprintf('%.2f', 2 * $earthRadius * $distU);
513
+ my $be = atan2(sin($t1-$t0)*cos($p1-$p0), $cp0*sin($p1)-sin($p0)*cos($p1)*cos($t1-$t0));
514
+ $be = int($be * 180 / $pi + 360.5) % 360; # convert from radians to integer degrees
515
+
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;
520
+ }
521
+
522
+ 1; #end
523
+
524
+ __END__
525
+
526
+ =head1 NAME
527
+
528
+ Image::ExifTool::Geolocation - Look up geolocation based on GPS position
529
+
530
+ =head1 SYNOPSIS
531
+
532
+ This module is used by the Image::ExifTool Geolocation feature.
533
+
534
+ =head1 DESCRIPTION
535
+
536
+ This module contains the code to convert GPS coordinates to city, region,
537
+ subregion, country, time zone, etc. It uses a database derived from
538
+ geonames.org, modified to reduce the size as much as possible.
539
+
540
+ =head1 METHODS
541
+
542
+ =head2 ReadDatabase
543
+
544
+ Load Geolocation database from file. This method is called automatically
545
+ when this module is loaded. By default, the database is loaded from
546
+ "Geolocation.dat" in the same directory as this module, but a different
547
+ directory may be used by setting $Image::ExifTool::Geolocation::geoDir
548
+ before loading this module. Setting this to an empty string avoids loading
549
+ any database. A warning is generated if the file can't be read.
550
+
551
+ Image::ExifTool::Geolocation::ReadDatabase($filename);
552
+
553
+ =over 4
554
+
555
+ =item Inputs:
556
+
557
+ 0) Database file name
558
+
559
+ =item Return Value:
560
+
561
+ True on success.
562
+
563
+ =back
564
+
565
+ =head2 SortDatabase
566
+
567
+ Sort database in specified order.
568
+
569
+ Image::ExifTool::Geolocation::ReadDatabase('City');
570
+
571
+ =over 4
572
+
573
+ =item Inputs:
574
+
575
+ 0) Sort order: 'Latitude', 'City' or 'Country'
576
+
577
+ =item Return Value:
578
+
579
+ 1 on success, 0 on failure (bad sort order specified).
580
+
581
+ =back
582
+
583
+ =head2 AddEntry
584
+
585
+ Add entry to Geolocation database.
586
+
587
+ Image::ExifTool::Geolocation::AddEntry($city, $region,
588
+ $countryCode, $country, $timezone, $featureCode
589
+ $population, $lat, $lon);
590
+
591
+ =over 4
592
+
593
+ =item Inputs:
594
+
595
+ 0) City name (UTF8)
596
+
597
+ 1) Region, state or province name (UTF8), or empty string if unknown
598
+
599
+ 2) Subregion name (UTF8), or empty string if unknown
600
+
601
+ 3) 2-character ISO 3166 country code
602
+
603
+ 4) Country name (UTF8), or empty string to use existing definition. If the
604
+ country name is provided for a country code that already exists in the
605
+ database, then the database entry is updated with the new country name.
606
+
607
+ 5) Time zone identifier (eg. "America/New_York")
608
+
609
+ 6) Feature code (eg. "PPL"), or empty if not known
610
+
611
+ 7) City population
612
+
613
+ 8) GPS latitude (signed floating point degrees)
614
+
615
+ 9) GPS longitude
616
+
617
+ =back
618
+
619
+ =head2 GetEntry
620
+
621
+ Get entry from Geolocation database.
622
+
623
+ my @vals = Image::ExifTool::Geolocation::GetEntry($num,$lang);
624
+
625
+ =over 4
626
+
627
+ =item Inputs:
628
+
629
+ 0) Entry number in database
630
+
631
+ 1) Optional language code
632
+
633
+ =item Return Values:
634
+
635
+ 0) City name, or undef if the entry didn't exist
636
+
637
+ 1) Region name, or "" if no region
638
+
639
+ 2) Subregion name, or "" if no subregion
640
+
641
+ 3) Country code
642
+
643
+ 4) Country name
644
+
645
+ 5) Time zone
646
+
647
+ 6) Feature code
648
+
649
+ 7) City population
650
+
651
+ 8) GPS latitude
652
+
653
+ 9) GPS longitude
654
+
655
+ =item Notes:
656
+
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.
660
+
661
+ =back
662
+
663
+ =head2 Geolocate
664
+
665
+ Return geolocation information for specified GPS coordinates or city name.
666
+
667
+ my @cityInfo =
668
+ Image::ExifTool::Geolocation::Geolocate($arg,$pop,$dist,$lang,$multi,$codes);
669
+
670
+ =over 4
671
+
672
+ =item Inputs:
673
+
674
+ 0) Input argument ("lat,lon", "city", "city,country", "city,region,country",
675
+ etc). When specifying a city, the city name must come first, followed by
676
+ zero or more of the following in any order, separated by commas: region
677
+ name, subregion name, country code, and/or country name. Regular
678
+ expressions in C</expr/> format are also allowed, optionally prefixed by
679
+ "ci", "re", "sr", "cc" or "co" to specifically match City, Region,
680
+ Subregion, CountryCode or Country name. See
681
+ L<https://exiftool.org/geolocation.html#Read> for details.
682
+
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
688
+
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.
691
+
692
+ 5) Comma-separated list of feature codes to include in search, or to exclude
693
+ if the list starts with a dash (-).
694
+
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:
703
+
704
+ 0) Name of matching city (UTF8), or undef if no match
705
+
706
+ 1) Region, state or province name (UTF8), or "" if no region
707
+
708
+ 2) Subregion name (UTF8), or "" if no region
709
+
710
+ 3) Country code
711
+
712
+ 4) Country name (UTF8)
713
+
714
+ 5) Standard time zone identifier name
715
+
716
+ 6) Feature code
717
+
718
+ 7) City population rounded to 2 significant figures
719
+
720
+ 8) Approximate city latitude (signed degrees)
721
+
722
+ 9) Approximate city longitude
723
+
724
+ 10) Distance to city in km if "lat,lon" specified
725
+
726
+ 11) Compass bearing for direction to city if "lat,lon" specified
727
+
728
+ 12) Flag set if multiple matches were found
729
+
730
+ =back
731
+
732
+ =head1 USING A CUSTOM DATABASE
733
+
734
+ This example shows how to use a custom database. In this example, the input
735
+ database file is a comma-separated text file with columns corresponding to
736
+ the input arguments of the AddEntry method.
737
+
738
+ $Image::ExifTool::Geolocation::geoDir = '';
739
+ require Image::ExifTool::Geolocation;
740
+ open DFILE, "<$filename";
741
+ Image::ExifTool::Geolocation::AddEntry(split /,/) foreach <DFILE>;
742
+ close DFILE;
743
+
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
+ =head1 AUTHOR
752
+
753
+ Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
754
+
755
+ 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.
758
+
759
+ =head1 REFERENCES
760
+
761
+ =over 4
762
+
763
+ =item L<https://download.geonames.org/export/>
764
+
765
+ =item L<https://exiftool.org/geolocation.html>
766
+
767
+ =back
768
+
769
+ =head1 SEE ALSO
770
+
771
+ L<Image::ExifTool(3pm)|Image::ExifTool>
772
+
773
+ =cut
774
+
775
+ 1; #end