File Coverage

File:lib/Geo/Coder/Free/Utils.pm
Coverage:51.5%

linestmtbrancondsubpodtimecode
1package Geo::Coder::Free::Utils;
2
3# VWF is licensed under GPL2.0 for personal use only
4# njh@bandsman.co.uk
5
6 - 14
=head1 NAME

Geo::Coder::Free::Utils - Random subroutines for Geo::Coder::Free

=head1 VERSION

Version 0.41

=cut
15
16our $VERSION = '0.41';
17
18
2
2
2
2
101901
1
19
use strict;
19
2
2
2
2
3
0
37
use warnings;
20
21
2
2
2
2
2
2
30
use Exporter qw(import);
22
23our @EXPORT = qw(create_disc_cache create_memory_cache distance);
24
25
2
2
2
2
354
29924
27
use CHI;
26
2
2
2
2
7
2
40
use Data::Dumper;
27
2
2
2
2
1300
13202
56
use DBI;
28
2
2
2
2
172
1423
6
use Error;
29
2
2
2
2
293
284
3
use Log::Any::Adapter;
30
2
2
2
2
116
3388
35
use Params::Get;
31
32BEGIN {
33
2
2
4
        Log::Any::Adapter->set('Log4perl');
34}
35
36 - 43
=head1 SUBROUTINES/METHODS

=head2 create_disc_cache

Initialise a disc-based cache using the CHI module.
Supports multiple cache drivers, including BerkeleyDB, DBI, and Redis.

=cut
44
45sub create_disc_cache {
46
2
2
1
96263
        my $args = Params::Get::get_params(undef, @_);
47
48
2
29
        my $config = $args->{'config'};
49
2
50
4
        throw Error::Simple('config is not optional') unless($config);
50
51
2
2
        my $logger = $args->{'logger'};
52
2
3
        my $driver = $config->{disc_cache}->{driver};
53
2
100
3
        unless(defined($driver)) {
54
1
33
7
                my $root_dir = $ENV{'root_dir'} || $args->{'root_dir'} || $config->{disc_cache}->{root_dir} || $config->{'root_dir'};
55
1
50
12
                throw Error::Simple('root_dir is not optional') unless($root_dir);
56
57
0
0
0
                if($logger) {
58
0
0
                        $logger->debug(Data::Dumper->new([$config])->Dump());
59
0
0
                        $logger->info('disc_cache not defined in ', $config->{'config_path'}, ' falling back to BerkeleyDB');
60                }
61
0
0
                return CHI->new(driver => 'BerkeleyDB', root_dir => $root_dir, namespace => $args->{'namespace'});
62        }
63
1
50
1
        if($logger) {
64
0
0
                $logger->debug('disc cache via ', $config->{disc_cache}->{driver}, ', namespace: ', $args->{'namespace'});
65        }
66
67        my %chi_args = (
68                on_get_error => 'warn',
69                on_set_error => 'die',
70                driver => $driver,
71
1
3
                namespace => $args->{'namespace'}
72        );
73
74        # Don't do this because it takes a lot of complex configuration
75        # if($logger) {
76                # $chi_args{'on_set_error'} = 'log';
77                # $chi_args{'on_get_error'} = 'log';
78        # }
79
80
1
50
50
50
50
5
        if($config->{disc_cache}->{server}) {
81
0
0
                my @servers;
82
0
0
0
                if($config->{disc_cache}->{server} =~ /,/) {
83
0
0
                        @servers = split /,/, $config->{disc_cache}->{server};
84                } else {
85
0
0
                        $servers[0] = $config->{disc_cache}->{server};
86
0
0
0
                        if($config->{disc_cache}->{'port'}) {
87
0
0
                                $servers[0] .= ':' . $config->{disc_cache}->{port};
88                        } else {
89
0
0
                                throw Error::Simple('port is not optional in ' . $config->{'config_path'});
90                        }
91
0
0
                        $chi_args{'server'} = $servers[0];
92
0
0
0
                        if($logger) {
93
0
0
                                $logger->debug("First server: $servers[0]");
94                        }
95                }
96
0
0
                $chi_args{'servers'} = \@servers;
97        } elsif($driver eq 'DBI') {
98                # Use the cache connection details in the configuration file
99
0
0
                $chi_args{'dbh'} = DBI->connect($config->{disc_cache}->{connect});
100
0
0
0
                if(!defined($chi_args{'dbh'})) {
101
0
0
0
                        if($logger) {
102
0
0
                                $logger->error($DBI::errstr);
103                        }
104
0
0
                        throw Error::Simple($DBI::errstr);
105                }
106
0
0
                $chi_args{'create_table'} = 1;
107        } elsif($driver eq 'Redis') {
108
0
0
                my %redis_options = (
109                        reconnect => 60,
110                        every => 1_000_000
111                );
112
0
0
                $chi_args{'redis_options'} = \%redis_options;
113        } elsif($driver ne 'Null') {
114
1
33
5
                $chi_args{'root_dir'} = $ENV{'root_dir'} || $args->{'root_dir'} || $config->{disc_cache}->{root_dir};
115
1
50
4
                throw Error::Simple('root_dir is not optional') unless($chi_args{'root_dir'});
116
1
50
2
                if($logger) {
117
0
0
                        $logger->debug("root_dir: $chi_args{root_dir}");
118                }
119        }
120
1
4
        return CHI->new(%chi_args);
121}
122
123 - 128
=head2 create_memory_cache

