#!/usr/bin/perl # # Page.pm: # Various HTML stuff for the BCI site. # # Copyright (c) 2006 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org; WWW: http://www.mysociety.org/ # # $Id: Page.pm,v 1.136 2009-01-26 14:22:54 matthew Exp $ # package Page; use strict; use Carp; use mySociety::CGIFast qw(-no_xhtml); use Error qw(:try); use File::Slurp; use HTTP::Date; use Image::Magick; use LWP::Simple; use Digest::MD5 qw(md5_hex); use POSIX qw(strftime); use URI::Escape; use Memcached; use Problems; use Utils; use mySociety::Config; use mySociety::DBHandle qw/dbh select_all/; use mySociety::EvEl; use mySociety::Gaze; use mySociety::GeoUtil; use mySociety::Locale; use mySociety::MaPit; use mySociety::PostcodeUtil; use mySociety::TempFiles; use mySociety::Tracking; use mySociety::WatchUpdate; use mySociety::Web qw(ent NewURL); BEGIN { mySociety::Config::set_file("$FindBin::Bin/../conf/general"); } my $lastmodified; sub do_fastcgi { my ($func, $lm) = @_; try { my $W = new mySociety::WatchUpdate(); while (my $q = new mySociety::Web()) { next if $lm && $q->Maybe304($lm); $lastmodified = $lm; microsite($q); &$func($q); dbh()->rollback() if $mySociety::DBHandle::conf_ok; $W->exit_if_changed(); } } catch Error::Simple with { report_error(@_); } catch Error with { report_error(@_); }; dbh()->rollback() if $mySociety::DBHandle::conf_ok; exit(0); } sub report_error { my $E = shift; my $msg = sprintf('%s:%d: %s', $E->file(), $E->line(), CGI::escapeHTML($E->text())); warn "caught fatal exception: $msg"; warn "aborting"; ent($msg); my $contact_email = mySociety::Config::get('CONTACT_EMAIL'); print "Status: 500\nContent-Type: text/html; charset=iso-8859-1\n\n", q(Sorry! Something's gone wrong.), q(), q(

Sorry! Something's gone wrong.

), qq(

Please try again later, or email us to let us know.

), q(
), q(

The text of the error was:

), qq(
$msg
), q(); } =item microsite Q Work out what site we're on, template appropriately =cut sub microsite { my $q = shift; my $host = $ENV{HTTP_HOST} || ''; $q->{site} = 'fixmystreet'; $q->{site} = 'scambs' if $host =~ /scambs/; $q->{site} = 'emptyhomes' if $host =~ /emptyhomes/; $q->{site} = 'guardian' if $host =~ /guardian/; if ($q->{site} eq 'emptyhomes') { mySociety::Locale::negotiate_language('en-gb,English,en_GB', 'en-gb'); mySociety::Locale::gettext_domain('FixMyStreet-EmptyHomes'); mySociety::Locale::change(); } else { mySociety::Locale::negotiate_language('en-gb,English,en_GB|nb,Norwegian,nb_NO'); # XXX Testing mySociety::Locale::gettext_domain('FixMyStreet'); mySociety::Locale::change(); } if ($q->{site} eq 'scambs') { Problems::set_site_restriction('scambs'); } Memcached::set_namespace(mySociety::Config::get('BCI_DB_NAME') . ":"); } =item header Q [PARAM VALUE ...] Return HTML for the top of the page, given PARAMs (TITLE is required). =cut sub header ($%) { my ($q, %params) = @_; my %permitted_params = map { $_ => 1 } qw(title rss js expires lastmodified); foreach (keys %params) { croak "bad parameter '$_'" if (!exists($permitted_params{$_})); } my $title = $params{title} || ''; $title .= ' - ' if $title; $title = ent($title); my $home = !$title && $ENV{SCRIPT_NAME} eq '/index.cgi' && !$ENV{QUERY_STRING}; my %head = (); $head{-expires} = $params{expires} if $params{expires}; $head{'-last-modified'} = time2str($params{lastmodified}) if $params{lastmodified}; $head{'-last-modified'} = time2str($lastmodified) if $lastmodified; print $q->header(%head); my $html; if ($q->{site} eq 'scambs' || $q->{site} eq 'emptyhomes' || $q->{site} eq 'guardian') { (my $file = __FILE__) =~ s{/[^/]*?$}{}; open FP, $file . '/../templates/website/' . $q->{site} . '-header'; $html = join('', ); close FP; $html =~ s##$title#; } else { $html = < ${title}FixMyStreet EOF $html .= $home ? '

