exiftool-vendored.pl 12.78.0 → 12.80.0

package/bin/lib/Image/ExifTool/Geolocation.pm

@@ -7,195 +7,520 @@
 #
 # References:   https://download.geonames.org/export/
 #
-# Notes:        Set $Image::ExifTool::Geolocation::databaseFile to override
-#               default database file (lib/Image/ExifTool/Geolocation.dat)
+# Notes:        Set $Image::ExifTool::Geolocation::geoDir to override
+#               default directory for the database file Geolocation.dat
+#               and language directory GeoLang.
 #
 #               Based on data from geonames.org Creative Commons databases,
 #               reformatted as follows in the Geolocation.dat file:
 #
-#   Header: GeolocationV.VV\tNNNN\n - V.VV=version, NNNN=num city entries
-#
+#   Header: 
+#       "GeolocationV.VV\tNNNN\n"  (V.VV=version, NNNN=num city entries)
+#       "# <comment>\n"
 #   NNNN City entries:
-#       1. int16u[2] - longitude.latitude (converted to 0-64k range)
-#       2. int8u - low byte of time zone number
-#       3. int8u - 100's=time zone high bit, population: 10's=num zeros, 1's=sig digit
-#       4. UTF8 City name, terminated by tab
-#       5. 2-character country code
-#       6. Region code, terminated by newline
-#   End of section marker - "\0\0\0\0\x01"
+#     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 - 0x7fff = index in subregion (admin2), 0x8000 = high bit of time zone
+#       11   int8u  - low byte of time zone index
+#       12   int8u  - 0x0f - feature code index (see below)
+#       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
-#   End of section marker - "\0\0\0\0\x02"
+#   "\0\0\0\0\x02"
 #   Region entries:
-#       1. 2-character country code
-#       2. Region code, terminated by tab
-#       3. Region name, terminated by newline
-#   End of section marker - "\0\0\0\0\x03"
+#       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
-#   End of file marker - "\0\0\0\0\0"
+#   "\0\0\0\0\0"
+#
+# Feature Codes: (see http://www.geonames.org/export/codes.html#P for descriptions)
+#
+#       0. Other    3. PPLA2    6. PPLA5    9. PPLF    12. PPLR
+#       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 $databaseFile);
+use vars qw($VERSION $geoDir $dbInfo);
+
+$VERSION = '1.02';
+
+my $databaseVersion = '1.02';
 
-$VERSION = '1.00';
+sub ReadDatabase($);
+sub SortDatabase($);
+sub AddEntry(@);
+sub GetEntry($;$);
+sub Geolocate($;$$$$$);
 
-my (@cityLookup, %countryLookup, %adminLookup, @timezoneLookup);
+my (@cityList, @countryList, @regionList, @subregionList, @timezoneList);
+my (%countryNum, %regionNum, %subregionNum, %timezoneNum, %langLookup);
+my $sortedBy = 'Latitude';
+my $pi = 3.1415926536;
+my $earthRadius = 6371;    # earth radius in km
+
+my @featureCodes = qw(Other PPL PPLA PPLA2 PPLA3 PPLA4 PPLA5
+                      PPLC PPLCH PPLF PPLG PPLL PPLR PPLS STLMT ?);
+my $i = 0;
+my %featureCodes = map { lc($_) => $i++ } @featureCodes;
 
 # get path name for database file from lib/Image/ExifTool/Geolocation.dat by default,
-# or according to $Image::ExifTool::Geolocation::databaseFile if specified
-my $datfile = $databaseFile;
-unless ($datfile) {
-    $datfile = $INC{'Image/ExifTool/Geolocation.pm'};
-    $datfile or $datfile = 'Geolocation.pm', warn("Error getting Geolocation directory\n");
-    $datfile =~ s/\.pm$/\.dat/;
+# 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");
 }
 
-# open geolocation database and verify header
-open DATFILE, "<$datfile" or warn("Error reading $datfile\n"), return 0;
-binmode DATFILE;
-my $line = <DATFILE>;
-unless ($line =~ /^Geolocation(\d+\.\d+)\t(\d+)/) {
-    warn("Bad format Geolocation database\n");
-    close(DATFILE);
-    return 0;
+# 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");
+    }
 }
