#!/usr/bin/perl -w # index.cgi: # Main code for Neighbourhood Fix-It # # Copyright (c) 2006 UK Citizens Online Democracy. All rights reserved. # Email: matthew@mysociety.org. WWW: http://www.mysociety.org # # $Id: index.cgi,v 1.133 2007-05-15 13:43:21 matthew Exp $ use strict; require 5.8.0; # Horrible boilerplate to set up appropriate library paths. use FindBin; use lib "$FindBin::Bin/../perllib"; use lib "$FindBin::Bin/../../perllib"; use Error qw(:try); use File::Slurp; use Image::Magick; use LWP::Simple; use RABX; use CGI::Carp; use Digest::MD5 qw(md5_hex); use URI::Escape; use Page; use mySociety::AuthToken; use mySociety::Config; use mySociety::DBHandle qw(dbh select_all); use mySociety::GeoUtil; use mySociety::Util; use mySociety::MaPit; use mySociety::VotingArea; use mySociety::Web qw(ent NewURL); BEGIN { mySociety::Config::set_file("$FindBin::Bin/../conf/general"); mySociety::DBHandle::configure( Name => mySociety::Config::get('BCI_DB_NAME'), User => mySociety::Config::get('BCI_DB_USER'), Password => mySociety::Config::get('BCI_DB_PASS'), Host => mySociety::Config::get('BCI_DB_HOST', undef), Port => mySociety::Config::get('BCI_DB_PORT', undef) ); if (!dbh()->selectrow_array('select secret from secret for update of secret')) { local dbh()->{HandleError}; dbh()->do('insert into secret (secret) values (?)', {}, unpack('h*', mySociety::Util::random_bytes(32))); } dbh()->commit(); } # Main code for index.cgi sub main { my $q = shift; my $out = ''; my $title = ''; my %params; if ($q->param('submit_problem')) { $title = 'Submitting your problem'; $out = submit_problem($q); } elsif ($q->param('submit_update')) { $title = 'Submitting your update'; ($out) = submit_update($q); } elsif ($q->param('submit_map')) { $title = 'Reporting a problem'; $out = display_form($q); } elsif ($q->param('id')) { ($out, $title, %params) = display_problem($q); $title .= ' - Viewing a problem'; } elsif ($q->param('pc') || ($q->param('x') && $q->param('y'))) { $title = 'Viewing a location'; ($out, %params) = display_location($q); } else { $out = front_page($q); } print Page::header($q, $title, %params); print $out; print Page::footer(); dbh()->rollback(); } Page::do_fastcgi(\&main); # Display front page sub front_page { my ($q, $error) = @_; my $pc_h = ent($q->param('pc') || ''); my $out = <Report, view, or discuss local problems like graffiti, fly tipping, broken paving slabs, or street lighting

EOF $out .= '

' . $error . '

' if ($error); $out .= <    

Reports are sent directly to the local council, apart from a few councils where we’re missing details.

Reporting a problem is very simple:

  1. Enter a postcode or street name and area;
  2. Locate the problem on a high-scale map;
  3. Enter details of the problem;
  4. Submit to the council.