Initialise a memory-based cache using the CHI module.
Supports multiple cache drivers, including SharedMem, Memory, and Redis.

=cut
129
130sub create_memory_cache {
131
4
4
1
736
        my $args = Params::Get::get_params(undef, @_);
132
133
4
43
        my $config = $args->{'config'};
134
4
50
6
        throw Error::Simple('config is not optional') unless($config);
135
136
4
4
        my $logger = $args->{'logger'};
137
4
8
        my $driver = $config->{'memory_cache'}->{driver};
138
4
50
18
        unless(defined($driver)) {
139
0
0
0
                if($logger) {
140
0
0
                        $logger->debug(Data::Dumper->new([$config])->Dump());
141
0
0
                        $logger->info('memory_cache not defined in ', $config->{'config_path'}, ' falling back to memory');
142                }
143                # return CHI->new(driver => 'Memcached', servers => [ '127.0.0.1:11211' ], namespace => $args->{'namespace'});
144                # return CHI->new(driver => 'File', root_dir => '/tmp/cache', namespace => $args->{'namespace'});
145                # return CHI->new(driver => 'SharedMem', max_size => 1024, shm_size => 16 * 1024, shm_key => 98766789, namespace => $args->{'namespace'});
146
0
0
                return CHI->new(driver => 'Memory', global => 1);
147        }
148
4
100
5
        if($logger) {
149
3
10
                $logger->debug('memory cache via ', $config->{memory_cache}->{driver}, ', namespace: ', $args->{'namespace'});
150        }
151
152        my %chi_args = (
153                on_get_error => 'warn',
154                on_set_error => 'die',
155                driver => $driver,
156
4
48
                namespace => $args->{'namespace'}
157        );
158
159
4
100
7
        if($logger) {
160
3
2
                $chi_args{'on_set_error'} = 'log';
161
3
3
                $chi_args{'on_get_error'} = 'log';
162        }
163
164
4
50
50
50
50
50
18
        if($config->{memory_cache}->{server}) {
165
0
0
                my @servers;
166
0
0
0
                if($config->{memory_cache}->{server} =~ /,/) {
167
0
0
                        @servers = split /,/, $config->{memory_cache}->{server};
168                } else {
169
0
0
                        $servers[0] = $config->{memory_cache}->{server};
170
0
0
0
                        if($config->{memory_cache}->{'port'}) {
171
0
0
                                $servers[0] .= ':' . $config->{memory_cache}->{port};
172                        } else {
173
0
0
                                throw Error::Simple('port is not optional in ' . $config->{'config_path'});
174                        }
175
0
0
                        $chi_args{'server'} = $servers[0];
176
0
0
0
                        if($logger) {
177
0
0
                                $logger->debug("First server: $servers[0]");
178                        }
179                }
180
0
0
                $chi_args{'servers'} = \@servers;
181        } elsif($driver eq 'SharedMem') {
182
0
0
0
                $chi_args{'shm_key'} = $args->{'shm_key'} || $config->{memory_cache}->{shm_key};
183
0
0
0
0
                if(my $shm_size = ($args->{'shm_size'} || $config->{'memory_cache'}->{'shm_size'})) {
184
0
0
                        $chi_args{'shm_size'} = $shm_size;
185                }
186
0
0
0
0
                if(my $max_size = ($args->{'max_size'} || $config->{'memory_cache'}->{'max_size'})) {
187
0
0
                        $chi_args{'max_size'} = $max_size;
188                }
189        } elsif($driver eq 'Memory') {
190
0
0
0
                $chi_args{'global'} = $config->{'memory_cache'}->{'global'} || 0;
191        } elsif($driver ne 'Null') {
192
0
0
0
                $chi_args{'root_dir'} = $ENV{'root_dir'} || $args->{'root_dir'} || $config->{memory_cache}->{root_dir} || $config->{'root_dir'};
193
0
0
0
                throw Error::Simple('root_dir is not optional') unless($chi_args{'root_dir'});
194
0
0
0
                if($logger) {
195
0
0
                        $logger->debug("root_dir: $chi_args{root_dir}");
196                }
197        } elsif($driver eq 'Redis') {
198
0
0
                my %redis_options = (
199                        reconnect => 60,
200                        every => 1_000_000
201                );
202
0
0
                $chi_args{'redis_options'} = \%redis_options;
203        }
204
4
14
        return CHI->new(%chi_args);
205}
206
207 - 215
=head2 distance