' : '

' : ''; $html .= '
'; } if ($params{rss}) { $html =~ s###; } if (mySociety::Config::get('STAGING_SITE')) { $html .= '

This is a developer site; things might break at any time.

'; } return $html; } =item footer =cut sub footer { my ($q, %params) = @_; my $extra = $params{extra}; my $js = $params{js} || ''; $js = ''; # Don't use fileupload JS at the moment if ($q->{site} eq 'scambs' || $q->{site} eq 'emptyhomes' || $q->{site} eq 'guardian') { (my $file = __FILE__) =~ s{/[^/]*?$}{}; open FP, $file . '/../templates/website/' . $q->{site} . '-footer'; my $html = join('', ); close FP; return $html; } my $pc = $q->param('pc') || ''; $pc = "?pc=" . ent($pc) if $pc; $extra = $q->{scratch} if $q->{scratch}; # Overrides my $track = mySociety::Tracking::code($q, $extra); my $piwik = ""; if (mySociety::Config::get('BASE_URL') eq "http://www.fixmystreet.com") { $piwik = < EOF } return <

Navigation

$track $js $piwik EOF } =item error_page Q MESSAGE =cut sub error_page ($$) { my ($q, $message); my $html = header($q, title=>"Error") . $q->p($message) . footer($q); print $q->header(-content_length => length($html)), $html; } # display_map Q PARAMS # PARAMS include: # X,Y is bottom left tile of 2x2 grid # TYPE is 1 if the map is clickable, 2 if clickable and has a form upload, # 0 if not clickable # PINS is HTML of pins to show # PX,PY are coordinates of pin # PRE/POST are HTML to show above/below map sub display_map { my ($q, %params) = @_; $params{pins} ||= ''; $params{pre} ||= ''; $params{post} ||= ''; my $mid_point = 254; if ($q->{site} eq 'scambs') { # Map is c. 380px wide $mid_point = 189; } my $px = defined($params{px}) ? $mid_point - $params{px} : 0; my $py = defined($params{py}) ? $mid_point - $params{py} : 0; my $x = int($params{x})<=0 ? 0 : $params{x}; my $y = int($params{y})<=0 ? 0 : $params{y}; my $url = mySociety::Config::get('TILES_URL'); my $tiles_url = $url . $x . '-' . ($x+1) . ',' . $y . '-' . ($y+1) . '/RABX'; my $tiles = LWP::Simple::get($tiles_url); return '
' if !$tiles; my $tileids = RABX::unserialise($tiles); my $tl = $x . '.' . ($y+1); my $tr = ($x+1) . '.' . ($y+1); my $bl = $x . '.' . $y; my $br = ($x+1) . '.' . $y; return '
' if (!$tileids->[0][0] || !$tileids->[0][1] || !$tileids->[1][0] || !$tileids->[1][1]); my $tl_src = $url . $tileids->[0][0]; my $tr_src = $url . $tileids->[0][1]; my $bl_src = $url . $tileids->[1][0]; my $br_src = $url . $tileids->[1][1]; my $out = ''; my $img_type; if ($params{type}) { my $encoding = ''; $encoding = ' enctype="multipart/form-data"' if ($params{type}==2); my $pc = $q->param('pc') || ''; my $pc_enc = ent($pc); $out .= < EOF $img_type = ' var x = $x - 2; var y = $y - 2; var start_x = $px; var start_y = $py;
$params{pre}
$img_type alt="NW map tile" id="t2.2" name="tile_$tl" src="$tl_src" style="top:0px; left:0;">$img_type alt="NE map tile" id="t2.3" name="tile_$tr" src="$tr_src" style="top:0px; left:$imgw;">
$img_type alt="SW map tile" id="t3.2" name="tile_$bl" src="$bl_src" style="top:$imgh; left:0;">$img_type alt="SE map tile" id="t3.3" name="tile_$br" src="$br_src" style="top:$imgh; left:$imgw;">
$params{pins}
EOF $out .= '
'; $out .= compass($q, $x, $y); $out .= < $params{post} EOF $out .= '
'; $out .= '
'; return $out; } sub display_map_end { my ($type) = @_; my $out = '
'; $out .= '' if ($type); return $out; } sub display_pin { my ($q, $px, $py, $col, $num) = @_; $num = '' if !$num || $num > 9; my %cols = (red=>'R', green=>'G', blue=>'B', purple=>'P'); my $out = '' . _('Problem') . ''; return $out unless $_ && $_->{id} && $col ne 'blue'; my $url = '/report/' . $_->{id}; $out = '' . $out . ''; return $out; } sub map_pins { my ($q, $x, $y, $sx, $sy, $interval) = @_; my $pins = ''; my $min_e = Page::tile_to_os($x-2); # Extra space to left/below due to rounding, I think my $min_n = Page::tile_to_os($y-2); #my $map_le = Page::tile_to_os($x); #my $map_ln = Page::tile_to_os($y); my $mid_e = Page::tile_to_os($x+1); my $mid_n = Page::tile_to_os($y+1); #my $map_re = Page::tile_to_os($x+2); #my $map_rn = Page::tile_to_os($y+2); my $max_e = Page::tile_to_os($x+3); my $max_n = Page::tile_to_os($y+3); my $around_map = Problems::around_map($min_e, $max_e, $min_n, $max_n, $interval); my @ids = (); foreach (@$around_map) { push(@ids, $_->{id}); my $px = Page::os_to_px($_->{easting}, $sx); my $py = Page::os_to_px($_->{northing}, $sy, 1); my $col = $_->{state} eq 'fixed' ? 'green' : 'red'; $pins .= Page::display_pin($q, $px, $py, $col); } my ($lat, $lon) = mySociety::GeoUtil::national_grid_to_wgs84($mid_e, $mid_n, 'G'); my $dist = mySociety::Gaze::get_radius_containing_population($lat, $lon, 200000); $dist = int($dist*10+0.5)/10; my $limit = 20; # - @$current_map; my $nearby = Problems::nearby($dist, join(',', @ids), $limit, $mid_e, $mid_n, $interval); foreach (@$nearby) { my $px = Page::os_to_px($_->{easting}, $sx); my $py = Page::os_to_px($_->{northing}, $sy, 1); my $col = $_->{state} eq 'fixed' ? 'green' : 'red'; $pins .= Page::display_pin($q, $px, $py, $col); } return ($pins, $around_map, $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); return < NW N NE W Recentre E SW S SE EOF } # P is easting or northing # BL is bottom left tile reference of displayed map sub os_to_px { my ($p, $bl, $invert) = @_; return tile_to_px(os_to_tile($p), $bl, $invert); } # Convert tile co-ordinates to pixel co-ordinates from top left of map # BL is bottom left tile reference of displayed map sub tile_to_px { my ($p, $bl, $invert) = @_; $p = 254 * ($p - $bl); $p = 508 - $p if $invert; $p = int($p + .5 * ($p <=> 0)); return $p; } # Tile co-ordinates are linear scale of OS E/N # Will need more generalising when more zooms appear sub os_to_tile { return $_[0] / (5000/31); } sub tile_to_os { return $_[0] * (5000/31); } sub click_to_tile { my ($pin_tile, $pin, $invert) = @_; $pin -= 254 while $pin > 254; $pin += 254 while $pin < 0; $pin = 254 - $pin if $invert; # image submits measured from top down return $pin_tile + $pin / 254; } sub os_to_px_with_adjust { my ($q, $easting, $northing, $in_x, $in_y) = @_; my $x = Page::os_to_tile($easting); my $y = Page::os_to_tile($northing); my $x_tile = $in_x || int($x); my $y_tile = $in_y || int($y); my $px = Page::os_to_px($easting, $x_tile); my $py = Page::os_to_px($northing, $y_tile, 1); if ($q->{site} eq 'scambs') { # Map is 380px if ($py > 380) { $y_tile--; $py = Page::os_to_px($northing, $y_tile, 1); } if ($px > 380) { $x_tile--; $px = Page::os_to_px($easting, $x_tile); } } return ($x, $y, $x_tile, $y_tile, $px, $py); } # send_email TO (NAME) TEMPLATE-NAME PARAMETERS # TEMPLATE-NAME is currently one of _(problem), update, alert, tms sub send_email { my ($q, $email, $name, $thing, %h) = @_; my $template = "$thing-confirm"; $template = File::Slurp::read_file("$FindBin::Bin/../templates/emails/$template"); $template =~ s/FixMyStreet/Envirocrime/ if $q->{site} eq 'scambs'; my $to = $name ? [[$email, $name]] : $email; my $sender = mySociety::Config::get('CONTACT_EMAIL'); $sender =~ s/team/fms-DO-NOT-REPLY/; mySociety::EvEl::send({ _template_ => _($template), _parameters_ => \%h, From => [ $sender, _('FixMyStreet')], To => $to, }, $email); my $action = 'posted'; # problem, update if ($thing eq 'alert') { $action = 'activated'; } elsif ($thing eq 'tms') { $action = 'registered'; } $thing .= ' report' if $thing eq _('problem'); $thing = 'expression of interest' if $thing eq 'tms'; my $out = <Nearly Done! Now check your email...