-my $ncity = $2;
-
-# read city database
-for (;;) {
-    $line = <DATFILE>;
-    last if length($line) == 6 and $line =~ /\0\0\0\0/;
-    $line .= <DATFILE> while length($line) < 7;
-    chomp $line;
-    push @cityLookup, $line;
+
+# set directory for language files
+my $geoLang;
+if ($geoDir and -d "$geoDir/GeoLang") {
+    $geoLang = "$geoDir/GeoLang";
+} elsif ($geoDir or not defined $geoDir) {
+    $geoLang = "$defaultDir/GeoLang";
 }
-@cityLookup == $ncity or warn("Bad number of entries in Geolocation database\n"), return 0;
-# read countries
-for (;;) {
-    $line = <DATFILE>;
-    last if length($line) == 6 and $line =~ /\0\0\0\0/;
-    chomp $line;
-    $countryLookup{substr($line,0,2)} = substr($line,2);
+
+# add user-defined entries to the database
+if (@Image::ExifTool::UserDefined::Geolocation) {
+    AddEntry(@$_) foreach @Image::ExifTool::UserDefined::Geolocation;
 }
-# read regions
-for (;;) {
-    $line = <DATFILE>;
-    last if length($line) == 6 and $line =~ /\0\0\0\0/;
-    chomp $line;
-    my ($code, $region) = split /\t/, $line;
-    $adminLookup{$code} = $region;
+
+#------------------------------------------------------------------------------
+# 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 = <DATFILE>;
+    unless ($line =~ /^Geolocation(\d+\.\d+)\t(\d+)/) {
+        warn("Bad format Geolocation database\n");
+        close(DATFILE);
+        return 0;
+    }
+    if ($1 != $databaseVersion) {
+        my $which = $1 < $databaseVersion ? 'database' : 'ExifTool';
+        warn("Incompatible Geolocation database (update your $which)\n");
+        close(DATFILE);
+        return 0;
+    }
+    my $ncity = $2;
+    my $comment = <DATFILE>;
+    defined $comment and $comment =~ /(\d+)/ or close(DATFILE), return 0;
+    $dbInfo = "$datfile v$databaseVersion: $ncity cities with population > $1";
+    my $isUserDefined = @Image::ExifTool::UserDefined::Geolocation;
+    
+    # read city database
+    undef @cityList;
+    for (;;) {
+        $line = <DATFILE>;
+        last if length($line) == 6 and $line =~ /\0\0\0\0/;
+        $line .= <DATFILE> 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 = <DATFILE>;
+        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 = <DATFILE>;
+        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 = <DATFILE>;
+        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 = <DATFILE>;
+        last if length($line) == 6 and $line =~ /\0\0\0\0/;
+        chomp $line;
+        push @timezoneList, $line;
+        $timezoneNum{lc $line} = $#timezoneList if $isUserDefined;
+    }
+    close DATFILE;
+    return 1;
 }
-# read time zones
-for (;;) {
-    $line = <DATFILE>;
-    last if length($line) == 6 and $line =~ /\0\0\0\0/;
-    chomp $line;
-    push @timezoneLookup, $line;
+
+#------------------------------------------------------------------------------
+# 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?
+    if ($field eq 'Latitude') {
+        @cityList = sort { $a cmp $b } @cityList;
+    } elsif ($field eq 'City') {
+        @cityList = sort { substr($a,13) cmp substr($b,13) } @cityList;
+    } elsif ($field eq 'Country') {
+        my %lkup;
+        foreach (@cityList) {
+            my $city = substr($_,13);
+            my $ctry = substr($countryList[ord substr($_,5,1)], 2);
+            $lkup{$_} = "$ctry $city";
+        }
+        @cityList = sort { $lkup{$a} cmp $lkup{$b} } @cityList;
+    } else {
+        return 0;
+    }
+    $sortedBy = $field;
+    return 1;
 }
-close DATFILE;
 
 #------------------------------------------------------------------------------
-# Look up lat/lon in geolocation database
-# Inputs: 0) Latitude, 1) longitude, 2) optional min population,
-#         3) optional max distance (km)
-# Returns: 0) UTF8 city name (or undef if geolocation is unsuccessful),
-#          1) UTF8 state, province or region (or undef),
-#          2) country code, 3) country name (undef is possible),
-#          4) time zone name (empty string possible), 5) approx population,
-#          6) approx distance (km), 7) approximate compass bearing (or undef),
-#          8/9) approx lat/lon
-sub Geolocate($$;$$)
+# Add cities to the Geolocation database
+# Inputs: 0-8) city,region,subregion,country_code,country,timezone,feature_code,population,lat,lon
+# eg. AddEntry('Sinemorets','Burgas','Obshtina Tsarevo','BG','Bulgaria','Europe/Sofia','',400,42.06115,27.97833)
+sub AddEntry(@)
 {
-    my ($lat, $lon, $pop, $km) = @_;
-    my ($minPop, $maxDist2);
-    my $earthCirc = 40000;  # earth circumference in km
+    my ($city, $region, $subregion, $cc, $country, $timezone, $fc, $pop, $lat, $lon) = @_;
+    @_ < 10 and warn("Too few arguments in $city definition (check for updated format)\n"), return;
+    if (@_ != 10 or length($cc) != 2) {
+        warn "Country code '${cc}' in UserDefined::Geolocation is not 2 characters\n";
+        return;
+    }
+    $fc = $featureCodes{lc $fc} || 0;
+    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) {
+        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) {
+        push @timezoneList, $timezone;
+        $tn = $timezoneNum{lc $timezone} = $#timezoneList;
+    }
+    my $rn = $regionNum{lc $region};
+    unless (defined $rn) {
+        push @regionList, $region;
+        $rn = $regionNum{lc $region} = $#regionList;
+    }
+    my $sn = $subregionNum{lc $subregion};
+    unless (defined $sn) {
+        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
+    $tn > 255 and $sn |= 0x8000, $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, $fc);
+    push @cityList, "$hdr$city";
+    $sortedBy = '';
+}
 
+#------------------------------------------------------------------------------
+# Unpack entry in database
+# Inputs: 0) entry number, 1) optional language code
+# Returns: 0-9) city,region,subregion,country_code,country,timezone,feature_code,pop,lat,lon
+sub GetEntry($;$)
+{
+    my ($entryNum, $lang) = @_;
+    return() if $entryNum > $#cityList;
+    my ($lt,$f,$ln,$code,$sb,$tn,$fc) = unpack('nCnNnCC', $cityList[$entryNum]);
+    my $city = substr($cityList[$entryNum],13);
+    my $ctry = $countryList[$code >> 24];
+    my $rgn = $regionList[$code & 0x0fff];
+    my $sub = $subregionList[$sb & 0x7fff];
+    # convert population digits back into exponent format
+    my $pop = (($code>>16 & 0x0f) . '.' . ($code>>12 & 0x0f) . 'e+' . ($code>>20 & 0x0f)) + 0;
+    $tn += 256 if $sb & 0x8000;
+    $lt = sprintf('%.4f', (($lt<<4)|($f >> 4))  * 180 / 0x100000 - 90);
+    $ln = sprintf('%.4f', (($ln<<4)|($f & 0x0f))* 360 / 0x100000 - 180);
+    $fc = $featureCodes[$fc & 0x0f];
+    my $cc = substr($ctry, 0, 2);
+    my $country = substr($ctry, 2);
+    if ($lang) {
+        my $xlat = $langLookup{$lang};
+        # load language lookups if  not done already
+        if (not defined $xlat) {
+            if (eval "require '$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;
+        }
+    }
+    return($city,$rgn,$sub,$cc,$country,$timezoneList[$tn],$fc,$pop,$lt,$ln);
+}
+
+#------------------------------------------------------------------------------
+# Look up lat,lon or city in geolocation database
+# Inputs: 0) "lat,lon", "city,region,country", etc, (city must be first)
+#         1) optional min population, 2) optional max distance (km)
+#         3) optional language code, 4) flag to return multiple cities
+#         5) comma-separated list of feature codes to match (or ignore if leading "-")
+# Returns: Reference to list of city information, or list of city information
+#          lists if returning multiple cities.
+# City information list elements:
+#         0) UTF8 city name (or undef if geolocation is unsuccessful),
+#         1) UTF8 state, province or region (or empty),
+#         2) UTF8 subregion (or empty)
+#         3) country code, 4) country name,
+#         5) time zone name (empty string possible), 6) feature code, 7) population,
+#         8/9) approx lat/lon (or undef if geolocation is unsuccessful,
+#         10) approx distance (km), 11) compass bearing to city,
+#         12) non-zero if multiple matches were possible (and city with
+#             the largest population is returned)
+sub Geolocate($;$$$$$)
+{
+    my ($arg, $pop, $maxDist, $lang, $multi, $fcodes) = @_;
+    my ($city, $i, %found, @exact, %regex, @multiCity, $other, $idx);
+    my ($minPop, $minDistU, $minDistC, @matchParms, @matches, @coords, $fcmask, $both);
+
+    @cityList or warn('No Geolocation database'), return();
+    # make population code for comparing with 2 bytes at offset 6 in database
     if ($pop) {
-        # convert population minimum to a 2-digit code
-        my $dig = substr($pop, 0, 1);
-        my $zer = length($pop) - 1;
-        # round up if necessary
-        if (length($pop) > 1 and substr($pop, 1, 1) >= 5) {
-            ++$dig > 9 and $dig = 1, ++$zer;
+        $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*/, $fcodes;
+        if ($neg) {
+            $fcmask = 0xffff;
+            defined $featureCodes{lc $_} and $fcmask &= ~((1 << $featureCodes{lc $_})) foreach @fcodes;
+        } else {
+            defined $featureCodes{lc $_} and $fcmask |= (1 << $featureCodes{lc $_}) foreach @fcodes;
+        }
+    }
+#
+# process input argument
+#
+    $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});
+            $other = 1 if $idx < 5;
+            $idx += 10 if $1;   # add 10 for negative matches
+            push @{$regex{$idx}}, $re;
+            $city = '' unless defined $city;
+        } elsif (/^[-+]?\d+(\.\d+)?$/) {    # coordinate format
+            push @coords, $_ if @coords < 2;
+        } elsif (lc eq 'both') {
+            $both = 1;
+        } elsif ($city) {
+            push @exact, lc $_;
+        } else {
+            $city = lc $_;
         }
-        $minPop = $zer.$dig;
-    }
-    if ($km) {
-        # convert max distance to reduced coordinate units
-        my $tmp = $km * 2 * 65536 / $earthCirc;
-        $maxDist2 = $tmp * $tmp;
-    }
-    my $cos = cos($lat * 3.14159 / 180); # cosine factor for longitude distances
-    # reduce lat/lon to the range 0-65536
-    $lat = int(($lat + 90)  / 180 * 65536 + 0.5) & 0xffff;
-    $lon = int(($lon + 180) / 360 * 65536 + 0.5) & 0xffff;
-    my $coord = pack('n2',$lon,$lat);   # pack for comparison with binary database values
+    }
+    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)) {
+Entry:  for ($i=0; $i<@cityList; ++$i) {
+            my $cty = substr($cityList[$i],13);
+            next if $city and $city ne lc $cty; # test exact city name first
+            # 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,$sb) = unpack('x5Nn', $cityList[$i]);
+            my $ct = $countryList[$cd >> 24];
+            my @geo = (substr($ct,0,2), substr($ct,2), $regionList[$cd & 0x0fff], $subregionList[$sb & 0x7fff]);
+            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 $fcmask and not $fcmask & (1 << (ord(substr($cityList[$i],12,1)) & 0x0f));
+            my $pc = substr($cityList[$i],6,2);
+            $found{$i} = $pc if not defined $minPop or $pc ge $minPop;
+        }
+        if (%found) {
+            @matches = keys %found;
+            @coords == 2 and @matches = sort({ $a <=> $b } @matches), last; # continue to use coords
+            scalar(keys %found) > 200 and warn("Too many matching cities\n"), return();
+            @matches = sort { $found{$b} cmp $found{$a} or $cityList[$a] cmp $cityList[$b] } @matches if @matches > 1;
+            foreach (@matches) {
+                my @cityInfo = GetEntry($_, $lang);
+                $cityInfo[12] = @matches if @matches > 1;
+                return \@cityInfo unless @matches > 1 and $multi;
+                push @multiCity, \@cityInfo;
+            }
+            return \@multiCity;
+        }
+        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);;
     # binary search to find closest longitude
