view release on metacpan or  search on metacpan

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

    my ($is_negative) = ($coord =~ s/[SW]//g);
    my ($is_positive) = ($coord =~ s/[NE]//g);

    croak 
        "Coordinate '$orig_coord' does not look like a proper coordinate"
            if !looks_like_number($coord);

    $is_negative = ($coord < 0) unless $is_negative;

    my $conflicting = ($is_negative and $is_positive) ? 'conflicting ' : '';
    croak "Multiple ${conflicting}sign indicators detected in '$orig_coord'"
      if  $conflicting or $is_negative > 1 or $is_positive > 1;

    foreach my $digit (@coord) {
        # Convert the next digit into a letter from the proper table.
        my $letter = $lists->[$list]->[$digit];
        ### "$letter -> $digit"

        # Decide whether to insert a sign consonant.        
        if (exists $vowel{$letter} and $is_negative and not $signed) {
            # If negative, we have a vowel, and we haven't inserted the sign
            # consonant yet, insert it.
            $letter .= $neg;
            # Now signed.
            $signed = 1;
            $list = !$list;
        }
        # Add new letter(s) to word and continue;
        $word .= $letter;
        $list = !$list;
    }
    return ucfirst $word;
}

sub _two_decimal {
    my ($coord) = @_;
    
    # Discard non-digits except for a decimal point.
    $coord =~ s/[^\d\.]//g;

    # Drop leading zeros.
    $coord =~ s/^0*//g;
    $coord = 0 unless $coord;

    if (abs($coord) > 180) {
        croak "$coord must be between -180 and +180\n";
    }
    unless ($coord =~ /\./) {
        # add decimals
        $coord .= ".";
    }
    # Add two more zeroes; we'll discard them if we don't need them.
    $coord .= "00"; 
    ($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;