#------------------------------------------------------------------------------ # File: Geolocation.pm # # Description: Determine geolocation from GPS and visa-versa # # Revisions: 2024-03-03 - P. Harvey Created # 2024-03-21 - PH Significant restructuring and addition of # several new features. # # References: https://download.geonames.org/export/ # # Notes: Set $Image::ExifTool::Geolocation::geoDir to override the # default directory containing the database file Geolocation.dat # and the GeoLang directory with the alternate language files. # If set, this directory is # # AltNames.dat may be loaded from a different directory by # specifying $Image::ExifTool::Geolocation::altDir. This # database and has entries in the same order as Geolocation.dat, # and each entry is a newline-separated list of alternate names # terminated by a null byte. These alternate names are used # only when searching for a city by name (eg. "Big Apple"). # # Databases are based on data from geonames.org with a # Creative Commons license, reformatted as follows in the # Geolocation.dat file: # # Header: # "GeolocationV.VV\tNNNN\n" (V.VV=version, NNNN=num city entries) # "# \n" # NNNN City entries: # Offset Format Description # 0 int16u - latitude high 16 bits (converted to 0-0x100000 range) # 2 int8u - latitude low 4 bits, longitude low 4 bits # 3 int16u - longitude high 16 bits # 5 int8u - index of country in country list # 6 int8u - 0xf0 = population E exponent (in format "N.Fe+0E"), 0x0f = population N digit # 7 int16u - 0xf000 = population F digit, 0x0fff = index in region list (admin1) # 9 int16u - v1.02: 0x7fff = index in subregion (admin2), 0x8000 = high bit of time zone # 9 int16u - v1.03: index in subregion (admin2) # 11 int8u - low byte of time zone index # 12 int8u - 0x3f = feature code index (see below), v1.03: 0x80 = high bit of time zone # 13 string - UTF8 City name, terminated by newline # "\0\0\0\0\x01" # Country entries: # 1. 2-character country code # 2. Country name, terminated by newline # "\0\0\0\0\x02" # Region entries: # 1. Region name, terminated by newline # "\0\0\0\0\x03" # Subregion entries: # 1. Subregion name, terminated by newline # "\0\0\0\0\x04" # Time zone entries: # 1. Time zone name, terminated by newline # "\0\0\0\0\x05" (feature codes added in v1.03) # Feature codes: # 1. Feature code, optional space-followed-by-feature-name, then newline # "\0\0\0\0\0" # # Feature Codes v1.02: (see http://www.geonames.org/export/codes.html#P for descriptions) # # 0. Other 3. PPLA2 6. PPLA5 9. PPLF 12. PPLR 15. PPLX # 1. PPL 4. PPLA3 7. PPLC 10. PPLG 13. PPLS # 2. PPLA 5. PPLA4 8. PPLCH 11. PPLL 14. STLMT #------------------------------------------------------------------------------ package Image::ExifTool::Geolocation; use strict; use vars qw($VERSION $geoDir $altDir $dbInfo); $VERSION = '1.08'; # (this is the module version number, not the database version) my $debug; # set to output processing time for testing sub ReadDatabase($); sub SortDatabase($); sub AddEntry(@); sub GetEntry($;$$); sub Geolocate($;$); my (@cityList, @countryList, @regionList, @subregionList, @timezoneList); my (%countryNum, %regionNum, %subregionNum, %timezoneNum); # reverse lookups my (@sortOrder, @altNames, %langLookup, $nCity, %featureCodes, %featureTypes); my ($lastArgs, %lastFound, @lastByPop, @lastByLat); # cached city matches my $dbVer = '1.03'; my $sortedBy = 'Latitude'; my $pi = 3.1415926536; my $earthRadius = 6371; # earth radius in km # hard-coded feature codes for v1.02 database my @featureCodes = qw(Other PPL PPLA PPLA2 PPLA3 PPLA4 PPLA5 PPLC PPLCH PPLF PPLG PPLL PPLR PPLS STLMT PPLX); # get path name for database file from lib/Image/ExifTool/Geolocation.dat by default, # or according to $Image::ExifTool::Geolocation::directory if specified my $defaultDir = $INC{'Image/ExifTool/Geolocation.pm'}; if ($defaultDir) { $defaultDir =~ s(/Geolocation\.pm$)(); } else { $defaultDir = '.'; warn("Error getting Geolocation.pm directory\n"); } # read the Geolocation database unless $geoDir set to empty string unless (defined $geoDir and not $geoDir) { unless ($geoDir and ReadDatabase("$geoDir/Geolocation.dat")) { ReadDatabase("$defaultDir/Geolocation.dat"); } } # set directory for language files and alternate names $geoDir = $defaultDir unless defined $geoDir; if (not defined $altDir and $geoDir and -e "$geoDir/AltNames.dat") { $altDir = $geoDir; } # add user-defined entries to the database if (@Image::ExifTool::UserDefined::Geolocation) { AddEntry(@$_) foreach @Image::ExifTool::UserDefined::Geolocation; } #------------------------------------------------------------------------------ # Read Geolocation database # Inputs: 0) database file name # Returns: true on success sub ReadDatabase($) { my $datfile = shift; # open geolocation database and verify header open DATFILE, "< $datfile" or warn("Error reading $datfile\n"), return 0; binmode DATFILE; my $line = ; unless ($line =~ /^Geolocation(\d+\.\d+)\t(\d+)/) { warn("Bad format Geolocation database\n"); close(DATFILE); return 0; } ($dbVer, $nCity) = ($1, $2); if ($dbVer !~ /^1\.0[23]$/) { my $which = $dbVer < 1.03 ? 'database' : 'ExifTool'; warn("Incompatible Geolocation database (update your $which)\n"); close(DATFILE); return 0; } my $comment = ; defined $comment and $comment =~ / (\d+) / or close(DATFILE), return 0; $dbInfo = "$datfile v$dbVer: $nCity cities with population > $1"; my $isUserDefined = @Image::ExifTool::UserDefined::Geolocation; undef @altNames; # reset altNames # read city database undef @cityList; my $i = 0; for (;;) { $line = ; last if length($line) == 6 and $line =~ /\0\0\0\0/; $line .= while length($line) < 14; chomp $line; push @cityList, $line; } @cityList == $nCity or warn("Bad number of entries in Geolocation database\n"), return 0; # read countries for (;;) { $line = ; last if length($line) == 6 and $line =~ /\0\0\0\0/; chomp $line; push @countryList, $line; $countryNum{lc substr($line,0,2)} = $#countryList if $isUserDefined; } # read regions for (;;) { $line = ; last if length($line) == 6 and $line =~ /\0\0\0\0/; chomp $line; push @regionList, $line; $regionNum{lc $line} = $#regionList if $isUserDefined; } # read subregions for (;;) { $line = ; last if length($line) == 6 and $line =~ /\0\0\0\0/; chomp $line; push @subregionList, $line; $subregionNum{lc $line} = $#subregionList if $isUserDefined; } # read time zones for (;;) { $line = ; last if length($line) == 6 and $line =~ /\0\0\0\0/; chomp $line; push @timezoneList, $line; $timezoneNum{lc $line} = $#timezoneList if $isUserDefined; } # read feature codes if available if ($line eq "\0\0\0\0\x05\n") { undef @featureCodes; for (;;) { $line = ; last if length($line) == 6 and $line =~ /\0\0\0\0/; chomp $line; $featureTypes{$line} = $1 if $line =~ s/ (.*)//; push @featureCodes, $line; } } close DATFILE; # initialize featureCodes lookup $i = 0; %featureCodes = map { lc($_) => $i++ } @featureCodes; return 1; } #------------------------------------------------------------------------------ # Read alternate-names database # Returns: True on success # Notes: Must be called after ReadDatabase(). Resets $altDir on exit. sub ReadAltNames() { my $success; if ($altDir and $nCity) { if (open ALTFILE, "< $altDir/AltNames.dat") { binmode ALTFILE; local $/ = "\0"; my $i = 0; while () { chop; $altNames[$i++] = $_; } close ALTFILE; if ($i == $nCity) { $success = 1; } else { warn("Bad number of entries in AltNames database\n"); undef @altNames; } } else { warn "Error reading $altDir/AltNames.dat\n"; } undef $altDir; } return $success; } #------------------------------------------------------------------------------ # Clear last city matches cache sub ClearLastMatches() { undef $lastArgs; # arguments in last call to Geolocate undef %lastFound; # keys are last matching city numbers, values are population codes undef @lastByPop; # last matching city numbers ordered by population undef @lastByLat; # last matching city numbers ordered by latitude } #------------------------------------------------------------------------------ # Sort database by specified field # Inputs: 0) Field name to sort (Latitude,City,Country) # Returns: 1 on success sub SortDatabase($) { my $field = shift; return 1 if $field eq $sortedBy; # already sorted? undef @sortOrder; if ($field eq 'Latitude') { @sortOrder = sort { $cityList[$a] cmp $cityList[$b] } 0..$#cityList; } elsif ($field eq 'City') { @sortOrder = sort { substr($cityList[$a],13) cmp substr($cityList[$b],13) } 0..$#cityList; } elsif ($field eq 'Country') { my %lkup; foreach (0..$#cityList) { my $city = substr($cityList[$_],13); my $ctry = substr($countryList[ord substr($cityList[$_],5,1)], 2); $lkup{$_} = "$ctry $city"; } @sortOrder = sort { $lkup{$a} cmp $lkup{$b} } 0..$#cityList; } else { return 0; } $sortedBy = $field; ClearLastMatches(); return 1; } #------------------------------------------------------------------------------ # Add cities to the Geolocation database # Inputs: 0-8) city,region,subregion,country_code,country,timezone,feature_code,population,lat,lon,altNames # eg. AddEntry('Sinemorets','Burgas','Obshtina Tsarevo','BG','Bulgaria','Europe/Sofia','',400,42.06115,27.97833) # Returns: true on success, otherwise issues warning sub AddEntry(@) { my ($city, $region, $subregion, $cc, $country, $timezone, $fc, $pop, $lat, $lon, $altNames) = @_; @_ < 10 and warn("Too few arguments in $city definition (check for updated format)\n"), return 0; length($cc) != 2 and warn("Country code '${cc}' is not 2 characters\n"), return 0; $featureTypes{$fc} = $1 if $fc =~ s/ (.*)//; my $fn = $featureCodes{lc $fc}; unless (defined $fn) { if ($dbVer eq '1.02' or @featureCodes > 0x3f or not length $fc) { $fn = 0; } else { push @featureCodes, uc($fc); $featureCodes{lc $fc} = $fn = $#featureCodes; } } chomp $lon; # (just in case it was read from file) # create reverse lookups for country/region/subregion/timezone if not done already # (eg. if the entries are being added manually instead of via UserDefined::Geolocation) unless (%countryNum) { my $i; $i = 0; $countryNum{lc substr($_,0,2)} = $i++ foreach @countryList; $i = 0; $regionNum{lc $_} = $i++ foreach @regionList; $i = 0; $subregionNum{lc $_} = $i++ foreach @subregionList; $i = 0; $timezoneNum{lc $_} = $i++ foreach @timezoneList; } my $cn = $countryNum{lc $cc}; unless (defined $cn) { $#countryList >= 0xff and warn("AddEntry: Too many countries\n"), return 0; push @countryList, "$cc$country"; $cn = $countryNum{lc $cc} = $#countryList; } elsif ($country) { $countryList[$cn] = "$cc$country"; # (override existing country name) } my $tn = $timezoneNum{lc $timezone}; unless (defined $tn) { $#timezoneList >= 0x1ff and warn("AddEntry: Too many time zones\n"), return 0; push @timezoneList, $timezone; $tn = $timezoneNum{lc $timezone} = $#timezoneList; } my $rn = $regionNum{lc $region}; unless (defined $rn) { $#regionList >= 0xfff and warn("AddEntry: Too many regions\n"), return 0; push @regionList, $region; $rn = $regionNum{lc $region} = $#regionList; } my $sn = $subregionNum{lc $subregion}; unless (defined $sn) { my $max = $dbVer eq '1.02' ? 0x7fff : 0xffff; $#subregionList >= $max and warn("AddEntry: Too many subregions\n"), return 0; push @subregionList, $subregion; $sn = $subregionNum{lc $subregion} = $#subregionList; } $pop = sprintf('%.1e',$pop); # format: "3.1e+04" or "3.1e+004" # pack CC index, population and region index into a 32-bit integer my $code = ($cn << 24) | (substr($pop,-1,1)<<20) | (substr($pop,0,1)<<16) | (substr($pop,2,1)<<12) | $rn; # store high bit of timezone index if ($tn > 255) { if ($dbVer eq '1.02') { $sn |= 0x8000; } else { $fn |= 0x80; } $tn -= 256; } $lat = int(($lat + 90) / 180 * 0x100000 + 0.5) & 0xfffff; $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff; my $hdr = pack('nCnNnCC', $lat>>4, (($lat&0x0f)<<4)|($lon&0x0f), $lon>>4, $code, $sn, $tn, $fn); push @cityList, "$hdr$city"; # add altNames entry if provided if ($altNames) { chomp $altNames; # (just in case) $altNames =~ tr/,/\n/; # add any more arguments in case altNames were passed separately (undocumented) foreach (11..$#_) { chomp $_[$_]; $altNames .= "\n$_[$_]"; } $altNames[$#cityList] = $altNames; } $sortedBy = ''; undef $lastArgs; # (faster than ClearLastArgs) return 1; } #------------------------------------------------------------------------------ # Unpack entry in database # Inputs: 0) entry number or index into sorted database, # 1) optional language code, 2) flag to use index into sorted database # Returns: 0-10) city,region,subregion,country_code,country,timezone, # feature_code,pop,lat,lon,feature_type sub GetEntry($;$$) { my ($entryNum, $lang, $sort) = @_; return() if $entryNum > $#cityList; $entryNum = $sortOrder[$entryNum] if $sort and @sortOrder > $entryNum; my ($lt,$f,$ln,$code,$sn,$tn,$fn) = unpack('nCnNnCC', $cityList[$entryNum]); my $city = substr($cityList[$entryNum],13); my $ctry = $countryList[$code >> 24]; my $rgn = $regionList[$code & 0x0fff]; if ($dbVer eq '1.02') { $sn & 0x8000 and $tn += 256, $sn &= 0x7fff; } else { $fn & 0x80 and $tn += 256; } my $sub = $subregionList[$sn]; # convert population digits back into exponent format my $pop = (($code>>16 & 0x0f) . '.' . ($code>>12 & 0x0f) . 'e+' . ($code>>20 & 0x0f)) + 0; $lt = sprintf('%.4f', (($lt<<4)|($f >> 4)) * 180 / 0x100000 - 90); $ln = sprintf('%.4f', (($ln<<4)|($f & 0x0f))* 360 / 0x100000 - 180); my $fc = $featureCodes[$fn & 0x3f] || 'Other'; my $cc = substr($ctry, 0, 2); my $country = substr($ctry, 2); my $ft = $featureTypes{$fc}; if ($lang and $lang ne 'en') { my $xlat = $langLookup{$lang}; # load language lookups if not done already if (not defined $xlat) { if (eval "require '$geoDir/GeoLang/$lang.pm'") { my $trans = "Image::ExifTool::GeoLang::${lang}::Translate"; no strict 'refs'; $xlat = \%$trans if %$trans; } # read user-defined language translations if (%Image::ExifTool::Geolocation::geoLang) { my $userLang = $Image::ExifTool::Geolocation::geoLang{$lang}; if ($userLang and ref($userLang) eq 'HASH') { if ($xlat) { # add user-defined entries to main lookup $$xlat{$_} = $$userLang{$_} foreach keys %$userLang; } else { $xlat = $userLang; } } } $langLookup{$lang} = $xlat || 0; } if ($xlat) { my $r2 = $rgn; # City-specific: "CCRgn,Sub,City", "CCRgn,City", "CC,City", ",City" # Subregion-specific: "CCRgn,Sub," # Region-specific: "CCRgn," # Country-specific: "CC," $city = $$xlat{"$cc$r2,$sub,$city"} || $$xlat{"$cc$r2,$city"} || $$xlat{"$cc,$city"} || $$xlat{",$city"} || $$xlat{$city} || $city; $sub = $$xlat{"$cc$rgn,$sub,"} || $$xlat{$sub} || $sub; $rgn = $$xlat{"$cc$rgn,"} || $$xlat{$rgn} || $rgn; $country = $$xlat{"$cc,"} || $$xlat{$country} || $country; $ft = $$xlat{$fc} if $$xlat{$fc}; } } return($city,$rgn,$sub,$cc,$country,$timezoneList[$tn],$fc,$pop,$lt,$ln,$ft); } #------------------------------------------------------------------------------ # Get alternate names for specified database entry # Inputs: 0) entry number or index into sorted database, 1) sort flag # Returns: comma-separated list of alternate names, or empty string if no names # Notes: ReadAltNames() must be called before this sub GetAltNames($;$) { my ($entryNum, $sort) = @_; $entryNum = $sortOrder[$entryNum] if $sort and @sortOrder > $entryNum; my $alt = $altNames[$entryNum] or return ''; $alt =~ tr/\n/,/; return $alt; } #------------------------------------------------------------------------------ # Look up lat,lon or city in geolocation database # Inputs: 0) "lat,lon", "city,region,country", etc, (city must be first) # 1) options hash reference (or undef for no options) # Options: GeolocMinPop, GeolocMaxDist, GeolocMulti, GeolocFeature, GeolocAltNames, # GeolocNearby # Returns: List of matching city information, empty if none found. # Each element in the list is an array with 0=index of city in database, # 1=distance in km (or undef if no distance), 2=compass bearing (or undef) sub Geolocate($;$) { my ($arg, $opts) = @_; my ($city, @exact, %regex, @multiCity, $other, $idx, @cargs, $useLastFound); my ($minPop, $minDistU, $minDistC, @matchParms, @coords, %fcOK, $both); my ($pop, $maxDist, $multi, $fcodes, $altNames, @startTime); $opts and ($pop, $maxDist, $multi, $fcodes, $altNames) = @$opts{qw(GeolocMinPop GeolocMaxDist GeolocMulti GeolocFeature GeolocAltNames)}; if ($debug) { require Time::HiRes; @startTime = Time::HiRes::gettimeofday(); } @cityList or warn('No Geolocation database'), return(); # make population code for comparing with 2 bytes at offset 6 in database if ($pop) { $pop = sprintf('%.1e', $pop); $minPop = chr((substr($pop,-1,1)<<4) | (substr($pop,0,1))) . chr(substr($pop,2,1)<<4); } if ($fcodes) { my $neg = $fcodes =~ s/^-//; my @fcodes = split /\s*,-?\s*/, lc $fcodes; # (allow leading dash on subsequent codes) if ($neg) { $fcOK{$_} = 1 foreach 0..$#featureCodes; defined $featureCodes{$_} and delete $fcOK{$featureCodes{$_}} foreach @fcodes; } else { defined $featureCodes{$_} and $fcOK{$featureCodes{$_}} = 1 foreach @fcodes; } } # # process input argument # my $num = 1; $arg =~ s/^\s+//; $arg =~ s/\s+$//; # remove leading/trailing spaces my @args = split /\s*,\s*/, $arg; my %ri = ( cc => 0, co => 1, re => 2, sr => 3, ci => 8, '' => 9 ); foreach (@args) { # allow regular expressions optionally prefixed by "ci", "cc", "co", "re" or "sr" if (m{^(-)?(\w{2})?/(.*)/(i?)$}) { my $re = $4 ? qr/$3/im : qr/$3/m; next if not defined($idx = $ri{$2}); push @cargs, $_; $other = 1 if $idx < 5; $idx += 10 if $1; # add 10 for negative matches $regex{$idx} or $regex{$idx} = [ ]; push @{$regex{$idx}}, $re; $city = '' unless defined $city; } elsif (/^[-+]?\d+(\.\d+)?$/) { # coordinate format push @coords, $_ if @coords < 2; } elsif (/^([-+]?\d+(?:\.\d+)?) *(([NS])[A-Z]*)? +([-+]?\d+(?:\.\d+)?) *(([EW])[A-Z]*)?/i) { # "lat lon" format next if @coords; my ($lat, $lon) = ($1, $4); $lat = -abs($lat) if $3 and uc($3) eq 'S'; $lon = -abs($lon) if $6 and uc($6) eq 'W'; push @coords, $lat, $lon; } elsif (lc $_ eq 'both') { $both = 1; } elsif ($_ =~ /^num=(\d+)$/i) { $num = $1; } elsif ($_) { push @cargs, $_; if ($city) { push @exact, lc $_; } else { $city = lc $_; } } } unless (defined $city or @coords == 2) { warn("Insufficient information to determine geolocation\n"); return(); } # sort database by logitude if finding entry based on coordinates SortDatabase('Latitude') if @coords == 2 and ($both or not defined $city); # # perform reverse Geolocation lookup to determine GPS based on city, country, etc. # while (defined $city and (@coords != 2 or $both)) { my $cargs = join(',', @cargs, $pop||'', $maxDist||'', $fcodes||''); my $i = 0; if ($lastArgs and $lastArgs eq $cargs) { $i = @cityList; # bypass search } else { ClearLastMatches(); $lastArgs = $cargs; } # read alternate names database if an exact city match is specified if ($altNames) { ReadAltNames() if $city and $altDir; $altNames = \@altNames; } else { $altNames = [ ]; # (don't search alt names) } Entry: for (; $i<@cityList; ++$i) { my $cty = substr($cityList[$i],13); if ($city and $city ne lc $cty) { # test exact city name first next unless $$altNames[$i] and $$altNames[$i] =~ /^$city$/im; } # test with city-specific regexes if ($regex{8}) { $cty =~ $_ or next Entry foreach @{$regex{8}} } if ($regex{18}) { $cty !~ $_ or next Entry foreach @{$regex{18}} } # test other arguments my ($cd,$sn) = unpack('x5Nn', $cityList[$i]); my $ct = $countryList[$cd >> 24]; $sn &= 0x7fff if $dbVer eq '1.02'; my @geo = (substr($ct,0,2), substr($ct,2), $regionList[$cd & 0x0fff], $subregionList[$sn]); if (@exact) { # make quick lookup for all names at this location my %geoLkup; $_ and $geoLkup{lc $_} = 1 foreach @geo; $geoLkup{$_} or next Entry foreach @exact; } # test with cc, co, re and sr regexes if ($other) { foreach $idx (0..3) { if ($regex{$idx}) { $geo[$idx] =~ $_ or next Entry foreach @{$regex{$idx}} } if ($regex{$idx+10}) { $geo[$idx] !~ $_ or next Entry foreach @{$regex{$idx+10}} } } } # test regexes for any place name if ($regex{9} or $regex{19}) { my $str = join "\n", $cty, @geo; $str =~ $_ or next Entry foreach @{$regex{9}}; $str !~ $_ or next Entry foreach @{$regex{19}}; } # test feature code and population next if $fcodes and not $fcOK{ord(substr($cityList[$i],12,1)) & 0x3f}; my $pc = substr($cityList[$i],6,2); if (not defined $minPop or $pc ge $minPop) { $lastFound{$i} = $pc; push @lastByLat, $i if @coords == 2; } } @startTime and printf("= Processing time: %.3f sec\n", Time::HiRes::tv_interval(\@startTime)); if (%lastFound) { @coords == 2 and $useLastFound = 1, last; # continue to use coords with last city matches scalar(keys %lastFound) > 200 and warn("Too many matching cities\n"), return(); unless (@lastByPop) { @lastByPop = sort { $lastFound{$b} cmp $lastFound{$a} or $cityList[$a] cmp $cityList[$b] } keys %lastFound; } return(\@lastByPop); } warn "No such city in Geolocation database\n"; return(); } # # determine Geolocation based on GPS coordinates # my ($lat, $lon) = @coords; if ($maxDist) { $minDistU = $maxDist / (2 * $earthRadius); # min distance on unit sphere $minDistC = $maxDist * 0x100000 / ($pi * $earthRadius); # min distance in coordinate units } else { $minDistU = $pi; $minDistC = 0x200000; } my $cos = cos($lat * $pi / 180); # cosine factor for longitude distances # reduce lat/lon to the range 0-0x100000 $lat = int(($lat + 90) / 180 * 0x100000 + 0.5) & 0xfffff; $lon = int(($lon + 180) / 360 * 0x100000 + 0.5) & 0xfffff; $lat or $lat = $coords[0] < 0 ? 1 : 0xfffff; # (zero latitude is a problem for our calculations) my $coord = pack('nCn',$lat>>4,(($lat&0x0f)<<4)|($lon&0x0f),$lon>>4);; # start from cached city matches if also using city information my $numEntries = @lastByLat || @cityList; # binary search to find closest longitude my ($n0, $n1) = (0, $numEntries - 1); my $sorted = @lastByLat ? \@lastByLat : (@sortOrder ? \@sortOrder : undef); while ($n1 - $n0 > 1) { my $n = int(($n0 + $n1) / 2); if ($coord lt $cityList[$sorted ? $$sorted[$n] : $n]) { $n1 = $n; } else { $n0 = $n; } } # step backward then forward through database to find nearest city my ($inc, $end, $n) = (-1, -1, $n0+1); my ($p0, $t0) = ($lat*$pi/0x100000 - $pi/2, $lon*$pi/0x080000 - $pi); my $cp0 = cos($p0); my (@matches, @rtnList, @dist); for (;;) { if (($n += $inc) == $end) { last if $inc == 1 or $n0 == $n1; ($inc, $end, $n) = (1, $numEntries, $n1); } my $i = $sorted ? $$sorted[$n] : $n; # get city latitude/longitude my ($lt,$f,$ln) = unpack('nCn', $cityList[$i]); $lt = ($lt << 4) | ($f >> 4); # searched far enough if latitude alone is further than best distance abs($lt - $lat) > $minDistC and $n = $end - $inc, next; # ignore if population is below threshold next if defined $minPop and $minPop ge substr($cityList[$i],6,2); next if $fcodes and not $fcOK{ord(substr($cityList[$i],12,1)) & 0x3f}; $ln = ($ln << 4) | ($f & 0x0f); # calculate great circle distance to this city on unit sphere my ($p1, $t1) = ($lt*$pi/0x100000 - $pi/2, $ln*$pi/0x080000 - $pi); my ($sp, $st) = (sin(($p1-$p0)/2), sin(($t1-$t0)/2)); my $a = $sp * $sp + $cp0 * cos($p1) * $st * $st; my $distU = atan2(sqrt($a), sqrt(1-$a)); # distance on unit sphere next if $distU > $minDistU; @matchParms = ($i, $p1, $t1, $distU); if ($num <= 1) { $minDistU = $distU; } else { my $j; # add this entry into list of matching cities ordered by closest first for ($j=0; $j<@matches; ++$j) { last if $distU < $matches[$j][3]; } if ($j < $#matches) { splice @matches, $j, 0, [ @matchParms ]; } else { $matches[$j] = [ @matchParms ]; } # restrict list to the specified number of nearest cities pop @matches if @matches > $num; # update minimum distance with furthest match if we satisfied our quota $minDistU = $matches[-1][3] if @matches >= $num; } $minDistC = $minDistU * 0x200000 / $pi; # distance in scaled coordinate units } @matchParms or warn("No suitable location in Geolocation database\n"), return(); $num = @matches; @startTime and printf("- Processing time: %.3f sec\n", Time::HiRes::tv_interval(\@startTime)); for (;;) { if ($num > 1) { last unless @matches; @matchParms = @{$matches[0]}; shift @matches; } # calculate distance in km and bearing to matching city my ($ii, $p1, $t1, $distU) = @matchParms; my $km = sprintf('%.2f', 2 * $earthRadius * $distU); my $be = atan2(sin($t1-$t0)*cos($p1-$p0), $cp0*sin($p1)-sin($p0)*cos($p1)*cos($t1-$t0)); $be = int($be * 180 / $pi + 360.5) % 360; # convert from radians to integer degrees push @rtnList, $ii; push @dist, [ $km, $be ]; last if $num <= 1; } return(\@rtnList, \@dist); } 1; #end __END__ =head1 NAME Image::ExifTool::Geolocation - Determine geolocation from GPS and visa-versa =head1 SYNOPSIS Look up geolocation information (city, region, subregion, country, etc) based on input GPS coordinates, or determine GPS coordinates based on city name, etc. =head1 DESCRIPTION This module contains the code to convert GPS coordinates to city, region, subregion, country, time zone, etc. It uses a database derived from geonames.org, modified to reduce the size as much as possible. =head1 METHODS =head2 ReadDatabase Load Geolocation database from file. This method is called automatically when this module is loaded. By default, the database is loaded from "Geolocation.dat" in the same directory as this module, but a different directory may be used by setting $Image::ExifTool::Geolocation::geoDir before loading this module. Setting this to an empty string avoids loading any database. A warning is generated if the file can't be read. Image::ExifTool::Geolocation::ReadDatabase($filename); =over 4 =item Inputs: 0) Database file name =item Return Value: True on success. =back =head2 ReadAltNames Load the alternate names database. Before calling this method the $altDir package variable may be set, otherwise AltNames.dat is loaded from the same directory as Geolocation.dat. This method is called automatically by L if the GeolocAltNames option is used and an input city name is provided. Image::ExifTool::Geolocation::ReadAltNames(); =over 4 =item Inputs: (none) =item Return Value: True on success. May be called repeatedly, but AltNames.dat is loaded only on the first call. =back =head2 SortDatabase Sort database in specified order. Image::ExifTool::Geolocation::ReadDatabase('City'); =over 4 =item Inputs: 0) Sort order: 'Latitude', 'City' or 'Country' =item Return Value: 1 on success, 0 on failure (bad sort order specified). =back =head2 AddEntry Add entry to Geolocation database. Image::ExifTool::Geolocation::AddEntry($city, $region, $subregion, $countryCode, $country, $timezone, $featureCode, $population, $lat, $lon, $altNames); =over 4 =item Inputs: 0) City name (UTF8) 1) Region, state or province name (UTF8), or empty string if unknown 2) Subregion name (UTF8), or empty string if unknown 3) 2-character ISO 3166 country code 4) Country name (UTF8), or empty string to use existing definition. If the country name is provided for a country code that already exists in the database, then the database entry is updated with the new country name. 5) Time zone identifier (eg. "America/New_York") 6) Feature code (eg. "PPL"), or empty if not known 7) City population 8) GPS latitude (signed floating point degrees) 9) GPS longitude 10) Optional comma-separated list of alternate names for the city =item Return Value: 1 on success, otherwise sends a warning message to stderr =back =head2 GetEntry Get entry from Geolocation database. my @vals = Image::ExifTool::Geolocation::GetEntry($num,$lang,$sort); =over 4 =item Inputs: 0) Entry number in database, or index into sorted database 1) Optional language code 2) Optional flag to treat first argument as an index into the sorted database item Return Values: 0) City name, or undef if the entry didn't exist 1) Region name, or "" if no region 2) Subregion name, or "" if no subregion 3) Country code 4) Country name 5) Time zone 6) Feature code 7) City population 8) GPS latitude 9) GPS longitude 10) Feature type, or undef =back =head2 GetAltNames Get alternate names for specified city. my $str = Image::ExifTool::Geolocation::GetAltNames($num,$sort); =over 4 =item Inputs: 0) Entry number in database or index into the sorted database 1) Optional flag to treat first argument as an index into the sorted database =item Return value: Comma-separated string of alternate names for this city. =item Notes: L must be called before calling this routine. =back =head2 Geolocate Return geolocation information for specified GPS coordinates or city name. my @rtnInfo = Image::ExifTool::Geolocation::Geolocate($arg,$opts); =over 4 =item Inputs: 0) Input argument ("lat,lon", "city", "city,country", "city,region,country", etc). When specifying a city, the city name must come first, followed by zero or more of the following in any order, separated by commas: region name, subregion name, country code, and/or country name. Regular expressions in C format are also allowed, optionally prefixed by "ci", "re", "sr", "cc" or "co" to specifically match City, Region, Subregion, CountryCode or Country name. Two special controls may be added to the argument list: 'both' - When search input includes both name and GPS coordinates, use both to determine the closest city matching the specified name(s) instead of using GPS only. 'num=##' - When the search includes GPS coordinates, return the nearest ## cities instead of just the closest one. Returned cities are in the order from nearest to farthest. See L for more details. 1) Optional reference to hash of options: GeolocMinPop - Minimum population of cities to consider in search. Default 0. GeolocMaxDist - Maximum distance (km) to search for cities when an input GPS position is used. Default infinity. GeolocMulti - Flag to return multiple cities if there is more than one match. Used in the case where no input GPS coordinates are provided. Default 0. GeolocFeature - Comma-separated list of feature codes to include in search, or exclude if the list starts with a dash (-). Default undef. GeolocAltNames - Flag to search alternate names database if available for matching city name (see ALTERNATE DATABASES below). Default undef. =item Return Values: 0) Reference to list of database entry numbers for matching cities, or undef if no matches were found. 1) Reference to list of distance/bearing pairs for each matching city, or undef if the search didn't provide GPS coordinates. =back =head1 ALTERNATE DATABASES A different version of the cities database may be specified setting the package $geoDir variable before loading this module. This directory should contain the Geolocation.dat file, and optionally a GeoLang directory for the language translations. The $geoDir variable may be set to an empty string to disable loading of a database. When searching for a city by name, AltNames.dat is checked to provide additional possibilities for matches if the GeolocAltNames option is set and an AltNames.dat database exists. The package $altDir variable may be set to specify a different directory for AltNames.dat, otherwise the Geolocation.dat directory is assumed. The entries in AltNames.dat must match those in the currently loaded version of Geolocation.dat. =head1 ADDING USER-DEFINED DATABASE ENTRIES User-defined entries may be created by defining them using the following technique before the Geolocation module is loaded. @Image::ExifTool::UserDefined::Geolocation = ( # city, region, subregion, country code, country, timezone, ['Sinemorets','burgas','Obshtina Tsarevo','BG','','Europe/Sofia', # feature code, population, lat, lon 'PPL',400,42.06115,27.97833], ); Similarly, user-defined language translations may be defined, and will override any existing translations. Translations for the default 'en' language may also be specified. See L for more information. =head1 USING A CUSTOM DATABASE This example shows how to use a custom database. In this example, the input database file is a comma-separated text file with columns corresponding to the input arguments of the AddEntry method. $Image::ExifTool::Geolocation::geoDir = ''; require Image::ExifTool::Geolocation; open DFILE, "< $filename"; Image::ExifTool::Geolocation::AddEntry(split /,/) foreach ; close DFILE; =head1 AUTHOR Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com) This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The associated database files are based on data from geonames.org with a Creative Commons license. =head1 REFERENCES =over 4 =item L =item L =back =head1 SEE ALSO L =cut 1; #end