-    my ($n0, $n1) = (0, scalar(@cityLookup)-1);
+    my $numEntries = @matches || @cityList;
+    my ($n0, $n1) = (0, $numEntries - 1);
     while ($n1 - $n0 > 1) {
         my $n = int(($n0 + $n1) / 2);
-        if ($coord lt $cityLookup[$n]) {
+        if ($coord lt $cityList[@matches ? $matches[$n] : $n]) {
             $n1 = $n;
         } else {
             $n0 = $n;
         }
     }
     # step backward then forward through database to find nearest city
-    my ($minDist2, $minN, @dxy);
     my ($inc, $end, $n) = (-1, -1, $n0+1);
+    my ($p0, $t0) = ($lat*$pi/0x100000 - $pi/2, $lon*$pi/0x080000 - $pi);
+    my $cp0 = cos($p0);
     for (;;) {
         if (($n += $inc) == $end) {
             last if $inc == 1;
-            ($inc, $end, $n) = (1, scalar(@cityLookup), $n1);
-        }
-        my ($x,$y) = unpack('n2', $cityLookup[$n]);
-        my ($dy,$dx) = ($y-$lat, $x-$lon);
-        $dx += 65536 if $dx < -32768;       # measure the short way around the world
-        $dx -= 65536 if $dx > 32768;
-        $dx = 2 * $cos * $dx;               # adjust for longitude spacing
-        my $dx2 = $dx * $dx;
-        my $dist2 = $dy * $dy + $dx2;
-        if (defined $minDist2) {
-            # searched far enough if longitude alone is further than best distance
-            $dx2 > $minDist2 and $n = $end - $inc, next;
-        } elsif (defined $maxDist2) {
-            $dx2 > $maxDist2 and $n = $end - $inc, next;
-            next if $dist2 > $maxDist2;   # ignore if distance is too great
+            ($inc, $end, $n) = (1, $numEntries, $n1);
         }
+        my $entryNum = @matches ? $matches[$n] : $n;
+        # get city latitude/longitude
+        my ($lt,$f,$ln) = unpack('nCn', $cityList[$entryNum]);
+        $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 $minPop and $minPop > unpack('x5C', $cityLookup[$n]) % 100;
-        if (not defined $minDist2 or $minDist2 > $dist2) {
-            $minDist2 = $dist2;
-            @dxy = ($dx, $dy);
-            $minN = $n;
-        }
+        next if defined $minPop and $minPop ge substr($cityList[$entryNum],6,2);
+        next if $fcmask and not $fcmask & (1 << (ord(substr($cityList[$entryNum],12,1)) & 0x0f));
+        $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));
+        next if $distU > $minDistU;
+        $minDistU = $distU;
+        $minDistC = $minDistU * 0x200000 / $pi;
+        @matchParms = ($entryNum, $p1, $t1, $distU);
     }