The confirmation email may take a few minutes to arrive — please be patient.

If you use web-based email or have 'junk mail' filters, you may wish to check your bulk/spam mail folders: sometimes, our messages are marked that way.

You must now click the link in the email we've just sent you — if you do not, your $thing will not be $action.

(Don't worry — we'll hang on to your $thing while you're checking your email.)

EOF return $out; } sub prettify_epoch { my $s = shift; my @s = localtime($s); my $tt = strftime('%H:%M', @s); my @t = localtime(); 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); } elsif (strftime('%Y', @s) eq strftime('%Y', @t)) { $tt = "$tt, " . strftime('%A %e %B %Y', @s); } else { $tt = "$tt, " . strftime('%a %e %B %Y', @s); } return $tt; } # argument is duration in seconds, rounds to the nearest minute sub prettify_duration { my ($s, $nearest) = @_; if ($nearest eq 'week') { $s = int(($s+60*60*24*3.5)/60/60/24/7)*60*60*24*7; } elsif ($nearest eq 'day') { $s = int(($s+60*60*12)/60/60/24)*60*60*24; } elsif ($nearest eq 'hour') { $s = int(($s+60*30)/60/60)*60*60; } elsif ($nearest eq 'minute') { $s = int(($s+30)/60)*60; 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); return join(', ', @out); } sub _part { my ($s, $m, $w, $o) = @_; if ($$s >= $m) { my $i = int($$s / $m); push @$o, "$i $w" . ($i != 1 ? 's' : ''); $$s -= $i * $m; } } sub display_problem_text { my ($q, $problem) = @_; my $out = $q->h1(ent($problem->{title})); # Display information about problem $out .= '

