File Coverage

blib/lib/Geo/Hash/Grid.pm
Criterion Covered Total %
statement 61 61 100.0
branch 10 16 62.5
condition 9 21 42.8
subroutine 11 11 100.0
pod 3 4 75.0
total 94 113 83.1


line stmt bran cond sub pod time code
1             package Geo::Hash::Grid;
2              
3 1     1   40715 use Moo;
  1         15678  
  1         6  
4 1     1   2262 use namespace::clean;
  1         10822  
  1         12  
5              
6 1     1   164 use strict;
  1         1  
  1         77  
7 1     1   5 use warnings;
  1         1  
  1         94  
8              
9 1     1   6 use Carp qw( croak );
  1         1  
  1         87  
10              
11 1     1   587 use Geo::Hash::XS qw( ADJ_RIGHT ADJ_TOP );
  1         484  
  1         56  
12 1     1   5 use Scalar::Util qw( looks_like_number );
  1         2  
  1         730  
13              
14             =head1 NAME
15              
16             Geo::Hash::Grid - Make a grid based off of GeoHashes
17              
18             =head1 VERSION
19              
20             Version 0.01
21              
22             =cut
23              
24             our $VERSION = '0.01';
25              
26              
27             =head1 SYNOPSIS
28              
29             Sometimes you need a simple grid to cover a geographic area. This is a pretty
30             easy way to get one that covers a geographic box and with a little spillover.
31              
32              
33             use Geo::Hash::Grid;
34            
35             my $grid = Geo::Hash::Grid->new(
36             sw_lat => $south_west_latitude,
37             sw_lon => $south_west_longidude,
38             ne_lat => $north_east_latitude,
39             ne_lon => $north_east_longitude,
40             precision => 8,
41             );
42            
43             my $hash_count = $grid->count;
44            
45             my $geohash_list = $grid->hashes;
46            
47             my $origin_list = $grid->origins;
48            
49              
50             =head1 METHODS
51              
52             =head2 new
53              
54             Create the geohash grid that fits in a bounding box and specify the grid size.
55              
56             =head3 poop
57              
58             =over 4
59              
60             =item * sw_lat => $decimal_degrees
61              
62             Latitude of the southwest corner of bounding box
63              
64             =item * sw_lon => $decimal_degrees
65              
66             Longitude of the southwest corner of bounding box
67              
68             =item * ne_lat => $decimal_degrees
69              
70             Latitude of the northeast corner of bounding box
71              
72             =item * ne_lon => $decimal_degrees
73              
74             Longitude of the northeast corner of bounding box
75              
76             =item * precision => $integer
77              
78             Geohash precision
79              
80             =back
81              
82             =cut
83              
84             has 'sw_lat' => ( is => 'ro', required => 1 );
85             has 'sw_lon' => ( is => 'ro', required => 1 );
86             has 'ne_lat' => ( is => 'ro', required => 1 );
87             has 'ne_lon' => ( is => 'ro', required => 1 );
88             has 'precision' => ( is => 'ro', required => 1 );
89              
90             sub BUILD {
91 1     1 0 3636 my $self = shift;
92            
93            
94 1 50 33     17 croak "sw_lat attribute missing or malformed" if not defined $self->sw_lat or not looks_like_number $self->sw_lat;
95 1 50 33     10 croak "sw_lon attribute missing or malformed" if not defined $self->sw_lon or not looks_like_number $self->sw_lon;
96 1 50 33     11 croak "ne_lat attribute missing or malformed" if not defined $self->ne_lat or not looks_like_number $self->ne_lat;
97 1 50 33     13 croak "ne_lon attribute missing or malformed" if not defined $self->ne_lon or not looks_like_number $self->ne_lon;
98 1 50 33     14 croak "precision attribute missing or malformed" if not defined $self->precision or not $self->precision =~ m/^\d+$/;
99            
100 1         8 my $gh = Geo::Hash::XS->new();
101            
102            
103             # place to store the hashes
104 1         5 my @coverage;
105            
106            
107             # convert the southwest corner into the start hash
108 1         11 my $current_hash = $gh->encode( $self->sw_lat, $self->sw_lon, $self->precision );
109            
110            
111             # let's find our start lat/lon
112 1         11 my ( $current_lat, $current_lon ) = $gh->decode( $current_hash );
113            
114 1         2 my $row_start_hash = $current_hash;
115            
116             # while both our current lat/longs are still within the bounding box
117 1         2 my $over_bounds_detected = 0;
118 1   66     1 do {
      66        
119            
120             # if our longitude hasn't over run our bounding box, then we need the next to the right
121             # if our longitude has run over the bounding box, then we need the next one on the top
122 36         27 my $next_hash;
123 36 100       51 if ( $current_lon <= $self->ne_lon ) {
124            
125 32         76 $next_hash = $gh->adjacent( $current_hash, ADJ_RIGHT );
126            
127 32         34 push @coverage, $current_hash;
128            
129             } else {
130            
131 4         5 $current_hash = $row_start_hash;
132 4         12 $next_hash = $gh->adjacent( $current_hash, ADJ_TOP );
133 4         4 $row_start_hash = $next_hash;
134            
135             # check to see if the next row is out of bounds
136 4         6 my ( $lat ) = $gh->decode( $row_start_hash );
137            
138 4 100       11 $over_bounds_detected = 1 if $lat > $self->ne_lat;
139            
140             }
141            
142             # get ready to evaluate the next hash
143 36         30 $current_hash = $next_hash;
144 36         198 ( $current_lat, $current_lon ) = $gh->decode( $current_hash );
145            
146             } while ( ( $current_lat <= $self->ne_lat or $current_lon <= $self->ne_lon ) and not $over_bounds_detected );
147            
148             # store data
149 1         37 $self->{'coverage'} = [ @coverage ];
150            
151             }
152              
153             =head2 count
154              
155             Get count of GeoHash's in bounding box
156              
157             =cut
158              
159             sub count {
160 1     1 1 10 my $self = shift;
161 1         2 return scalar @{$self->{'coverage'}};
  1         10  
162             }
163              
164             =head2 hashes
165              
166             Get array reference of GeoHash's in bounding box
167              
168             =cut
169              
170             sub hashes {
171 1     1 1 4 my $self = shift;
172 1         13 return $self->{'coverage'};
173             }
174              
175             =head2 origins
176              
177             Get list of hash references of GeoHash lat/long origins in bounding box
178              
179             =cut
180              
181             sub origins {
182 1     1 1 3 my $self = shift;
183            
184 1         5 my $gh = Geo::Hash::XS->new();
185            
186 1 50       9 if ( not defined $self->{'origins'} ) {
187 1         1 my $origins;
188 1         2 foreach my $hash ( @{$self->{'coverage'}} ) {
  1         3  
189 32         48 my ( $lat, $lon ) = $gh->decode( $hash );
190 32         66 push @$origins, {
191             lat => $lat,
192             lon => $lon,
193             };
194             }
195 1         22 $self->{'origins'} = $origins;
196             }
197            
198 1         42 return $self->{'origins'};
199            
200             }
201              
202             =head1 AUTHOR
203              
204             Adam Wohld, C<<
205              
206             =head1 BUGS
207              
208             Please report any bugs or feature requests to C, or through
209             the web interface at L. I will be notified, and then you'll
210             automatically be notified of progress on your bug as I make changes.
211              
212              
213              
214              
215             =head1 SUPPORT
216              
217             You can find documentation for this module with the perldoc command.
218              
219             perldoc Geo::Hash::Grid
220              
221              
222             You can also look for information at:
223              
224             =over 4
225              
226             =item * RT: CPAN's request tracker (report bugs here)
227              
228             L
229              
230             =item * AnnoCPAN: Annotated CPAN documentation
231              
232             L
233              
234             =item * CPAN Ratings
235              
236             L
237              
238             =item * Search CPAN
239              
240             L
241              
242             =back
243              
244              
245             =head1 ACKNOWLEDGEMENTS
246              
247              
248             =head1 LICENSE AND COPYRIGHT
249              
250             Copyright 2015 Adam Wohld.
251              
252             This program is free software; you can redistribute it and/or modify it
253             under the terms of the the Artistic License (2.0). You may obtain a
254             copy of the full license at:
255              
256             L
257              
258             Any use, modification, and distribution of the Standard or Modified
259             Versions is governed by this Artistic License. By using, modifying or
260             distributing the Package, you accept this license. Do not use, modify,
261             or distribute the Package, if you do not accept this license.
262              
263             If your Modified Version has been derived from a Modified Version made
264             by someone other than you, you are nevertheless required to ensure that
265             your Modified Version complies with the requirements of this license.
266              
267             This license does not grant you the right to use any trademark, service
268             mark, tradename, or logo of the Copyright Holder.
269              
270             This license includes the non-exclusive, worldwide, free-of-charge
271             patent license to make, have made, use, offer to sell, sell, import and
272             otherwise transfer the Package with respect to any patent claims
273             licensable by the Copyright Holder that are necessarily infringed by the
274             Package. If you institute patent litigation (including a cross-claim or
275             counterclaim) against any party alleging that the Package constitutes
276             direct or contributory patent infringement, then this Artistic License
277             to you shall terminate on the date that such litigation is filed.
278              
279             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
280             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
281             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
282             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
283             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
284             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
285             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
286             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
287              
288              
289             =cut
290              
291             1;