diff options
Diffstat (limited to 'perllib')
23 files changed, 1209 insertions, 519 deletions
diff --git a/perllib/Carp/Always.pm b/perllib/Carp/Always.pm new file mode 100644 index 000000000..68bcaee52 --- /dev/null +++ b/perllib/Carp/Always.pm @@ -0,0 +1,162 @@ + +package Carp::Always; + +use 5.006; +use strict; +use warnings; + +our $VERSION = '0.09'; + +use Carp qw(verbose); # makes carp() cluck and croak() confess + +sub _warn { + if ($_[-1] =~ /\n$/s) { + my $arg = pop @_; + $arg =~ s/ at .*? line .*?\n$//s; + push @_, $arg; + } + warn &Carp::longmess; +} + +sub _die { + if ($_[-1] =~ /\n$/s) { + my $arg = pop @_; + $arg =~ s/ at .*? line .*?\n$//s; + push @_, $arg; + } + die &Carp::longmess; +} + +my %OLD_SIG; + +BEGIN { + @OLD_SIG{qw(__DIE__ __WARN__)} = @SIG{qw(__DIE__ __WARN__)}; + $SIG{__DIE__} = \&_die; + $SIG{__WARN__} = \&_warn; +} + +END { + @SIG{qw(__DIE__ __WARN__)} = @OLD_SIG{qw(__DIE__ __WARN__)}; +} + +1; +__END__ + +=head1 NAME + +Carp::Always - Warns and dies noisily with stack backtraces + +=head1 SYNOPSIS + + use Carp::Always; + +makes every C<warn()> and C<die()> complains loudly in the calling package +and elsewhere. More often used on the command line: + + perl -MCarp::Always script.pl + +=head1 DESCRIPTION + +This module is meant as a debugging aid. It can be +used to make a script complain loudly with stack backtraces +when warn()ing or die()ing. + +Here are how stack backtraces produced by this module +looks: + + # it works for explicit die's and warn's + $ perl -MCarp::Always -e 'sub f { die "arghh" }; sub g { f }; g' + arghh at -e line 1 + main::f() called at -e line 1 + main::g() called at -e line 1 + + # it works for interpreter-thrown failures + $ perl -MCarp::Always -w -e 'sub f { $a = shift; @a = @$a };' \ + -e 'sub g { f(undef) }; g' + Use of uninitialized value in array dereference at -e line 1 + main::f('undef') called at -e line 2 + main::g() called at -e line 2 + +In the implementation, the C<Carp> module does +the heavy work, through C<longmess()>. The +actual implementation sets the signal hooks +C<$SIG{__WARN__}> and C<$SIG{__DIE__}> to +emit the stack backtraces. + +Oh, by the way, C<carp> and C<croak> when requiring/using +the C<Carp> module are also made verbose, behaving +like C<cloak> and C<confess>, respectively. + +=head2 EXPORT + +Nothing at all is exported. + +=head1 ACKNOWLEDGMENTS + +This module was born as a reaction to a release +of L<Acme::JavaTrace> by Sébastien Aperghis-Tramoni. +Sébastien also has a newer module called +L<Devel::SimpleTrace> with the same code and fewer flame +comments on docs. The pruning of the uselessly long +docs of this module were prodded by Michael Schwern. + +Schwern and others told me "the module name stinked" - +it was called C<Carp::Indeed>. After thinking long +and not getting nowhere, I went with nuffin's suggestion +and now it is called C<Carp::Always>. +C<Carp::Indeed> which is now deprecate +lives in its own distribution (which won't go anywhere +but will stay there as a redirection to this module). + +=head1 SEE ALSO + +=over 4 + +=item * + +L<Carp> + +=item * + +L<Acme::JavaTrace> and L<Devel::SimpleTrace> + +=back + +Please report bugs via CPAN RT +http://rt.cpan.org/NoAuth/Bugs.html?Dist=Carp-Always. + +=head1 BUGS + +Every (un)deserving module has its own pet bugs. + +=over 4 + +=item * + +This module does not play well with other modules which fusses +around with C<warn>, C<die>, C<$SIG{'__WARN__'}>, +C<$SIG{'__DIE__'}>. + +=item * + +Test scripts are good. I should write more of these. + +=item * + +I don't know if this module name is still a bug as it was +at the time of C<Carp::Indeed>. + +=back + +=head1 AUTHOR + +Adriano Ferreira, E<lt>ferreira@cpan.orgE<gt> + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2005-2007 by Adriano R. Ferreira + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/perllib/Cobrand.pm b/perllib/Cobrand.pm index 328445fcc..fa2dd9e88 100644 --- a/perllib/Cobrand.pm +++ b/perllib/Cobrand.pm @@ -41,7 +41,7 @@ my %fns = ( # Return the base url for the cobranded version of the site 'base_url' => { default => "mySociety::Config::get('BASE_URL')" }, # Return the text that prompts the user to enter their postcode/place name. Parameter is QUERY - 'enter_postcode_text' => { default => '_("Enter a nearby GB postcode, or street name and area:")' }, + 'enter_postcode_text' => { default => '""' }, # Set the language and domain of the site based on the cobrand and host 'set_lang_and_domain' => { default => '\&default_set_lang_and_domain' }, # Return HTML for a list of alert options for the cobrand, given QUERY and OPTIONS. @@ -55,7 +55,7 @@ my %fns = ( 'front_stats' => { default => '\&Problems::front_stats' }, # Given a STRING ($_[1]) representing a location and a QUERY, return a string that # includes any disambiguating information available - 'disambiguate_location' => { default => '$_[1]' }, + 'disambiguate_location' => { default => '"$_[1]&gl=uk"' }, # Parameter is EPOCHTIME 'prettify_epoch' => { default => '0' }, # Parameters are FORM_NAME, QUERY. Return HTML for any extra needed elements for FORM_NAME @@ -116,6 +116,9 @@ my %fns = ( 'admin_pages' => { default => '0' }, # Show the problem creation graph in the admin interface 'admin_show_creation_graph' => { default => '1' }, + # The MaPit types this site handles + 'area_types' => { default => '[qw(DIS LBO MTD UTA CTY COI)]' }, + 'area_min_generation' => { default => '10' }, ); foreach (keys %fns) { diff --git a/perllib/Cobrands/Barnet/Util.pm b/perllib/Cobrands/Barnet/Util.pm index 32973c10c..0e5ddcf68 100644 --- a/perllib/Cobrands/Barnet/Util.pm +++ b/perllib/Cobrands/Barnet/Util.pm @@ -54,7 +54,7 @@ sub site_title { sub enter_postcode_text { my ($self,$q) = @_; - return 'Enter a Barnet postcode, or street name and area:'; + return 'Enter a Barnet postcode, or street name and area'; } =item council_check COUNCILS QUERY CONTEXT @@ -69,9 +69,9 @@ sub council_check { my $councils; if ($params->{all_councils}) { $councils = $params->{all_councils}; - } elsif ($params->{e}) { + } elsif (defined $params->{lat}) { my $parent_types = $mySociety::VotingArea::council_parent_types; - $councils = mySociety::MaPit::call('point', "27700/$params->{e},$params->{n}", type => $parent_types); + $councils = mySociety::MaPit::call('point', "4326/$params->{lon},$params->{lat}", type => $parent_types); } my $council_match = defined $councils->{2489}; if ($council_match) { @@ -104,9 +104,9 @@ sub disambiguate_location { } sub recent_photos { - my ($self, $num, $e, $n, $dist) = @_; + my ($self, $num, $lat, $lon, $dist) = @_; $num = 2 if $num == 3; - return Problems::recent_photos($num, $e, $n, $dist); + return Problems::recent_photos($num, $lat, $lon, $dist); } 1; diff --git a/perllib/Cobrands/Emptyhomes/Util.pm b/perllib/Cobrands/Emptyhomes/Util.pm index acb870695..d23857f50 100644 --- a/perllib/Cobrands/Emptyhomes/Util.pm +++ b/perllib/Cobrands/Emptyhomes/Util.pm @@ -33,6 +33,10 @@ sub admin_base_url { return 'https://secure.mysociety.org/admin/emptyhomes/'; } +sub area_types { + return qw(DIS LBO MTD UTA LGD COI); # No CTY +} + =item set_lang_and_domain LANG UNICODE Set the language and text domain for the site based on the query and host. diff --git a/perllib/Cobrands/Fiksgatami/Util.pm b/perllib/Cobrands/Fiksgatami/Util.pm new file mode 100644 index 000000000..2abc03d00 --- /dev/null +++ b/perllib/Cobrands/Fiksgatami/Util.pm @@ -0,0 +1,62 @@ +#!/usr/bin/perl -w +# +# Util.pm: +# Fiksgatami cobranding for FixMyStreet. +# +# Copyright (c) 2011 UK Citizens Online Democracy. All rights reserved. +# Email: matthew@mysociety.org. WWW: http://www.mysociety.org + +package Cobrands::Fiksgatami::Util; +use strict; +use Carp; + +sub new { + my $class = shift; + return bless {}, $class; +} + +sub set_lang_and_domain { + my ($self, $lang, $unicode) = @_; + mySociety::Locale::negotiate_language('en-gb,English,en_GB|nb,Norwegian,nb_NO', 'nb'); + mySociety::Locale::gettext_domain('FixMyStreet', $unicode); + mySociety::Locale::change(); +} + +# If lat/lon are present in the URL, OpenLayers will use that to centre the map. +# Need to specify a zoom to stop it defaulting to null/0. +sub url { + my ($self, $url) = @_; + if ($url =~ /lat=/ && $url !~ /zoom=/) { + $url .= ';zoom=2'; + } + return $url; +} + +sub enter_postcode_text { + my ($self, $q) = @_; + return _('Enter a nearby postcode, or street name and area'); +} + +# Is also adding language parameter +sub disambiguate_location { + my ($self, $s, $q) = @_; + $s = "hl=no&gl=no&$s"; + return $s; +} + +sub geocoded_string_check { + my ($self, $s) = @_; + return 1 if $s =~ /, Norge/; + return 0; +} + +sub area_types { + return ( 'NKO', 'NFY' ); +} + +sub area_min_generation { + return ''; +} + +1; + diff --git a/perllib/Cobrands/Southampton/Util.pm b/perllib/Cobrands/Southampton/Util.pm new file mode 100644 index 000000000..ee7d8e728 --- /dev/null +++ b/perllib/Cobrands/Southampton/Util.pm @@ -0,0 +1,113 @@ +#!/usr/bin/perl -w +# +# Util.pm: +# Southampton cobranding for FixMyStreet. +# +# Copyright (c) 2011 UK Citizens Online Democracy. All rights reserved. +# Email: matthew@mysociety.org. WWW: http://www.mysociety.org + +package Cobrands::Southampton::Util; +use strict; +use Carp; +use URI::Escape; +use mySociety::VotingArea; + +sub new { + my $class = shift; + return bless {}, $class; +} + +=item site_restriction Q + +Return a site restriction clause and a site key. + +=cut +sub site_restriction { + return ("and council='2567'", 'southampton'); +} + +=item + +Return the base url for this cobranded site + +=cut + +sub base_url { + my $base_url = mySociety::Config::get('BASE_URL'); + if ($base_url !~ /southampton/) { + $base_url =~ s/http:\/\/(?!www\.)/http:\/\/southampton\./g; + $base_url =~ s/http:\/\/www\./http:\/\/southampton\./g; + } + return $base_url; +} + +=item site_title + +Return the title to be used in page heads + +=cut + +sub site_title { + my ($self) = @_; + return 'Southampton City Council FixMyStreet'; +} + +sub enter_postcode_text { + my ($self,$q) = @_; + return 'Enter a Southampton postcode, or street name and area'; +} + +=item council_check COUNCILS QUERY CONTEXT + +Return a boolean indicating whether COUNCILS are okay for the location +in the QUERY, and an error message appropriate to the CONTEXT. + +=cut + +sub council_check { + my ($self, $params, $q, $context) = @_; + my $councils; + if ($params->{all_councils}) { + $councils = $params->{all_councils}; + } elsif (defined $params->{lat}) { + my $parent_types = $mySociety::VotingArea::council_parent_types; + $councils = mySociety::MaPit::call('point', "4326/$params->{lon},$params->{lat}", type => $parent_types); + } + my $council_match = defined $councils->{2567}; + if ($council_match) { + return 1; + } + my $url = 'http://www.fixmystreet.com/'; + $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 Southampton. +Please visit <a href=\"$url\">the main FixMyStreet site</a>."; + return (0, $error_msg); +} + +# All reports page only has the one council. +sub all_councils_report { + return 0; +} + +=item disambiguate_location S Q + +Given a string representing a location (street and area expected), +bias the viewport to around Southampton. + +=cut + +sub disambiguate_location { + my ($self, $s, $q) = @_; + $s = "ll=50.913822,-1.400493&spn=0.084628,0.15701&$s"; + return $s; +} + +sub recent_photos { + my ($self, $num, $lat, $lon, $dist) = @_; + $num = 2 if $num == 3; + return Problems::recent_photos($num, $lat, $lon, $dist); +} + +1; + diff --git a/perllib/FixMyStreet/Alert.pm b/perllib/FixMyStreet/Alert.pm index 9996f03c8..cfe9c1781 100644 --- a/perllib/FixMyStreet/Alert.pm +++ b/perllib/FixMyStreet/Alert.pm @@ -30,7 +30,6 @@ 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); @@ -91,7 +90,7 @@ sub delete ($) { sub email_alerts ($) { my ($testing_email) = @_; my $url; - my $q = dbh()->prepare("select * from alert_type where ref not like 'local_problems%'"); + 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) { @@ -135,12 +134,19 @@ sub email_alerts ($) { # 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 => '' ); } + # create problem status message for the templates + $data{state_message} = + $row->{state} eq 'fixed' + ? _("This report is currently marked as fixed.") + : _("This report is currently marked as open."); + $url = Cobrand::base_url_for_emails($row->{alert_cobrand}, $row->{alert_cobrand_data}); if ($row->{item_text}) { $data{problem_url} = $url . "/report/" . $row->{id}; @@ -177,12 +183,11 @@ sub email_alerts ($) { $query->execute(); while (my $alert = $query->fetchrow_hashref) { next unless (Cobrand::email_host($alert->{cobrand})); - my $e = $alert->{parameter}; - my $n = $alert->{parameter2}; + my $longitude = $alert->{parameter}; + my $latitude = $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); + my $d = mySociety::Gaze::get_radius_containing_population($latitude, $longitude, 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} ); @@ -195,7 +200,7 @@ sub email_alerts ($) { $site_restriction order by confirmed desc"; $q = dbh()->prepare($q); - $q->execute($e, $n, $d, $alert->{whensubscribed}, $alert->{id}, $alert->{email}); + $q->execute($latitude, $longitude, $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"; @@ -248,12 +253,10 @@ sub generate_rss ($$$;$$$$) { 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 ' @@ -269,19 +272,19 @@ sub generate_rss ($$$;$$$$) { $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... :-/ + + my $pubDate; 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]; + $row->{confirmed} = strftime("%e %B", $6, $5, $4, $3, $2-1, $1-1900, -1, -1, 0); + $row->{confirmed} =~ s/^\s+//; + $row->{confirmed} =~ s/^(\d+)/ordinal($1)/e if $mySociety::Locale::lang eq 'en-gb'; } (my $title = _($alert_type->{item_title})) =~ s/{{(.*?)}}/$row->{$1}/g; @@ -295,17 +298,18 @@ sub generate_rss ($$$;$$$$) { description => ent(ent($desc)) # Yes, double-encoded, really. ); $item{pubDate} = $pubDate if $pubDate; + $item{category} = $row->{category} if $row->{category}; - # 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>"); + my $recipient_name = Cobrand::contact_name($cobrand); + $item{description} .= ent("\n<br><a href='$cobrand_url'>" . + sprintf(_("Report on %s"), $recipient_name) . "</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" }; + if ($row->{latitude} || $row->{longitude}) { + $item{georss} = { point => "$row->{latitude} $row->{longitude}" }; } $rss->add_item( %item ); } diff --git a/perllib/FixMyStreet/Geocode.pm b/perllib/FixMyStreet/Geocode.pm index 9e89b4f7b..c06c3bb55 100644 --- a/perllib/FixMyStreet/Geocode.pm +++ b/perllib/FixMyStreet/Geocode.pm @@ -9,16 +9,19 @@ package FixMyStreet::Geocode; use strict; +use Encode; use Error qw(:try); use File::Slurp; +use File::Path (); use LWP::Simple; use Digest::MD5 qw(md5_hex); use URI::Escape; use Cobrand; use Page; +use Utils; use mySociety::Config; -use mySociety::GeoUtil; +use mySociety::Locale; use mySociety::MaPit; use mySociety::PostcodeUtil; use mySociety::Web qw(NewURL); @@ -36,52 +39,82 @@ BEGIN { # 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}; + my ($latitude, $longitude, $error); + if (mySociety::Config::get('COUNTRY') eq 'GB') { + 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)) { + $latitude = $location->{wgs84_lat}; + $longitude = $location->{wgs84_lon}; + } } - } else { - ($easting, $northing, $error) = FixMyStreet::Geocode::string($s, $q); + } elsif (mySociety::Config::get('COUNTRY') eq 'NO') { + if ($s =~ /^\d{4}$/) { + my $location = mySociety::MaPit::call('postcode', $s); + unless ($error = Page::mapit_check_error($location)) { + $latitude = $location->{wgs84_lat}; + $longitude = $location->{wgs84_lon}; + } + } + } + unless ($error || defined $latitude) { + ($latitude, $longitude, $error) = FixMyStreet::Geocode::string($s, $q); } - return ($easting, $northing, $error); + return ($latitude, $longitude, $error); } sub geocoded_string_coordinates { my ($js, $q) = @_; - my ($easting, $northing, $error); + my ($latitude, $longitude, $error); my ($accuracy) = $js =~ /"Accuracy" *: *(\d)/; if ($accuracy < 4) { $error = _('Sorry, that location appears to be too general; please be more specific.'); - } else { + } elsif ( $js =~ /"coordinates" *: *\[ *(.*?), *(.*?),/ ) { + $longitude = $1; + $latitude = $2; + if (mySociety::Config::get('COUNTRY') eq 'GB') { + try { + my ($easting, $northing) = Utils::convert_latlon_to_en( $latitude, $longitude ); + } catch Error::Simple with { + mySociety::Locale::pop(); # We threw exception, so it won't have happened. + $error = shift; + $error = _('That location does not appear to be in Britain; please try again.') + if $error =~ /out of the area covered/; + } + } + } + return ($latitude, $longitude, $error); +} - $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); +sub results_check { + my $q = shift; + my ($error, @valid_locations); + foreach (@_) { + 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 (@$error, $address); + push (@valid_locations, $_); + } + if (scalar @valid_locations == 1) { + return geocoded_string_coordinates($valid_locations[0], $q); + } + $error = _('Sorry, we could not find that location.') unless $error; + return (undef, undef, $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. +# Returns array of (LAT, LON, 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/[^-&\w ']/ /g; $s =~ s/\s+/ /g; $s = URI::Escape::uri_escape_utf8($s); $s = Cobrand::disambiguate_location(Page::get_cobrand($q), "q=$s", $q); @@ -89,13 +122,16 @@ sub string { 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); + my ($js, $error); 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'); + $url .= ',+UK' unless $url =~ /united\++kingdom$/ || $url =~ /uk$/i + || mySociety::Config::get('COUNTRY') ne 'GB'; + $url .= '&sensor=false&key=' . mySociety::Config::get('GOOGLE_MAPS_API_KEY'); $js = LWP::Simple::get($url); + $js = encode_utf8($js) if utf8::is_utf8($js); + File::Path::mkpath($cache_dir); File::Slurp::write_file($cache_file, $js) if $js && $js !~ /"code":6[12]0/; } if (!$js) { @@ -103,27 +139,14 @@ sub string { } 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; + return results_check($q, (split /}, *{/, $js)); } 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 results_check($q, $js); } - return ($easting, $northing, $error); + return (undef, undef, $error); } # list_choices @@ -136,6 +159,7 @@ sub list_choices { my $out = '<p>' . $message . '</p>'; my $choice_list = '<ul>'; foreach my $choice (@$choices) { + $choice = decode_utf8($choice); $choice =~ s/, United Kingdom//; $choice =~ s/, UK//; $url = Cobrand::url($cobrand, NewURL($q, -retain => 1, -url => $page, 'pc' => $choice), $q); diff --git a/perllib/FixMyStreet/Map.pm b/perllib/FixMyStreet/Map.pm index 12ecf78fe..5305b360a 100644 --- a/perllib/FixMyStreet/Map.pm +++ b/perllib/FixMyStreet/Map.pm @@ -10,105 +10,135 @@ package FixMyStreet::Map; use strict; +use Module::Pluggable + sub_name => 'maps', + search_path => __PACKAGE__, + except => 'FixMyStreet::Map::Tilma::Original', + require => 1; + +# Get the list of maps we want and load map classes at compile time +my @ALL_MAP_CLASSES = allowed_maps(); + use Problems; use Cobrand; use mySociety::Config; use mySociety::Gaze; -use mySociety::GeoUtil; use mySociety::Locale; -use mySociety::Web qw(ent NewURL); +use mySociety::Web qw(ent); + +=head2 allowed_maps + +Returns an array of all the map classes that were found and that +are permitted by the config. + +=cut + +sub allowed_maps { + my @allowed = split /,/, mySociety::Config::get('MAP_TYPE'); + @allowed = map { __PACKAGE__.'::'.$_ } @allowed; + my %avail = map { $_ => 1 } __PACKAGE__->maps; + return grep { $avail{$_} } @allowed; +} + +=head2 map_class + +Set and return the appropriate class given a query parameter string. + +=cut + +our $map_class; +sub set_map_class { + my $str = shift; + $str = __PACKAGE__.'::'.$str if $str; + my %avail = map { $_ => 1 } @ALL_MAP_CLASSES; + $str = $ALL_MAP_CLASSES[0] unless $str && $avail{$str}; + $map_class = $str; +} + +sub header_js { + return $map_class->header_js(@_); +} -# Run on module boot up -load(); +sub display_map { + return $map_class->display_map(@_); +} -# 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 display_map_end { + my ($type) = @_; + my $out = '</div>'; + $out .= '</form>' if ($type); + return $out; } sub header { - my ($q, $type) = @_; + 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 $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); + $encoding = ' enctype="multipart/form-data"' if $type == 2; + my $pc = ent($q->param('pc') || ''); + my $map = ent($q->param('map') || ''); 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"> +<input type="hidden" name="map" value="$map"> +<input type="hidden" name="pc" value="$pc"> $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 ( $q, $lat, $lon, $interval ) = @_; + + # TODO - be smarter about calculating the surrounding square + # use deltas that are roughly 500m in the UK - so we get a 1 sq km search box + my $lat_delta = 0.00438; + my $lon_delta = 0.00736; + + my $min_lat = $lat - $lat_delta; + my $max_lat = $lat + $lat_delta; + + my $min_lon = $lon - $lon_delta; + my $max_lon = $lon + $lon_delta; + + # list of problems around map can be limited, but should show all pins + my $around_limit # + = Cobrand::on_map_list_limit( Page::get_cobrand($q) ) || undef; + + my @around_args = ( $min_lat, $max_lat, $min_lon, $max_lon, $interval ); + my $around_map_list = Problems::around_map( @around_args, $around_limit ); + my $around_map = Problems::around_map( @around_args, 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 = + mySociety::Gaze::get_radius_containing_population( $lat, $lon, + 200000 ); }; - $dist = int($dist*10+0.5)/10; + $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); + my $limit = 20; + my @ids = map { $_->{id} } @$around_map_list; + my $nearby = Problems::nearby( $dist, join( ',', @ids ), + $limit, $lat, $lon, $interval ); - return ($around_map, $around_map_list, $nearby, $dist); + 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 +sub map_pins { + return $map_class->map_pins(@_); +} + +sub click_to_wgs84 { + return $map_class->click_to_wgs84(@_); +} + +sub tile_xy_to_wgs84 { + return $map_class->tile_xy_to_wgs84(@_); } 1; diff --git a/perllib/FixMyStreet/Map/Bing.pm b/perllib/FixMyStreet/Map/Bing.pm index 8446a10fd..335759b08 100644 --- a/perllib/FixMyStreet/Map/Bing.pm +++ b/perllib/FixMyStreet/Map/Bing.pm @@ -6,10 +6,9 @@ # Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::Bing; use strict; -use mySociety::GeoUtil; use mySociety::Web qw(ent); sub header_js { @@ -27,21 +26,29 @@ sub header_js { # 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) = @_; + my ($self, $q, %params) = @_; $params{pre} ||= ''; $params{post} ||= ''; + my @pins; foreach my $pin (@{$params{pins}}) { + $pin->[3] ||= ''; + push @pins, "[ $pin->[0], $pin->[1], '$pin->[2]', '$pin->[3]' ]"; } + my $pins_js = join(",\n", @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.'); + my $key = mySociety::Config::get('BING_MAPS_API_KEY'); $out .= <<EOF; +<input type="hidden" name="latitude" id="fixmystreet.latitude" value="$params{latitude}"> +<input type="hidden" name="longitude" id="fixmystreet.longitude" value="$params{longitude}"> <script type="text/javascript"> var fixmystreet = { - 'lat': $lat, - 'lon': $lon + 'key': '$key', + 'latitude': $params{latitude}, + 'longitude': $params{longitude}, + 'pins': [ $pins_js ] } </script> <div id="map_box"> @@ -55,17 +62,4 @@ 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 index 3939a710f..4e93243a9 100644 --- a/perllib/FixMyStreet/Map/BingOL.pm +++ b/perllib/FixMyStreet/Map/BingOL.pm @@ -1,12 +1,12 @@ #!/usr/bin/perl # -# FixMyStreet:Map::Bing -# Bing maps on FixMyStreet. +# FixMyStreet:Map::BingOL +# Bing maps on FixMyStreet, using OpenLayers. # -# Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. +# Copyright (c) 2011 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::BingOL; use strict; use mySociety::Web qw(ent); @@ -14,9 +14,9 @@ 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="/jslib/OpenLayers-2.10/OpenLayers.js"></script> +<script type="text/javascript" src="/js/map-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> '; } @@ -28,20 +28,27 @@ sub header_js { # 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) = @_; + my ($self, $q, %params) = @_; $params{pre} ||= ''; $params{post} ||= ''; + my @pins; foreach my $pin (@{$params{pins}}) { + $pin->[3] ||= ''; + push @pins, "[ $pin->[0], $pin->[1], '$pin->[2]', '$pin->[3]' ]"; } + my $pins_js = join(",\n", @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; +<input type="hidden" name="latitude" id="fixmystreet.latitude" value="$params{latitude}"> +<input type="hidden" name="longitude" id="fixmystreet.longitude" value="$params{longitude}"> <script type="text/javascript"> var fixmystreet = { - 'easting': $params{easting}, - 'northing': $params{northing} + 'latitude': $params{latitude}, + 'longitude': $params{longitude}, + 'pins': [ $pins_js ] } </script> <div id="map_box"> @@ -55,17 +62,4 @@ 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 index 7a314efad..35896108b 100644 --- a/perllib/FixMyStreet/Map/Google.pm +++ b/perllib/FixMyStreet/Map/Google.pm @@ -6,10 +6,9 @@ # Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::Google; use strict; -use mySociety::GeoUtil; use mySociety::Web qw(ent); sub header_js { @@ -27,21 +26,27 @@ sub header_js { # 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) = @_; + my ($self, $q, %params) = @_; $params{pre} ||= ''; $params{post} ||= ''; + my @pins; foreach my $pin (@{$params{pins}}) { + $pin->[3] ||= ''; + push @pins, "[ $pin->[0], $pin->[1], '$pin->[2]', '$pin->[3]' ]"; } + my $pins_js = join(",\n", @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; +<input type="hidden" name="latitude" id="fixmystreet.latitude" value="$params{latitude}"> +<input type="hidden" name="longitude" id="fixmystreet.longitude" value="$params{longitude}"> <script type="text/javascript"> var fixmystreet = { - 'lat': $lat, - 'lon': $lon + 'latitude': $params{latitude}, + 'longitude': $params{longitude}, + 'pins': [ $pins_js ] } </script> <div id="map_box"> @@ -55,17 +60,4 @@ 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 index ccbb3ca53..b930a4e4d 100644 --- a/perllib/FixMyStreet/Map/OSM.pm +++ b/perllib/FixMyStreet/Map/OSM.pm @@ -6,47 +6,95 @@ # Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::OSM; use strict; -use mySociety::Web qw(ent); +use Math::Trig; +use mySociety::Web qw(ent NewURL); +use Utils; sub header_js { return ' -<script type="text/javascript" src="http://openlayers.org/api/OpenLayers.js"></script> +<script type="text/javascript" src="/jslib/OpenLayers-2.10/OpenLayers.js"></script> +<script type="text/javascript" src="/js/map-OpenLayers.js"></script> <script type="text/javascript" src="/js/map-OpenStreetMap.js"></script> -<script type="text/javascript" src="/js/OpenLayers.Projection.OrdnanceSurvey.js"></script> '; } +sub map_type { + return 'OpenLayers.Layer.OSM.Mapnik'; +} + # display_map Q PARAMS # PARAMS include: -# EASTING, NORTHING for the centre point of the map +# latitude, longitude 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) = @_; + my ($self, $q, %params) = @_; $params{pre} ||= ''; $params{post} ||= ''; + # Map centre may be overridden in the query string + $params{latitude} = Utils::truncate_coordinate($q->param('lat')+0) + if defined $q->param('lat'); + $params{longitude} = Utils::truncate_coordinate($q->param('lon')+0) + if defined $q->param('lon'); + + my $zoom = defined $q->param('zoom') ? $q->param('zoom') : 2; + my $zoom_act = 14 + $zoom; + my ($x_tile, $y_tile) = latlon_to_tile_with_adjust($params{latitude}, $params{longitude}, $zoom_act); + + my $tl = ($x_tile-1) . "/" . ($y_tile-1); + my $tr = "$x_tile/" . ($y_tile-1); + my $bl = ($x_tile-1) . "/$y_tile"; + my $br = "$x_tile/$y_tile"; + my $tl_src = "http://a.tile.openstreetmap.org/$zoom_act/$tl.png"; + my $tr_src = "http://b.tile.openstreetmap.org/$zoom_act/$tr.png"; + my $bl_src = "http://c.tile.openstreetmap.org/$zoom_act/$bl.png"; + my $br_src = "http://tile.openstreetmap.org/$zoom_act/$br.png"; + map { s{/}{.} } ($tl, $tr, $bl, $br); + + my @pins; + my $pins = ''; foreach my $pin (@{$params{pins}}) { + $pin->[3] ||= ''; + push @pins, "[ $pin->[0], $pin->[1], '$pin->[2]', '$pin->[3]' ]"; + $pins .= display_pin($q, $pin, $x_tile, $y_tile, $zoom_act); } + my $pins_js = join(",\n", @pins); + my $img_type; + if ($params{type}) { + $img_type = '<input type="image"'; + } else { + $img_type = '<img'; + } 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>'); + my $copyright = _('Map © <a id="osm_link" href="http://www.openstreetmap.org/">OpenStreetMap</a> and contributors, <a href="http://creativecommons.org/licenses/by-sa/2.0/">CC-BY-SA</a>'); + my $compass = compass($q, $x_tile, $y_tile, $zoom); + my $map_type = $self->map_type(); $out .= <<EOF; +<input type="hidden" name="latitude" id="fixmystreet.latitude" value="$params{latitude}"> +<input type="hidden" name="longitude" id="fixmystreet.longitude" value="$params{longitude}"> +<input type="hidden" name="zoom" value="$zoom"> <script type="text/javascript"> var fixmystreet = { - 'easting': $params{easting}, - 'northing': $params{northing}, - 'map_type': OpenLayers.Layer.OSM.Mapnik + 'latitude': $params{latitude}, + 'longitude': $params{longitude}, + 'pins': [ $pins_js ], + 'map_type': $map_type } </script> <div id="map_box"> $params{pre} - <div id="map"></div> + <div id="map"><noscript> + <div id="drag">$img_type alt="NW map tile" id="t2.2" name="tile_$tl" src="$tl_src" style="top:0; left:0;">$img_type alt="NE map tile" id="t2.3" name="tile_$tr" src="$tr_src" style="top:0px; left:256px;"><br>$img_type alt="SW map tile" id="t3.2" name="tile_$bl" src="$bl_src" style="top:256px; left:0;">$img_type alt="SE map tile" id="t3.3" name="tile_$br" src="$br_src" style="top:256px; left:256px;"></div> + <div id="pins">$pins</div> + $compass + </noscript></div> <p id="copyright">$copyright</p> $params{post} </div> @@ -55,17 +103,123 @@ EOF return $out; } -sub display_map_end { - my ($type) = @_; - my $out = '</div>'; - $out .= '</form>' if ($type); +sub display_pin { + my ($q, $pin, $x_tile, $y_tile, $zoom) = @_; + + my ($px, $py) = latlon_to_px($pin->[0], $pin->[1], $x_tile, $y_tile, $zoom); + + my $num = ''; + my $host = Page::base_url_with_lang($q, undef); + my %cols = (red=>'R', green=>'G', blue=>'B', purple=>'P'); + my $out = '<img border="0" class="pin" src="' . $host . '/i/pin' . $cols{$pin->[2]} + . $num . '.gif" alt="' . _('Problem') . '" style="top:' . ($py-59) + . 'px; left:' . ($px) . 'px; position: absolute;">'; + return $out unless $pin->[3]; + my $cobrand = Page::get_cobrand($q); + my $url = Cobrand::url($cobrand, NewURL($q, -url => '/report/' . $pin->[3]), $q); + # XXX Would like to include title here in title="" + $out = '<a href="' . $url . '">' . $out . '</a>'; return $out; } -sub display_pin { +# Given a lat/lon, convert it to OSM tile co-ordinates (precise). +sub latlon_to_tile($$$) { + my ($lat, $lon, $zoom) = @_; + my $x_tile = ($lon + 180) / 360 * 2**$zoom; + my $y_tile = (1 - log(tan(deg2rad($lat)) + sec(deg2rad($lat))) / pi) / 2 * 2**$zoom; + return ( $x_tile, $y_tile ); +} + +# Given a lat/lon, convert it to OSM tile co-ordinates (nearest actual tile, +# adjusted so the point will be near the centre of a 2x2 tiled map). +sub latlon_to_tile_with_adjust($$$) { + my ($lat, $lon, $zoom) = @_; + my ($x_tile, $y_tile) = latlon_to_tile($lat, $lon, $zoom); + + # Try and have point near centre of map + if ($x_tile - int($x_tile) > 0.5) { + $x_tile += 1; + } + if ($y_tile - int($y_tile) > 0.5) { + $y_tile += 1; + } + + return ( int($x_tile), int($y_tile) ); +} + +sub tile_to_latlon { + my ($x, $y, $zoom) = @_; + my $n = 2 ** $zoom; + my $lon = $x / $n * 360 - 180; + my $lat = rad2deg(atan(sinh(pi * (1 - 2 * $y / $n)))); + return ( $lat, $lon ); +} + +# Given a lat/lon, convert it to pixel co-ordinates from the top left of the map +sub latlon_to_px($$$$$) { + my ($lat, $lon, $x_tile, $y_tile, $zoom) = @_; + my ($pin_x_tile, $pin_y_tile) = latlon_to_tile($lat, $lon, $zoom); + my $pin_x = tile_to_px($pin_x_tile, $x_tile); + my $pin_y = tile_to_px($pin_y_tile, $y_tile); + return ($pin_x, $pin_y); +} + +# 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) = @_; + $p = 256 * ($p - $c + 1); + $p = int($p + .5 * ($p <=> 0)); + return $p; } -sub map_pins { +sub click_to_tile { + my ($pin_tile, $pin) = @_; + $pin -= 256 while $pin > 256; + $pin += 256 while $pin < 0; + return $pin_tile + $pin / 256; +} + +# Given some click co-ords (the tile they were on, and where in the +# tile they were), convert to WGS84 and return. +sub click_to_wgs84 { + my ($self, $q, $pin_tile_x, $pin_x, $pin_tile_y, $pin_y) = @_; + my $tile_x = click_to_tile($pin_tile_x, $pin_x); + my $tile_y = click_to_tile($pin_tile_y, $pin_y); + my $zoom = 14 + (defined $q->param('zoom') ? $q->param('zoom') : 2); + my ($lat, $lon) = tile_to_latlon($tile_x, $tile_y, $zoom); + return ( $lat, $lon ); +} + +sub compass ($$$$) { + my ( $q, $x, $y, $zoom ) = @_; + + my ($lat, $lon) = map { Utils::truncate_coordinate($_) } tile_to_latlon($x, $y-1, $zoom+14); + my $north = NewURL( $q, lat => $lat, lon => $lon, zoom => $zoom ); + ($lat, $lon) = map { Utils::truncate_coordinate($_) } tile_to_latlon($x, $y+1, $zoom+14); + my $south = NewURL( $q, lat => $lat, lon => $lon, zoom => $zoom ); + ($lat, $lon) = map { Utils::truncate_coordinate($_) } tile_to_latlon($x-1, $y, $zoom+14); + my $west = NewURL( $q, lat => $lat, lon => $lon, zoom => $zoom ); + ($lat, $lon) = map { Utils::truncate_coordinate($_) } tile_to_latlon($x+1, $y, $zoom+14); + my $east = NewURL( $q, lat => $lat, lon => $lon, zoom => $zoom ); + ($lat, $lon) = map { Utils::truncate_coordinate($_) } tile_to_latlon($x, $y, $zoom+14); + my $zoom_in = $zoom < 3 ? NewURL( $q, lat => $lat, lon => $lon, zoom => $zoom+1 ) : '#'; + my $zoom_out = $zoom > 0 ? NewURL( $q, lat => $lat, lon => $lon, zoom => $zoom-1 ) : '#'; + my $world = NewURL( $q, lat => $lat, lon => $lon, zoom => 0 ); + + #my $host = Page::base_url_with_lang( $q, undef ); + my $dir = "/jslib/OpenLayers-2.10/img"; + return <<EOF; +<div style="position: absolute; left: 4px; top: 4px; z-index: 1007;" class="olControlPanZoom olControlNoSelect" unselectable="on"> + <div style="position: absolute; left: 13px; top: 4px; width: 18px; height: 18px;"><a href="$north"><img style="position: relative; width: 18px; height: 18px;" src="$dir/north-mini.png" border="0"></a></div> + <div style="position: absolute; left: 4px; top: 22px; width: 18px; height: 18px;"><a href="$west"><img style="position: relative; width: 18px; height: 18px;" src="$dir/west-mini.png" border="0"></a></div> + <div style="position: absolute; left: 22px; top: 22px; width: 18px; height: 18px;"><a href="$east"><img style="position: relative; width: 18px; height: 18px;" src="$dir/east-mini.png" border="0"></a></div> + <div style="position: absolute; left: 13px; top: 40px; width: 18px; height: 18px;"><a href="$south"><img style="position: relative; width: 18px; height: 18px;" src="$dir/south-mini.png" border="0"></a></div> + <div style="position: absolute; left: 13px; top: 63px; width: 18px; height: 18px;"><a href="$zoom_in"><img style="position: relative; width: 18px; height: 18px;" src="$dir/zoom-plus-mini.png" border="0"></a></div> + <div style="position: absolute; left: 13px; top: 81px; width: 18px; height: 18px;"><a href="$world"><img style="position: relative; width: 18px; height: 18px;" src="$dir/zoom-world-mini.png" border="0"></a></div> + <div style="position: absolute; left: 13px; top: 99px; width: 18px; height: 18px;"><a href="$zoom_out"><img style="position: relative; width: 18px; height: 18px;" src="$dir/zoom-minus-mini.png" border="0"></a></div> +</div> +EOF } 1; diff --git a/perllib/FixMyStreet/Map/OSM/CycleMap.pm b/perllib/FixMyStreet/Map/OSM/CycleMap.pm index 01c51acf4..06b07ae20 100644 --- a/perllib/FixMyStreet/Map/OSM/CycleMap.pm +++ b/perllib/FixMyStreet/Map/OSM/CycleMap.pm @@ -6,66 +6,13 @@ # Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::OSM::CycleMap; +use base 'FixMyStreet::Map::OSM'; 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 { +sub map_type { + return 'OpenLayers.Layer.OSM.CycleMap'; } 1; diff --git a/perllib/FixMyStreet/Map/OSM/StreetView.pm b/perllib/FixMyStreet/Map/OSM/StreetView.pm index 08f677d25..9c9a1ac8e 100644 --- a/perllib/FixMyStreet/Map/OSM/StreetView.pm +++ b/perllib/FixMyStreet/Map/OSM/StreetView.pm @@ -6,16 +6,16 @@ # Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::OSM::StreetView; 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="/jslib/OpenLayers-2.10/OpenLayers.js"></script> +<script type="text/javascript" src="/js/map-OpenLayers.js"></script> <script type="text/javascript" src="/js/map-streetview.js"></script> -<script type="text/javascript" src="/js/OpenLayers.Projection.OrdnanceSurvey.js"></script> '; } @@ -27,20 +27,27 @@ sub header_js { # 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) = @_; + my ($self, $q, %params) = @_; $params{pre} ||= ''; $params{post} ||= ''; + my @pins; foreach my $pin (@{$params{pins}}) { + $pin->[3] ||= ''; + push @pins, "[ $pin->[0], $pin->[1], '$pin->[2]', '$pin->[3]' ]"; } + my $pins_js = join(",\n", @pins); my $out = FixMyStreet::Map::header($q, $params{type}); my $copyright = _('Map contains Ordnance Survey data © Crown copyright and database right 2010.'); $out .= <<EOF; +<input type="hidden" name="latitude" id="fixmystreet.latitude" value="$params{latitude}"> +<input type="hidden" name="longitude" id="fixmystreet.longitude" value="$params{longitude}"> <script type="text/javascript"> var fixmystreet = { - 'easting': $params{easting}, - 'northing': $params{northing} + 'latitude': $params{latitude}, + 'longitude': $params{longitude}, + 'pins': [ $pins_js ] } </script> <div id="map_box"> @@ -54,17 +61,4 @@ 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 index b1fe0126d..9ae5829c4 100644 --- a/perllib/FixMyStreet/Map/Tilma/OL/1_10k.pm +++ b/perllib/FixMyStreet/Map/Tilma/OL/1_10k.pm @@ -6,7 +6,7 @@ # Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::Tilma::OL::1_10k; use strict; @@ -18,8 +18,10 @@ 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="/jslib/OpenLayers-2.10/OpenLayers.js"></script> +<script type="text/javascript" src="/js/map-OpenLayers.js"></script> <script type="text/javascript" src="/js/map-tilma-ol.js"></script> +<script type="text/javascript" src="/js/OpenLayers.Projection.OrdnanceSurvey.js"></script> '; } @@ -31,12 +33,16 @@ sub header_js { # 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) = @_; + my ($self, $q, %params) = @_; $params{pre} ||= ''; $params{post} ||= ''; + my @pins; foreach my $pin (@{$params{pins}}) { + $pin->[3] ||= ''; + push @pins, "[ $pin->[0], $pin->[1], '$pin->[2]', '$pin->[3]' ]"; } + my $pins_js = join(",\n", @pins); my $out = FixMyStreet::Map::header($q, $params{type}); my $tile_width = TILE_WIDTH; @@ -44,12 +50,15 @@ sub display_map { my $sf = SCALE_FACTOR / TILE_WIDTH; my $copyright = _('© Crown copyright. All rights reserved. Ministry of Justice 100037819 2008.'); $out .= <<EOF; +<input type="hidden" name="latitude" id="fixmystreet.latitude" value="$params{latitude}"> +<input type="hidden" name="longitude" id="fixmystreet.longitude" value="$params{longitude}"> <script type="text/javascript"> var fixmystreet = { 'tilewidth': $tile_width, 'tileheight': $tile_width, - 'easting': $params{easting}, - 'northing': $params{northing}, + 'latitude': $params{latitude}, + 'longitude': $params{longitude}, + 'pins': [ $pins_js ], 'tile_type': '$tile_type', 'maxResolution': $sf }; @@ -67,17 +76,4 @@ 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 index 7ef372351..7a898b55b 100644 --- a/perllib/FixMyStreet/Map/Tilma/OL/StreetView.pm +++ b/perllib/FixMyStreet/Map/Tilma/OL/StreetView.pm @@ -6,7 +6,7 @@ # Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::Tilma::OL::StreetView; use strict; @@ -18,8 +18,10 @@ 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="/jslib/OpenLayers-2.10/OpenLayers.js"></script> +<script type="text/javascript" src="/js/map-OpenLayers.js"></script> <script type="text/javascript" src="/js/map-tilma-ol.js"></script> +<script type="text/javascript" src="/js/OpenLayers.Projection.OrdnanceSurvey.js"></script> '; } @@ -31,12 +33,16 @@ sub header_js { # 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) = @_; + my ($self, $q, %params) = @_; $params{pre} ||= ''; $params{post} ||= ''; + my @pins; foreach my $pin (@{$params{pins}}) { + $pin->[3] ||= ''; + push @pins, "[ $pin->[0], $pin->[1], '$pin->[2]', '$pin->[3]' ]"; } + my $pins_js = join(",\n", @pins); my $out = FixMyStreet::Map::header($q, $params{type}); my $tile_width = TILE_WIDTH; @@ -44,12 +50,15 @@ sub display_map { my $sf = SCALE_FACTOR / TILE_WIDTH; my $copyright = _('Map contains Ordnance Survey data © Crown copyright and database right 2010.'); $out .= <<EOF; +<input type="hidden" name="latitude" id="fixmystreet.latitude" value="$params{latitude}"> +<input type="hidden" name="longitude" id="fixmystreet.longitude" value="$params{longitude}"> <script type="text/javascript"> var fixmystreet = { 'tilewidth': $tile_width, 'tileheight': $tile_width, - 'easting': $params{easting}, - 'northing': $params{northing}, + 'latitude': $params{latitude}, + 'longitude': $params{longitude}, + 'pins': [ $pins_js ], 'tile_type': '$tile_type', 'maxResolution': $sf }; @@ -65,17 +74,4 @@ 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 index 5772f6ccd..2a64b5bbb 100644 --- a/perllib/FixMyStreet/Map/Tilma/Original.pm +++ b/perllib/FixMyStreet/Map/Tilma/Original.pm @@ -6,13 +6,26 @@ # Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::Tilma::Original; use strict; use LWP::Simple; use Cobrand; +use mySociety::GeoUtil; +use mySociety::Locale; use mySociety::Web qw(ent NewURL); +use Utils; +use RABX; + +sub TILE_WIDTH() { return $FixMyStreet::Map::map_class->tile_width; } +sub SCALE_FACTOR() { return $FixMyStreet::Map::map_class->scale_factor; } +sub TILE_TYPE() { return $FixMyStreet::Map::map_class->tile_type; } + +sub _ll_to_en { + my ($lat, $lon) = @_; + return Utils::convert_latlon_to_en( $lat, $lon ); +} sub header_js { return ' @@ -22,13 +35,13 @@ sub header_js { # display_map Q PARAMS # PARAMS include: -# EASTING, NORTHING for the centre point of the map +# latitude, longitude 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) = @_; +sub display_map { + my ($self, $q, %params) = @_; $params{pre} ||= ''; $params{post} ||= ''; my $mid_point = TILE_WIDTH; # Map is 2 TILE_WIDTHs in size, square. @@ -36,19 +49,31 @@ sub _display_map { $mid_point = 189; } + # convert map center point to easting, northing + ( $params{easting}, $params{northing} ) = + _ll_to_en( $params{latitude}, $params{longitude} ); + + # FIXME - convert all pins to lat, lng + # all the pins are currently [lat, lng, colour] - convert them + foreach my $pin ( @{ $params{pins} ||= [] } ) { + my ( $lat, $lon ) = ( $pin->[0], $pin->[1] ); + my ( $e, $n ) = _ll_to_en( $lat, $lon ); + ( $pin->[0], $pin->[1] ) = ( $e, $n ); + } + # 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 ($x, $y, $px, $py) = 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]); + my $pin_x = os_to_px($pin->[0], $x); + my $pin_y = os_to_px($pin->[1], $y, 1); + $pins .= display_pin($q, $pin_x, $pin_y, $pin->[2]); } $px = defined($px) ? $mid_point - $px : 0; @@ -78,6 +103,8 @@ sub _display_map { $out .= <<EOF; <input type="hidden" name="x" id="formX" value="$x"> <input type="hidden" name="y" id="formY" value="$y"> +<input type="hidden" name="latitude" value="$params{latitude}"> +<input type="hidden" name="longitude" value="$params{longitude}"> EOF $img_type = '<input type="image"'; } else { @@ -106,9 +133,9 @@ $params{pre} <div id="pins">$pins</div> </div> EOF - $out .= '<div id="watermark"></div>' if $params{watermark}; + $out .= '<div id="watermark"></div>' if $self->watermark(); $out .= compass($q, $x, $y); - my $copyright = $params{copyright}; + my $copyright = $self->copyright(); $out .= <<EOF; </div> <p id="copyright">$copyright</p> @@ -119,13 +146,6 @@ 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; @@ -136,39 +156,38 @@ sub display_pin { . '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); + my $url = Cobrand::url($cobrand, NewURL($q, -url => '/report/' . $_->{id}), $q); $out = '<a title="' . ent($_->{title}) . '" href="' . $url . '">' . $out . '</a>'; return $out; } sub map_pins { - my ($q, $x, $y, $sx, $sy, $interval) = @_; + my ($self, $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 $e = tile_to_os($x); + my $n = tile_to_os($y); + + my ( $lat, $lon ) = Utils::convert_en_to_latlon( $e, $n ); + my ( $around_map, $around_map_list, $nearby, $dist ) = + FixMyStreet::Map::map_features( $q, $lat, $lon, $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); + ( $_->{easting}, $_->{northing} ) = + _ll_to_en( $_->{latitude}, $_->{longitude} ); + my $px = os_to_px($_->{easting}, $sx); + my $py = os_to_px($_->{northing}, $sy, 1); my $col = $_->{state} eq 'fixed' ? 'green' : 'red'; - $pins .= FixMyStreet::Map::display_pin($q, $px, $py, $col); + $pins .= 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); + ( $_->{easting}, $_->{northing} ) = + _ll_to_en( $_->{latitude}, $_->{longitude} ); + my $px = os_to_px($_->{easting}, $sx); + my $py = os_to_px($_->{northing}, $sy, 1); my $col = $_->{state} eq 'fixed' ? 'green' : 'red'; - $pins .= FixMyStreet::Map::display_pin($q, $px, $py, $col); + $pins .= display_pin($q, $px, $py, $col); } return ($pins, $around_map_list, $nearby, $dist); @@ -196,10 +215,30 @@ sub tile_to_px { sub os_to_tile { return $_[0] / SCALE_FACTOR; } + sub tile_to_os { return int($_[0] * SCALE_FACTOR + 0.5); } +=head2 tile_xy_to_wgs84 + + ($lat, $lon) = tile_xy_to_wgs84( $x, $y ); + +Takes the tile x,y and converts to lat, lon. + +=cut + +sub tile_xy_to_wgs84 { + my ( $self, $x, $y ) = @_; + + my $easting = tile_to_os($x); + my $northing = tile_to_os($y); + + my ( $lat, $lon ) = Utils::convert_en_to_latlon( $easting, $northing ); + return ( $lat, $lon ); +} + + sub click_to_tile { my ($pin_tile, $pin, $invert) = @_; $pin -= TILE_WIDTH while $pin > TILE_WIDTH; @@ -212,21 +251,31 @@ sub click_to_tile { # 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); + my $tile_x = click_to_tile($pin_tile_x, $pin_x); + my $tile_y = click_to_tile($pin_tile_y, $pin_y, 1); + my $easting = tile_to_os($tile_x); + my $northing = tile_to_os($tile_y); return ($easting, $northing); } +# Given some click co-ords (the tile they were on, and where in the +# tile they were), convert to WGS84 and return. +sub click_to_wgs84 { + my $self = shift; + my $q = shift; + my ( $easting, $northing ) = click_to_os(@_); + my ( $lat, $lon ) = mySociety::GeoUtil::national_grid_to_wgs84( $easting, $northing, 'G' ); + return ( $lat, $lon ); +} + # 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 = os_to_tile($easting); + my $y = os_to_tile($northing); my $x_tile = $in_x || int($x); my $y_tile = $in_y || int($y); @@ -238,20 +287,51 @@ sub os_to_px_with_adjust { $y_tile += 1; } - my $px = FixMyStreet::Map::os_to_px($easting, $x_tile); - my $py = FixMyStreet::Map::os_to_px($northing, $y_tile, 1); + my $px = os_to_px($easting, $x_tile); + my $py = 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); + $px = os_to_px($easting, $x_tile); } if (!$in_y && $py > 380) { $y_tile--; - $py = FixMyStreet::Map::os_to_px($northing, $y_tile, 1); + $py = os_to_px($northing, $y_tile, 1); } } return ($x_tile, $y_tile, $px, $py); } +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/Tilma/Original/1_10k.pm b/perllib/FixMyStreet/Map/Tilma/Original/1_10k.pm index f97163c68..722df2a46 100644 --- a/perllib/FixMyStreet/Map/Tilma/Original/1_10k.pm +++ b/perllib/FixMyStreet/Map/Tilma/Original/1_10k.pm @@ -6,23 +6,23 @@ # Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::Tilma::Original::1_10k; +use base 'FixMyStreet::Map::Tilma::Original'; 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 tile_width { return 254; } +sub tif_size_m { return 5000; } +sub tif_size_px { return 7874; } +sub scale_factor { return tif_size_m() / (tif_size_px() / tile_width()); } +sub tile_type { return '10k-full'; } -use FixMyStreet::Map::Tilma::Original; +sub copyright { + return _('© Crown copyright. All rights reserved. Ministry of Justice 100037819 2008.'); +} -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); +sub watermark { + return 1; } 1; diff --git a/perllib/FixMyStreet/Map/Tilma/Original/StreetView.pm b/perllib/FixMyStreet/Map/Tilma/Original/StreetView.pm index 103f4c15c..fe03fdb00 100644 --- a/perllib/FixMyStreet/Map/Tilma/Original/StreetView.pm +++ b/perllib/FixMyStreet/Map/Tilma/Original/StreetView.pm @@ -6,22 +6,23 @@ # Copyright (c) 2010 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ -package FixMyStreet::Map; +package FixMyStreet::Map::Tilma::Original::StreetView; +use base 'FixMyStreet::Map::Tilma::Original'; 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 tile_width { return 250; } +sub tif_size_m { return 5000; } +sub tif_size_px { return 5000; } +sub scale_factor { return tif_size_m() / (tif_size_px() / tile_width()); } +sub tile_type { return 'streetview'; } -use FixMyStreet::Map::Tilma::Original; +sub copyright { + return _('Map contains Ordnance Survey data © Crown copyright and database right 2010.'); +} -sub display_map { - my ($q, %params) = @_; - $params{copyright} = _('Map contains Ordnance Survey data © Crown copyright and database right 2010.'); - return _display_map($q, %params); +sub watermark { + return 0; } 1; diff --git a/perllib/Page.pm b/perllib/Page.pm index 817a56761..24c52885a 100644 --- a/perllib/Page.pm +++ b/perllib/Page.pm @@ -14,11 +14,14 @@ package Page; use strict; use Carp; use mySociety::CGIFast qw(-no_xhtml); +use Data::Dumper; +use Encode; use Error qw(:try); use File::Slurp; use HTTP::Date; # time2str use Image::Magick; use Image::Size; +use IO::String; use POSIX qw(strftime); use URI::Escape; use Text::Template; @@ -29,6 +32,7 @@ use Cobrand; use mySociety::Config; use mySociety::DBHandle qw/dbh select_all/; +use mySociety::Email; use mySociety::EvEl; use mySociety::Locale; use mySociety::MaPit; @@ -47,15 +51,19 @@ use FixMyStreet::Map; my $lastmodified; sub do_fastcgi { - my ($func, $lm) = @_; + my ($func, $lm, $binary) = @_; try { my $W = new mySociety::WatchUpdate(); - while (my $q = new mySociety::Web()) { + while (my $q = new mySociety::Web(unicode => 1)) { next if $lm && $q->Maybe304($lm); $lastmodified = $lm; microsite($q); + my $str_fh = IO::String->new; + my $old_fh = select($str_fh); &$func($q); + select($old_fh) if defined $old_fh; + print $binary ? ${$str_fh->string_ref} : encode_utf8(${$str_fh->string_ref}); dbh()->rollback() if $mySociety::DBHandle::conf_ok; $W->exit_if_changed(); } @@ -78,14 +86,17 @@ sub report_error { my $trylater = sprintf(_('Please try again later, or <a href="mailto:%s">email us</a> to let us know.'), $contact_email); my $somethingwrong = _("Sorry! Something's gone wrong."); my $errortext = _("The text of the error was:"); - print "Status: 500\nContent-Type: text/html; charset=iso-8859-1\n\n", + + my $msg_br = join '<br><br>', split m{\n}, $msg; + + print "Status: 500\nContent-Type: text/html; charset=utf-8\n\n", qq(<html><head><title>$somethingwrong</title></head></html>), q(<body>), qq(<h1>$somethingwrong</h1>), qq(<p>$trylater</p>), q(<hr>), qq(<p>$errortext</p>), - qq(<blockquote class="errortext">$msg</blockquote>), + qq(<blockquote class="errortext">$msg_br</blockquote>), q(</body></html>); } @@ -106,7 +117,9 @@ sub microsite { my $lang; $lang = 'cy' if $host =~ /cy/; $lang = 'en-gb' if $host =~ /^en\./; - Cobrand::set_lang_and_domain(get_cobrand($q), $lang); + Cobrand::set_lang_and_domain(get_cobrand($q), $lang, 1); + + FixMyStreet::Map::set_map_class($q->param('map')); Problems::set_site_restriction($q); Memcached::set_namespace(mySociety::Config::get('BCI_DB_NAME') . ":"); @@ -180,9 +193,8 @@ sub template_vars ($%) { my $lang_url = base_url_with_lang($q, 1); $lang_url .= $ENV{REQUEST_URI} if $ENV{REQUEST_URI}; - my $site_title = $q->{site} eq 'fixmystreet' - ? _('FixMyStreet') - : Cobrand::site_title(get_cobrand($q)); + my $site_title = Cobrand::site_title(get_cobrand($q)); + $site_title = _('FixMyStreet') unless $site_title; %vars = ( 'report' => _('Report a problem'), @@ -197,7 +209,7 @@ sub template_vars ($%) { 'lang_url' => $lang_url, 'title' => $params{title}, 'rss' => '', - map_js => FixMyStreet::Map::header_js(), + map_js => $params{js} || '', ); if ($params{rss}) { @@ -208,12 +220,10 @@ sub template_vars ($%) { $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="/">'; - $vars{heading} = _('Fix<span id="my">My</span>Street'); - $vars{heading_element_end} = $home ? '</h1>' : '</a></div>'; - } + 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="/">'; + $vars{heading} = _('Fix<span id="my">My</span>Street'); + $vars{heading_element_end} = $home ? '</h1>' : '</a></div>'; return \%vars; } @@ -249,28 +259,14 @@ sub template_include { return undef unless -e $template_file; $template = Text::Template->new( - SOURCE => $template_file, + TYPE => 'STRING', + # Don't use FILE, because we need to make sure it's Unicode characters + SOURCE => decode_utf8(File::Slurp::read_file($template_file)), DELIMITERS => ['{{', '}}'], ); return $template->fill_in(HASH => \%params); } -=item template_header TEMPLATE Q ROOT PARAMS - -Return HTML for the templated top of a page, given a -template name, request, template root, and parameters. - -=cut - -sub template_header($$$%) { - my ($template, $q, $template_root, %params) = @_; - $template = $q->{site} eq 'fixmystreet' - ? 'header' - : $template . '-header'; - my $vars = template_vars($q, %params); - return template_include($template, $q, $template_root, %$vars); -} - =item header Q [PARAM VALUE ...] Return HTML for the top of the page, given PARAMs (TITLE is required). @@ -282,7 +278,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 expires lastmodified template cachecontrol context status_code robots); + my %permitted_params = map { $_ => 1 } qw(title rss expires lastmodified template cachecontrol context status_code robots js); foreach (keys %params) { croak "bad parameter '$_'" if (!exists($permitted_params{$_})); } @@ -300,8 +296,8 @@ sub header ($%) { $params{title} = ent($params{title}); $params{lang} = $mySociety::Locale::lang; - my $template = template($q, %params); - my $html = template_header($template, $q, template_root($q), %params); + my $vars = template_vars($q, %params); + my $html = template_include('header', $q, template_root($q), %$vars); my $cache_val = $default_params{cachecontrol}; if (mySociety::Config::get('STAGING_SITE')) { $html .= '<p class="error">' . _("This is a developer site; things might break at any time, and the database will be periodically deleted.") . '</p>'; @@ -315,10 +311,28 @@ sub header ($%) { sub footer { my ($q, %params) = @_; - if ($q->{site} ne 'fixmystreet') { - my $template = template($q, %params) . '-footer'; - my $template_root = template_root($q); - my $html = template_include($template, $q, $template_root, %params); + my $pc = $q->param('pc') || ''; + $pc = '?pc=' . URI::Escape::uri_escape_utf8($pc) if $pc; + + my $creditline = _('Built by <a href="http://www.mysociety.org/">mySociety</a>, using some <a href="http://github.com/mysociety/fixmystreet">clever</a> <a href="https://secure.mysociety.org/cvstrac/dir?d=mysociety/services/TilMa">code</a>.'); + if (mySociety::Config::get('COUNTRY') eq 'NO') { + $creditline = _('Built by <a href="http://www.mysociety.org/">mySociety</a> and maintained by <a href="http://www.nuug.no/">NUUG</a>, using some <a href="http://github.com/mysociety/fixmystreet">clever</a> <a href="https://secure.mysociety.org/cvstrac/dir?d=mysociety/services/TilMa">code</a>.'); + } + + %params = (%params, + navigation => _('Navigation'), + report => _("Report a problem"), + reports => _("All reports"), + alerts => _("Local alerts"), + help => _("Help"), + contact => _("Contact"), + pc => $pc, + orglogo => _('<a href="http://www.mysociety.org/"><img id="logo" width="133" height="26" src="/i/mysociety-dark.png" alt="View mySociety.org"><span id="logoie"></span></a>'), + creditline => $creditline, + ); + + my $html = template_include('footer', $q, template_root($q), %params); + if ($html) { my $lang = $mySociety::Locale::lang; if ($q->{site} eq 'emptyhomes' && $lang eq 'cy') { $html =~ s/25 Walter Road<br>Swansea/25 Heol Walter<br>Abertawe/; @@ -326,9 +340,6 @@ sub footer { return $html; } - my $pc = $q->param('pc') || ''; - $pc = "?pc=" . ent($pc) if $pc; - my $piwik = ""; if (mySociety::Config::get('BASE_URL') eq "http://www.fixmystreet.com") { $piwik = <<EOF; @@ -347,29 +358,20 @@ piwikTracker.enableLinkTracking(); EOF } - my $navigation = _('Navigation'); - my $report = _("Report a problem"); - my $reports = _("All reports"); - my $alerts = _("Local alerts"); - my $help = _("Help"); - my $contact = _("Contact"); - my $orglogo = _('<a href="http://www.mysociety.org/"><img id="logo" width="133" height="26" src="/i/mysociety-dark.png" alt="View mySociety.org"><span id="logoie"></span></a>'); - my $creditline = _('Built by <a href="http://www.mysociety.org/">mySociety</a>, using some <a href="http://github.com/mysociety/fixmystreet">clever</a> <a href="https://secure.mysociety.org/cvstrac/dir?d=mysociety/services/TilMa">code</a>.'); - return <<EOF; </div></div> -<h2 class="v">$navigation</h2> +<h2 class="v">$params{navigation}</h2> <ul id="navigation"> -<li><a href="/">$report</a></li> -<li><a href="/reports">$reports</a></li> -<li><a href="/alert$pc">$alerts</a></li> -<li><a href="/faq">$help</a></li> -<li><a href="/contact">$contact</a></li> +<li><a href="/">$params{report}</a></li> +<li><a href="/reports">$params{reports}</a></li> +<li><a href="/alert$params{pc}">$params{alerts}</a></li> +<li><a href="/faq">$params{help}</a></li> +<li><a href="/contact">$params{contact}</a></li> </ul> -$orglogo +$params{orglogo} -<p id="footer">$creditline</p> +<p id="footer">$params{creditline}</p> $piwik @@ -390,24 +392,69 @@ sub error_page ($$) { } # send_email TO (NAME) TEMPLATE-NAME PARAMETERS -# TEMPLATE-NAME is currently one of problem, update, alert, tms +# TEMPLATE-NAME is a full filename here. sub send_email { - my ($q, $email, $name, $thing, %h) = @_; - my $file_thing = $thing; - $file_thing = 'empty property' if $q->{site} eq 'emptyhomes' && $thing eq 'problem'; # Needs to be in English - my $template = "$file_thing-confirm"; + my ($q, $recipient_email_address, $name, $template, %h) = @_; + $template = File::Slurp::read_file("$FindBin::Bin/../templates/emails/$template"); - my $to = $name ? [[$email, $name]] : $email; + my $to = $name ? [[$recipient_email_address, $name]] : $recipient_email_address; my $cobrand = get_cobrand($q); my $sender = Cobrand::contact_email($cobrand); my $sender_name = Cobrand::contact_name($cobrand); $sender =~ s/team/fms-DO-NOT-REPLY/; - mySociety::EvEl::send({ - _template_ => _($template), + + # Can send email either via EvEl (if configured) or via local MTA on + # machine. If EvEl fails (server down etc) fall back to local sending + + my $email_building_args = { + _template_ => _($template), _parameters_ => \%h, - From => [ $sender, _($sender_name)], - To => $to, - }, $email); + From => [ $sender, _($sender_name) ], + To => $to, + }; + + my $email_sent_successfully = 0; + + if ( my $EvEl_url = mySociety::Config::get('EVEL_URL') ) { + eval { + mySociety::EvEl::send( $email_building_args, $recipient_email_address ); + $email_sent_successfully = 1; + }; + + warn "ERROR: sending email via '$EvEl_url' failed: $@" if $@; + } + + # If not sent through EvEL, or EvEl failed + if ( !$email_sent_successfully ) { + my $email = mySociety::Locale::in_gb_locale { + mySociety::Email::construct_email( $email_building_args ); + }; + + my $send_email_result = + mySociety::EmailUtil::send_email( $email, $sender, $recipient_email_address ); + $email_sent_successfully = !$send_email_result; # invert result + } + + # Could not send email - die + if ( !$email_sent_successfully ) { + throw Error::Simple( + "Could not send email to '$recipient_email_address' " + . "using either EvEl or local MTA." + ); + } + +} + +# send_confirmation_email TO (NAME) TEMPLATE-NAME PARAMETERS +# TEMPLATE-NAME is currently one of problem, update, alert, tms +sub send_confirmation_email { + my ($q, $recipient_email_address, $name, $thing, %h) = @_; + + my $file_thing = $thing; + $file_thing = 'empty property' if $q->{site} eq 'emptyhomes' && $thing eq 'problem'; # Needs to be in English + my $template = "$file_thing-confirm"; + + send_email($q, $recipient_email_address, $name, $template, %h); my ($action, $worry); if ($thing eq 'problem') { @@ -433,6 +480,7 @@ if you do not, %s.</p> <p>(Don't worry — %s)</p> EOF + my $cobrand = get_cobrand($q); my %vars = ( action => $action, worry => $worry, @@ -454,13 +502,13 @@ sub prettify_epoch { if (strftime('%Y%m%d', @s) eq strftime('%Y%m%d', @t)) { $tt = "$tt " . _('today'); } elsif (strftime('%Y %U', @s) eq strftime('%Y %U', @t)) { - $tt = "$tt, " . strftime('%A', @s); + $tt = "$tt, " . decode_utf8(strftime('%A', @s)); } elsif ($short) { - $tt = "$tt, " . strftime('%e %b %Y', @s); + $tt = "$tt, " . decode_utf8(strftime('%e %b %Y', @s)); } elsif (strftime('%Y', @s) eq strftime('%Y', @t)) { - $tt = "$tt, " . strftime('%A %e %B %Y', @s); + $tt = "$tt, " . decode_utf8(strftime('%A %e %B %Y', @s)); } else { - $tt = "$tt, " . strftime('%a %e %B %Y', @s); + $tt = "$tt, " . decode_utf8(strftime('%a %e %B %Y', @s)); } return $tt; } @@ -479,17 +527,17 @@ sub prettify_duration { return _('less than a minute') if $s == 0; } my @out = (); - _part(\$s, 60*60*24*7, _('week'), \@out); - _part(\$s, 60*60*24, _('day'), \@out); - _part(\$s, 60*60, _('hour'), \@out); - _part(\$s, 60, _('minute'), \@out); + _part(\$s, 60*60*24*7, _('%d week'), _('%d weeks'), \@out); + _part(\$s, 60*60*24, _('%d day'), _('%d days'), \@out); + _part(\$s, 60*60, _('%d hour'), _('%d hours'), \@out); + _part(\$s, 60, _('%d minute'), _('%d minutes'), \@out); return join(', ', @out); } sub _part { - my ($s, $m, $w, $o) = @_; + my ($s, $m, $w1, $w2, $o) = @_; if ($$s >= $m) { my $i = int($$s / $m); - push @$o, "$i $w" . ($i != 1 ? 's' : ''); + push @$o, sprintf(mySociety::Locale::nget($w1, $w2, $i), $i); $$s -= $i * $m; } } @@ -507,17 +555,17 @@ sub display_problem_meta_line($$) { $out .= sprintf(_('%s, reported by %s at %s'), ent($category), ent($problem->{name}), $date_time); } } else { - if ($problem->{service} && $problem->{category} && $problem->{category} ne 'Other' && $problem->{anonymous}) { + if ($problem->{service} && $problem->{category} && $problem->{category} ne _('Other') && $problem->{anonymous}) { $out .= sprintf(_('Reported by %s in the %s category anonymously at %s'), ent($problem->{service}), ent($problem->{category}), $date_time); - } elsif ($problem->{service} && $problem->{category} && $problem->{category} ne 'Other') { + } elsif ($problem->{service} && $problem->{category} && $problem->{category} ne _('Other')) { $out .= sprintf(_('Reported by %s in the %s category by %s at %s'), ent($problem->{service}), ent($problem->{category}), ent($problem->{name}), $date_time); } elsif ($problem->{service} && $problem->{anonymous}) { $out .= sprintf(_('Reported by %s anonymously at %s'), ent($problem->{service}), $date_time); } elsif ($problem->{service}) { $out .= sprintf(_('Reported by %s by %s at %s'), ent($problem->{service}), ent($problem->{name}), $date_time); - } elsif ($problem->{category} && $problem->{category} ne 'Other' && $problem->{anonymous}) { + } elsif ($problem->{category} && $problem->{category} ne _('Other') && $problem->{anonymous}) { $out .= sprintf(_('Reported in the %s category anonymously at %s'), ent($problem->{category}), $date_time); - } elsif ($problem->{category} && $problem->{category} ne 'Other') { + } elsif ($problem->{category} && $problem->{category} ne _('Other')) { $out .= sprintf(_('Reported in the %s category by %s at %s'), ent($problem->{category}), ent($problem->{name}), $date_time); } elsif ($problem->{anonymous}) { $out .= sprintf(_('Reported anonymously at %s'), $date_time); @@ -638,21 +686,29 @@ sub mapit_check_error { return _('That postcode was not recognised, sorry.') if $location->{code} =~ /^4/; return $location->{error}; } - my $island = $location->{coordsyst}; - if (!$island) { - return _("Sorry, that appears to be a Crown dependency postcode, which we don't cover."); - } - if ($island eq 'I') { - return _("We do not cover Northern Ireland, I'm afraid, as our licence doesn't include any maps for the region."); + if (mySociety::Config::get('COUNTRY') eq 'GB') { + my $island = $location->{coordsyst}; + if (!$island) { + return _("Sorry, that appears to be a Crown dependency postcode, which we don't cover."); + } + if ($island eq 'I') { + return _("We do not cover Northern Ireland, I'm afraid, as our licence doesn't include any maps for the region."); + } } return 0; } sub short_name { - my $name = shift; + my ($area, $info) = @_; # Special case Durham as it's the only place with two councils of the same name - return 'Durham+County' if ($name eq 'Durham County Council'); - return 'Durham+City' if ($name eq 'Durham City Council'); + # And some places in Norway + return 'Durham+County' if $area->{name} eq 'Durham County Council'; + return 'Durham+City' if $area->{name} eq 'Durham City Council'; + if ($area->{name} =~ /^(Os|Nes|V\xe5ler|Sande|B\xf8|Her\xf8y)$/) { + my $parent = $info->{$area->{parent_area}}->{name}; + return URI::Escape::uri_escape_utf8("$area->{name}, $parent"); + } + my $name = $area->{name}; $name =~ s/ (Borough|City|District|County) Council$//; $name =~ s/ Council$//; $name =~ s/ & / and /; diff --git a/perllib/Problems.pm b/perllib/Problems.pm index 1556b7724..3710c3a95 100644 --- a/perllib/Problems.pm +++ b/perllib/Problems.pm @@ -12,6 +12,7 @@ package Problems; use strict; +use Encode; use Memcached; use mySociety::DBHandle qw/dbh select_all/; use mySociety::Locale; @@ -87,18 +88,21 @@ sub recent_new { # Front page recent lists sub recent_photos { - my ($num, $e, $n, $dist) = @_; + my ($num, $lat, $lon, $dist) = @_; my $probs; - if ($e) { - my $key = "recent_photos:$site_key:$num:$e:$n:$dist"; + if (defined $lat) { + my $dist2 = $dist; # Create a copy of the variable to stop it being stringified into a locale in the next line! + my $key = "recent_photos:$site_key:$num:$lat:$lon:$dist2"; $probs = Memcached::get($key); unless ($probs) { - $probs = select_all("select id, title + $probs = mySociety::Locale::in_gb_locale { + select_all("select id, title from problem_find_nearby(?, ?, ?) as nearby, problem where nearby.problem_id = problem.id and state in ('confirmed', 'fixed') and photo is not null $site_restriction - order by confirmed desc limit $num", $e, $n, $dist); + order by confirmed desc limit $num", $lat, $lon, $dist); + }; Memcached::set($key, $probs, 3600); } } else { @@ -170,46 +174,46 @@ sub front_stats { # Problems around a location sub around_map { - my ($min_e, $max_e, $min_n, $max_n, $interval, $limit) = @_; + my ($min_lat, $max_lat, $min_lon, $max_lon, $interval, $limit) = @_; my $limit_clause = ''; if ($limit) { $limit_clause = " limit $limit"; } mySociety::Locale::in_gb_locale { select_all( - "select id,title,easting,northing,state, + "select id,title,latitude,longitude,state, extract(epoch from confirmed) as time from problem where state in ('confirmed', 'fixed') - and easting>=? and easting<? and northing>=? and northing<? " . + and latitude>=? and latitude<? and longitude>=? and longitude<? " . ($interval ? " and ms_current_timestamp()-lastupdate < '$interval'::interval" : '') . " $site_restriction order by created desc - $limit_clause", $min_e, $max_e, $min_n, $max_n); + $limit_clause", $min_lat, $max_lat, $min_lon, $max_lon); }; } sub nearby { - my ($dist, $ids, $limit, $mid_e, $mid_n, $interval) = @_; + my ($dist, $ids, $limit, $mid_lat, $mid_lon, $interval) = @_; mySociety::Locale::in_gb_locale { select_all( - "select id, title, easting, northing, distance, state, + "select id, title, latitude, longitude, distance, state, extract(epoch from confirmed) as time from problem_find_nearby(?, ?, $dist) as nearby, problem where nearby.problem_id = problem.id " . ($interval ? " and ms_current_timestamp()-lastupdate < '$interval'::interval" : '') . " and state in ('confirmed', 'fixed')" . ($ids ? ' and id not in (' . $ids . ')' : '') . " $site_restriction - order by distance, created desc limit $limit", $mid_e, $mid_n); + order by distance, created desc limit $limit", $mid_lat, $mid_lon); } } sub fixed_nearby { - my ($dist, $mid_e, $mid_n) = @_; + my ($dist, $mid_lat, $mid_lon) = @_; mySociety::Locale::in_gb_locale { select_all( - "select id, title, easting, northing, distance + "select id, title, latitude, longitude, distance from problem_find_nearby(?, ?, $dist) as nearby, problem where nearby.problem_id = problem.id and state='fixed' $site_restriction - order by lastupdate desc", $mid_e, $mid_n); + order by lastupdate desc", $mid_lat, $mid_lon); } } @@ -218,7 +222,7 @@ sub fixed_nearby { sub fetch_problem { my $id = shift; my $p = dbh()->selectrow_hashref( - "select id, easting, northing, council, category, title, detail, photo, + "select id, latitude, longitude, council, category, title, detail, photo, used_map, name, anonymous, extract(epoch from confirmed) as time, state, extract(epoch from whensent-confirmed) as whensent, extract(epoch from ms_current_timestamp()-lastupdate) as duration, @@ -259,7 +263,7 @@ sub problems_matching_criteria { my $areas_info = mySociety::MaPit::call('areas', \@councils); foreach my $problem (@$problems){ if ($problem->{council}) { - my @council_names = map { $areas_info->{$_}->{name}} @{$problem->{council}} ; + my @council_names = map { $areas_info->{$_}->{name} } @{$problem->{council}} ; $problem->{council} = join(' and ', @council_names); } } diff --git a/perllib/Utils.pm b/perllib/Utils.pm index 24f4a6f94..21994d20b 100644 --- a/perllib/Utils.pm +++ b/perllib/Utils.pm @@ -13,18 +13,98 @@ package Utils; use strict; use mySociety::DBHandle qw(dbh); +use mySociety::GeoUtil; +use mySociety::Locale; sub workaround_pg_bytea { - my ($st, $img_idx, @elements) = @_; + my ( $st, $img_idx, @elements ) = @_; my $s = dbh()->prepare($st); - for (my $i=1; $i<=@elements; $i++) { - if ($i == $img_idx) { - $s->bind_param($i, $elements[$i-1], { pg_type => DBD::Pg::PG_BYTEA }); - } else { - $s->bind_param($i, $elements[$i-1]); + for ( my $i = 1 ; $i <= @elements ; $i++ ) { + if ( $i == $img_idx ) { + $s->bind_param( + $i, + $elements[ $i - 1 ], + { pg_type => DBD::Pg::PG_BYTEA } + ); + } + else { + $s->bind_param( $i, $elements[ $i - 1 ] ); } } $s->execute(); } +=head2 convert_latlon_to_en + + ( $easting, $northing ) = Utils::convert_en_to_latlon( $latitude, $longitude ); + +Takes the WGS84 latitude and longitude and returns OSGB36 easting and northing. + +=cut + +sub convert_latlon_to_en { + my ( $latitude, $longitude ) = @_; + + my ( $easting, $northing ) = + mySociety::Locale::in_gb_locale { + mySociety::GeoUtil::wgs84_to_national_grid( $latitude, $longitude, 'G' ); + }; + + return ( $easting, $northing ); +} + +=head2 convert_en_to_latlon + + ( $latitude, $longitude ) = Utils::convert_en_to_latlon( $easting, $northing ); + +Takes the OSGB36 easting and northing and returns WGS84 latitude and longitude. + +=cut + +sub convert_en_to_latlon { + my ( $easting, $northing ) = @_; + + my ( $latitude, $longitude ) = + + # map { truncate_coordinate($_) } + mySociety::GeoUtil::national_grid_to_wgs84( $easting, $northing, 'G' ); + + return ( $latitude, $longitude ); +} + +=head2 convert_en_to_latlon_truncated + + ( $lat, $lon ) = Utils::convert_en_to_latlon( $easting, $northing ); + +Takes the OSGB36 easting and northing and returns WGS84 latitude and longitude +(truncated using C<Utils::truncate_coordinate>). + +=cut + +sub convert_en_to_latlon_truncated { + my ( $easting, $northing ) = @_; + + return + map { truncate_coordinate($_) } + convert_en_to_latlon( $easting, $northing ); +} + +=head2 truncate_coordinate + + $short = Utils::truncate_coordinate( $long ); + +Given a long coordinate returns a shorter one - rounded to 6 decimal places - +which is < 1m at the equator, if you're using WGS84 lat/lon. + +=cut + +sub truncate_coordinate { + my $in = shift; + my $out = mySociety::Locale::in_gb_locale { + sprintf( '%0.6f', $in ); + }; + $out =~ s{\.?0+\z}{} if $out =~ m{\.}; + return $out; +} + 1; |