'; if ($q->{site} eq 'emptyhomes') { $out .= ent($problem->{category}) . ', reported '; } else { $out .= 'Reported '; $out .= 'by ' . ent($problem->{service}) . ' ' if $problem->{service}; $out .= 'in the ' . ent($problem->{category}) . ' category ' if $problem->{category} && $problem->{category} ne 'Other'; } $out .= ($problem->{anonymous}) ? 'anonymously' : "by " . ent($problem->{name}); $out .= ' at ' . prettify_epoch($problem->{time}); $out .= '; the map was not used so pin location may be inaccurate' unless ($problem->{used_map}); if ($problem->{council}) { if ($problem->{whensent}) { $problem->{council} =~ s/\|.*//g; my @councils = split /,/, $problem->{council}; my $areas_info = mySociety::MaPit::get_voting_areas_info(\@councils); my $council = join(' and ', map { $areas_info->{$_}->{name} } @councils); $out .= $q->br() . $q->small('Sent to ' . $council . ' ' . prettify_duration($problem->{whensent}, 'minute') . ' later'); } } else { $out .= $q->br() . $q->small('Not reported to council'); } $out .= '

'; my $detail = $problem->{detail}; $detail =~ s/\r//g; foreach (split /\n{2,}/, $detail) { $out .= '

