#!/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.59 2007-01-26 22:48:31 matthew Exp $
# TODO
# Nothing is done about the update checkboxes - not stored anywhere on anything!
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 POSIX qw(strftime);
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();
mySociety::MaPit::configure();
}
# Main code for index.cgi
sub main {
my $q = shift;
my $out = '';
my $title = '';
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')) {
$title = 'Viewing a problem';
$out = display_problem($q);
} elsif ($q->param('pc') || ($q->param('x') && $q->param('y'))) {
$title = 'Viewing a location';
$out = display_location($q);
} else {
$out = front_page($q);
}
print Page::header($q, $title);
print $out;
print Page::footer();
}
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:
Enter a postcode or street name and area;
Locate the problem on a high-scale map;
Enter details of the problem;
Submit to your council.
EOF
return $out;
}
sub submit_update {
my $q = shift;
my @vars = qw(id name email update fixed reopen);
my %input = map { $_ => $q->param($_) || '' } @vars;
my @errors;
push(@errors, 'Please enter a message') unless $input{update};
push(@errors, 'Please enter your name') unless $input{name};
if (!$input{email}) {
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, mark_open)
values (?, ?, ?, ?, ?, ?, 'unconfirmed', ?, ?)", {},
$id, $input{id}, $input{name}, $input{email}, '', $input{update},
$input{fixed}?'t':'f', $input{reopen}?'t':'f');
my %h = ();
$h{update} = $input{update};
$h{name} = $input{name};
$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-confirm', %h);
return $out;
}
sub submit_problem {
my $q = shift;
my @vars = qw(council title detail name email phone pc easting northing);
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+)$/;
push(@errors, 'Please enter a title') unless $input{title};
push(@errors, 'Please enter some details') unless $input{detail};
push(@errors, 'Please enter your name') unless $input{name};
if (!$input{email}) {
push(@errors, 'Please enter your email');
} elsif (!mySociety::Util::is_valid_email($input{email})) {
push(@errors, 'Please enter a valid email');
}
if ($input{easting} && $input{northing}) {
if ($input{council} != -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;
push(@errors, 'That location is not part of that council') unless $councils{$input{council}};
push(@errors, 'We do not yet have details for the council that covers that location') unless is_valid_council($input{council});
}
} elsif ($input{easting} || $input{northing}) {
push(@errors, 'Somehow, you only have one co-ordinate. Please try again.');
}
return display_form($q, @errors) if (@errors);
my $id = dbh()->selectrow_array("select nextval('problem_id_seq');");
my $image;
if ($fh) {
$image = Image::Magick->new;
$image->Read(file=>$fh);
close $fh;
$image->Scale(geometry=>"250x250>");
my @blobs = $image->ImageToBlob();
undef $image;
$image = $blobs[0];
}
delete $input{council} if $input{council} == -1;
# This is horrid
my $s = dbh()->prepare("insert into problem
(id, postcode, easting, northing, title, detail, name, email, phone, photo, state, council)
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->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-confirm', %h);
return $out;
}
sub display_form {
my ($q, @errors) = @_;
my ($pin_x, $pin_y, $pin_tile_x, $pin_tile_y);
my @vars = qw(title detail name email phone pc easting northing x y skipped council);
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 $input{skipped} || ($pin_x && $pin_y)
|| ($input{easting} && $input{northing});
my $out = '';
my ($px, $py, $easting, $northing);
if ($input{skipped}) {
my ($x, $y, $e, $n, $error) = geocode($input{pc});
$easting = $e; $northing = $n;
} elsif ($pin_x && $pin_y) {
# Map was clicked on
$pin_x = click_to_tile($pin_tile_x, $pin_x);
$pin_y = click_to_tile($pin_tile_y, $pin_y, 1);
$px = tile_to_px($pin_x, $input{x});
$py = tile_to_px($pin_y, $input{y});
$easting = tile_to_os($pin_x);
$northing = tile_to_os($pin_y);
} else {
# Normal form submission
$px = os_to_px($input{easting}, $input{x});
$py = 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);
my @councils = is_valid_council($all_councils);
if ($input{skipped}) {
$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 (@councils > 1) {
$out .= '
This spot lies in more than one council area; if you want, please choose which
council you wish to send the report to below:
';
$out .= '
';
my $c = 0;
# XXX: We don't know the order of display here!
foreach my $council (@councils) {
$out .= '
';
}
$out .= '
';
} elsif (@councils == 1) {
$out .= '
This problem will be reported to '
. $areas_info->{$councils[0]}->{name} . '.
';
$out .= '';
} else {
my $e = mySociety::Config::get('CONTACT_EMAIL');
my $list = join(', ', map { $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 your 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 .= '
Please fill in the form below with details of the problem, and
describe the location as precisely as possible in the details box.
';
} else {
$out .= '
Please fill in details of the problem below. Your 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 (ie. on a wall or the floor), and so on.
EOF
$out .= 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);
my $x = $input{x}; my $y = $input{y};
$x ||= 0; $x += 0;
$y ||= 0; $y += 0;
if (!$x && !$y) {
try {
($x, $y, $easting, $northing, $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 = display_map($q, $x, $y, 1, 1, $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 .= <
Receive email when updates are left on this problem
EOF
# Display updates
my $updates = select_all(
"select id, name, extract(epoch from created) as created, text, mark_fixed, mark_open
from comment where problem_id = ? and state='confirmed'
order by created desc", $input{id});
if (@$updates) {
$out .= '
';
$out .= '
Updates
';
foreach my $row (@$updates) {
$out .= "
{id}\">Posted by $row->{name} at " . prettify_epoch($row->{created});
$out .= ', marked fixed' if ($row->{mark_fixed});
$out .= ', reopened' if ($row->{mark_open});
$out .= '';
$out .= ' ' . $row->{text} . '
';
}
$out .= '
';
}
$out .= '
Provide an update
';
if (@errors) {
$out .= '
' . join('
', @errors) . '
';
}
my $fixed = ($input{fixed}) ? ' checked' : '';
my $reopen = ($input{reopen}) ? ' checked' : '';
my $fixedline = $state eq 'fixed' ? qq{
} : qq{
};
$out .= <
EOF
$out .= display_map_end(0);
return $out;
}
sub map_pins {
my ($q, $x, $y, $id) = @_;
my $pins = '';
my $min_e = tile_to_os($x);
my $min_n = tile_to_os($y);
my $mid_e = tile_to_os($x+1);
my $mid_n = tile_to_os($y+1);
my $max_e = tile_to_os($x+2);
my $max_n = 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>=? and northing
order by created desc limit 9", $min_e, $max_e, $min_n, $max_n);
my @ids = ();
my $count_prob = 1;
my $count_fixed = 1;
foreach (@$current_map) {
push(@ids, $_->{id});
my $px = os_to_px($_->{easting}, $x);
my $py = os_to_px($_->{northing}, $y);
if ($_->{id}==$id) {
$pins .= display_pin($q, $px, $py, 'blue');
} else {
$pins .= display_pin($q, $px, $py, 'red', $count_prob++);
}
}
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 limit $limit", $mid_e, $mid_n);
foreach (@$current) {
my $px = os_to_px($_->{easting}, $x);
my $py = os_to_px($_->{northing}, $y);
if ($_->{id}==$id) {
$pins .= display_pin($q, $px, $py, 'blue');
} else {
$pins .= 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 = os_to_px($_->{easting}, $x);
my $py = os_to_px($_->{northing}, $y);
if ($_->{id}==$id) {
$pins .= display_pin($q, $px, $py, 'blue');
} else {
$pins .= display_pin($q, $px, $py, 'green', $count_fixed++);
}
}
return ($pins, $current_map, $current, $fixed);
}
sub display_pin {
my ($q, $px, $py, $col, $num) = @_;
$num = '' unless $num;
my %cols = (red=>'R', green=>'G', blue=>'B', purple=>'P');
my $out = '';
return $out unless $_->{id} && $col ne 'blue';
my $url = NewURL($q, id=>$_->{id}, x=>undef, y=>undef);
$out = '' . $out . '';
return $out;
}
# display_map Q X Y TYPE COMPASS PINS
# X,Y is bottom left tile of 2x2 grid
# TYPE is 1 if the map is clickable, 0 if not
# COMPASS is 1 to show the compass, 0 to not
# PINS is HTML of pins to show
sub display_map {
my ($q, $x, $y, $type, $compass, $pins) = @_;
$pins ||= '';
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);
throw Error::Simple("Unable to get tiles from URL $tiles_url\n") 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;
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 ($type) {
my $encoding = '';
$encoding = ' enctype="multipart/form-data"' if ($type==2);
my $pc_enc = ent($q->param('pc'));
$out .= <
EOF
$img_type = '
var x = $x - 2; var y = $y - 2;
var drag_x = 0; var drag_y = 0;