Calculate the distance between two geographical points using latitude and longitude.
Supports distance in kilometres (K), nautical miles (N), or miles.

From L<http://www.geodatasource.com/developers/perl>
FIXME:  use Math::Trig

=cut
216
217sub distance {
218
3
3
1
6597
        my ($lat1, $lon1, $lat2, $lon2, $unit) = @_;
219
3
3
        my $theta = $lon1 - $lon2;
220
3
3
        my $dist = sin(_deg2rad($lat1)) * sin(_deg2rad($lat2)) + cos(_deg2rad($lat1)) * cos(_deg2rad($lat2)) * cos(_deg2rad($theta));
221
3
5
        $dist = _acos($dist);
222
3
5
        $dist = _rad2deg($dist);
223
3
3
        $dist = $dist * 60 * 1.1515;
224
3
100
100
6
        if ($unit eq 'K') {
225
1
1
                $dist = $dist * 1.609344;       # number of kilometres in a mile
226        } elsif ($unit eq 'N') {
227
1
1
                $dist = $dist * 0.8684;
228        }
229
3
3
        return ($dist);
230}
231
232my $pi = atan2(1,1) * 4;
233
234#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
235#:::  This function get the arccos function using arctan function   :::
236#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
237sub _acos {
238
3
3
2
        my ($rad) = @_;
239
3
6
        my $ret = atan2(sqrt(1 - $rad**2), $rad);
240
3
2
        return $ret;
241}
242
243#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
244#:::  This function converts decimal degrees to radians             :::
245#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
246sub _deg2rad {
247
15
15
5
        my ($deg) = @_;
248
15
21
        return ($deg * $pi / 180);
249}
250
251#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
252#:::  This function converts radians to decimal degrees             :::
253#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
254sub _rad2deg {
255
3
3
1
        my ($rad) = @_;
256
3
3
        return ($rad * 180 / $pi);
257}
258
2591;