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