diff options
Diffstat (limited to 'perllib')
| -rw-r--r-- | perllib/Cobrand.pm | 2 | ||||
| -rw-r--r-- | perllib/Cobrands/Barnet/Util.pm | 7 | ||||
| -rw-r--r-- | perllib/Cobrands/Emptyhomes/Util.pm | 9 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Alert.pm | 339 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Geocode.pm | 156 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map.pm | 114 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/Bing.pm | 71 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/BingOL.pm | 71 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/Google.pm | 71 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/OSM.pm | 71 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/OSM/CycleMap.pm | 71 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/OSM/StreetView.pm | 70 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/Tilma/OL/1_10k.pm | 83 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/Tilma/OL/StreetView.pm | 81 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/Tilma/Original.pm | 257 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/Tilma/Original/1_10k.pm | 28 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/Tilma/Original/StreetView.pm | 27 | ||||
| -rw-r--r-- | perllib/Page.pm | 434 | ||||
| -rw-r--r-- | perllib/Standard.pm | 1 |
19 files changed, 1524 insertions, 439 deletions
diff --git a/perllib/Cobrand.pm b/perllib/Cobrand.pm index 4433858bb..328445fcc 100644 --- a/perllib/Cobrand.pm +++ b/perllib/Cobrand.pm @@ -75,8 +75,6 @@ my %fns = ( # Given a QUERY, return a hash of extra params to be included in # any URLs in links produced on the page returned by that query. 'extra_params' => { default => "''" }, - # Returns a boolean indicating whether the map watermark should be displayed - 'show_watermark' => { default => '1' }, # Returns any extra text to be displayed with a PROBLEM. 'extra_problem_meta_text' => { default => "''" }, # Returns any extra text to be displayed with an UPDATE. diff --git a/perllib/Cobrands/Barnet/Util.pm b/perllib/Cobrands/Barnet/Util.pm index 3cc60117f..32973c10c 100644 --- a/perllib/Cobrands/Barnet/Util.pm +++ b/perllib/Cobrands/Barnet/Util.pm @@ -3,18 +3,13 @@ # Util.pm: # Barnet cobranding for FixMyStreet. # -# # Copyright (c) 2009 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org. WWW: http://www.mysociety.org -# -# $Id: Util.pm,v 1.9 2009-12-22 13:04:05 matthew Exp $ package Cobrands::Barnet::Util; -use Standard; use strict; use Carp; use URI::Escape; -use mySociety::Web qw(ent); use mySociety::VotingArea; sub new { @@ -86,7 +81,7 @@ sub council_check { $url .= 'alert' if $context eq 'alert'; $url .= '?pc=' . URI::Escape::uri_escape_utf8($q->param('pc')) if $q->param('pc'); my $error_msg = "That location is not covered by Barnet. -Please visit <a href='$url'>the main FixMyStreet site</a>."; +Please visit <a href=\"$url\">the main FixMyStreet site</a>."; return (0, $error_msg); } diff --git a/perllib/Cobrands/Emptyhomes/Util.pm b/perllib/Cobrands/Emptyhomes/Util.pm index f562a849b..acb870695 100644 --- a/perllib/Cobrands/Emptyhomes/Util.pm +++ b/perllib/Cobrands/Emptyhomes/Util.pm @@ -3,19 +3,14 @@ # Util.pm: # Emptyhomes Cobranding for FixMyStreet. # -# # Copyright (c) 2009 UK Citizens Online Democracy. All rights reserved. # Email: louise@mysociety.org. WWW: http://www.mysociety.org -# -# $Id: Util.pm,v 1.8 2009-12-22 11:17:26 matthew Exp $ package Cobrands::Emptyhomes::Util; -use Standard; use strict; use Carp; -use mySociety::Web qw(ent); -sub new{ +sub new { my $class = shift; return bless {}, $class; } @@ -44,7 +39,7 @@ Set the language and text domain for the site based on the query and host. =cut -sub set_lang_and_domain{ +sub set_lang_and_domain { my ($self, $lang, $unicode) = @_; mySociety::Locale::negotiate_language('en-gb,English,en_GB|cy,Cymraeg,cy_GB', $lang); mySociety::Locale::gettext_domain('FixMyStreet-EmptyHomes', $unicode); 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 © 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 © 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 © 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 © <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 © <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 © 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 = _('© Crown copyright. All rights reserved. Ministry of Justice 100037819 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 © 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} = _('© Crown copyright. All rights reserved. Ministry of Justice 100037819 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 © Crown copyright and database right 2010.'); + return _display_map($q, %params); +} + +1; diff --git a/perllib/Page.pm b/perllib/Page.pm index 127fad11b..1b94f5c2b 100644 --- a/perllib/Page.pm +++ b/perllib/Page.pm @@ -16,41 +16,34 @@ use Carp; use mySociety::CGIFast qw(-no_xhtml); use Error qw(:try); use File::Slurp; -use HTTP::Date; +use HTTP::Date; # time2str use Image::Magick; use Image::Size; -use LWP::Simple; -use Digest::MD5 qw(md5_hex); use POSIX qw(strftime); use URI::Escape; use Text::Template; use Memcached; use Problems; -use Utils; use Cobrand; + use mySociety::Config; use mySociety::DBHandle qw/dbh select_all/; use mySociety::EvEl; -use mySociety::Gaze; -use mySociety::GeoUtil; use mySociety::Locale; use mySociety::MaPit; -use mySociety::PostcodeUtil; use mySociety::TempFiles; use mySociety::Tracking; use mySociety::WatchUpdate; -use mySociety::Web qw(ent NewURL); +use mySociety::Web qw(ent); BEGIN { (my $dir = __FILE__) =~ s{/[^/]*?$}{}; mySociety::Config::set_file("$dir/../conf/general"); } -use constant TILE_WIDTH => mySociety::Config::get('TILES_WIDTH'); -use constant TIF_SIZE_M => mySociety::Config::get('TILES_TIFF_SIZE_METRES'); -use constant TIF_SIZE_PX => mySociety::Config::get('TILES_TIFF_SIZE_PIXELS'); -use constant SCALE_FACTOR => TIF_SIZE_M / (TIF_SIZE_PX / TILE_WIDTH); +# Under the BEGIN so that the config has been set. +use FixMyStreet::Map; my $lastmodified; @@ -205,12 +198,17 @@ sub template_vars ($%) { 'lang_url' => $lang_url, 'title' => $params{title}, 'rss' => '', + map_js => FixMyStreet::Map::header_js(), ); if ($params{rss}) { $vars{rss} = '<link rel="alternate" type="application/rss+xml" title="' . $params{rss}[0] . '" href="' . $params{rss}[1] . '">'; } + if ($params{robots}) { + $vars{robots} = '<meta name="robots" content="' . $params{robots} . '">'; + } + if ($q->{site} eq 'fixmystreet') { my $home = !$params{title} && $ENV{SCRIPT_NAME} eq '/index.cgi' && !$ENV{QUERY_STRING}; $vars{heading_element_start} = $home ? '<h1 id="header">' : '<div id="header"><a href="/">'; @@ -285,7 +283,7 @@ sub header ($%) { my $default_params = Cobrand::header_params(get_cobrand($q), $q, %params); my %default_params = %{$default_params}; %params = (%default_params, %params); - my %permitted_params = map { $_ => 1 } qw(title rss js expires lastmodified template cachecontrol context status_code); + my %permitted_params = map { $_ => 1 } qw(title rss expires lastmodified template cachecontrol context status_code robots); foreach (keys %params) { croak "bad parameter '$_'" if (!exists($permitted_params{$_})); } @@ -318,8 +316,6 @@ sub header ($%) { sub footer { my ($q, %params) = @_; my $extra = $params{extra}; - my $js = $params{js} || ''; - $js = ''; # Don't use fileupload JS at the moment if ($q->{site} ne 'fixmystreet') { my $template = template($q, %params) . '-footer'; @@ -381,8 +377,6 @@ $orglogo $track -$js - $piwik </body> @@ -401,275 +395,6 @@ sub error_page ($$) { print $q->header(-content_length => length($html)), $html; } -# display_map Q PARAMS -# PARAMS include: -# X,Y is bottom left tile of 2x2 grid -# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload, -# 0 if not clickable -# PINS is HTML of pins to show -# PX,PY are coordinates of pin -# PRE/POST are HTML to show above/below map -sub display_map { - my ($q, %params) = @_; - $params{pins} ||= ''; - $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; - } - my $px = defined($params{px}) ? $mid_point - $params{px} : 0; - my $py = defined($params{py}) ? $mid_point - $params{py} : 0; - my $x = int($params{x})<=0 ? 0 : $params{x}; - my $y = int($params{y})<=0 ? 0 : $params{y}; - my $url = mySociety::Config::get('TILES_URL'); - 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 $out = ''; - my $cobrand = Page::get_cobrand($q); - my $root_path_js = Cobrand::root_path_js($cobrand, $q); - my $cobrand_form_elements = Cobrand::form_elements($cobrand, 'mapForm', $q); - my $img_type; - my $form_action = Cobrand::url($cobrand, '', $q); - if ($params{type}) { - my $encoding = ''; - $encoding = ' enctype="multipart/form-data"' if ($params{type}==2); - my $pc = $q->param('pc') || ''; - my $pc_enc = ent($pc); - $out .= <<EOF; -<form action="$form_action" method="post" name="mapForm" id="mapForm"$encoding> -<input type="hidden" name="submit_map" value="1"> -<input type="hidden" name="x" id="formX" value="$x"> -<input type="hidden" name="y" id="formY" value="$y"> -<input type="hidden" name="pc" value="$pc_enc"> -$cobrand_form_elements -EOF - $img_type = '<input type="image"'; - } else { - $img_type = '<img'; - } - my $imgw = TILE_WIDTH . 'px'; - my $tile_width = TILE_WIDTH; - my $tile_type = mySociety::Config::get('TILES_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">$params{pins}</div> - </div> -EOF - if (Cobrand::show_watermark($cobrand) && mySociety::Config::get('TILES_TYPE') ne 'streetview') { - $out .= '<div id="watermark"></div>'; - } - $out .= compass($q, $x, $y); - my $copyright; - if (mySociety::Config::get('TILES_TYPE') eq 'streetview') { - $copyright = _('Map contains Ordnance Survey data © Crown copyright and database right 2010.'); - } else { - $copyright = _('© Crown copyright. All rights reserved. Ministry of Justice 100037819 2008.'); - } - $out .= <<EOF; - </div> - <p id="copyright">$copyright</p> -$params{post} -EOF - $out .= '</div>'; - $out .= '<div id="side">'; - 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 = 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 $pins = ''; - my $min_e = Page::tile_to_os($x-3); # Extra space to left/below due to rounding, I think - my $min_n = Page::tile_to_os($y-3); - my $mid_e = Page::tile_to_os($x); - my $mid_n = Page::tile_to_os($y); - my $max_e = Page::tile_to_os($x+2); - my $max_n = Page::tile_to_os($y+2); - my $cobrand = Page::get_cobrand($q); - # list of problems aoround map can be limited, but should show all pins - my $around_limit = Cobrand::on_map_list_limit($cobrand); - my $around_map; - my $around_map_list = Problems::around_map($min_e, $max_e, $min_n, $max_n, $interval, $around_limit); - if ($around_limit) { - $around_map = Problems::around_map($min_e, $max_e, $min_n, $max_n, $interval, undef); - } else { - $around_map = $around_map_list; - } - my @ids = (); - foreach (@$around_map_list) { - push(@ids, $_->{id}); - } - foreach (@$around_map) { - my $px = Page::os_to_px($_->{easting}, $sx); - my $py = Page::os_to_px($_->{northing}, $sy, 1); - my $col = $_->{state} eq 'fixed' ? 'green' : 'red'; - $pins .= Page::display_pin($q, $px, $py, $col); - } - - 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; # - @$current_map; - my $nearby = Problems::nearby($dist, join(',', @ids), $limit, $mid_e, $mid_n, $interval); - foreach (@$nearby) { - my $px = Page::os_to_px($_->{easting}, $sx); - my $py = Page::os_to_px($_->{northing}, $sy, 1); - my $col = $_->{state} eq 'fixed' ? 'green' : 'red'; - $pins .= Page::display_pin($q, $px, $py, $col); - } - - return ($pins, $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 = 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 -} - -# 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; -} - -sub os_to_px_with_adjust { - my ($q, $easting, $northing, $in_x, $in_y) = @_; - - my $x = Page::os_to_tile($easting); - my $y = Page::os_to_tile($northing); - my $x_tile = $in_x || int($x); - my $y_tile = $in_y || int($y); - my $px = Page::os_to_px($easting, $x_tile); - my $py = Page::os_to_px($northing, $y_tile, 1); - if ($q->{site} eq 'barnet') { # Map is 380px - if ($py > 380) { - $y_tile--; - $py = Page::os_to_px($northing, $y_tile, 1); - } - if ($px > 380) { - $x_tile++; - $px = Page::os_to_px($easting, $x_tile); - } - } - return ($x, $y, $x_tile, $y_tile, $px, $py); -} - # send_email TO (NAME) TEMPLATE-NAME PARAMETERS # TEMPLATE-NAME is currently one of problem, update, alert, tms sub send_email { @@ -927,143 +652,6 @@ sub mapit_check_error { return 0; } -# geocode 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 geocode { - my ($s, $q) = @_; - my ($x, $y, $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 = mapit_check_error($location)) { - $easting = $location->{easting}; - $northing = $location->{northing}; - my $xx = Page::os_to_tile($easting); - my $yy = Page::os_to_tile($northing); - $x = int($xx); - $y = int($yy); - $x += 1 if ($xx - $x > 0.5); - $y += 1 if ($yy - $y > 0.5); - } - } else { - ($x, $y, $easting, $northing, $error) = geocode_string($s, $q); - } - return ($x, $y, $easting, $northing, $error); -} - -sub geocoded_string_coordinates { - my ($js, $q) = @_; - my ($x, $y, $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'); - my $xx = Page::os_to_tile($easting); - my $yy = Page::os_to_tile($northing); - $x = int($xx); - $y = int($yy); - $x += 1 if ($xx - $x > 0.5); - $y += 1 if ($yy - $y > 0.5); - } 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 ($x, $y, $easting, $northing, $error); -} - -# geocode_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 geocode_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(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, $x, $y, $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(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 { - ($x, $y, $easting, $northing, $error) = geocoded_string_coordinates($js, $q); - } - return ($x, $y, $easting, $northing, $error); -} - -# geocode_choice -# Prints response if there's more than one possible result -sub geocode_choice { - 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; -} - sub short_name { my $name = shift; # Special case Durham as it's the only place with two councils of the same name diff --git a/perllib/Standard.pm b/perllib/Standard.pm index eda2d89fb..571065c14 100644 --- a/perllib/Standard.pm +++ b/perllib/Standard.pm @@ -20,7 +20,6 @@ use lib "$FindBin::Bin/../commonlib/perllib"; use Page; - package Standard; sub import { |