Add Highways England junction lookup

This is taken from the sort-my-sign repo. It allows the user to search
for motorways names and junction numbers, e.g. "M60, Junction 2", and
then geocodes that using a SQLite database created from Highways England
markerpost locations.

6 files changed, 210 insertions, 0 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index b858ac0d1..adbcf2f85 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,6 +5,8 @@
         - order unsent reports by confirmed date
     - Bugfixes
 	- Application user in Docker container can't install packages. #2914
+    - UK:
+        - Added junction lookup, so you can search for things like "M60, Junction 2"
 
 * v3.0 (4th March 2020)
     - Security:
diff --git a/bin/make-junctions-database b/bin/make-junctions-database
new file mode 100755
index 000000000..f7a12c586
--- /dev/null
+++ b/bin/make-junctions-database
@@ -0,0 +1,116 @@
+#!/usr/bin/env perl
+
+=head1 NAME
+
+make-junctions-database
+
+=head1 USAGE
+
+make-junctions-database path/to/markerposts.csv
+
+=head1 DESCRIPTION
+
+Creates a SQLite database of Highways England junctions to facilitate looking
+up locations by junction name, e.g. "M60, Junction 2" or "M6 323.5".
+
+
+1. Download the database of all marker posts from
+https://www.whatdotheyknow.com/request/positions_of_driver_location_sig
+The filename is "Gazetteer All Mposts only.zip".
+
+2. Unzip and export the XLSX file as a CSV (using in2csv from csvkit, for example).
+
+3. Run this script to build the database.
+
+The resulting database is used by the L<HighwaysEngland> package to lookup junctions.
+
+=cut
+
+use strict;
+use warnings;
+
+BEGIN {
+    use File::Basename qw(dirname);
+    use File::Spec;
+    my $d = dirname(File::Spec->rel2abs($0));
+    require "$d/../setenv.pl";
+}
+
+use DBI;
+use Text::CSV;
+use FixMyStreet;
+use HighwaysEngland;
+
+my $db = DBI->connect('dbi:SQLite:dbname='. HighwaysEngland::database_file);
+
+$db->do(<<EOF) or die $db->errstr;
+CREATE TABLE IF NOT EXISTS junction (
+    name TEXT NOT NULL,
+    road TEXT NOT NULL,
+    easting INTEGER NOT NULL,
+    northing INTEGER NOT NULL,
+    PRIMARY KEY (name, road)
+);
+EOF
+
+$db->do(<<EOF) or die $db->errstr;
+CREATE TABLE IF NOT EXISTS sign (
+    road TEXT NOT NULL,
+    distance TEXT NOT NULL,
+    side TEXT NOT NULL,
+    easting INTEGER NOT NULL,
+    northing INTEGER NOT NULL
+);
+EOF
+
+$db->do(<<EOF) or die $db->errstr;
+CREATE INDEX IF NOT EXISTS sign_idx ON sign (road, distance);
+EOF
+
+my $q_sign = $db->prepare('INSERT INTO sign (road, distance, side, easting, northing) VALUES (?, ?, ?, ?, ?)');
+my $q_junction = $db->prepare('INSERT INTO junction (road, name, easting, northing) VALUES (?, ?, ?, ?)');
+
+my $csv = Text::CSV->new ({ binary => 1, auto_diag => 1 });
+die "Usage: $0 <csv_file>\n" unless @ARGV;
+open my $fh, "<:encoding(utf8)", $ARGV[0] or die "$ARGV[0]: $!";
+$csv->header($fh);
+
+my %all;
+my $c = 0;
+while (my $row = $csv->getline_hr($fh)) {
+    my $marker = $row->{bd};
+    $marker =~ /P(\d+)\/(\d+)([ABJMKL])/ or next;
+
+    my $kms = "$1.$2";
+    my $letter = $3;
+
+    my $road = $row->{dd};
+    next unless $road =~ /^[AM]/;
+
+    my $e = $row->{easting};
+    my $n = $row->{northing};
+    my $name = $row->{tn};
+
+    $q_sign->execute($road, $kms, $letter, $e, $n) or warn $db->errstr . " $road $kms $letter";
+    print '.' unless $c++ % 1000;
+
+    next unless $name =~ /ASIDE|BSIDE/;
+    $name =~ s/ ASIDE| BSIDE//;
+    push @{$all{$road}{$name}}, $row;
+}
+
+close $fh;
+
+for my $road (sort keys %all) {
+    foreach my $junction (sort keys %{$all{$road}}) {
+        my $tot_e = 0; my $tot_n = 0; my $n = 0;
+        foreach (@{$all{$road}{$junction}}) {
+            $tot_e += $_->{easting};
+            $tot_n += $_->{northing};
+            $n++;
+        }
+        my $avg_e = int($tot_e/$n+0.5);
+        my $avg_n = int($tot_n/$n+0.5);
+        $q_junction->execute($road, $junction, $avg_e, $avg_n);
+    }
+}
diff --git a/docs/customising/geocoder.md b/docs/customising/geocoder.md
index 4dc44b507..6e5e54c4c 100644
--- a/docs/customising/geocoder.md
+++ b/docs/customising/geocoder.md
@@ -30,6 +30,27 @@ a specific country or city.
 
 The options vary [depending on which geocoder you use]({{ "/customising/config/#geocoding_disambiguation" | relative_url }}).
 
+If you're running a site in the UK and want junction lookup (e.g. "M5 junction
+11a") then see the [Junction lookup](#junction-lookup) section below.
+
 ## Detailed flow: location &rarr; map pin &rarr; drop-down menu
 
 ![FMS bodies and contacts](/assets/img/fms_bodies_and_contacts.png)