-    return () unless defined $minN;
-
-    my ($ln,$lt,$tn,$pc) = unpack('n2C2', $cityLookup[$minN]);
-    my ($city, $code) = split /\t/, substr($cityLookup[$minN],6);
-    my $ctry = substr($code,0,2);
-    my $rgn = $adminLookup{$code};
-    my $po2 = substr($pc, -1) . (length($pc) > 1 ? '0' x substr($pc, -2, 1) : '');
-    $tn += 256 if $pc > 99;
-    my $be; # calculate bearing to geolocated city
-    if ($dxy[0] or $dxy[1]) {
-        $be = atan2($dxy[0],$dxy[1]) * 180 / 3.14159;
-        $be += 360 if $be < 0;
-        $be = int($be + 0.5);
-    }
-    $lt = sprintf('%.3f', $lt * 180 / 65536 - 90);
-    $ln = sprintf('%.3f', $ln * 360 / 65536 - 180);
-    $km = sprintf('%.1f', sqrt($minDist2) * $earthCirc / (2 * 65536));
-
-    return($city,$rgn,$ctry,$countryLookup{$ctry},$timezoneLookup[$tn],$po2,$km,$be,$lt,$ln);
+    @matchParms or warn("No suitable location in Geolocation database\n"), return();
+
+    # calculate distance in km and bearing to matching city
+    my ($en, $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
+
+    # unpack return values from database entry
+    my @cityInfo = GetEntry($en, $lang);
+    @cityInfo[10,11] = ($km, $be);   # add distance and heading
+    return \@cityInfo;
 }
 
