File Coverage

blib/lib/Alien/Proj4.pm
Criterion Covered Total %
statement 51 60 85.0
branch 7 8 87.5
condition n/a
subroutine 6 11 54.5
pod 0 7 0.0
total 64 86 74.4


line stmt bran cond sub pod time code
1             package Alien::Proj4;
2              
3 4     4   463411 use strict;
  4         33  
  4         132  
4 4     4   91 use warnings;
  4         11  
  4         143  
5 4     4   932 use parent qw( Alien::Base );
  4         689  
  4         31  
6              
7             our $VERSION = '2.019112';
8              
9             # most of the following are for compat with PDLA Makefiles
10             # and should not be used by other code
11 0     0 0 0 sub installed {1}
12              
13             sub import {
14             # do nothing
15 4     4   4853 return;
16             }
17              
18             sub default_lib {
19 0     0 0 0 return;
20             }
21              
22             sub default_inc {
23 0     0 0 0 return;
24             }
25              
26             sub libflags {
27 0     0 0 0 my ($class) = @_;
28 0         0 my $flags = join ' ', $class->libs;
29 0         0 return $flags;
30             }
31              
32             sub incflags {
33 0     0 0 0 my ($class) = @_;
34 0         0 my $flags = $class->cflags;
35 0         0 return $flags;
36             }
37              
38             # dup of code currently in PDLA::GIS::Proj
39             sub load_projection_descriptions {
40 1     1 0 4 my ($class) = @_;
41 1         8 my $incflags = $class->cflags;
42 1         256 my $libflags = $class->libs;
43              
44 1         1098 require Inline;
45 1 50       38899 Inline->bind(C => <<'EOF', inc => $incflags, libs => $libflags) unless defined &list_projections;
46             #include "projects.h"
47             HV *list_projections() {
48             struct PJ_LIST *lp;
49             SV* scalar_val;
50             HV *hv = newHV();
51             for (lp = pj_get_list_ref() ; lp->id ; ++lp) {
52             scalar_val = newSVpv( *lp->descr, 0 );
53             hv_store( hv, lp->id, strlen( lp->id ), scalar_val, 0 );
54             }
55             return hv;
56             }
57             EOF
58 1         1510971 list_projections();
59             }
60              
61             # dup of code currently in PDLA::GIS::Proj
62             sub load_projection_information {
63 1     1 0 49255 my ($class) = @_;
64 1         6 my $descriptions = $class->load_projection_descriptions();
65 1         10 my $info = {};
66 1         26 foreach my $projection ( keys %$descriptions ) {
67 143         216 my $description = $descriptions->{$projection};
68 143         196 my $hash = {};
69 143         278 $hash->{CODE} = $projection;
70 143         357 my @lines = split( /\n/, $description );
71 143         239 chomp @lines;
72             # Full name of this projection:
73 143         244 $hash->{NAME} = $lines[0];
74             # The second line is usually a list of projection types this one is:
75 143         184 my $temp = $lines[1];
76 143         274 $temp =~ s/no inv\.*,*//;
77 143         202 $temp =~ s/or//;
78 143         484 my @temp_types = split(/[,&\s]/, $temp );
79 143         547 my @types = grep( /.+/, @temp_types );
80 143         258 $hash->{CATEGORIES} = \@types;
81             # If there's more than 2 lines, then it usually is a listing of parameters:
82             # General parameters for all projections:
83             $hash->{PARAMS}->{GENERAL} =
84 143         586 [ qw( x_0 y_0 lon_0 units init no_defs geoc over ) ];
85             # Earth Figure Parameters:
86             $hash->{PARAMS}->{EARTH} =
87 143         655 [ qw( ellps b f rf e es R R_A R_V R_a R_g R_h R_lat_g ) ];
88             # Projection Specific Parameters:
89 143         228 my @proj_params = ();
90 143 100       320 if( $#lines >= 2 ) {
91 49         107 foreach my $i ( 2 .. $#lines ) {
92 54         81 my $text = $lines[$i];
93 54         232 my @temp2 = split( /\s+/, $text );
94 54         193 my @params = grep( /.+/, @temp2 );
95 54         89 foreach my $param (@params) {
96 138         296 $param =~ s/=//;
97 138         352 $param =~ s/[,\[\]]//sg;
98 138 100       362 next if $param =~ /^and|or|Special|for|Madagascar|fixed|Earth|For|CH1903$/;
99 118         279 push(@proj_params, $param);
100             }
101             }
102             }
103 143         239 $hash->{PARAMS}->{PROJ} = \@proj_params;
104             # Can this projection do inverse?
105 143 100       316 $hash->{INVERSE} = ( $description =~ /no inv/ ) ? 0 : 1;
106 143         405 $info->{$projection} = $hash;
107             }
108             # A couple of overrides:
109             $info->{ob_tran}->{PARAMS}->{PROJ} =
110 1         14 [ 'o_proj', 'o_lat_p', 'o_lon_p', 'o_alpha', 'o_lon_c',
111             'o_lat_c', 'o_lon_1', 'o_lat_1', 'o_lon_2', 'o_lat_2' ];
112 1         12 $info->{nzmg}->{CATEGORIES} = [ 'fixed Earth' ];
113 1         7 return $info;
114             }
115              
116              
117             1;
118              
119             __END__