+
+## Junction lookup
+
+If the site is going to be run in the UK and you'd like the ability to do
+junction lookups, i.e. allow the user to search for "M60, Junction 2" and have
+it geocode to the correct location, then you'll need to generate a junctions
+database.
+
+{% highlight bash %}
+$ mkdir ../data
+$ wget https://www.whatdotheyknow.com/request/272238/response/675823/attach/2/Gazetteer%20All%20Mposts%20only.zip
+$ unzip Gazetteer\ All\ Mposts\ only.zip
+$ in2csv Gazetteer_All_Mposts_only.xlsx > markerposts.csv
+$ bin/make-junctions-database markerposts.csv
+{% endhighlight %}
+
+This will create a SQLite database at `../data/roads.sqlite`. If this is present
+then it will be used by the postcode search to do a junction lookup.
diff --git a/perllib/FixMyStreet/Cobrand/UK.pm b/perllib/FixMyStreet/Cobrand/UK.pm
index a9f8c2f01..512dfa973 100644
--- a/perllib/FixMyStreet/Cobrand/UK.pm
+++ b/perllib/FixMyStreet/Cobrand/UK.pm
@@ -6,6 +6,7 @@ use JSON::MaybeXS;
 use mySociety::MaPit;
 use mySociety::VotingArea;
 use Utils;
+use HighwaysEngland;
 
 sub country             { return 'GB'; }
 sub area_types          { [ 'DIS', 'LBO', 'MTD', 'UTA', 'CTY', 'COI', 'LGD' ] }
@@ -89,6 +90,8 @@ sub geocode_postcode {
             latitude  => $location->{wgs84_lat},
             longitude => $location->{wgs84_lon},
         };
+    } elsif (my $junction_location = HighwaysEngland::junction_lookup($s)) {
+        return $junction_location;
     }
     return {};
 }
diff --git a/perllib/HighwaysEngland.pm b/perllib/HighwaysEngland.pm
new file mode 100644
index 000000000..d4ef65369
--- /dev/null
+++ b/perllib/HighwaysEngland.pm
@@ -0,0 +1,39 @@
+package HighwaysEngland;
+
+use strict;
+use warnings;
+
+use FixMyStreet;
+use DBI;
+use Utils;
+
+sub database_file { FixMyStreet->path_to('../data/roads.sqlite') }
+
+sub junction_lookup {
+    my $s = shift;
+    if ($s =~ /^\s*(?<road>[AM][0-9MT]*)[\s,.]*(junction|junc|j)\s*(?<junction>.*?)\s*$/i
+          || $s =~ /^\s*(junction|junc|j)\s*(?<junction>.*?)[,.\s]*(?<road>[AM][0-9MT]*)\s*$/i
+    ) {
+        return _lookup_db($+{road}, 'junction', $+{junction}, 'name') || undef;
+    } elsif ($s =~ /^\s*(?<road>[AM][^ ]*)\s*(?<dist>[0-9.]+)\s*$/i
+          || $s =~ /^\s*(?<dist>[0-9.]+)\s*(?<road>[AM][^ ]*)\s*$/i
+    ) {
+        return _lookup_db($+{road}, 'sign', $+{dist}, 'distance') || undef;
+    }
+}
+
+sub _lookup_db {
+    my ($road, $table, $thing, $thing_name) = @_;
+    my $db = DBI->connect("dbi:SQLite:dbname=".database_file(), undef, undef) or return;
+    $thing = "J$thing" if $table eq 'junction' && $thing =~ /^[1-9]/;
+    my $results = $db->selectall_arrayref(
+        "SELECT * FROM $table where road=? and $thing_name=?",
+        { Slice => {} }, uc $road, uc $thing);
+    return unless $results;
+    if (@$results) {
+        my ($lat, $lon) = Utils::convert_en_to_latlon($results->[0]{easting}, $results->[0]{northing});
+        return { latitude => $lat, longitude => $lon };
+    }
+}
+
+1;
diff --git a/t/app/controller/around.t b/t/app/controller/around.t
index cd992270f..db7244863 100644
--- a/t/app/controller/around.t
+++ b/t/app/controller/around.t
@@ -400,4 +400,33 @@ subtest 'check nearby lookup' => sub {
     $mech->content_contains('[51.754926,-1.256179,"yellow",' . $p->id . ',"Around page Test 1 for ' . $body->id . '","small",false]');
 };
 
+my $he = Test::MockModule->new('HighwaysEngland');
+$he->mock('_lookup_db', sub {
+    my ($road, $table, $thing, $thing_name) = @_;
+
+    if ($road eq 'M6' && $thing eq '11') {
+        return { latitude => 52.65866, longitude => -2.06447 };
+    } elsif ($road eq 'M5' && $thing eq '132.5') {
+        return { latitude => 51.5457, longitude => 2.57136 };
+    }
+});
+
+subtest 'junction lookup' => sub {
+    FixMyStreet::override_config {
+        ALLOWED_COBRANDS => 'fixmystreet',
+        MAPIT_URL => 'http://mapit.uk',
+        MAPIT_TYPES => ['EUR'],
+    }, sub {
+        $mech->log_out_ok;
+
+        $mech->get_ok('/');
+        $mech->submit_form_ok({ with_fields => { pc => 'M6, Junction 11' } });
+        $mech->content_contains('52.65866');
+
+        $mech->get_ok('/');
+        $mech->submit_form_ok({ with_fields => { pc => 'M5 132.5' } });
+        $mech->content_contains('51.5457');
+    };
+};
+
 done_testing();