+1; #end
+
 __END__
 
 =head1 NAME
@@ -209,8 +534,219 @@ This module is used by the Image::ExifTool Geolocation feature.
 =head1 DESCRIPTION
 
 This module contains the code to convert GPS coordinates to city, region,
-country, time zone, etc.  It uses a database derived from geonames.org,
-modified to reduce the size as much as possible.
+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 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,
+        $countryCode, $country, $timezone, $featureCode
+        $population, $lat, $lon);
+
+=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
+
+=back
+
+=head2 GetEntry
+
+Get entry from Geolocation database.
+
+    my @vals = Image::ExifTool::Geolocation::GetEntry($num,$lang);
+
+=over 4
+
+=item Inputs:
+
+0) Entry number in database
+
+1) Optional language code
+
+=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
+
+=item Notes:
+
+The alternate-language feature of this method (and of L</Geolocate>)
+requires the installation of optional GeoLang modules.  See
+L<https://exiftool.org/geolocation.html> for more information.
+
+=back
+
+=head2 Geolocate
+
+Return geolocation information for specified GPS coordinates or city name.
+
+    my @cityInfo =
+        Image::ExifTool::Geolocation::Geolocate($arg,$pop,$dist,$lang,$multi,$codes);
+
+=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</expr/> format are also allowed, optionally prefixed by
+"ci", "re", "sr", "cc" or "co" to specifically match City, Region,
+Subregion, CountryCode or Country name.  See
+L<https://exiftool.org/geolocation.html#Read> for details.
+
+1) Minimum city population (cities smaller than this are ignored)
+
+2) Maximum distance to city (farther cities are not considered)
+
+3) Language code
+
+4) Flag to return multiple cities if there is more than one match.  In this
+case the return value is a list of city information lists.
+
+5) Comma-separated list of feature codes to include in search, or to exclude
+if the list starts with a dash (-).
+
+=item Return Value:
+
+Reference to list of information about the matching city.  If multiple
+matches were found, the city with the highest population is returned unless
+the flag is set to allow multiple cities to be returned, in which case all
+cities are turned as a list of city lists in order of decreasing population.
+
+The city information list contains the following entries:
+
+0) Name of matching city (UTF8), or undef if no match
+
+1) Region, state or province name (UTF8), or "" if no region
+
+2) Subregion name (UTF8), or "" if no region
+
+3) Country code
+
+4) Country name (UTF8)
+
+5) Standard time zone identifier name
+
+6) Feature code
+
+7) City population rounded to 2 significant figures
+
+8) Approximate city latitude (signed degrees)
+
+9) Approximate city longitude
+
+10) Distance to city in km if "lat,lon" specified
+
+11) Compass bearing for direction to city if "lat,lon" specified
+
+12) Flag set if multiple matches were found
+
+=back
+
+=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 <DFILE>;
+    close DFILE;
+
+=head1 CUSTOM LANGUAGE TRANSLATIONS
+
+User-defined language translations may be added by defining
+%Image::ExifTool::Geolocation::geoLang before calling GetEntry() or
+Geolocate().  See L<http://exiftool.org/geolocation.html#Custom> for
+details.
 
 =head1 AUTHOR
 
@@ -226,6 +762,8 @@ from geonames.org with a Creative Commons license.
 
 =item L<https://download.geonames.org/export/>
 
+=item L<https://exiftool.org/geolocation.html>
+
 =back
 
 =head1 SEE ALSO