File Coverage

blib/lib/GIS/Distance/Formula.pm
Criterion Covered Total %
statement 34 38 89.4
branch 4 8 50.0
condition 2 5 40.0
subroutine 9 10 90.0
pod 0 4 0.0
total 49 65 75.3


line stmt bran cond sub pod time code
1             package GIS::Distance::Formula;
2 3     3   1392 use 5.008001;
  3         12  
3 3     3   17 use strictures 2;
  3         20  
  3         104  
4             our $VERSION = '0.19';
5              
6 3     3   2054 use Class::Measure::Length qw( length );
  3         53392  
  3         14  
7 3     3   791 use Carp qw( croak );
  3         8  
  3         152  
8 3     3   17 use Scalar::Util qw( blessed );
  3         8  
  3         124  
9 3     3   1673 use namespace::clean;
  3         49615  
  3         19  
10              
11             our $SELF;
12              
13             sub new {
14 9     9 0 21 my $class = shift;
15              
16 9         39 my $args = $class->BUILDARGS( @_ );
17              
18 9         25 my $self = bless { %$args }, $class;
19 9         85 $self->{code} = $class->can('_distance');
20 9 50       53 $self->BUILD() if $self->can('BUILD');
21              
22 9         50 return $self;
23             }
24              
25             sub BUILDARGS {
26 9     9 0 18 my $class = shift;
27              
28             return shift
29 9 50 33     30 if @_==1 and ref($_[0]) eq 'HASH';
30              
31 9         23 return { @_ };
32             }
33              
34             sub distance {
35 33     33 0 8440 my $self = shift;
36              
37 33         46 my @coords;
38 33         68 foreach my $coord (@_) {
39 132 50 50     451 if ((blessed($coord)||'') eq 'Geo::Point') {
40 0         0 push @coords, $coord->latlong();
41 0         0 next;
42             }
43              
44 132         231 push @coords, $coord;
45             }
46              
47 33 50       71 croak 'Invalid arguments passsed to distance()'
48             if @coords!=4;
49              
50 33         102 local $SELF = $self;
51              
52             return length(
53 33         102 $self->{code}->( @coords ),
54             'km',
55             );
56             }
57              
58             sub distance_metal {
59 0     0 0   my $self = shift;
60 0           return $self->{code}->( @_ );
61             }
62              
63             1;
64             __END__