view release on metacpan or  search on metacpan

lib/Acme/Geo/Whitwell/Name.pm  view on Meta::CPAN

    ($coord) = ($coord =~ /^(\d{0,3}\.\d\d)/);
    return $coord;
}

=head2 from_whitwell($whitwell_name, signed => $yes_or_no)

Converts a Whitwell name back into a lat/lon pair, in trailing indicator
format.  Results will be undefined if the string does not match the Whitwell
scheme; if the strings I<is> Whitwell-compatible, but includes extra letters,
these will be assumed to be further digits after the decimal point.

If you supply the 'signed' option with a true value, the returned values are
signed numbers rather than numbers with trailing sign indicators.

=cut

sub from_whitwell {
    my($name, %opts) = @_;
    my ($lat_name, $lon_name) = split(/\s+/, $name);

    my ($value, $negative);
    ($value, $negative) = _coord_for(lc($lat_name)); 
    if ($negative) {
        if ($opts{signed}) {
            $value = -$value;
        }
        else {
            $value .= "S";
        }
    }
    else {
        unless ($opts{signed}) {
            $value .= "N";
        }
    } 
    my $lat = $value;

    ($value, $negative) = _coord_for(lc($lon_name));
    if ($negative) {
        if ($opts{signed}) {
            $value = -$value;
        }
        else {
            $value .= "W";
        }
    }
    else {
        unless ($opts{signed}) {
            $value .= "E";
        }
    } 
    my $lon = $value;

    return ($lat, $lon);
    
}

sub _coord_for {
    my($original) = my($string) = @_;

    # Determine if the string starts in the vowel table or the consonant table.
    my @tables  = (\@consonants, \@vowels);
    my $vowel_found;
    my $current = ($string =~ /^[aeiouy]/) || 0;

    # Decompose and look up the character(s).
    my $coord_string;
    my $try_sign = 0;
    my $is_negative = 0;
    my $sign_checked = 0;

  PARSE:
    while ($string) {
        # If we need to look for the sign character, 
        # do so. Since we've allowed names to start in either table
        # as seems to have been the historical precedent (yes, someone
        # actually did use this at least once for a real placename),
        # we check for both sign characters and record whether or not
        # we found one.
        if ($try_sign) {
            # Don't try more than once.
            $try_sign = 0;
            if ($string =~ s/^[vs]//) {
                $is_negative = 1;
                # Return to the vowel table again.
                $current = 1;
                next PARSE;
            }
            # Note we've looked for the sign once, so we shouldn't look
            # again. This wil trap badly-placed sign characters.
            $sign_checked = 1; 
        }
        # Longer entries occur at the end of the vowel table, so
        # to avoid parsing 'ee' as 'e' and 'e', we try the longer
        # strings first. However: complicating this process is the '0'
        # entry, which is also a longer one, so it has to be checked first.
        for my $i (0, reverse 1..9) {
            my $char = $tables[$current]->[$i];
            if ($string =~ s/^$char//) {
                # Found it. Tack the number onto the coordinate string,
                # swap tables, and see if we need to check the sign.
                $coord_string .= $i;
                $try_sign = ($current == 1 and !$sign_checked);
                $current = !$current;
                next PARSE;
            }
        }
        # The current table should have matched, so the input string is bad.
        croak "Bad character or sequencing found in '$original' at '$string'";
    }
    # Insert the decimal point such that the resulting number is < 180.
    # This allows "high-precision" Whitwell names (constructed in some
    # manner other than via to_whitwell) to be converted back correctly.
    if (length($coord_string) >= 3) { 
        # Need to insert a decimal point. The final value must be < 180,
        # and we asssume at least two decimal places.

        # Let's try the easy case first, and insert a decimal point 
        # right before the last two digits. All names generated via 
        # to_whitwell() will work with this case. Since we know the 
        # coordinate string only has numbers in it, we can just divide
        # by 100.
        my $trial_value = $coord_string/100;

        # Manufactured by some other means. Move the decimal left one
        # character at a time until the number is < 180. We never do this
        # at all if our initial guess worked.
        $trial_value /= 10 while $trial_value > 180;
        $coord_string = $trial_value;
    }
    else {
        # < 3, so can't be > 180. Just add decimals.
        $coord_string .= ".00";
    }
    return ($coord_string, $is_negative);