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