File Coverage

blib/lib/Geo/Mercator.pm
Criterion Covered Total %
statement 30 30 100.0
branch 2 4 50.0
condition 2 3 66.6
subroutine 8 8 100.0
pod 2 2 100.0
total 44 47 93.6


line stmt bran cond sub pod time code
1             package Geo::Mercator;
2              
3 1     1   1970 use Math::Trig qw(tan atan pi);
  1         21255  
  1         736  
4 1     1   12 use base qw(Exporter);
  1         3  
  1         106  
5              
6             our @EXPORT = qw(mercate demercate);
7              
8 1     1   15 use strict;
  1         2  
  1         32  
9 1     1   4 use warnings;
  1         1  
  1         523  
10              
11             our $VERSION ='1.01';
12              
13             our $DEG_TO_RAD = (pi/180.0);
14             our $RAD_TO_DEG = (180.0/pi);
15             our $R_MAJOR = 6378137.000;
16             our $R_MINOR = 6356752.3142;
17             our $PI_OVER_2 = (pi/2);
18             our $ECCENT = sqrt(1.0 - ($R_MINOR / $R_MAJOR) * ($R_MINOR / $R_MAJOR));
19             our $ECCENTH = (0.5 * $ECCENT);
20              
21             sub mercate {
22 5     5 1 1750 return ($R_MAJOR * $DEG_TO_RAD * $_[1], _mercate_lat($_[0]));
23             }
24              
25             sub _mercate_lat {
26             #
27             # limit the polar damage
28             #
29 5 50   5   21 my $phi = $DEG_TO_RAD * (
    50          
30             ($_[0] > 89.5) ? 89.5
31             : ($_[0] < -89.5) ?-89.5
32             : $_[0]);
33 5         8 my $sinphi = sin($phi);
34 5         9 my $con = $ECCENT * $sinphi;
35 5         30 $con = ((1.0 - $con)/(1.0 + $con)) ** $ECCENTH;
36 5         19 my $ts = tan(0.5 * ($PI_OVER_2 - $phi))/$con;
37 5         112 return 0 - $R_MAJOR * log($ts);
38             }
39              
40             sub demercate {
41 5     5 1 1526 return ( _demercate_y($_[1]), $RAD_TO_DEG * $_[0] / $R_MAJOR);
42             }
43             #
44             # !!!WE NEED A MORE ACCURATE SOLUTION TO THIS!!!
45             #
46             sub _demercate_y {
47 5     5   19 my $ts = exp(- $_[0] / $R_MAJOR);
48 5         16 my $phi = $PI_OVER_2 - 2 * atan($ts);
49 5         48 my $i = 0;
50 5         6 my $dphi = 1;
51 5   66     29 while(abs($dphi) > 0.000000001 && $i < 15) {
52 17         26 my $con = $ECCENT * sin($phi);
53 17         70 $dphi = $PI_OVER_2 - 2.0 * atan($ts * (((1.0 - $con) / (1.0 + $con))**$ECCENTH)) - $phi;
54 17         88 $phi += $dphi;
55 17         72 $i++;
56             }
57 5         21 return $RAD_TO_DEG * $phi;
58             }
59              
60             1;