' . ent($_) . '

'; } if ($problem->{photo}) { $out .= '

'; } return $out; } # Display updates sub display_problem_updates { my $id = shift; my $updates = select_all( "select id, name, extract(epoch from created) as created, text, mark_fixed, mark_open, (photo is not null) as has_photo from comment where problem_id = ? and state='confirmed' order by created", $id); my $out = ''; if (@$updates) { $out .= '
'; $out .= '

Updates

'; foreach my $row (@$updates) { $out .= "

{id}\">"; if ($row->{name}) { $out .= sprintf(_('Posted by %s'), ent($row->{name})); } else { $out .= _("Posted anonymously"); } $out .= " at " . prettify_epoch($row->{created}); $out .= ', ' . _('marked as fixed') if ($row->{mark_fixed}); $out .= ', ' . _('reopened') if ($row->{mark_open}); $out .= '

'; my $text = $row->{text}; $text =~ s/\r//g; foreach (split /\n{2,}/, $text) { $out .= '

' . ent($_) . '

'; } if ($row->{has_photo}) { $out .= '

'; } $out .= '
'; } $out .= '
'; } return $out; } # geocode STRING # Given a user-inputted string, try and convert it into co-ordinates using either # MaPit if it's a postcode, or Google Maps API otherwise. Returns an array of # data, including an error if there is one (which includes a location being in # Northern Ireland). sub geocode { my ($s) = @_; my ($x, $y, $easting, $northing, $error); if (mySociety::PostcodeUtil::is_valid_postcode($s)) { try { my $location = mySociety::MaPit::get_location($s); my $island = $location->{coordsyst}; throw RABX::Error("We do not cover Northern Ireland, I'm afraid, as our licence doesn't include any maps for the region.") if $island eq 'I'; $easting = $location->{easting}; $northing = $location->{northing}; my $xx = Page::os_to_tile($easting); my $yy = Page::os_to_tile($northing); $x = int($xx); $y = int($yy); $x -= 1 if ($xx - $x < 0.5); $y -= 1 if ($yy - $y < 0.5); } catch RABX::Error with { my $e = shift; if ($e->value() && ($e->value() == mySociety::MaPit::BAD_POSTCODE || $e->value() == mySociety::MaPit::POSTCODE_NOT_FOUND)) { $error = 'That postcode was not recognised, sorry.'; } else { $error = $e; } } } else { ($x, $y, $easting, $northing, $error) = geocode_string($s); } return ($x, $y, $easting, $northing, $error); } # geocode_string STRING # 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. sub geocode_string { my $s = shift; $s = lc($s); $s =~ s/[^-&0-9a-z ']/ /g; $s =~ s/\s+/ /g; $s = uri_escape($s); $s =~ s/%20/+/g; my $url = 'http://maps.google.com/maps/geo?q=' . $s; my $cache_dir = mySociety::Config::get('GEO_CACHE'); my $cache_file = $cache_dir . md5_hex($url); my ($js, $error, $x, $y, $easting, $northing); if (-s $cache_file) { $js = File::Slurp::read_file($cache_file); } else { $url .= ',+United+Kingdom' unless $url =~ /united\++kingdom$/ || $url =~ /uk$/i; $url .= '&sensor=false&gl=uk&key=' . mySociety::Config::get('GOOGLE_MAPS_API_KEY'); $js = LWP::Simple::get($url); File::Slurp::write_file($cache_file, $js) if $js && $js !~ /"code":6[12]0/; } if (!$js) { $error = 'Sorry, we had a problem parsing that location. Please try again.'; } elsif ($js !~ /"code": *200/) { $error = 'Sorry, we could not find that location.'; } elsif ($js =~ /}, *{/) { # Multiple while ($js =~ /"address": *"(.*?)",\s*"AddressDetails":.*?"PostalCodeNumber": *"(.*?)"/g) { my $address = $1; my $pc = $2; $address =~ s/UK/$pc, UK/; push (@$error, $address) unless $address =~ /BT\d/; } $error = 'Sorry, we could not find that location.' unless $error; } elsif ($js =~ /BT\d/) { # Northern Ireland, hopefully $error = "We do not cover Northern Ireland, I'm afraid, as our licence doesn't include any maps for the region."; } else { my ($accuracy) = $js =~ /"Accuracy": *(\d)/; if ($accuracy < 4) { $error = 'Sorry, that location appears to be too general; please be more specific.'; } else { $js =~ /"coordinates" *: *\[ *(.*?), *(.*?),/; my $lon = $1; my $lat = $2; try { ($easting, $northing) = mySociety::GeoUtil::wgs84_to_national_grid($lat, $lon, 'G'); my $xx = Page::os_to_tile($easting); my $yy = Page::os_to_tile($northing); $x = int($xx); $y = int($yy); $x -= 1 if ($xx - $x < 0.5); $y -= 1 if ($yy - $y < 0.5); } catch Error::Simple with { $error = shift; $error = "That location doesn't appear to be in Britain; please try again." if $error =~ /out of the area covered/; } } } return ($x, $y, $easting, $northing, $error); } # geocode_choice # Prints response if there's more than one possible result sub geocode_choice { my ($choices, $page) = @_; my $out = '

