1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
|
package FixMyStreet::App::Controller::Location;
use Moose;
use namespace::autoclean;
BEGIN {extends 'Catalyst::Controller'; }
use Encode;
use FixMyStreet::Geocode;
use Geo::OLC;
use Try::Tiny;
use Utils;
=head1 NAME
FixMyStreet::App::Controller::Location - Catalyst Controller
=head1 DESCRIPTION
Catalyst Controller.
This is purely an internal controller for keeping all the location finding things in one place
=head1 METHODS
=head2 determine_location_from_coords
Use latitude and longitude if provided in parameters.
=cut
sub determine_location_from_coords : Private {
my ( $self, $c ) = @_;
my $latitude = $c->get_param('latitude') || $c->get_param('lat');
my $longitude = $c->get_param('longitude') || $c->get_param('lon');
if ( defined $latitude && defined $longitude ) {
($c->stash->{latitude}, $c->stash->{longitude}) =
map { Utils::truncate_coordinate($_) } ($latitude, $longitude);
# Also save the pc if there is one
if ( my $pc = $c->get_param('pc') ) {
$c->stash->{pc} = $pc;
}
return $c->forward( 'check_location' );
}
return;
}
=head2 determine_location_from_pc
User has searched for a location - try to find it for them.
Return false if nothing provided.
If one match is found returns true and lat/lng is set.
If several possible matches are found puts an array onto stash so that user can be prompted to pick one and returns false.
If no matches are found returns false.
=cut
sub determine_location_from_pc : Private {
my ( $self, $c, $pc ) = @_;
# check for something to search
$pc ||= $c->get_param('pc') || return;
$c->stash->{pc} = $pc; # for template
if ( $pc =~ /^(-?\d+(?:\.\d+)?)\s*,\s*(-?\d+(?:\.\d+)?)$/ ) {
($c->stash->{latitude}, $c->stash->{longitude}) =
map { Utils::truncate_coordinate($_) } ($1, $2);
return $c->forward( 'check_location' );
}
if (Geo::OLC::is_full($pc)) {
my $ref = Geo::OLC::decode($pc);
($c->stash->{latitude}, $c->stash->{longitude}) =
map { Utils::truncate_coordinate($_) } @{$ref->{center}};
return $c->forward( 'check_location' );
}
if ($pc =~ /^\s*([2-9CFGHJMPQRVWX]{4,6}\+[2-9CFGHJMPQRVWX]{2,3})\s+(.*)$/i) {
my ($code, $rest) = ($1, $2);
my ($lat, $lon, $error) = FixMyStreet::Geocode::lookup($rest, $c);
if (ref($error) eq 'ARRAY') { # Just take the first result
$lat = $error->[0]{latitude};
$lon = $error->[0]{longitude};
}
if (defined $lat && defined $lon) {
$code = Geo::OLC::recover_nearest($code, $lat, $lon);
my $ref = Geo::OLC::decode($code);
($c->stash->{latitude}, $c->stash->{longitude}) =
map { Utils::truncate_coordinate($_) } @{$ref->{center}};
return $c->forward( 'check_location' );
}
}
if ( $c->cobrand->country eq 'GB' && $pc =~ /^([A-Z])([A-Z])([\d\s]{4,})$/i) {
if (my $convert = gridref_to_latlon( $1, $2, $3 )) {
($c->stash->{latitude}, $c->stash->{longitude}) =
map { Utils::truncate_coordinate($_) }
($convert->{latitude}, $convert->{longitude});
return $c->forward( 'check_location' );
}
}
my ( $latitude, $longitude, $error ) =
FixMyStreet::Geocode::lookup( $pc, $c );
# If we got a lat/lng set to stash and return true
if ( defined $latitude && defined $longitude ) {
$c->stash->{latitude} = $latitude;
$c->stash->{longitude} = $longitude;
return $c->forward( 'check_location' );
}
# $error doubles up to return multiple choices by being an array
if ( ref($error) eq 'ARRAY' ) {
foreach (@$error) {
my $a = $_->{address};
$a =~ s/, United Kingdom//;
$a =~ s/, UK//;
$_->{address} = $a;
}
$c->stash->{possible_location_matches} = $error;
return;
}
# pass errors back to the template
$c->stash->{location_error_pc_lookup} = 1;
$c->stash->{location_error} = $error;
# Log failure in a log db
try {
my $dbfile = FixMyStreet->path_to('../data/analytics.sqlite');
my $db = DBI->connect("dbi:SQLite:dbname=$dbfile", undef, undef, { PrintError => 0 }) or die "$DBI::errstr\n";
my $sth = $db->prepare("INSERT INTO location_searches_with_no_results
(datetime, cobrand, geocoder, url, user_input)
VALUES (?, ?, ?, ?, ?)") or die $db->errstr . "\n";
my $rv = $sth->execute(
POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime(time())),
$c->cobrand->moniker,
$c->cobrand->get_geocoder(),
$c->stash->{geocoder_url},
$pc,
);
} catch {
$c->log->debug("Unable to log to analytics.sqlite: $_");
};
return;
}
sub determine_location_from_bbox : Private {
my ( $self, $c ) = @_;
my $bbox = $c->get_param('bbox');
return unless $bbox;
my ($min_lon, $min_lat, $max_lon, $max_lat) = split /,/, $bbox;
my $longitude = ($max_lon + $min_lon ) / 2;
my $latitude = ($max_lat + $min_lat ) / 2;
$c->stash->{bbox} = $bbox;
$c->stash->{latitude} = $latitude;
$c->stash->{longitude} = $longitude;
return $c->forward('check_location');
}
=head2 check_location
Just make sure that for UK installs, our co-ordinates are indeed in the UK.
=cut
sub check_location : Private {
my ( $self, $c ) = @_;
if ( $c->stash->{latitude} && $c->cobrand->country eq 'GB' ) {
eval { Utils::convert_latlon_to_en( $c->stash->{latitude}, $c->stash->{longitude} ); };
if (my $error = $@) {
mySociety::Locale::pop(); # We threw exception, so it won't have happened.
$error = _('That location does not appear to be in the UK; please try again.')
if $error =~ /of the area covered/;
$c->stash->{location_error} = $error;
return;
}
}
return 1;
}
# Utility function for if someone (rarely) enters a grid reference
sub gridref_to_latlon {
my ( $a, $b, $num ) = @_;
$a = ord(uc $a) - 65; $a-- if $a > 7;
$b = ord(uc $b) - 65; $b-- if $b > 7;
my $e = (($a-2)%5)*5 + $b%5;
my $n = 19 - int($a/5)*5 - int($b/5);
$num =~ s/\s+//g;
my $l = length($num);
return if $l % 2 or $l > 10;
$l /= 2;
$e .= substr($num, 0, $l);
$n .= substr($num, $l);
if ( $l < 5 ) {
$e .= 5;
$n .= 5;
$e .= 0 x (4-$l);
$n .= 0 x (4-$l);
}
my ( $lat, $lon ) = Utils::convert_en_to_latlon( $e, $n );
return {
latitude => $lat,
longitude => $lon,
};
}
=head1 AUTHOR
Struan Donald
=head1 LICENSE
This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
__PACKAGE__->meta->make_immutable;
1;
|
