diff options
Diffstat (limited to 'perllib')
| -rw-r--r-- | perllib/Carp/Always.pm | 162 | ||||
| -rw-r--r-- | perllib/Cobrands/Barnet/Util.pm | 8 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Alert.pm | 14 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Geocode.pm | 36 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map.pm | 93 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Map/Tilma/Original.pm | 57 | ||||
| -rw-r--r-- | perllib/Page.pm | 5 | ||||
| -rw-r--r-- | perllib/Problems.pm | 30 | ||||
| -rw-r--r-- | perllib/Utils.pm | 70 |
9 files changed, 382 insertions, 93 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/Cobrands/Barnet/Util.pm b/perllib/Cobrands/Barnet/Util.pm index 32973c10c..8ce296aaf 100644 --- a/perllib/Cobrands/Barnet/Util.pm +++ b/perllib/Cobrands/Barnet/Util.pm @@ -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/FixMyStreet/Alert.pm b/perllib/FixMyStreet/Alert.pm index b9c124741..90a5b1aaa 100644 --- a/perllib/FixMyStreet/Alert.pm +++ b/perllib/FixMyStreet/Alert.pm @@ -184,12 +184,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} ); @@ -202,7 +201,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"; @@ -310,9 +309,8 @@ sub generate_rss ($$$;$$$$) { } $item{description} .= ent("\n<br><a href='$cobrand_url'>Report on FixMyStreet</a>"); - if ($row->{easting} && $row->{northing}) { - my ($lat,$lon) = mySociety::GeoUtil::national_grid_to_wgs84($row->{easting}, $row->{northing}, 'G'); - $item{georss} = { point => "$lat $lon" }; + 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 4854411cf..0379169b8 100644 --- a/perllib/FixMyStreet/Geocode.pm +++ b/perllib/FixMyStreet/Geocode.pm @@ -37,40 +37,32 @@ BEGIN { # of the site to diambiguate locations. sub lookup { my ($s, $q) = @_; - my ($easting, $northing, $error); + my ($latitude, $longitude, $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}; + $latitude = $location->{wgs84_lat}; + $longitude = $location->{wgs84_lon}; } } else { - ($easting, $northing, $error) = FixMyStreet::Geocode::string($s, $q); + ($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 { - - $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); + } elsif ( $js =~ /"coordinates" *: *\[ *(.*?), *(.*?),/ ) { + $longitude = $1; + $latitude = $2; + } + return ($latitude, $longitude, $error); } # string STRING QUERY @@ -90,7 +82,7 @@ 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, $latitude, $longitude); if (-s $cache_file) { $js = File::Slurp::read_file($cache_file); } else { @@ -123,9 +115,9 @@ sub string { # 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); + ($latitude, $longitude, $error) = geocoded_string_coordinates($js, $q); } - return ($easting, $northing, $error); + return ($latitude, $longitude, $error); } # list_choices diff --git a/perllib/FixMyStreet/Map.pm b/perllib/FixMyStreet/Map.pm index 12ecf78fe..0902914dd 100644 --- a/perllib/FixMyStreet/Map.pm +++ b/perllib/FixMyStreet/Map.pm @@ -14,29 +14,34 @@ use Problems; use Cobrand; use mySociety::Config; use mySociety::Gaze; -use mySociety::GeoUtil; +use mySociety::GeoUtil qw(national_grid_to_wgs84); use mySociety::Locale; use mySociety::Web qw(ent NewURL); +use Utils; # Run on module boot up load(); # This is yucky, but no-one's taught me a better way sub load { - my $type = mySociety::Config::get('MAP_TYPE'); + my $type = mySociety::Config::get('MAP_TYPE'); my $class = "FixMyStreet::Map::$type"; eval "use $class"; + + # If we have an error die as it is a compile error rather than runtime error + die $@ if $@; } 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; + $encoding = ' enctype="multipart/form-data"' if $type == 2; my $pc = $q->param('pc') || ''; my $pc_enc = ent($pc); return <<EOF; @@ -47,49 +52,67 @@ $cobrand_form_elements EOF } +=head2 map_features_easting_northing + +Wrapper around map_features which does the easting, northing to lat, lon +conversion. + +=cut + +sub map_features_easting_northing { + my ( $q, $easting, $northing, $interval ) = @_; + my ( $lat, $lon ) = Utils::convert_en_to_latlon( $easting, $northing ); + return map_features( $q, $lat, $lon, $interval ); +} + 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 ( $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); + 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); + my $host = Page::base_url_with_lang( $q, undef ); return <<EOF; <table cellpadding="0" cellspacing="0" border="0" id="compass"> <tr valign="bottom"> diff --git a/perllib/FixMyStreet/Map/Tilma/Original.pm b/perllib/FixMyStreet/Map/Tilma/Original.pm index 5772f6ccd..81b123b30 100644 --- a/perllib/FixMyStreet/Map/Tilma/Original.pm +++ b/perllib/FixMyStreet/Map/Tilma/Original.pm @@ -13,6 +13,13 @@ use LWP::Simple; use Cobrand; use mySociety::Web qw(ent NewURL); +use mySociety::GeoUtil; +use Utils; + +sub _ll_to_en { + my ($lat, $lon) = @_; + return mySociety::GeoUtil::wgs84_to_national_grid( $lat, $lon, 'G' ); +} sub header_js { return ' @@ -22,7 +29,7 @@ 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 @@ -36,6 +43,18 @@ 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; @@ -154,10 +173,14 @@ sub map_pins { 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 ( $around_map, $around_map_list, $nearby, $dist ) = + FixMyStreet::Map::map_features_easting_northing( $q, $e, $n, $interval ); my $pins = ''; foreach (@$around_map) { + ( $_->{easting}, $_->{northing} ) = + _ll_to_en( $_->{latitude}, $_->{longitude} ); my $px = FixMyStreet::Map::os_to_px($_->{easting}, $sx); my $py = FixMyStreet::Map::os_to_px($_->{northing}, $sy, 1); my $col = $_->{state} eq 'fixed' ? 'green' : 'red'; @@ -165,6 +188,8 @@ sub map_pins { } foreach (@$nearby) { + ( $_->{easting}, $_->{northing} ) = + _ll_to_en( $_->{latitude}, $_->{longitude} ); my $px = FixMyStreet::Map::os_to_px($_->{easting}, $sx); my $py = FixMyStreet::Map::os_to_px($_->{northing}, $sy, 1); my $col = $_->{state} eq 'fixed' ? 'green' : 'red'; @@ -196,10 +221,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 ( $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; @@ -219,6 +264,14 @@ sub click_to_os { 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 ( $easting, $northing ) = FixMyStreet::Map::click_to_os(@_); + my ( $lat, $lon ) = 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. diff --git a/perllib/Page.pm b/perllib/Page.pm index b3f320f5d..fc7127a78 100644 --- a/perllib/Page.pm +++ b/perllib/Page.pm @@ -80,6 +80,9 @@ 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:"); + + my $msg_br = join '<br><br>', split m{\n}, $msg; + print "Status: 500\nContent-Type: text/html; charset=iso-8859-1\n\n", qq(<html><head><title>$somethingwrong</title></head></html>), q(<body>), @@ -87,7 +90,7 @@ sub report_error { 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>); } diff --git a/perllib/Problems.pm b/perllib/Problems.pm index 1556b7724..8c6eeccad 100644 --- a/perllib/Problems.pm +++ b/perllib/Problems.pm @@ -87,10 +87,10 @@ 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 $key = "recent_photos:$site_key:$num:$lat:$lon:$dist"; $probs = Memcached::get($key); unless ($probs) { $probs = select_all("select id, title @@ -98,7 +98,7 @@ sub recent_photos { 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 +170,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 +218,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, diff --git a/perllib/Utils.pm b/perllib/Utils.pm index 24f4a6f94..d54e081c8 100644 --- a/perllib/Utils.pm +++ b/perllib/Utils.pm @@ -13,18 +13,76 @@ package Utils; use strict; use mySociety::DBHandle qw(dbh); +use mySociety::GeoUtil; 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_en_to_latlon + + ( $latitude, $longitude ) = Utils::convert_en_to_latlon( $easting, $northing ); + +Takes the easting and northing and returns 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 easting and northing and returns 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. + +=cut + +sub truncate_coordinate { + my $in = shift; + my $out = sprintf( '%0.6f', $in ); + $out =~ s{\.?0+\z}{} if $out =~ m{\.}; + return $out; +} + 1; |