File Coverage

lib/Geo/ShapeFile/Point.pm
Criterion Covered Total %
statement 83 146 56.8
branch 25 52 48.0
condition 14 39 35.9
subroutine 21 47 44.6
pod 19 26 73.0
total 162 310 52.2


line stmt bran cond sub pod time code
1             package Geo::ShapeFile::Point;
2             # TODO - add dimension operators (to specify if 2 or 3 dimensional point)
3 2     2   12 use strict;
  2         6  
  2         63  
4 2     2   11 use warnings;
  2         4  
  2         55  
5 2     2   1142 use Math::Trig 1.04;
  2         31698  
  2         284  
6 2     2   16 use Carp;
  2         4  
  2         222  
7            
8             our $VERSION = '3.00';
9            
10             use overload
11 2         15 '==' => 'eq',
12             'eq' => 'eq',
13             '""' => 'stringify',
14             '+' => \&add,
15             '-' => \&subtract,
16             '*' => \&multiply,
17             '/' => \÷,
18             fallback => 1,
19 2     2   16 ;
  2         4  
20            
21             my %config = (
22             comp_includes_z => 1,
23             comp_includes_m => 1,
24             );
25            
26             sub new {
27 83413     83413 1 168285 my $proto = shift;
28 83413   33     196928 my $class = ref($proto) || $proto;
29            
30 83413         217543 my $self = {@_};
31            
32 83413         132949 bless $self, $class;
33            
34 83413         215020 return $self;
35             }
36            
37             sub _var {
38 107360     107360   154748 my $self = shift;
39 107360         143511 my $var = shift;
40            
41 107360 100       171633 if (@_) {
42 10098         25747 return $self->{$var} = shift;
43             }
44             else {
45 97262         195412 return $self->{$var};
46             }
47             }
48            
49             # these could be factory generated
50 48490     48490 1 2715941 sub X { shift()->_var('X', @_); }
51 48490     48490 1 149039 sub Y { shift()->_var('Y', @_); }
52 7791     7791 1 14819 sub Z { shift()->_var('Z', @_); }
53 2589     2589 1 5138 sub M { shift()->_var('M', @_); }
54            
55 0     0 1 0 sub x_min { $_[0]->_var('X'); }
56 0     0 1 0 sub x_max { $_[0]->_var('X'); }
57 0     0 1 0 sub y_min { $_[0]->_var('Y'); }
58 0     0 1 0 sub y_max { $_[0]->_var('Y'); }
59 0     0 1 0 sub z_min { $_[0]->_var('Z'); }
60 0     0 1 0 sub z_max { $_[0]->_var('Z'); }
61 0     0 1 0 sub m_min { $_[0]->_var('M'); }
62 0     0 1 0 sub m_max { $_[0]->_var('M'); }
63            
64 16984     16984 1 41620 sub get_x { $_[0]->{X} }
65 16984     16984 1 49495 sub get_y { $_[0]->{Y} }
66 0     0 1 0 sub get_z { $_[0]->{Z} }
67 0     0 1 0 sub get_m { $_[0]->{M} }
68            
69            
70             sub import {
71 4     4   145 my $self = shift;
72 4         10 my %args = @_;
73            
74 4         124 foreach(keys %args) { $config{$_} = $args{$_}; }
  0         0  
75             }
76            
77             sub eq {
78 8     8 0 1392 my $left = shift;
79 8         14 my $right = shift;
80            
81 8 100 66     34 if ($config{comp_includes_z} && (defined $left->Z || defined $right->Z)) {
      33        
82 1 50 33     5 return 0 unless defined $left->Z && defined $right->Z;
83 1 50       4 return 0 unless $left->Z == $right->Z;
84             }
85 8 100 66     25 if ($config{comp_includes_m} && (defined $left->M || defined $right->M)) {
      33        
86 3 50 33     9 return 0 unless defined $left->M && defined $right->M;
87 3 50       9 return 0 unless $left->M == $right->M;
88             }
89            
90 8   33     18 return ($left->X == $right->X && $left->Y == $right->Y);
91             }
92            
93             sub stringify {
94 107     107 0 2934 my $self = shift;
95            
96 107         207 my @foo = ();
97 107         248 foreach(qw/X Y Z M/) {
98 428 100       1089 if(defined $self->$_()) {
99 230         577 push @foo, "$_=" . $self->$_();
100             }
101             }
102 107         940 my $r = 'Point(' . join(',', @foo) . ')';
103             }
104            
105             sub distance_from {
106 0     0 1 0 my ($p1, $p2) = @_;
107            
108 0         0 my $dp = $p2->subtract($p1);
109 0         0 return sqrt ( ($dp->X ** 2) + ($dp->Y **2) );
110             }
111            
112 0     0 0 0 sub distance_to { distance_from(@_); }
113            
114             sub angle_to {
115 8     8 1 37 my ($p1, $p2) = @_;
116            
117 8         22 my $dp = $p2->subtract ($p1);
118            
119 8         21 my $x_off = $dp->get_x;
120 8         18 my $y_off = $dp->get_y;
121            
122 8 100 100     34 return 0 if !($x_off || $y_off);
123            
124 7         61 my $bearing = 90 - Math::Trig::rad2deg (Math::Trig::atan2 ($y_off, $x_off));
125 7 100       184 if ($bearing < 0) {
126 2         5 $bearing += 360;
127             }
128            
129 7         28 return $bearing;
130             }
131            
132 0     0 0 0 sub add { _mathemagic('add', @_); }
133 8     8 0 24 sub subtract { _mathemagic('subtract', @_); }
134 0     0 0 0 sub multiply { _mathemagic('multiply', @_); }
135 0     0 0 0 sub divide { _mathemagic('divide', @_); }
136            
137             sub _mathemagic {
138 8     8   21 my ($op, $l, $r, $reverse) = @_;
139            
140 8 50       24 if ($reverse) { # put them back in the right order
141 0         0 ($l, $r) = ($r, $l);
142             }
143 8         15 my ($left, $right);
144            
145 8 50       33 if (UNIVERSAL::isa($l, 'Geo::ShapeFile::Point')) { $left = 'point'; }
  8         17  
146 8 50       24 if (UNIVERSAL::isa($r, 'Geo::ShapeFile::Point')) { $right = 'point'; }
  8         14  
147            
148 8 50       26 if ($l =~ /^[\d\.]+$/) { $left = 'number'; }
  0         0  
149 8 50       92 if ($r =~ /^[\d\.]+$/) { $right = 'number'; }
  0         0  
150            
151 8 50       26 unless ($left) { croak "Couldn't identify $l for $op"; }
  0         0  
152 8 50       21 unless ($right) { croak "Couldn't identify $r for $op"; }
  0         0  
153            
154 8         26 my $function = '_' . join '_', $op, $left, $right;
155            
156             croak "Don't know how to $op $left and $right"
157 8 50       15 if !defined &{$function};
  8         34  
158            
159 8         12 do {
160 2     2   2802 no strict 'refs';
  2         5  
  2         1626  
161 8         28 return $function->($l, $r);
162             }
163             }
164            
165             sub _add_point_point {
166 0     0   0 my ($p1, $p2) = @_;
167            
168 0         0 my $z;
169 0 0 0     0 if(defined($p2->Z) && defined($p1->Z)) { $z = ($p2->Z + $p1->Z); }
  0         0  
170            
171             Geo::ShapeFile::Point->new(
172 0         0 X => ($p2->X + $p1->X),
173             Y => ($p2->Y + $p1->Y),
174             Z => $z,
175             );
176             }
177            
178             sub _add_point_number {
179 0     0   0 my ($p1, $n) = @_;
180            
181 0         0 my $z;
182 0 0       0 if (defined($p1->Z)) { $z = ($p1->Z + $n); }
  0         0  
183            
184             Geo::ShapeFile::Point->new(
185 0         0 X => ($p1->X + $n),
186             Y => ($p1->Y + $n),
187             Z => $z,
188             );
189             }
190 0     0   0 sub _add_number_point { add_point_number(@_); }
191            
192             sub _subtract_point_point {
193 8     8   19 my($p1, $p2) = @_;
194            
195 8         14 my $z;
196 8 50 33     18 if(defined($p2->Z) && defined($p1->Z)) { $z = ($p2->Z - $p1->Z); }
  0         0  
197            
198 8         24 my $result = Geo::ShapeFile::Point->new(
199             X => ($p1->X - $p2->X),
200             Y => ($p1->Y - $p2->Y),
201             Z => $z,
202             );
203 8         24 return $result;
204             }
205            
206             sub _subtract_point_number {
207 0     0     my($p1, $n) = @_;
208            
209 0           my $z;
210 0 0         if (defined $p1->Z) {
211 0           $z = ($p1->Z - $n);
212             }
213            
214             Geo::ShapeFile::Point->new(
215 0           X => ($p1->X - $n),
216             Y => ($p1->Y - $n),
217             Z => $z,
218             );
219             }
220 0     0     sub _subtract_number_point { _subtract_point_number(reverse @_); }
221            
222             sub _multiply_point_point {
223 0     0     my ($p1, $p2) = @_;
224            
225 0           my $z;
226 0 0 0       if (defined $p2->Z and defined $p1->Z) {
227 0           $z = $p2->Z * $p1->Z;
228             }
229            
230             Geo::ShapeFile::Point->new(
231 0           X => ($p2->X * $p1->X),
232             Y => ($p2->Y * $p1->Y),
233             Z => $z,
234             );
235             }
236             sub _multiply_point_number {
237 0     0     my($p1, $n) = @_;
238            
239 0           my $z;
240 0 0         if (defined $p1->Z) {
241 0           $z = $p1->Z * $n;
242             }
243            
244             Geo::ShapeFile::Point->new(
245 0           X => ($p1->X * $n),
246             Y => ($p1->Y * $n),
247             Z => $z,
248             );
249             }
250            
251 0     0     sub _multiply_number_point { _multiply_point_number(reverse @_); }
252            
253             sub _divide_point_point {
254 0     0     my($p1, $p2) = @_;
255            
256 0           my $z;
257 0 0 0       if (defined $p2->Z and defined $p1->Z) {
258 0           $z = $p1->Z / $p2->Z;
259             }
260            
261             Geo::ShapeFile::Point->new(
262 0           X => ($p1->X / $p2->X),
263             Y => ($p1->Y / $p2->Y),
264             Z => $z,
265             );
266             }
267            
268             sub _divide_point_number {
269 0     0     my ($p1, $n) = @_;
270            
271 0           my $z;
272 0 0         if (defined $p1->Z) {
273 0           $z = $p1->Z / $n;
274             }
275            
276             Geo::ShapeFile::Point->new(
277 0           X => ($p1->X / $n),
278             Y => ($p1->Y / $n),
279             Z => $z,
280             );
281             }
282            
283 0     0     sub _divide_number_point { divide_point_number(reverse @_); }
284            
285             1;
286             __END__