aboutsummaryrefslogtreecommitdiffstats
path: root/perllib/FixMyStreet
diff options
context:
space:
mode:
Diffstat (limited to 'perllib/FixMyStreet')
-rw-r--r--perllib/FixMyStreet/Alert.pm339
-rw-r--r--perllib/FixMyStreet/Geocode.pm156
-rw-r--r--perllib/FixMyStreet/Map.pm114
-rw-r--r--perllib/FixMyStreet/Map/Bing.pm71
-rw-r--r--perllib/FixMyStreet/Map/BingOL.pm71
-rw-r--r--perllib/FixMyStreet/Map/Google.pm71
-rw-r--r--perllib/FixMyStreet/Map/OSM.pm71
-rw-r--r--perllib/FixMyStreet/Map/OSM/CycleMap.pm71
-rw-r--r--perllib/FixMyStreet/Map/OSM/StreetView.pm70
-rw-r--r--perllib/FixMyStreet/Map/Tilma/OL/1_10k.pm83
-rw-r--r--perllib/FixMyStreet/Map/Tilma/OL/StreetView.pm81
-rw-r--r--perllib/FixMyStreet/Map/Tilma/Original.pm257
-rw-r--r--perllib/FixMyStreet/Map/Tilma/Original/1_10k.pm28
-rw-r--r--perllib/FixMyStreet/Map/Tilma/Original/StreetView.pm27
14 files changed, 1510 insertions, 0 deletions
diff --git a/perllib/FixMyStreet/Alert.pm b/perllib/FixMyStreet/Alert.pm
new file mode 100644
index 000000000..9996f03c8
--- /dev/null
+++ b/perllib/FixMyStreet/Alert.pm
@@ -0,0 +1,339 @@
+#!/usr/bin/perl -w
+#
+# FixMyStreet::Alert.pm
+# Alerts by email or RSS.
+#
+# Copyright (c) 2007 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+#
+# $Id: Alert.pm,v 1.71 2010-01-06 16:50:27 louise Exp $
+
+package FixMyStreet::Alert::Error;
+
+use Error qw(:try);
+
+@FixMyStreet::Alert::Error::ISA = qw(Error::Simple);
+
+package FixMyStreet::Alert;
+
+use strict;
+use Error qw(:try);
+use File::Slurp;
+use FindBin;
+use POSIX qw(strftime);
+use XML::RSS;
+
+use Cobrand;
+use mySociety::AuthToken;
+use mySociety::Config;
+use mySociety::DBHandle qw(dbh);
+use mySociety::Email;
+use mySociety::EmailUtil;
+use mySociety::Gaze;
+use mySociety::GeoUtil;
+use mySociety::Locale;
+use mySociety::MaPit;
+use mySociety::Random qw(random_bytes);
+use mySociety::Sundries qw(ordinal);
+use mySociety::Web qw(ent);
+
+# Add a new alert
+sub create ($$$$;@) {
+ my ($email, $alert_type, $cobrand, $cobrand_data, @params) = @_;
+ my $already = 0;
+ if (0==@params) {
+ ($already) = dbh()->selectrow_array('select id from alert where alert_type=? and email=? limit 1',
+ {}, $alert_type, $email);
+ } elsif (1==@params) {
+ ($already) = dbh()->selectrow_array('select id from alert where alert_type=? and email=? and parameter=? limit 1',
+ {}, $alert_type, $email, @params);
+ } elsif (2==@params) {
+ ($already) = dbh()->selectrow_array('select id from alert where alert_type=? and email=? and parameter=? and parameter2=? limit 1',
+ {}, $alert_type, $email, @params);
+ }
+ return $already if $already;
+
+ my $id = dbh()->selectrow_array("select nextval('alert_id_seq');");
+ my $lang = $mySociety::Locale::lang;
+ if (0==@params) {
+ dbh()->do('insert into alert (id, alert_type, email, lang, cobrand, cobrand_data)
+ values (?, ?, ?, ?, ?, ?)', {}, $id, $alert_type, $email, $lang, $cobrand, $cobrand_data);
+ } elsif (1==@params) {
+ dbh()->do('insert into alert (id, alert_type, parameter, email, lang, cobrand, cobrand_data)
+ values (?, ?, ?, ?, ?, ?, ?)', {}, $id, $alert_type, @params, $email, $lang, $cobrand, $cobrand_data);
+ } elsif (2==@params) {
+ dbh()->do('insert into alert (id, alert_type, parameter, parameter2, email, lang, cobrand, cobrand_data)
+ values (?, ?, ?, ?, ?, ?, ?, ?)', {}, $id, $alert_type, @params, $email, $lang, $cobrand, $cobrand_data);
+ }
+ dbh()->commit();
+ return $id;
+}
+
+sub confirm ($) {
+ my $id = shift;
+ dbh()->do("update alert set confirmed=1, whendisabled=null where id=?", {}, $id);
+ dbh()->commit();
+}
+
+# Delete an alert
+sub delete ($) {
+ my $id = shift;
+ dbh()->do('update alert set whendisabled = ms_current_timestamp() where id = ?', {}, $id);
+ dbh()->commit();
+}
+
+# This makes load of assumptions, but still should be useful
+#
+# Child must have confirmed, id, email, state(!) columns
+# If parent/child, child table must also have name and text
+# and foreign key to parent must be PARENT_id
+
+sub email_alerts ($) {
+ my ($testing_email) = @_;
+ my $url;
+ my $q = dbh()->prepare("select * from alert_type where ref not like 'local_problems%'");
+ $q->execute();
+ my $testing_email_clause = '';
+ while (my $alert_type = $q->fetchrow_hashref) {
+ my $ref = $alert_type->{ref};
+ my $head_table = $alert_type->{head_table};
+ my $item_table = $alert_type->{item_table};
+ my $testing_email_clause = "and $item_table.email <> '$testing_email'" if $testing_email;
+ my $query = 'select alert.id as alert_id, alert.email as alert_email, alert.lang as alert_lang, alert.cobrand as alert_cobrand,
+ alert.cobrand_data as alert_cobrand_data, alert.parameter as alert_parameter, alert.parameter2 as alert_parameter2, ';
+ if ($head_table) {
+ $query .= "
+ $item_table.id as item_id, $item_table.name as item_name, $item_table.text as item_text,
+ $head_table.*
+ from alert
+ inner join $item_table on alert.parameter::integer = $item_table.${head_table}_id
+ inner join $head_table on alert.parameter::integer = $head_table.id";
+ } else {
+ $query .= " $item_table.*,
+ $item_table.id as item_id
+ from alert, $item_table";
+ }
+ $query .= "
+ where alert_type='$ref' and whendisabled is null and $item_table.confirmed >= whensubscribed
+ and $item_table.confirmed >= ms_current_timestamp() - '7 days'::interval
+ and (select whenqueued from alert_sent where alert_sent.alert_id = alert.id and alert_sent.parameter::integer = $item_table.id) is null
+ and $item_table.email <> alert.email
+ $testing_email_clause
+ and $alert_type->{item_where}
+ and alert.confirmed = 1
+ order by alert.id, $item_table.confirmed";
+ # XXX Ugh - needs work
+ $query =~ s/\?/alert.parameter/ if ($query =~ /\?/);
+ $query =~ s/\?/alert.parameter2/ if ($query =~ /\?/);
+ $query = dbh()->prepare($query);
+ $query->execute();
+ my $last_alert_id;
+ my %data = ( template => $alert_type->{template}, data => '' );
+ while (my $row = $query->fetchrow_hashref) {
+ # Cobranded and non-cobranded messages can share a database. In this case, the conf file
+ # should specify a vhost to send the reports for each cobrand, so that they don't get sent
+ # more than once if there are multiple vhosts running off the same database. The email_host
+ # call checks if this is the host that sends mail for this cobrand.
+ next unless (Cobrand::email_host($row->{alert_cobrand}));
+ dbh()->do('insert into alert_sent (alert_id, parameter) values (?,?)', {}, $row->{alert_id}, $row->{item_id});
+ if ($last_alert_id && $last_alert_id != $row->{alert_id}) {
+ _send_aggregated_alert_email(%data);
+ %data = ( template => $alert_type->{template}, data => '' );
+ }
+
+ $url = Cobrand::base_url_for_emails($row->{alert_cobrand}, $row->{alert_cobrand_data});
+ if ($row->{item_text}) {
+ $data{problem_url} = $url . "/report/" . $row->{id};
+ $data{data} .= $row->{item_name} . ' : ' if $row->{item_name};
+ $data{data} .= $row->{item_text} . "\n\n------\n\n";
+ } else {
+ $data{data} .= $url . "/report/" . $row->{id} . " - $row->{title}\n\n";
+ }
+ if (!$data{alert_email}) {
+ %data = (%data, %$row);
+ if ($ref eq 'area_problems' || $ref eq 'council_problems' || $ref eq 'ward_problems') {
+ my $va_info = mySociety::MaPit::get_voting_area_info($row->{alert_parameter});
+ $data{area_name} = $va_info->{name};
+ }
+ if ($ref eq 'ward_problems') {
+ my $va_info = mySociety::MaPit::get_voting_area_info($row->{alert_parameter2});
+ $data{ward_name} = $va_info->{name};
+ }
+ }
+ $data{cobrand} = $row->{alert_cobrand};
+ $data{cobrand_data} = $row->{alert_cobrand_data};
+ $data{lang} = $row->{alert_lang};
+ $last_alert_id = $row->{alert_id};
+ }
+ if ($last_alert_id) {
+ _send_aggregated_alert_email(%data);
+ }
+ }
+
+ # Nearby done separately as the table contains the parameters
+ my $template = dbh()->selectrow_array("select template from alert_type where ref = 'local_problems'");
+ my $query = "select * from alert where alert_type='local_problems' and whendisabled is null and confirmed=1 order by id";
+ $query = dbh()->prepare($query);
+ $query->execute();
+ while (my $alert = $query->fetchrow_hashref) {
+ next unless (Cobrand::email_host($alert->{cobrand}));
+ my $e = $alert->{parameter};
+ my $n = $alert->{parameter2};
+ $url = Cobrand::base_url_for_emails($alert->{cobrand}, $alert->{cobrand_data});
+ my ($site_restriction, $site_id) = Cobrand::site_restriction($alert->{cobrand}, $alert->{cobrand_data});
+ my ($lat, $lon) = mySociety::GeoUtil::national_grid_to_wgs84($e, $n, 'G');
+ my $d = mySociety::Gaze::get_radius_containing_population($lat, $lon, 200000);
+ $d = int($d*10+0.5)/10;
+ my $testing_email_clause = "and problem.email <> '$testing_email'" if $testing_email;
+ my %data = ( template => $template, data => '', alert_id => $alert->{id}, alert_email => $alert->{email}, lang => $alert->{lang}, cobrand => $alert->{cobrand}, cobrand_data => $alert->{cobrand_data} );
+ my $q = "select * from problem_find_nearby(?, ?, ?) as nearby, problem
+ where nearby.problem_id = problem.id and problem.state in ('confirmed', 'fixed')
+ and problem.confirmed >= ? and problem.confirmed >= ms_current_timestamp() - '7 days'::interval
+ and (select whenqueued from alert_sent where alert_sent.alert_id = ? and alert_sent.parameter::integer = problem.id) is null
+ and problem.email <> ?
+ $testing_email_clause
+ $site_restriction
+ order by confirmed desc";
+ $q = dbh()->prepare($q);
+ $q->execute($e, $n, $d, $alert->{whensubscribed}, $alert->{id}, $alert->{email});
+ while (my $row = $q->fetchrow_hashref) {
+ dbh()->do('insert into alert_sent (alert_id, parameter) values (?,?)', {}, $alert->{id}, $row->{id});
+ $data{data} .= $url . "/report/" . $row->{id} . " - $row->{title}\n\n";
+ }
+ _send_aggregated_alert_email(%data) if $data{data};
+ }
+}
+
+sub _send_aggregated_alert_email(%) {
+ my %data = @_;
+ Cobrand::set_lang_and_domain($data{cobrand}, $data{lang}, 1);
+
+ $data{unsubscribe_url} = Cobrand::base_url_for_emails($data{cobrand}, $data{cobrand_data}) . '/A/'
+ . mySociety::AuthToken::store('alert', { id => $data{alert_id}, type => 'unsubscribe', email => $data{alert_email} } );
+ my $template = "$FindBin::Bin/../templates/emails/$data{template}";
+ if ($data{cobrand}) {
+ my $template_cobrand = "$FindBin::Bin/../templates/emails/$data{cobrand}/$data{template}";
+ $template = $template_cobrand if -e $template_cobrand;
+ }
+ $template = File::Slurp::read_file($template);
+ my $sender = Cobrand::contact_email($data{cobrand});
+ my $sender_name = Cobrand::contact_name($data{cobrand});
+ (my $from = $sender) =~ s/team/fms-DO-NOT-REPLY/; # XXX
+ my $email = mySociety::Email::construct_email({
+ _template_ => _($template),
+ _parameters_ => \%data,
+ From => [ $from, _($sender_name) ],
+ To => $data{alert_email},
+ 'Message-ID' => sprintf('<alert-%s-%s@mysociety.org>', time(), unpack('h*', random_bytes(5, 1))),
+ });
+
+ my $result = mySociety::EmailUtil::send_email($email, $sender, $data{alert_email});
+ if ($result == mySociety::EmailUtil::EMAIL_SUCCESS) {
+ dbh()->commit();
+ } else {
+ dbh()->rollback();
+ throw FixMyStreet::Alert::Error("Failed to send alert $data{alert_id}!");
+ }
+}
+
+sub generate_rss ($$$;$$$$) {
+ my ($type, $xsl, $qs, $db_params, $title_params, $cobrand, $http_q) = @_;
+ $db_params ||= [];
+ my $url = Cobrand::base_url($cobrand);
+ my $cobrand_data = Cobrand::extra_data($cobrand, $http_q);
+ my $q = dbh()->prepare('select * from alert_type where ref=?');
+ $q->execute($type);
+ my $alert_type = $q->fetchrow_hashref;
+ my ($site_restriction, $site_id) = Cobrand::site_restriction($cobrand, $cobrand_data);
+ throw FixMyStreet::Alert::Error('Unknown alert type') unless $alert_type;
+
+ # Do our own encoding
+
+ my $rss = new XML::RSS( version => '2.0', encoding => 'UTF-8',
+ stylesheet=> $xsl, encode_output => undef );
+ $rss->add_module(prefix=>'georss', uri=>'http://www.georss.org/georss');
+
+ # XXX: Not generic
+ # Only apply a site restriction if the alert uses the problem table
+ $site_restriction = '' unless $alert_type->{item_table} eq 'problem';
+ my $query = 'select * from ' . $alert_type->{item_table} . ' where '
+ . ($alert_type->{head_table} ? $alert_type->{head_table}.'_id=? and ' : '')
+ . $alert_type->{item_where} . $site_restriction . ' order by '
+ . $alert_type->{item_order};
+ $query .= ' limit 20' unless $type =~ /^all/;
+ $q = dbh()->prepare($query);
+ if ($query =~ /\?/) {
+ throw FixMyStreet::Alert::Error('Missing parameter') unless @$db_params;
+ $q->execute(@$db_params);
+ } else {
+ $q->execute();
+ }
+
+ my @months = ('', 'January','February','March','April','May','June',
+ 'July','August','September','October','November','December');
+ while (my $row = $q->fetchrow_hashref) {
+ # XXX: How to do this properly? name might be null in comment table, hence needing this
+ my $pubDate;
+ $row->{name} ||= 'anonymous';
+ # And we want pretty dates... :-/
+ if ($row->{confirmed}) {
+ $row->{confirmed} =~ /^(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)/;
+ $pubDate = mySociety::Locale::in_gb_locale {
+ strftime("%a, %d %b %Y %H:%M:%S %z", $6, $5, $4, $3, $2-1, $1-1900, -1, -1, 0)
+ };
+ $row->{confirmed} = ordinal($3+0) . ' ' . $months[$2];
+ }
+
+ (my $title = _($alert_type->{item_title})) =~ s/{{(.*?)}}/$row->{$1}/g;
+ (my $link = $alert_type->{item_link}) =~ s/{{(.*?)}}/$row->{$1}/g;
+ (my $desc = _($alert_type->{item_description})) =~ s/{{(.*?)}}/$row->{$1}/g;
+ my $cobrand_url = Cobrand::url($cobrand, $url . $link, $http_q);
+ my %item = (
+ title => ent($title),
+ link => $cobrand_url,
+ guid => $cobrand_url,
+ description => ent(ent($desc)) # Yes, double-encoded, really.
+ );
+ $item{pubDate} = $pubDate if $pubDate;
+
+ # XXX: Not-very-generic extensions, at all
+ my $display_photos = Cobrand::allow_photo_display($cobrand);
+ if ($display_photos && $row->{photo}) {
+ $item{description} .= ent("\n<br><img src=\"". Cobrand::url($cobrand, $url, $http_q) . "/photo?id=$row->{id}\">");
+ }
+ $item{description} .= ent("\n<br><a href='$cobrand_url'>Report on FixMyStreet</a>");
+
+ if ($row->{easting} && $row->{northing}) {
+ my ($lat,$lon) = mySociety::GeoUtil::national_grid_to_wgs84($row->{easting}, $row->{northing}, 'G');
+ $item{georss} = { point => "$lat $lon" };
+ }
+ $rss->add_item( %item );
+ }
+
+ my $row = {};
+ if ($alert_type->{head_sql_query}) {
+ $q = dbh()->prepare($alert_type->{head_sql_query});
+ if ($alert_type->{head_sql_query} =~ /\?/) {
+ $q->execute(@$db_params);
+ } else {
+ $q->execute();
+ }
+ $row = $q->fetchrow_hashref;
+ }
+ foreach (keys %$title_params) {
+ $row->{$_} = $title_params->{$_};
+ }
+ (my $title = _($alert_type->{head_title})) =~ s/{{(.*?)}}/$row->{$1}/g;
+ (my $link = $alert_type->{head_link}) =~ s/{{(.*?)}}/$row->{$1}/g;
+ (my $desc = _($alert_type->{head_description})) =~ s/{{(.*?)}}/$row->{$1}/g;
+ $rss->channel(
+ title => ent($title), link => "$url$link$qs", description => ent($desc),
+ language => 'en-gb'
+ );
+
+ my $out = $rss->as_string;
+ my $uri = Cobrand::url($cobrand, $ENV{SCRIPT_URI}, $http_q);
+ $out =~ s{<link>(.*?)</link>}{"<link>" . Cobrand::url($cobrand, $1, $http_q) . "</link><uri>$uri</uri>"}e;
+
+ return $out;
+}
diff --git a/perllib/FixMyStreet/Geocode.pm b/perllib/FixMyStreet/Geocode.pm
new file mode 100644
index 000000000..9e89b4f7b
--- /dev/null
+++ b/perllib/FixMyStreet/Geocode.pm
@@ -0,0 +1,156 @@
+#!/usr/bin/perl
+#
+# FixMyStreet::Geocode
+# The geocoding functions for FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Geocode;
+
+use strict;
+use Error qw(:try);
+use File::Slurp;
+use LWP::Simple;
+use Digest::MD5 qw(md5_hex);
+use URI::Escape;
+
+use Cobrand;
+use Page;
+use mySociety::Config;
+use mySociety::GeoUtil;
+use mySociety::MaPit;
+use mySociety::PostcodeUtil;
+use mySociety::Web qw(NewURL);
+
+BEGIN {
+ (my $dir = __FILE__) =~ s{/[^/]*?$}{};
+ mySociety::Config::set_file("$dir/../../conf/general");
+}
+
+# lookup STRING QUERY
+# Given a user-inputted string, try and convert it into co-ordinates using either
+# MaPit if it's a postcode, or Google Maps API otherwise. Returns an array of
+# data, including an error if there is one (which includes a location being in
+# Northern Ireland). The information in the query may be used by cobranded versions
+# of the site to diambiguate locations.
+sub lookup {
+ my ($s, $q) = @_;
+ my ($easting, $northing, $error);
+ if ($s =~ /^\d+$/) {
+ $error = 'FixMyStreet is a UK-based website that currently works in England, Scotland, and Wales. Please enter either a postcode, or a Great British street name and area.';
+ } elsif (mySociety::PostcodeUtil::is_valid_postcode($s)) {
+ my $location = mySociety::MaPit::call('postcode', $s);
+ unless ($error = Page::mapit_check_error($location)) {
+ $easting = $location->{easting};
+ $northing = $location->{northing};
+ }
+ } else {
+ ($easting, $northing, $error) = FixMyStreet::Geocode::string($s, $q);
+ }
+ return ($easting, $northing, $error);
+}
+
+sub geocoded_string_coordinates {
+ my ($js, $q) = @_;
+ my ($easting, $northing, $error);
+ my ($accuracy) = $js =~ /"Accuracy" *: *(\d)/;
+ if ($accuracy < 4) {
+ $error = _('Sorry, that location appears to be too general; please be more specific.');
+ } else {
+
+ $js =~ /"coordinates" *: *\[ *(.*?), *(.*?),/;
+ my $lon = $1; my $lat = $2;
+ try {
+ ($easting, $northing) = mySociety::GeoUtil::wgs84_to_national_grid($lat, $lon, 'G');
+ } catch Error::Simple with {
+ $error = shift;
+ $error = _('That location does not appear to be in Britain; please try again.')
+ if $error =~ /out of the area covered/;
+ }
+ }
+ return ($easting, $northing, $error);
+}
+
+# string STRING QUERY
+# Canonicalises, looks up on Google Maps API, and caches, a user-inputted location.
+# Returns array of (TILE_X, TILE_Y, EASTING, NORTHING, ERROR), where ERROR is
+# either undef, a string, or an array of matches if there are more than one. The
+# information in the query may be used to disambiguate the location in cobranded versions
+# of the site.
+sub string {
+ my ($s, $q) = @_;
+ $s = lc($s);
+ $s =~ s/[^-&0-9a-z ']/ /g;
+ $s =~ s/\s+/ /g;
+ $s = URI::Escape::uri_escape_utf8($s);
+ $s = Cobrand::disambiguate_location(Page::get_cobrand($q), "q=$s", $q);
+ $s =~ s/%20/+/g;
+ my $url = 'http://maps.google.com/maps/geo?' . $s;
+ my $cache_dir = mySociety::Config::get('GEO_CACHE');
+ my $cache_file = $cache_dir . md5_hex($url);
+ my ($js, $error, $easting, $northing);
+ if (-s $cache_file) {
+ $js = File::Slurp::read_file($cache_file);
+ } else {
+ $url .= ',+UK' unless $url =~ /united\++kingdom$/ || $url =~ /uk$/i;
+ $url .= '&sensor=false&gl=uk&key=' . mySociety::Config::get('GOOGLE_MAPS_API_KEY');
+ $js = LWP::Simple::get($url);
+ File::Slurp::write_file($cache_file, $js) if $js && $js !~ /"code":6[12]0/;
+ }
+ if (!$js) {
+ $error = _('Sorry, we could not parse that location. Please try again.');
+ } elsif ($js !~ /"code" *: *200/) {
+ $error = _('Sorry, we could not find that location.');
+ } elsif ($js =~ /}, *{/) { # Multiple
+ my @js = split /}, *{/, $js;
+ my @valid_locations;
+ foreach (@js) {
+ next unless /"address" *: *"(.*?)"/s;
+ my $address = $1;
+ next unless Cobrand::geocoded_string_check(Page::get_cobrand($q), $address, $q);
+ next if $address =~ /BT\d/;
+ push (@valid_locations, $_);
+ push (@$error, $address);
+ }
+ if (scalar @valid_locations == 1) {
+ return geocoded_string_coordinates($valid_locations[0], $q);
+ }
+ $error = _('Sorry, we could not find that location.') unless $error;
+ } elsif ($js =~ /BT\d/) {
+ # Northern Ireland, hopefully
+ $error = _("We do not cover Northern Ireland, I'm afraid, as our licence doesn't include any maps for the region.");
+ } else {
+ ($easting, $northing, $error) = geocoded_string_coordinates($js, $q);
+ }
+ return ($easting, $northing, $error);
+}
+
+# list_choices
+# Prints response if there's more than one possible result
+sub list_choices {
+ my ($choices, $page, $q) = @_;
+ my $url;
+ my $cobrand = Page::get_cobrand($q);
+ my $message = _('We found more than one match for that location. We show up to ten matches, please try a different search if yours is not here.');
+ my $out = '<p>' . $message . '</p>';
+ my $choice_list = '<ul>';
+ foreach my $choice (@$choices) {
+ $choice =~ s/, United Kingdom//;
+ $choice =~ s/, UK//;
+ $url = Cobrand::url($cobrand, NewURL($q, -retain => 1, -url => $page, 'pc' => $choice), $q);
+ $url =~ s/%20/+/g;
+ $choice_list .= '<li><a href="' . $url . '">' . $choice . "</a></li>\n";
+ }
+ $choice_list .= '</ul>';
+ $out .= $choice_list;
+ my %vars = (message => $message,
+ choice_list => $choice_list,
+ header => _('More than one match'),
+ url_home => Cobrand::url($cobrand, '/', $q));
+ my $cobrand_choice = Page::template_include('geocode-choice', $q, Page::template_root($q), %vars);
+ return $cobrand_choice if $cobrand_choice;
+ return $out;
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map.pm b/perllib/FixMyStreet/Map.pm
new file mode 100644
index 000000000..12ecf78fe
--- /dev/null
+++ b/perllib/FixMyStreet/Map.pm
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map
+# Adding the ability to have different maps on FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+
+use Problems;
+use Cobrand;
+use mySociety::Config;
+use mySociety::Gaze;
+use mySociety::GeoUtil;
+use mySociety::Locale;
+use mySociety::Web qw(ent NewURL);
+
+# Run on module boot up
+load();
+
+# This is yucky, but no-one's taught me a better way
+sub load {
+ my $type = mySociety::Config::get('MAP_TYPE');
+ my $class = "FixMyStreet::Map::$type";
+ eval "use $class";
+}
+
+sub header {
+ my ($q, $type) = @_;
+ return '' unless $type;
+
+ my $cobrand = Page::get_cobrand($q);
+ my $cobrand_form_elements = Cobrand::form_elements($cobrand, 'mapForm', $q);
+ my $form_action = Cobrand::url($cobrand, '', $q);
+ my $encoding = '';
+ $encoding = ' enctype="multipart/form-data"' if $type==2;
+ my $pc = $q->param('pc') || '';
+ my $pc_enc = ent($pc);
+ return <<EOF;
+<form action="$form_action" method="post" name="mapForm" id="mapForm"$encoding>
+<input type="hidden" name="submit_map" value="1">
+<input type="hidden" name="pc" value="$pc_enc">
+$cobrand_form_elements
+EOF
+}
+
+sub map_features {
+ my ($q, $easting, $northing, $interval) = @_;
+
+ my $min_e = $easting - 500;
+ my $min_n = $northing - 500;
+ my $mid_e = $easting;
+ my $mid_n = $northing;
+ my $max_e = $easting + 500;
+ my $max_n = $northing + 500;
+
+ # list of problems aoround map can be limited, but should show all pins
+ my ($around_map, $around_map_list);
+ if (my $around_limit = Cobrand::on_map_list_limit(Page::get_cobrand($q))) {
+ $around_map_list = Problems::around_map($min_e, $max_e, $min_n, $max_n, $interval, $around_limit);
+ $around_map = Problems::around_map($min_e, $max_e, $min_n, $max_n, $interval, undef);
+ } else {
+ $around_map = $around_map_list = Problems::around_map($min_e, $max_e, $min_n, $max_n, $interval, undef);
+ }
+
+ my $dist;
+ mySociety::Locale::in_gb_locale {
+ my ($lat, $lon) = mySociety::GeoUtil::national_grid_to_wgs84($mid_e, $mid_n, 'G');
+ $dist = mySociety::Gaze::get_radius_containing_population($lat, $lon, 200000);
+ };
+ $dist = int($dist*10+0.5)/10;
+
+ my $limit = 20;
+ my @ids = map { $_->{id} } @$around_map_list;
+ my $nearby = Problems::nearby($dist, join(',', @ids), $limit, $mid_e, $mid_n, $interval);
+
+ return ($around_map, $around_map_list, $nearby, $dist);
+}
+
+sub compass ($$$) {
+ my ($q, $x, $y) = @_;
+ my @compass;
+ for (my $i=$x-1; $i<=$x+1; $i++) {
+ for (my $j=$y-1; $j<=$y+1; $j++) {
+ $compass[$i][$j] = NewURL($q, x=>$i, y=>$j);
+ }
+ }
+ my $recentre = NewURL($q);
+ my $host = Page::base_url_with_lang($q, undef);
+ return <<EOF;
+<table cellpadding="0" cellspacing="0" border="0" id="compass">
+<tr valign="bottom">
+<td align="right"><a rel="nofollow" href="${compass[$x-1][$y+1]}"><img src="$host/i/arrow-northwest.gif" alt="NW" width=11 height=11></a></td>
+<td align="center"><a rel="nofollow" href="${compass[$x][$y+1]}"><img src="$host/i/arrow-north.gif" vspace="3" alt="N" width=13 height=11></a></td>
+<td><a rel="nofollow" href="${compass[$x+1][$y+1]}"><img src="$host/i/arrow-northeast.gif" alt="NE" width=11 height=11></a></td>
+</tr>
+<tr>
+<td><a rel="nofollow" href="${compass[$x-1][$y]}"><img src="$host/i/arrow-west.gif" hspace="3" alt="W" width=11 height=13></a></td>
+<td align="center"><a rel="nofollow" href="$recentre"><img src="$host/i/rose.gif" alt="Recentre" width=35 height=34></a></td>
+<td><a rel="nofollow" href="${compass[$x+1][$y]}"><img src="$host/i/arrow-east.gif" hspace="3" alt="E" width=11 height=13></a></td>
+</tr>
+<tr valign="top">
+<td align="right"><a rel="nofollow" href="${compass[$x-1][$y-1]}"><img src="$host/i/arrow-southwest.gif" alt="SW" width=11 height=11></a></td>
+<td align="center"><a rel="nofollow" href="${compass[$x][$y-1]}"><img src="$host/i/arrow-south.gif" vspace="3" alt="S" width=13 height=11></a></td>
+<td><a rel="nofollow" href="${compass[$x+1][$y-1]}"><img src="$host/i/arrow-southeast.gif" alt="SE" width=11 height=11></a></td>
+</tr>
+</table>
+EOF
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/Bing.pm b/perllib/FixMyStreet/Map/Bing.pm
new file mode 100644
index 000000000..8446a10fd
--- /dev/null
+++ b/perllib/FixMyStreet/Map/Bing.pm
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map::Bing
+# Bing maps on FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+use mySociety::GeoUtil;
+use mySociety::Web qw(ent);
+
+sub header_js {
+ return '
+<script type="text/javascript" src="http://ecn.dev.virtualearth.net/mapcontrol/mapcontrol.ashx?v=7.0&mkt=en-GB"></script>
+<script type="text/javascript" src="/js/map-bing.js"></script>
+';
+}
+
+# display_map Q PARAMS
+# PARAMS include:
+# EASTING, NORTHING for the centre point of the map
+# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload,
+# 0 if not clickable
+# PINS is array of pins to show, location and colour
+# PRE/POST are HTML to show above/below map
+sub display_map {
+ my ($q, %params) = @_;
+ $params{pre} ||= '';
+ $params{post} ||= '';
+
+ foreach my $pin (@{$params{pins}}) {
+ }
+
+ my $out = FixMyStreet::Map::header($q, $params{type});
+ my ($lat, $lon) = mySociety::GeoUtil::national_grid_to_wgs84($params{easting}, $params{northing}, 'G');
+ my $copyright = _('Map contains Ordnance Survey data &copy; Crown copyright and database right 2010.');
+ $out .= <<EOF;
+<script type="text/javascript">
+var fixmystreet = {
+ 'lat': $lat,
+ 'lon': $lon
+}
+</script>
+<div id="map_box">
+ $params{pre}
+ <div id="map"></div>
+ <p id="copyright">$copyright</p>
+ $params{post}
+</div>
+<div id="side">
+EOF
+ return $out;
+}
+
+sub display_map_end {
+ my ($type) = @_;
+ my $out = '</div>';
+ $out .= '</form>' if ($type);
+ return $out;
+}
+
+sub display_pin {
+}
+
+sub map_pins {
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/BingOL.pm b/perllib/FixMyStreet/Map/BingOL.pm
new file mode 100644
index 000000000..3939a710f
--- /dev/null
+++ b/perllib/FixMyStreet/Map/BingOL.pm
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map::Bing
+# Bing maps on FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+use mySociety::Web qw(ent);
+
+sub header_js {
+ return '
+<!-- <script type="text/javascript" src="http://ecn.dev.virtualearth.net/mapcontrol/mapcontrol.ashx?v=7.0&mkt=en-GB"></script> -->
+<script type="text/javascript" src="http://openlayers.org/api/OpenLayers.js"></script>
+<script type="text/javascript" src="/js/map-bing-ol.js"></script>
+<script type="text/javascript" src="/js/OpenLayers.Projection.OrdnanceSurvey.js"></script>
+';
+}
+
+# display_map Q PARAMS
+# PARAMS include:
+# EASTING, NORTHING for the centre point of the map
+# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload,
+# 0 if not clickable
+# PINS is array of pins to show, location and colour
+# PRE/POST are HTML to show above/below map
+sub display_map {
+ my ($q, %params) = @_;
+ $params{pre} ||= '';
+ $params{post} ||= '';
+
+ foreach my $pin (@{$params{pins}}) {
+ }
+
+ my $out = FixMyStreet::Map::header($q, $params{type});
+ my $copyright = _('Map contains Ordnance Survey data &copy; Crown copyright and database right 2010. Microsoft');
+ $out .= <<EOF;
+<script type="text/javascript">
+var fixmystreet = {
+ 'easting': $params{easting},
+ 'northing': $params{northing}
+}
+</script>
+<div id="map_box">
+ $params{pre}
+ <div id="map"></div>
+ <p id="copyright">$copyright</p>
+ $params{post}
+</div>
+<div id="side">
+EOF
+ return $out;
+}
+
+sub display_map_end {
+ my ($type) = @_;
+ my $out = '</div>';
+ $out .= '</form>' if ($type);
+ return $out;
+}
+
+sub display_pin {
+}
+
+sub map_pins {
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/Google.pm b/perllib/FixMyStreet/Map/Google.pm
new file mode 100644
index 000000000..7a314efad
--- /dev/null
+++ b/perllib/FixMyStreet/Map/Google.pm
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map::Google
+# Google maps on FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+use mySociety::GeoUtil;
+use mySociety::Web qw(ent);
+
+sub header_js {
+ return '
+<script type="text/javascript" src="http://maps.google.com/maps/api/js?sensor=false"></script>
+<script type="text/javascript" src="/js/map-google.js"></script>
+';
+}
+
+# display_map Q PARAMS
+# PARAMS include:
+# EASTING, NORTHING for the centre point of the map
+# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload,
+# 0 if not clickable
+# PINS is array of pins to show, location and colour
+# PRE/POST are HTML to show above/below map
+sub display_map {
+ my ($q, %params) = @_;
+ $params{pre} ||= '';
+ $params{post} ||= '';
+
+ foreach my $pin (@{$params{pins}}) {
+ }
+
+ my $out = FixMyStreet::Map::header($q, $params{type});
+ my ($lat, $lon) = mySociety::GeoUtil::national_grid_to_wgs84($params{easting}, $params{northing}, 'G');
+ my $copyright = _('Map contains Ordnance Survey data &copy; Crown copyright and database right 2010.');
+ $out .= <<EOF;
+<script type="text/javascript">
+var fixmystreet = {
+ 'lat': $lat,
+ 'lon': $lon
+}
+</script>
+<div id="map_box">
+ $params{pre}
+ <div id="map"></div>
+ <p id="copyright">$copyright</p>
+ $params{post}
+</div>
+<div id="side">
+EOF
+ return $out;
+}
+
+sub display_map_end {
+ my ($type) = @_;
+ my $out = '</div>';
+ $out .= '</form>' if ($type);
+ return $out;
+}
+
+sub display_pin {
+}
+
+sub map_pins {
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/OSM.pm b/perllib/FixMyStreet/Map/OSM.pm
new file mode 100644
index 000000000..ccbb3ca53
--- /dev/null
+++ b/perllib/FixMyStreet/Map/OSM.pm
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map::OSM
+# OSM maps on FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+use mySociety::Web qw(ent);
+
+sub header_js {
+ return '
+<script type="text/javascript" src="http://openlayers.org/api/OpenLayers.js"></script>
+<script type="text/javascript" src="/js/map-OpenStreetMap.js"></script>
+<script type="text/javascript" src="/js/OpenLayers.Projection.OrdnanceSurvey.js"></script>
+';
+}
+
+# display_map Q PARAMS
+# PARAMS include:
+# EASTING, NORTHING for the centre point of the map
+# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload,
+# 0 if not clickable
+# PINS is array of pins to show, location and colour
+# PRE/POST are HTML to show above/below map
+sub display_map {
+ my ($q, %params) = @_;
+ $params{pre} ||= '';
+ $params{post} ||= '';
+
+ foreach my $pin (@{$params{pins}}) {
+ }
+
+ my $out = FixMyStreet::Map::header($q, $params{type});
+ my $copyright = _('Map &copy; <a href="http://www.openstreetmap.org/">OpenStreetMap</a> and contributors, <a href="http://creativecommons.org/licenses/by-sa/2.0/">CC-BY-SA</a>');
+ $out .= <<EOF;
+<script type="text/javascript">
+var fixmystreet = {
+ 'easting': $params{easting},
+ 'northing': $params{northing},
+ 'map_type': OpenLayers.Layer.OSM.Mapnik
+}
+</script>
+<div id="map_box">
+ $params{pre}
+ <div id="map"></div>
+ <p id="copyright">$copyright</p>
+ $params{post}
+</div>
+<div id="side">
+EOF
+ return $out;
+}
+
+sub display_map_end {
+ my ($type) = @_;
+ my $out = '</div>';
+ $out .= '</form>' if ($type);
+ return $out;
+}
+
+sub display_pin {
+}
+
+sub map_pins {
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/OSM/CycleMap.pm b/perllib/FixMyStreet/Map/OSM/CycleMap.pm
new file mode 100644
index 000000000..01c51acf4
--- /dev/null
+++ b/perllib/FixMyStreet/Map/OSM/CycleMap.pm
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map::OSM::CycleMap
+# OSM CycleMap maps on FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+use mySociety::Web qw(ent);
+
+sub header_js {
+ return '
+<script type="text/javascript" src="http://openlayers.org/api/OpenLayers.js"></script>
+<script type="text/javascript" src="/js/map-OpenStreetMap.js"></script>
+<script type="text/javascript" src="/js/OpenLayers.Projection.OrdnanceSurvey.js"></script>
+';
+}
+
+# display_map Q PARAMS
+# PARAMS include:
+# EASTING, NORTHING for the centre point of the map
+# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload,
+# 0 if not clickable
+# PINS is array of pins to show, location and colour
+# PRE/POST are HTML to show above/below map
+sub display_map {
+ my ($q, %params) = @_;
+ $params{pre} ||= '';
+ $params{post} ||= '';
+
+ foreach my $pin (@{$params{pins}}) {
+ }
+
+ my $out = FixMyStreet::Map::header($q, $params{type});
+ my $copyright = _('Map &copy; <a href="http://www.openstreetmap.org/">OpenStreetMap</a> and contributors, <a href="http://creativecommons.org/licenses/by-sa/2.0/">CC-BY-SA</a>');
+ $out .= <<EOF;
+<script type="text/javascript">
+var fixmystreet = {
+ 'easting': $params{easting},
+ 'northing': $params{northing},
+ 'map_type': OpenLayers.Layer.OSM.CycleMap
+}
+</script>
+<div id="map_box">
+ $params{pre}
+ <div id="map"></div>
+ <p id="copyright">$copyright</p>
+ $params{post}
+</div>
+<div id="side">
+EOF
+ return $out;
+}
+
+sub display_map_end {
+ my ($type) = @_;
+ my $out = '</div>';
+ $out .= '</form>' if ($type);
+ return $out;
+}
+
+sub display_pin {
+}
+
+sub map_pins {
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/OSM/StreetView.pm b/perllib/FixMyStreet/Map/OSM/StreetView.pm
new file mode 100644
index 000000000..08f677d25
--- /dev/null
+++ b/perllib/FixMyStreet/Map/OSM/StreetView.pm
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map::OSM::StreetView
+# OSM StreetView maps on FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+use mySociety::Web qw(ent);
+
+sub header_js {
+ return '
+<script type="text/javascript" src="http://openlayers.org/api/OpenLayers.js"></script>
+<script type="text/javascript" src="/js/map-streetview.js"></script>
+<script type="text/javascript" src="/js/OpenLayers.Projection.OrdnanceSurvey.js"></script>
+';
+}
+
+# display_map Q PARAMS
+# PARAMS include:
+# EASTING, NORTHING for the centre point of the map
+# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload,
+# 0 if not clickable
+# PINS is array of pins to show, location and colour
+# PRE/POST are HTML to show above/below map
+sub display_map {
+ my ($q, %params) = @_;
+ $params{pre} ||= '';
+ $params{post} ||= '';
+
+ foreach my $pin (@{$params{pins}}) {
+ }
+
+ my $out = FixMyStreet::Map::header($q, $params{type});
+ my $copyright = _('Map contains Ordnance Survey data &copy; Crown copyright and database right 2010.');
+ $out .= <<EOF;
+<script type="text/javascript">
+var fixmystreet = {
+ 'easting': $params{easting},
+ 'northing': $params{northing}
+}
+</script>
+<div id="map_box">
+ $params{pre}
+ <div id="map"></div>
+ <p id="copyright">$copyright</p>
+ $params{post}
+</div>
+<div id="side">
+EOF
+ return $out;
+}
+
+sub display_map_end {
+ my ($type) = @_;
+ my $out = '</div>';
+ $out .= '</form>' if ($type);
+ return $out;
+}
+
+sub display_pin {
+}
+
+sub map_pins {
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/Tilma/OL/1_10k.pm b/perllib/FixMyStreet/Map/Tilma/OL/1_10k.pm
new file mode 100644
index 000000000..b1fe0126d
--- /dev/null
+++ b/perllib/FixMyStreet/Map/Tilma/OL/1_10k.pm
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map::Tilma::1_10k_OL
+# Using tilma.mysociety.org with OpenLayers
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+
+use constant TILE_WIDTH => 254;
+use constant TIF_SIZE_M => 5000;
+use constant TIF_SIZE_PX => 7874;
+use constant SCALE_FACTOR => TIF_SIZE_M / (TIF_SIZE_PX / TILE_WIDTH);
+use constant TILE_TYPE => '10k-full';
+
+sub header_js {
+ return '
+<script type="text/javascript" src="http://openlayers.org/api/OpenLayers.js"></script>
+<script type="text/javascript" src="/js/map-tilma-ol.js"></script>
+';
+}
+
+# display_map Q PARAMS
+# PARAMS include:
+# EASTING, NORTHING for the centre point of the map
+# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload,
+# 0 if not clickable
+# PINS is array of pins to show, location and colour
+# PRE/POST are HTML to show above/below map
+sub display_map {
+ my ($q, %params) = @_;
+ $params{pre} ||= '';
+ $params{post} ||= '';
+
+ foreach my $pin (@{$params{pins}}) {
+ }
+
+ my $out = FixMyStreet::Map::header($q, $params{type});
+ my $tile_width = TILE_WIDTH;
+ my $tile_type = TILE_TYPE;
+ my $sf = SCALE_FACTOR / TILE_WIDTH;
+ my $copyright = _('&copy; Crown copyright. All rights reserved. Ministry of Justice 100037819&nbsp;2008.');
+ $out .= <<EOF;
+<script type="text/javascript">
+var fixmystreet = {
+ 'tilewidth': $tile_width,
+ 'tileheight': $tile_width,
+ 'easting': $params{easting},
+ 'northing': $params{northing},
+ 'tile_type': '$tile_type',
+ 'maxResolution': $sf
+};
+</script>
+<div id="map_box">
+ $params{pre}
+ <div id="map">
+ <div id="watermark"></div>
+ </div>
+ <p id="copyright">$copyright</p>
+$params{post}
+</div>
+<div id="side">
+EOF
+ return $out;
+}
+
+sub display_map_end {
+ my ($type) = @_;
+ my $out = '</div>';
+ $out .= '</form>' if ($type);
+ return $out;
+}
+
+sub display_pin {
+}
+
+sub map_pins {
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/Tilma/OL/StreetView.pm b/perllib/FixMyStreet/Map/Tilma/OL/StreetView.pm
new file mode 100644
index 000000000..7ef372351
--- /dev/null
+++ b/perllib/FixMyStreet/Map/Tilma/OL/StreetView.pm
@@ -0,0 +1,81 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map::TilmaXY
+# Using tilma.mysociety.org but accessing images directly.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+
+use constant TILE_WIDTH => 250;
+use constant TIF_SIZE_M => 5000;
+use constant TIF_SIZE_PX => 5000;
+use constant SCALE_FACTOR => TIF_SIZE_M / (TIF_SIZE_PX / TILE_WIDTH);
+use constant TILE_TYPE => 'streetview';
+
+sub header_js {
+ return '
+<script type="text/javascript" src="http://openlayers.org/api/OpenLayers.js"></script>
+<script type="text/javascript" src="/js/map-tilma-ol.js"></script>
+';
+}
+
+# display_map Q PARAMS
+# PARAMS include:
+# EASTING, NORTHING for the centre point of the map
+# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload,
+# 0 if not clickable
+# PINS is array of pins to show, location and colour
+# PRE/POST are HTML to show above/below map
+sub display_map {
+ my ($q, %params) = @_;
+ $params{pre} ||= '';
+ $params{post} ||= '';
+
+ foreach my $pin (@{$params{pins}}) {
+ }
+
+ my $out = FixMyStreet::Map::header($q, $params{type});
+ my $tile_width = TILE_WIDTH;
+ my $tile_type = TILE_TYPE;
+ my $sf = SCALE_FACTOR / TILE_WIDTH;
+ my $copyright = _('Map contains Ordnance Survey data &copy; Crown copyright and database right 2010.');
+ $out .= <<EOF;
+<script type="text/javascript">
+var fixmystreet = {
+ 'tilewidth': $tile_width,
+ 'tileheight': $tile_width,
+ 'easting': $params{easting},
+ 'northing': $params{northing},
+ 'tile_type': '$tile_type',
+ 'maxResolution': $sf
+};
+</script>
+<div id="map_box">
+ $params{pre}
+ <div id="map"></div>
+ <p id="copyright">$copyright</p>
+ $params{post}
+</div>
+<div id="side">
+EOF
+ return $out;
+}
+
+sub display_map_end {
+ my ($type) = @_;
+ my $out = '</div>';
+ $out .= '</form>' if ($type);
+ return $out;
+}
+
+sub display_pin {
+}
+
+sub map_pins {
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/Tilma/Original.pm b/perllib/FixMyStreet/Map/Tilma/Original.pm
new file mode 100644
index 000000000..5772f6ccd
--- /dev/null
+++ b/perllib/FixMyStreet/Map/Tilma/Original.pm
@@ -0,0 +1,257 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map
+# Adding the ability to have different maps on FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+use LWP::Simple;
+
+use Cobrand;
+use mySociety::Web qw(ent NewURL);
+
+sub header_js {
+ return '
+<script type="text/javascript" src="/js/map-tilma.js"></script>
+';
+}
+
+# display_map Q PARAMS
+# PARAMS include:
+# EASTING, NORTHING for the centre point of the map
+# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload,
+# 0 if not clickable
+# PINS is array of pins to show, location and colour
+# PRE/POST are HTML to show above/below map
+sub _display_map {
+ my ($q, %params) = @_;
+ $params{pre} ||= '';
+ $params{post} ||= '';
+ my $mid_point = TILE_WIDTH; # Map is 2 TILE_WIDTHs in size, square.
+ if ($q->{site} eq 'barnet') { # Map is c. 380px wide
+ $mid_point = 189;
+ }
+
+ # X/Y tile co-ords may be overridden in the query string
+ my @vars = qw(x y);
+ my %input = map { $_ => $q->param($_) || '' } @vars;
+ ($input{x}) = $input{x} =~ /^(\d+)/; $input{x} ||= 0;
+ ($input{y}) = $input{y} =~ /^(\d+)/; $input{y} ||= 0;
+
+ my ($x, $y, $px, $py) = FixMyStreet::Map::os_to_px_with_adjust($q, $params{easting}, $params{northing}, $input{x}, $input{y});
+
+ my $pins = '';
+ foreach my $pin (@{$params{pins}}) {
+ my $pin_x = FixMyStreet::Map::os_to_px($pin->[0], $x);
+ my $pin_y = FixMyStreet::Map::os_to_px($pin->[1], $y, 1);
+ $pins .= FixMyStreet::Map::display_pin($q, $pin_x, $pin_y, $pin->[2]);
+ }
+
+ $px = defined($px) ? $mid_point - $px : 0;
+ $py = defined($py) ? $mid_point - $py : 0;
+ $x = int($x)<=0 ? 0 : $x;
+ $y = int($y)<=0 ? 0 : $y;
+ my $url = 'http://tilma.mysociety.org/tileserver/' . TILE_TYPE . '/';
+ my $tiles_url = $url . ($x-1) . '-' . $x . ',' . ($y-1) . '-' . $y . '/RABX';
+ my $tiles = LWP::Simple::get($tiles_url);
+ return '<div id="map_box"> <div id="map"><div id="drag">' . _("Unable to fetch the map tiles from the tile server.") . '</div></div></div><div id="side">' if !$tiles;
+ my $tileids = RABX::unserialise($tiles);
+ my $tl = ($x-1) . '.' . $y;
+ my $tr = $x . '.' . $y;
+ my $bl = ($x-1) . '.' . ($y-1);
+ my $br = $x . '.' . ($y-1);
+ return '<div id="side">' if (!$tileids->[0][0] || !$tileids->[0][1] || !$tileids->[1][0] || !$tileids->[1][1]);
+ my $tl_src = $url . $tileids->[0][0];
+ my $tr_src = $url . $tileids->[0][1];
+ my $bl_src = $url . $tileids->[1][0];
+ my $br_src = $url . $tileids->[1][1];
+
+ my $cobrand = Page::get_cobrand($q);
+ my $root_path_js = Cobrand::root_path_js($cobrand, $q);
+ my $out = FixMyStreet::Map::header($q, $params{type});
+ my $img_type;
+ if ($params{type}) {
+ $out .= <<EOF;
+<input type="hidden" name="x" id="formX" value="$x">
+<input type="hidden" name="y" id="formY" value="$y">
+EOF
+ $img_type = '<input type="image"';
+ } else {
+ $img_type = '<img';
+ }
+ my $imgw = TILE_WIDTH . 'px';
+ my $tile_width = TILE_WIDTH;
+ my $tile_type = TILE_TYPE;
+ $out .= <<EOF;
+<script type="text/javascript">
+$root_path_js
+var fixmystreet = {
+ 'x': $x - 3,
+ 'y': $y - 3,
+ 'start_x': $px,
+ 'start_y': $py,
+ 'tile_type': '$tile_type',
+ 'tilewidth': $tile_width,
+ 'tileheight': $tile_width
+};
+</script>
+<div id="map_box">
+$params{pre}
+ <div id="map"><div id="drag">
+ $img_type alt="NW map tile" id="t2.2" name="tile_$tl" src="$tl_src" style="top:0px; left:0;">$img_type alt="NE map tile" id="t2.3" name="tile_$tr" src="$tr_src" style="top:0px; left:$imgw;"><br>$img_type alt="SW map tile" id="t3.2" name="tile_$bl" src="$bl_src" style="top:$imgw; left:0;">$img_type alt="SE map tile" id="t3.3" name="tile_$br" src="$br_src" style="top:$imgw; left:$imgw;">
+ <div id="pins">$pins</div>
+ </div>
+EOF
+ $out .= '<div id="watermark"></div>' if $params{watermark};
+ $out .= compass($q, $x, $y);
+ my $copyright = $params{copyright};
+ $out .= <<EOF;
+ </div>
+ <p id="copyright">$copyright</p>
+$params{post}
+</div>
+<div id="side">
+EOF
+ return $out;
+}
+
+sub display_map_end {
+ my ($type) = @_;
+ my $out = '</div>';
+ $out .= '</form>' if ($type);
+ return $out;
+}
+
+sub display_pin {
+ my ($q, $px, $py, $col, $num) = @_;
+ $num = '' if !$num || $num > 9;
+ my $host = Page::base_url_with_lang($q, undef);
+ my %cols = (red=>'R', green=>'G', blue=>'B', purple=>'P');
+ my $out = '<img class="pin" src="' . $host . '/i/pin' . $cols{$col}
+ . $num . '.gif" alt="' . _('Problem') . '" style="top:' . ($py-59)
+ . 'px; left:' . ($px) . 'px; position: absolute;">';
+ return $out unless $_ && $_->{id} && $col ne 'blue';
+ my $cobrand = Page::get_cobrand($q);
+ my $url = Cobrand::url($cobrand, NewURL($q, -retain => 1,
+ -url => '/report/' . $_->{id},
+ pc => undef,
+ x => undef,
+ y => undef,
+ sx => undef,
+ sy => undef,
+ all_pins => undef,
+ no_pins => undef), $q);
+ $out = '<a title="' . ent($_->{title}) . '" href="' . $url . '">' . $out . '</a>';
+ return $out;
+}
+
+sub map_pins {
+ my ($q, $x, $y, $sx, $sy, $interval) = @_;
+
+ my $e = FixMyStreet::Map::tile_to_os($x);
+ my $n = FixMyStreet::Map::tile_to_os($y);
+ my ($around_map, $around_map_list, $nearby, $dist) = FixMyStreet::Map::map_features($q, $e, $n, $interval);
+
+ my $pins = '';
+ foreach (@$around_map) {
+ my $px = FixMyStreet::Map::os_to_px($_->{easting}, $sx);
+ my $py = FixMyStreet::Map::os_to_px($_->{northing}, $sy, 1);
+ my $col = $_->{state} eq 'fixed' ? 'green' : 'red';
+ $pins .= FixMyStreet::Map::display_pin($q, $px, $py, $col);
+ }
+
+ foreach (@$nearby) {
+ my $px = FixMyStreet::Map::os_to_px($_->{easting}, $sx);
+ my $py = FixMyStreet::Map::os_to_px($_->{northing}, $sy, 1);
+ my $col = $_->{state} eq 'fixed' ? 'green' : 'red';
+ $pins .= FixMyStreet::Map::display_pin($q, $px, $py, $col);
+ }
+
+ return ($pins, $around_map_list, $nearby, $dist);
+}
+
+# P is easting or northing
+# C is centre tile reference of displayed map
+sub os_to_px {
+ my ($p, $c, $invert) = @_;
+ return tile_to_px(os_to_tile($p), $c, $invert);
+}
+
+# Convert tile co-ordinates to pixel co-ordinates from top left of map
+# C is centre tile reference of displayed map
+sub tile_to_px {
+ my ($p, $c, $invert) = @_;
+ $p = TILE_WIDTH * ($p - $c + 1);
+ $p = 2 * TILE_WIDTH - $p if $invert;
+ $p = int($p + .5 * ($p <=> 0));
+ return $p;
+}
+
+# Tile co-ordinates are linear scale of OS E/N
+# Will need more generalising when more zooms appear
+sub os_to_tile {
+ return $_[0] / SCALE_FACTOR;
+}
+sub tile_to_os {
+ return int($_[0] * SCALE_FACTOR + 0.5);
+}
+
+sub click_to_tile {
+ my ($pin_tile, $pin, $invert) = @_;
+ $pin -= TILE_WIDTH while $pin > TILE_WIDTH;
+ $pin += TILE_WIDTH while $pin < 0;
+ $pin = TILE_WIDTH - $pin if $invert; # image submits measured from top down
+ return $pin_tile + $pin / TILE_WIDTH;
+}
+
+# Given some click co-ords (the tile they were on, and where in the
+# tile they were), convert to OSGB36 and return.
+sub click_to_os {
+ my ($pin_tile_x, $pin_x, $pin_tile_y, $pin_y) = @_;
+ my $tile_x = FixMyStreet::Map::click_to_tile($pin_tile_x, $pin_x);
+ my $tile_y = FixMyStreet::Map::click_to_tile($pin_tile_y, $pin_y, 1);
+ my $easting = FixMyStreet::Map::tile_to_os($tile_x);
+ my $northing = FixMyStreet::Map::tile_to_os($tile_y);
+ return ($easting, $northing);
+}
+
+# Given (E,N) and potential override (X,Y), return the X/Y tile for the centre
+# of the map (either to get the point near the middle, or the override X,Y),
+# and the pixel co-ords of the point, relative to that map.
+sub os_to_px_with_adjust {
+ my ($q, $easting, $northing, $in_x, $in_y) = @_;
+
+ my $x = FixMyStreet::Map::os_to_tile($easting);
+ my $y = FixMyStreet::Map::os_to_tile($northing);
+ my $x_tile = $in_x || int($x);
+ my $y_tile = $in_y || int($y);
+
+ # Try and have point near centre of map
+ if (!$in_x && $x - $x_tile > 0.5) {
+ $x_tile += 1;
+ }
+ if (!$in_y && $y - $y_tile > 0.5) {
+ $y_tile += 1;
+ }
+
+ my $px = FixMyStreet::Map::os_to_px($easting, $x_tile);
+ my $py = FixMyStreet::Map::os_to_px($northing, $y_tile, 1);
+ if ($q->{site} eq 'barnet') { # Map is 380px, so might need to adjust
+ if (!$in_x && $px > 380) {
+ $x_tile++;
+ $px = FixMyStreet::Map::os_to_px($easting, $x_tile);
+ }
+ if (!$in_y && $py > 380) {
+ $y_tile--;
+ $py = FixMyStreet::Map::os_to_px($northing, $y_tile, 1);
+ }
+ }
+
+ return ($x_tile, $y_tile, $px, $py);
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/Tilma/Original/1_10k.pm b/perllib/FixMyStreet/Map/Tilma/Original/1_10k.pm
new file mode 100644
index 000000000..f97163c68
--- /dev/null
+++ b/perllib/FixMyStreet/Map/Tilma/Original/1_10k.pm
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map
+# Adding the ability to have different maps on FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+
+use constant TILE_WIDTH => 254;
+use constant TIF_SIZE_M => 5000;
+use constant TIF_SIZE_PX => 7874;
+use constant SCALE_FACTOR => TIF_SIZE_M / (TIF_SIZE_PX / TILE_WIDTH);
+use constant TILE_TYPE => '10k-full';
+
+use FixMyStreet::Map::Tilma::Original;
+
+sub display_map {
+ my ($q, %params) = @_;
+ $params{copyright} = _('&copy; Crown copyright. All rights reserved. Ministry of Justice 100037819&nbsp;2008.');
+ $params{watermark} = 1;
+ return _display_map($q, %params);
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/Tilma/Original/StreetView.pm b/perllib/FixMyStreet/Map/Tilma/Original/StreetView.pm
new file mode 100644
index 000000000..103f4c15c
--- /dev/null
+++ b/perllib/FixMyStreet/Map/Tilma/Original/StreetView.pm
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+#
+# FixMyStreet:Map
+# Adding the ability to have different maps on FixMyStreet.
+#
+# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved.
+# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
+
+package FixMyStreet::Map;
+
+use strict;
+
+use constant TILE_WIDTH => 250;
+use constant TIF_SIZE_M => 5000;
+use constant TIF_SIZE_PX => 5000;
+use constant SCALE_FACTOR => TIF_SIZE_M / (TIF_SIZE_PX / TILE_WIDTH);
+use constant TILE_TYPE => 'streetview';
+
+use FixMyStreet::Map::Tilma::Original;
+
+sub display_map {
+ my ($q, %params) = @_;
+ $params{copyright} = _('Map contains Ordnance Survey data &copy; Crown copyright and database right 2010.');
+ return _display_map($q, %params);
+}
+
+1;