We found more than one match for that location. We show up to ten matches, please try a different search if yours is not here.

    '; foreach my $choice (@$choices) { $choice =~ s/, United Kingdom//; $choice =~ s/, UK//; my $url = uri_escape($choice); $url =~ s/%20/+/g; $out .= '
  • ' . $choice . "
  • \n"; } $out .= '
'; return $out; } sub short_name { my $name = shift; # 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'); $name =~ s/ (Borough|City|District|County) Council$//; $name =~ s/ Council$//; $name =~ s/ & / and /; $name = uri_escape($name); $name =~ s/%20/+/g; return $name; } sub check_photo { my ($q, $fh) = @_; my $ct = $q->uploadInfo($fh)->{'Content-Type'}; my $cd = $q->uploadInfo($fh)->{'Content-Disposition'}; # Must delete photo param, otherwise display functions get confused $q->delete('photo'); return 'Please upload a JPEG image only' unless ($ct eq 'image/jpeg' || $ct eq 'image/pjpeg'); return ''; } sub process_photo { my $fh = shift; my $import = shift; my $photo = Image::Magick->new; my $err = $photo->Read(file => \*$fh); # Mustn't be stringified close $fh; throw Error::Simple("read failed: $err") if "$err"; $err = $photo->Scale(geometry => "250x250>"); throw Error::Simple("resize failed: $err") if "$err"; my @blobs = $photo->ImageToBlob(); undef $photo; $photo = $blobs[0]; return $photo unless $import; # Only check orientation for iPhone imports at present # Now check if it needs orientating my $filename; ($fh, $filename) = mySociety::TempFiles::named_tempfile('.jpeg'); print $fh $photo; close $fh; my $out = `jhead -se -autorot $filename`; if ($out) { open(FP, $filename) or die $!; $photo = join('', ); close FP; } unlink $filename; return $photo; } sub scambs_categories { return ('Abandoned vehicles', 'Discarded hypodermic needles', 'Dog fouling', 'Flytipping', 'Graffiti', 'Lighting (e.g. security lights)', 'Litter', 'Neighbourhood noise'); } 1;