exiftool_vendored 12.76.0 → 12.80.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 +79 -4
- data/bin/MANIFEST +27 -0
- data/bin/META.json +1 -1
- data/bin/META.yml +1 -1
- data/bin/README +3 -3
- data/bin/config_files/acdsee.config +37 -57
- data/bin/config_files/example.config +16 -2
- data/bin/exiftool +84 -29
- data/bin/lib/Image/ExifTool/Canon.pm +12 -9
- data/bin/lib/Image/ExifTool/CanonVRD.pm +7 -1
- data/bin/lib/Image/ExifTool/Exif.pm +52 -4
- data/bin/lib/Image/ExifTool/FujiFilm.pm +3 -0
- data/bin/lib/Image/ExifTool/GPS.pm +5 -3
- data/bin/lib/Image/ExifTool/GeoLang/cs.pm +978 -0
- data/bin/lib/Image/ExifTool/GeoLang/de.pm +1975 -0
- data/bin/lib/Image/ExifTool/GeoLang/en_ca.pm +44 -0
- data/bin/lib/Image/ExifTool/GeoLang/en_gb.pm +124 -0
- data/bin/lib/Image/ExifTool/GeoLang/es.pm +2921 -0
- data/bin/lib/Image/ExifTool/GeoLang/fi.pm +1116 -0
- data/bin/lib/Image/ExifTool/GeoLang/fr.pm +3171 -0
- data/bin/lib/Image/ExifTool/GeoLang/it.pm +2750 -0
- data/bin/lib/Image/ExifTool/GeoLang/ja.pm +10256 -0
- data/bin/lib/Image/ExifTool/GeoLang/ko.pm +4499 -0
- data/bin/lib/Image/ExifTool/GeoLang/nl.pm +1270 -0
- data/bin/lib/Image/ExifTool/GeoLang/pl.pm +3019 -0
- data/bin/lib/Image/ExifTool/GeoLang/ru.pm +18220 -0
- data/bin/lib/Image/ExifTool/GeoLang/sk.pm +441 -0
- data/bin/lib/Image/ExifTool/GeoLang/sv.pm +714 -0
- data/bin/lib/Image/ExifTool/GeoLang/tr.pm +452 -0
- data/bin/lib/Image/ExifTool/GeoLang/zh_cn.pm +2225 -0
- data/bin/lib/Image/ExifTool/GeoLang/zh_tw.pm +72 -0
- data/bin/lib/Image/ExifTool/Geolocation.dat +0 -0
- data/bin/lib/Image/ExifTool/Geolocation.pm +775 -0
- data/bin/lib/Image/ExifTool/Geotag.pm +8 -1
- data/bin/lib/Image/ExifTool/HtmlDump.pm +2 -1
- data/bin/lib/Image/ExifTool/Import.pm +5 -2
- data/bin/lib/Image/ExifTool/JSON.pm +15 -10
- data/bin/lib/Image/ExifTool/MWG.pm +1 -0
- data/bin/lib/Image/ExifTool/MacOS.pm +19 -4
- data/bin/lib/Image/ExifTool/Nikon.pm +2 -2
- data/bin/lib/Image/ExifTool/Ogg.pm +3 -2
- data/bin/lib/Image/ExifTool/Olympus.pm +3 -1
- data/bin/lib/Image/ExifTool/OpenEXR.pm +17 -17
- data/bin/lib/Image/ExifTool/PDF.pm +5 -5
- data/bin/lib/Image/ExifTool/Pentax.pm +1 -1
- data/bin/lib/Image/ExifTool/QuickTime.pm +183 -11
- data/bin/lib/Image/ExifTool/QuickTimeStream.pl +253 -237
- data/bin/lib/Image/ExifTool/README +6 -5
- data/bin/lib/Image/ExifTool/TagLookup.pm +2624 -2520
- data/bin/lib/Image/ExifTool/TagNames.pod +184 -4
- data/bin/lib/Image/ExifTool/WriteQuickTime.pl +15 -1
- data/bin/lib/Image/ExifTool/WriteXMP.pl +1 -1
- data/bin/lib/Image/ExifTool/Writer.pl +59 -8
- data/bin/lib/Image/ExifTool/XMP.pm +17 -2
- data/bin/lib/Image/ExifTool/XMP2.pl +64 -0
- data/bin/lib/Image/ExifTool.pm +249 -47
- data/bin/lib/Image/ExifTool.pod +57 -25
- data/bin/perl-Image-ExifTool.spec +2 -2
- data/lib/exiftool_vendored/version.rb +1 -1
- 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
|