[Buckinghamshire] Improve the site_code lookup to fetch nearest asset

The previous approach of requesting a small bounding box from the
WFS server and using the first asset, if any, wasn’t sufficiently
tolerant of reports that were made more than 5M away from a road,
of which there were many. The problem with extending the bounding
box used to fetch assets from the server is that the order of the
returned assets didn’t have any bearing on their proximity to the
centre of the bounding box (i.e., the location of the report). As
an alternative approach this commit changes the method to instead
fetch all assets within a much wider bounding box surrounding the
report and iterates across the returned features in order to find
the closest point and uses the site_code value from that feature.

1 files changed, 51 insertions, 3 deletions

diff --git a/perllib/FixMyStreet/Cobrand/Buckinghamshire.pm b/perllib/FixMyStreet/Cobrand/Buckinghamshire.pm
index a1ba25e6c..1b42055b6 100644
--- a/perllib/FixMyStreet/Cobrand/Buckinghamshire.pm
+++ b/perllib/FixMyStreet/Cobrand/Buckinghamshire.pm
@@ -322,7 +322,7 @@ sub lookup_site_code {
     my $self = shift;
     my $row = shift;
 
-    my $buffer = 10; # metres
+    my $buffer = 200; # metres
     my ($x, $y) = $row->local_coords;
     my ($w, $s, $e, $n) = ($x-$buffer, $y-$buffer, $x+$buffer, $y+$buffer);
 
@@ -342,13 +342,61 @@ sub lookup_site_code {
     my $j = JSON->new->utf8->allow_nonref;
     try {
         $j = $j->decode($response);
-        return $j->{features}->[0]->{properties}->{site_code};
     } catch {
         # There was either no asset found, or an error with the WFS
         # call - in either case let's just proceed without the USRN.
-        return;
+        return '';
+    };
+
+    # We have a list of features, and we want to find the one closest to the
+    # report location.
+    my $site_code = '';
+    my $nearest;
+
+    # There are only certain features we care about, the rest can be ignored.
+    my @valid_types = ( "2", "3A", "3B", "4A", "4B", "HE", "HWOA", "HWSA", "P" );
+    my %valid_types = map { $_ => 1 } @valid_types;
+
+    for my $feature ( @{ $j->{features} } ) {
+        my $type = $feature->{properties}->{feature_ty};
+        next unless $valid_types{$type};
+
+        # We shouldn't receive anything aside from these two geometry types, but belt and braces.
+        next unless $feature->{geometry}->{type} eq 'MultiLineString' || $feature->{geometry}->{type} eq 'LineString';
+
+        my @coordinates = @{ $feature->{geometry}->{coordinates} };
+        if ( $feature->{geometry}->{type} eq 'MultiLineString') {
+            # The coordinates are stored as a list of lists, so flatten 'em out
+            @coordinates = map { @{ $_ } } @coordinates;
+        }
+
+        # If any of this feature's points are closer than those we've seen so
+        # far then use the site_code from this feature.
+        for my $coords ( @coordinates ) {
+            my ($fx, $fy) = @$coords;
+            my $distance = $self->_distance($x, $y, $fx, $fy);
+            if ( !defined $nearest || $distance < $nearest ) {
+                $site_code = $feature->{properties}->{site_code};
+                $nearest = $distance;
+            }
+        }
     }
 
+    return $site_code;
+}
+
+
+=head2 _distance
+
+Returns the cartesian distance between two coordinates.
+This is not a general-purpose distance function, it's intended for use with
+fairly nearby coordinates in EPSG:27700 where a spheroid doesn't need to be
+taken into account.
+
+=cut
+sub _distance {
+    my ($self, $ax, $ay, $bx, $by) = @_;
+    return sqrt( (($ax - $bx) ** 2) + (($ay - $by) ** 2) );
 }
 
 1;