EOF return $out; } sub submit_update { my $q = shift; my @vars = qw(id name email update fixed); my %input = map { $_ => $q->param($_) || '' } @vars; my @errors; push(@errors, 'Please enter a message') unless $input{update} =~ /\S/; $input{name} = undef unless $input{name} =~ /\S/; if ($input{email} !~ /\S/) { push(@errors, 'Please enter your email'); } elsif (!mySociety::Util::is_valid_email($input{email})) { push(@errors, 'Please enter a valid email'); } return display_problem($q, @errors) if (@errors); my $id = dbh()->selectrow_array("select nextval('comment_id_seq');"); dbh()->do("insert into comment (id, problem_id, name, email, website, text, state, mark_fixed) values (?, ?, ?, ?, ?, ?, 'unconfirmed', ?)", {}, $id, $input{id}, $input{name}, $input{email}, '', $input{update}, $input{fixed}?'t':'f'); my %h = (); $h{update} = $input{update}; $h{name} = $input{name} ? $input{name} : "Anonymous"; $h{url} = mySociety::Config::get('BASE_URL') . '/C/' . mySociety::AuthToken::store('update', $id); dbh()->commit(); my $out = Page::send_email($input{email}, $input{name}, 'update', %h); return $out; } sub submit_problem { my $q = shift; my @vars = qw(council title detail name email phone pc easting northing skipped anonymous category); my %input = map { $_ => scalar $q->param($_) } @vars; my @errors; my $fh = $q->upload('photo'); if ($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'); push (@errors, 'Please upload a JPEG image only') unless ($ct eq 'image/jpeg' || $ct eq 'image/pjpeg'); } push(@errors, 'No council selected') unless ($input{council} && $input{council} =~ /^(?:-1|[\d,]+(?:\|[\d,]+)?)$/); push(@errors, 'Please enter a subject') unless $input{title} =~ /\S/; push(@errors, 'Please enter some details') unless $input{detail} =~ /\S/; push(@errors, 'Please enter your name') unless $input{name} =~ /\S/; if ($input{email} !~ /\S/) { push(@errors, 'Please enter your email'); } elsif (!mySociety::Util::is_valid_email($input{email})) { push(@errors, 'Please enter a valid email'); } if ($input{category} && $input{category} eq '-- Pick a category --') { push (@errors, 'Please choose a category'); $input{category} = ''; } if ($input{easting} && $input{northing}) { if ($input{council} =~ /^[\d,]+(\|[\d,]+)?$/) { my $no_details = $1 || ''; my $councils = mySociety::MaPit::get_voting_area_by_location_en($input{easting}, $input{northing}, 'polygon', $mySociety::VotingArea::council_parent_types); my %councils = map { $_ => 1 } @$councils; my @input_councils = split /,|\|/, $input{council}; foreach (@input_councils) { if (!$councils{$_}) { push(@errors, 'That location is not part of that council'); last; } } if ($no_details) { $input{council} =~ s/\Q$no_details\E//; @input_councils = split /,/, $input{council}; } # Check category here, won't be present if council is -1 my @valid_councils = @input_councils; if ($input{category}) { my $categories = select_all("select area_id from contacts where deleted='f' and area_id in (" . $input{council} . ') and category = ?', $input{category}); push (@errors, 'Please choose a category') unless @$categories; @valid_councils = map { $_->{area_id} } @$categories; foreach my $c (@valid_councils) { if ($no_details =~ /$c/) { push(@errors, 'We have details for that council'); $no_details =~ s/,?$c//; } } } $input{council} = join(',', @valid_councils) . $no_details; } } elsif ($input{easting} || $input{northing}) { push(@errors, 'Somehow, you only have one co-ordinate. Please try again.'); } else { push(@errors, 'You haven\'t specified any sort of co-ordinates. Please try again.'); } my $image; if ($fh) { try { $image = Image::Magick->new; my $err = $image->Read(file => \*$fh); # Mustn't be stringified close $fh; throw Error::Simple("read failed: $err") if "$err"; $err = $image->Scale(geometry => "250x250>"); throw Error::Simple("resize failed: $err") if "$err"; my @blobs = $image->ImageToBlob(); undef $image; $image = $blobs[0]; } catch Error::Simple with { my $e = shift; push(@errors, "That image doesn't appear to have uploaded correctly ($e), please try again."); }; } return display_form($q, @errors) if (@errors); delete $input{council} if $input{council} eq '-1'; my $used_map = $input{skipped} ? 'f' : 't'; $input{category} = 'Other' unless $input{category}; my $id = dbh()->selectrow_array("select nextval('problem_id_seq');"); # This is horrid my $s = dbh()->prepare("insert into problem (id, postcode, easting, northing, title, detail, name, email, phone, photo, state, council, used_map, anonymous, category) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, 'unconfirmed', ?, ?, ?, ?)"); $s->bind_param(1, $id); $s->bind_param(2, $input{pc}); $s->bind_param(3, $input{easting}); $s->bind_param(4, $input{northing}); $s->bind_param(5, $input{title}); $s->bind_param(6, $input{detail}); $s->bind_param(7, $input{name}); $s->bind_param(8, $input{email}); $s->bind_param(9, $input{phone}); $s->bind_param(10, $image, { pg_type => DBD::Pg::PG_BYTEA }); $s->bind_param(11, $input{council}); $s->bind_param(12, $used_map); $s->bind_param(13, $input{anonymous} ? 'f': 't'); $s->bind_param(14, $input{category}); $s->execute(); my %h = (); $h{title} = $input{title}; $h{detail} = $input{detail}; $h{name} = $input{name}; $h{url} = mySociety::Config::get('BASE_URL') . '/P/' . mySociety::AuthToken::store('problem', $id); dbh()->commit(); my $out = Page::send_email($input{email}, $input{name}, 'problem', %h); return $out; } sub display_form { my ($q, @errors) = @_; my ($pin_x, $pin_y, $pin_tile_x, $pin_tile_y) = (0,0,0,0); my @vars = qw(title detail name email phone pc easting northing x y skipped council anonymous); my %input = map { $_ => $q->param($_) || '' } @vars; my %input_h = map { $_ => $q->param($_) ? ent($q->param($_)) : '' } @vars; my @ps = $q->param; foreach (@ps) { ($pin_tile_x, $pin_tile_y, $pin_x) = ($1, $2, $q->param($_)) if /^tile_(\d+)\.(\d+)\.x$/; $pin_y = $q->param($_) if /\.y$/; } return display_location($q) unless ($pin_x && $pin_y) || ($input{easting} && $input{northing}) || ($input{skipped} && $input{x} && $input{y}) || ($input{skipped} && $input{pc}); my $out = ''; my ($px, $py, $easting, $northing, $island); if ($input{skipped}) { # Map is being skipped if ($input{x} && $input{y}) { $easting = Page::tile_to_os($input{x}); $northing = Page::tile_to_os($input{y}); } else { my ($x, $y, $e, $n, $i, $error) = geocode($input{pc}); $easting = $e; $northing = $n; $island = $i; } } elsif ($pin_x && $pin_y) { # Map was clicked on $pin_x = Page::click_to_tile($pin_tile_x, $pin_x); $pin_y = Page::click_to_tile($pin_tile_y, $pin_y, 1); $px = Page::tile_to_px($pin_x, $input{x}); $py = Page::tile_to_px($pin_y, $input{y}); $easting = Page::tile_to_os($pin_x); $northing = Page::tile_to_os($pin_y); } else { # Normal form submission $px = Page::os_to_px($input{easting}, $input{x}); $py = Page::os_to_px($input{northing}, $input{y}); $easting = $input_h{easting}; $northing = $input_h{northing}; } my $all_councils = mySociety::MaPit::get_voting_area_by_location_en($easting, $northing, 'polygon', $mySociety::VotingArea::council_parent_types); my $areas_info = mySociety::MaPit::get_voting_areas_info($all_councils); # Look up categories for this council or councils my $category = ''; my %council_ok; my $categories = select_all("select area_id, category from contacts where deleted='f' and area_id in (" . join(',', @$all_councils) . ')'); @$categories = sort { $a->{category} cmp $b->{category} } @$categories; my @categories; foreach (@$categories) { $council_ok{$_->{area_id}} = 1; next if $_->{category} eq 'Other'; push @categories, $_->{category}; } if (@categories) { @categories = ('-- Pick a category --', @categories, 'Other'); $category = $q->div($q->label({'for'=>'form_category'}, 'Category:'), $q->popup_menu(-name=>'category', -values=>\@categories, -attributes=>{id=>'form_category'}) ); } my @councils = keys %council_ok; my $details; if (@councils == @$all_councils) { $details = 'all'; } elsif (@councils == 0) { $details = 'none'; } else { $details = 'some'; } if ($input{skipped}) { $out .= <

Reporting a problem

EOF } else { my $pins = Page::display_pin($q, $px, $py, 'purple'); $out .= Page::display_map($q, x => $input{x}, y => $input{y}, type => 2, pins => $pins, px => $px, py => $py ); $out .= '

Reporting a problem

'; $out .= '

You have located the problem at the point marked with a purple pin on the map. If this is not the correct location, simply click on the map again.

'; } if ($details eq 'all') { $out .= '

All the details you provide here will be sent to ' . join(' or ', map { Page::canonicalise_council($areas_info->{$_}->{name}) } @$all_councils) . '. We show the subject and details of the problem on the site, along with your name if you give us permission.

'; $out .= ''; } elsif ($details eq 'some') { my $e = mySociety::Config::get('CONTACT_EMAIL'); my %councils = map { $_ => 1 } @councils; my @missing; foreach (@$all_councils) { push @missing, $_ unless $councils{$_}; } my $n = @missing; my $list = join(' or ', map { Page::canonicalise_council($areas_info->{$_}->{name}) } @missing); $out .= '

All the details you provide here will be sent to ' . join(' or ', map { Page::canonicalise_council($areas_info->{$_}->{name}) } @councils) . '. We show the subject and details of the problem on the site, along with your name if you give us permission.

'; $out .= ' We do not yet have details for the other council'; $out .= ($n>1) ? 's that cover' : ' that covers'; $out .= " this location. You can help us by finding a contact email address for local problems for $list and emailing it to us at $e.

"; $out .= ''; } else { my $e = mySociety::Config::get('CONTACT_EMAIL'); my $list = join(' or ', map { Page::canonicalise_council($areas_info->{$_}->{name}) } @$all_councils); my $n = @$all_councils; $out .= '

We do not yet have details for the council'; $out .= ($n>1) ? 's that cover' : ' that covers'; $out .= " this location. If you submit a problem here it will be left on the site, but not reported to the council. You can help us by finding a contact email address for local problems for $list and emailing it to us at $e.

"; $out .= ''; } if ($input{skipped}) { $out .= $q->p('Please fill in the form below with details of the problem, and describe the location as precisely as possible in the details box.'); } elsif ($details ne 'none') { $out .= $q->p('Please fill in details of the problem below. The council won\'t be able to help unless you leave as much detail as you can, so please describe the exact location of the problem (e.g. on a wall or the floor), and so on.'); } else { $out .= $q->p('Please fill in details of the problem below.'); } $out .= ' '; if (@errors) { $out .= '
  • ' . join('
  • ', @errors) . '
'; } my $back = NewURL($q, submit_map => undef, "tile_$pin_tile_x.$pin_tile_y.x" => undef, "tile_$pin_tile_x.$pin_tile_y.y" => undef, skipped => undef); my $anon = ($input{anonymous}) ? ' checked' : ($input{title} ? '' : ' checked'); $out .= <Problem details $category
(we never show your email address or phone number)
(optional, so the council can get in touch)

Back to listings

EOF $out .= Page::display_map_end(1); return $out; } sub display_location { my ($q, @errors) = @_; my @vars = qw(pc x y); my %input = map { $_ => $q->param($_) || '' } @vars; my %input_h = map { $_ => $q->param($_) ? ent($q->param($_)) : '' } @vars; my($error, $easting, $northing, $island); my $x = $input{x}; my $y = $input{y}; $x ||= 0; $x += 0; $y ||= 0; $y += 0; if (!$x && !$y) { try { ($x, $y, $easting, $northing, $island, $error) = geocode($input{pc}); } catch Error::Simple with { $error = shift; }; } return geocode_choice($error) if (ref($error) eq 'ARRAY'); return front_page($q, $error) if ($error); my ($pins, $current_map, $current, $fixed) = map_pins($q, $x, $y); my $out = Page::display_map($q, x => $x, y => $y, type => 1, pins => $pins ); $out .= '

Click on the map to report a problem

'; if (@errors) { $out .= '
  • ' . join('
  • ', @errors) . '
'; } my $skipurl = NewURL($q, 'submit_map'=>1, skipped=>1); $out .= <If you cannot see a map – if you have images turned off, or are using a text only browser, for example – and you wish to report a problem, please skip this step and we will ask you to describe the location of your problem instead.

EOF $out .= <

Recent problems reported on this map

EOF my $list = ''; foreach (@$current_map) { $list .= '
  • '; $list .= $_->{title}; $list .= '
  • '; } if (@$current_map) { $out .= '
      ' . $list . '
    '; } else { $out .= '

    No problems have been reported yet.

    '; } $out .= <Closest problems within 10km

    RSS feed

    EOF $list = ''; foreach (@$current) { $list .= '
  • '; $list .= $_->{title} . ' (c. ' . int($_->{distance}/100+.5)/10 . 'km)'; $list .= '
  • '; } if (@$current) { my $list_start = @$current_map + 1; $out .= '
      ' . $list . '
    '; } else { $out .= '

    No problems have been reported yet.

    '; } $out .= <Recently fixed problems within 10km EOF $list = ''; foreach (@$fixed) { $list .= '
  • '; $list .= $_->{title} . ' (c. ' . int($_->{distance}/100+.5)/10 . 'km)'; $list .= '
  • '; } if (@$fixed) { $out .= "
      $list
    \n"; } else { $out .= '

    No problems have been fixed yet

    '; } $out .= ''; $out .= Page::display_map_end(1); my %params = ( rss => [ 'Recent local problems, Neighbourhood Fix-It', "/rss/$x,$y" ] ); return ($out, %params); } sub display_problem { my ($q, @errors) = @_; my @vars = qw(id name email update fixed x y); my %input = map { $_ => $q->param($_) || '' } @vars; my %input_h = map { $_ => $q->param($_) ? ent($q->param($_)) : '' } @vars; $input{x} ||= 0; $input{x} += 0; $input{y} ||= 0; $input{y} += 0; # Get all information from database my $problem = dbh()->selectrow_hashref( "select state, easting, northing, title, detail, name, extract(epoch from confirmed) as time, photo, anonymous, extract(epoch from whensent-confirmed) as whensent, council, id, extract(epoch from ms_current_timestamp()-lastupdate) as duration from problem where id=? and state in ('confirmed','fixed', 'hidden')", {}, $input{id}); return display_location($q, 'Unknown problem ID') unless $problem; return front_page($q, 'That problem has been hidden from public view as it contained inappropriate public details') if $problem->{state} eq 'hidden'; my $x = Page::os_to_tile($problem->{easting}); my $y = Page::os_to_tile($problem->{northing}); my $x_tile = $input{x} || int($x); my $y_tile = $input{y} || int($y); my $px = Page::os_to_px($problem->{easting}, $x_tile); my $py = Page::os_to_px($problem->{northing}, $y_tile); my $out = ''; my $pins = Page::display_pin($q, $px, $py, 'blue'); $out .= Page::display_map($q, x => $x_tile, y => $y_tile, type => 0, pins => $pins, px => $px, py => $py ); $out .= $q->p({id => 'unknown'}, _('This problem is old and of unknown status.')) if $problem->{state} eq 'confirmed' && $problem->{duration} > 8*7*24*60*60; $out .= $q->p({id => 'fixed'}, _('This problem has been fixed.')) if $problem->{state} eq 'fixed'; $out .= Page::display_problem_text($q, $problem); $out .= $q->p({align=>'right'}, $q->small($q->a({href => '/contact?id=' . $input{id}}, 'Offensive? Unsuitable? Tell us')) ); my $back = NewURL($q, id=>undef, x=>$x_tile, y=>$y_tile); $out .= '

    Back to listings

    '; $out .= 'RSS feed of updates to this problem '; $out .= 'Email alerts of updates to this problem'; $out .= <

    Receive email when updates are left on this problem

    EOF $out .= Page::display_problem_updates($input{id}); $out .= '

    Provide an update

    '; $out .= $q->p($q->small('Please note that updates are not sent to the council.')); if (@errors) { $out .= '
    • ' . join('
    • ', @errors) . '
    '; } my $fixed = ($input{fixed}) ? ' checked' : ''; my $fixedline = $problem->{state} eq 'fixed' ? '' : qq{
    }; $out .= <
    Update details
    (optional)
    $fixedline
    EOF $out .= Page::display_map_end(0); my %params = ( rss => [ 'Updates to this problem, Neighbourhood Fix-It', "/rss/$input_h{id}" ] ); return ($out, $problem->{title}, %params); } sub map_pins { my ($q, $x, $y) = @_; my $pins = ''; my $min_e = Page::tile_to_os($x); my $min_n = Page::tile_to_os($y); my $mid_e = Page::tile_to_os($x+1); my $mid_n = Page::tile_to_os($y+1); my $max_e = Page::tile_to_os($x+2); my $max_n = Page::tile_to_os($y+2); my $current_map = select_all( "select id,title,easting,northing from problem where state='confirmed' and easting>=? and easting=? and northing{id}); my $px = Page::os_to_px($_->{easting}, $x); my $py = Page::os_to_px($_->{northing}, $y); $pins .= Page::display_pin($q, $px, $py, 'red', $count_prob++); } # XXX: Change to only show problems with extract(epoch from ms_current_timestamp()-lastupdate) < 8 weeks # And somehow display/link to old problems somewhere else... my $current = []; if (@$current_map < 9) { my $limit = 9 - @$current_map; $current = select_all( "select id, title, easting, northing, distance from problem_find_nearby(?, ?, 10) as nearby, problem where nearby.problem_id = problem.id and state = 'confirmed'" . (@ids ? ' and id not in (' . join(',' , @ids) . ')' : '') . " order by distance, created desc limit $limit", $mid_e, $mid_n); foreach (@$current) { my $px = Page::os_to_px($_->{easting}, $x); my $py = Page::os_to_px($_->{northing}, $y); $pins .= Page::display_pin($q, $px, $py, 'red', $count_prob++); } } my $fixed = select_all( "select id, title, easting, northing, distance from problem_find_nearby(?, ?, 10) as nearby, problem where nearby.problem_id = problem.id and state='fixed' order by created desc limit 9", $mid_e, $mid_n); foreach (@$fixed) { my $px = Page::os_to_px($_->{easting}, $x); my $py = Page::os_to_px($_->{northing}, $y); $pins .= Page::display_pin($q, $px, $py, 'green', $count_fixed++); } return ($pins, $current_map, $current, $fixed); } sub geocode_choice { my $choices = shift; my $out = '

    We found more than one match for that location:

      '; foreach my $choice (@$choices) { my $qs = $choice->[0]; my $text = $choice->[1]; $text =~ s/<\/?(?:b|i)>//g; $text =~ s/, United Kingdom//; $qs =~ s/,\+United\+Kingdom//; $out .= '
    • ' . $text . "
    • \n"; } $out .= '
    '; return $out; } sub geocode { my ($s) = @_; my ($x, $y, $easting, $northing, $island, $error); if (mySociety::Util::is_valid_postcode($s)) { try { my $location = mySociety::MaPit::get_location($s); $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, $island, $error); } sub geocode_string { my $s = shift; $s = lc($s); $s =~ s/[^-&0-9a-z ']/ /g; $s = uri_escape($s); $s =~ s/%20/+/g; my $url = 'http://maps.google.co.uk/maps?output=js&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$/; $js = LWP::Simple::get($url); File::Slurp::write_file($cache_file, $js) if $js; } if (!$js) { $error = 'Sorry, we had a problem parsing that location. Please try again.'; } elsif ($js =~ /suggest noprint/ && $js =~ /We could not understand/) { $error = $1; } elsif ($js =~ /suggest noprint/) { while ($js =~ /