#!/usr/bin/perl -w
# index.pl:
# 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.24 2006-09-25 18:39:54 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 LWP::Simple;
use RABX;
use POSIX qw(strftime);
use CGI::Carp;
use Page;
use mySociety::Config;
use mySociety::DBHandle qw(dbh select_all);
use mySociety::Util;
use mySociety::MaPit;
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')) {
$out = submit_problem($q);
} elsif ($q->param('submit_comment')) {
$out = submit_comment($q);
} elsif ($q->param('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')) {
$title = 'Map';
$out = display($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 or view local problems
like graffiti, fly tipping, broken paving slabs, or street lighting
EOF
$out .= '
' . $error . 'Please try again.
' if ($error);
$out .= <
Reports are sent directly to your local council – at the moment, we only cover Newham, Lewisham, and Islington councils.
Reporting a problem is hopefully very simple:
Enter a postcode;
Locate the problem on a high-scale map;
Enter details of the problem;
Submit to your council.
EOF
return $out;
}
sub submit_comment {
my $q = shift;
my @vars = qw(id name email comment updates);
my %input = map { $_ => $q->param($_) } @vars;
my @errors;
push(@errors, 'Please enter a comment') unless $input{comment};
push(@errors, 'Please enter your name') unless $input{name};
push(@errors, 'Please enter your email') unless $input{email};
return display_problem($q, @errors) if (@errors);
dbh()->do("insert into comment
(problem_id, name, email, website, text, state)
values (?, ?, ?, ?, ?, 'unconfirmed')", {},
$input{id}, $input{name}, $input{email}, '', $input{comment});
dbh()->commit();
# Send confirmation email
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 on the link within the email we've just sent you -
if you do not, your comment will not be posted.
(Don't worry - we'll hang on to your comment while you're checking your email.)
EOF
return $out;
}
sub submit_problem {
my $q = shift;
my @vars = qw(title detail name email pc easting northing updates);
my %input = map { $_ => $q->param($_) } @vars;
my @errors;
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};
push(@errors, 'Please enter your email') unless $input{email};
return display_form($q, @errors) if (@errors);
dbh()->do("insert into problem
(postcode, easting, northing, title, detail, name, email, state)
values
(?, ?, ?, ?, ?, ?, ?, 'unconfirmed')", {},
$input{pc}, $input{easting}, $input{northing}, $input{title},
$input{detail}, $input{name}, $input{email}
);
dbh()->commit();
# Send confirmation email
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 on the link within the email we've just sent you -
if you do not, your problem will not be posted on the site.
(Don't worry - we'll hang on to your information while you're checking your email.)
EOF
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 updates pc easting northing x y skipped);
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($q)
unless $input{skipped} || ($pin_x && $pin_y)
|| ($input{easting} && $input{northing});
my $out = '';
if ($input{skipped}) {
$out .= <
Reporting a problem
Please fill in the form below with details of the problem:
EOF
$out .= display_map_end(1);
return $out;
}
sub display {
my ($q, @errors) = @_;
my $pc = $q->param('pc');
my($error, $x, $y, $name);
try {
($name, $x, $y) = postcode_check($q, $pc);
} catch RABX::Error with {
my $e = shift;
if ($e->value() == mySociety::MaPit::BAD_POSTCODE
|| $e->value() == mySociety::MaPit::POSTCODE_NOT_FOUND) {
$error = 'That postcode was not recognised, sorry. ';
} else {
$error = $e;
}
} catch Error::Simple with {
my $e = shift;
$error = $e;
};
return front_page($q, $error) if ($error);
my $out = '';
$out .= display_map($q, $x, $y, 1, 1);
$out .= "
$name
";
if (@errors) {
$out .= '
' . join('
', @errors) . '
';
}
$out .= <To report a problem, please select the location of it on the map.
Use the arrows to the left of the map to scroll around.
EOF
# XXX: These lists are currently global; should presumably be local to map!
$out .= <
Problems already reported
EOF
my $current = select_all(
"select id,title,easting,northing from problem where state='confirmed'
order by created desc limit 3");
foreach (@$current) {
my $px = os_to_px($_->{easting}, $x);
my $py = os_to_px($_->{northing}, $y);
$out .= '
';
$out .= <If you cannot see a map – if you have images turned off,
or are using a text only browser, for example – please
skip this step and we will ask you
to describe the location of your problem instead.
EOF
$out .= display_map_end(1);
return $out;
}
sub display_pin {
my ($px, $py, $col) = @_;
$col = 'red' unless $col;
return '' if ($px<0 || $px>508 || $py<0 || $py>508);
return '';
}
sub display_problem {
my ($q, @errors) = @_;
my @vars = qw(id name email comment updates x y);
my %input = map { $_ => $q->param($_) } @vars;
my %input_h = map { $_ => $q->param($_) ? ent($q->param($_)) : '' } @vars;
$input{x} += 0;
$input{y} += 0;
# Get all information from database
my $problem = dbh()->selectrow_arrayref(
"select easting, northing, title, detail, name, extract(epoch from created)
from problem where id=? and state='confirmed'", {}, $input{id});
return display($q, 'Unknown problem ID') unless $problem;
my ($easting, $northing, $title, $desc, $name, $time) = @$problem;
my $x = os_to_tile($easting);
my $y = os_to_tile($northing);
my $x_tile = $input{x} || int($x);
my $y_tile = $input{y} || int($y);
my $created = time();
my $px = os_to_px($easting, $x_tile);
my $py = os_to_px($northing, $y_tile);
my $out = '';
$out .= display_map($q, $x_tile, $y_tile, 0, 1);
$out .= "
';
# Display comments
my $comments = select_all(
"select id, name, whenposted, text
from comment where problem_id = ? and state='confirmed'
order by whenposted desc", $input{id});
if (@$comments) {
$out .= '
';
}
my $updates = $input{updates} ? ' checked' : '';
# XXX: Should we have website too?
$out .= <
EOF
$out .= display_map_end(0);
return $out;
}
# display_map Q X Y TYPE COMPASS
# 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
sub display_map {
my ($q, $x, $y, $type, $compass) = @_;
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 $pc_enc = ent($q->param('pc'));
$out .= <
EOF
$img_type = '
$img_type id="2.2" name="tile_$tl" src="$tl_src" style="top:0px; left:0px;">$img_type id="3.2" name="tile_$tr" src="$tr_src" style="top:0px; left:254px;"> $img_type id="2.3" name="tile_$bl" src="$bl_src" style="top:254px; left:0px;">$img_type id="3.3" name="tile_$br" src="$br_src" style="top:254px; left:254px;">
EOF
$out .= Page::compass($q, $x, $y) if $compass;
$out .= '
';
return $out;
}
sub display_map_end {
my ($type) = @_;
my $out = '
';
$out .= '' if ($type);
return $out;
}
# Checks the postcode is in one of the two London boroughs
# and sets default X/Y co-ordinates if not provided in the URI
sub postcode_check {
my ($q, $pc) = @_;
my $areas;
$areas = mySociety::MaPit::get_voting_areas($pc);
# Check for London Borough
throw Error::Simple("I'm afraid that postcode isn't in our covered area.\n") if (!$areas || !$areas->{LBO});
# Check for Lewisham or Newham
my $lbo = $areas->{LBO};
throw Error::Simple("I'm afraid that postcode isn't in our covered London boroughs.\n") unless ($lbo == 2510 || $lbo == 2492 || $lbo == 2507);
my $area_info = mySociety::MaPit::get_voting_area_info($lbo);
my $name = $area_info->{name};
my $x = $q->param('x') || 0;
my $y = $q->param('y') || 0;
$x += 0;
$y += 0;
if (!$x && !$y) {
my $location = mySociety::MaPit::get_location($pc);
my $northing = $location->{northing};
my $easting = $location->{easting};
$x = int(os_to_tile($easting));
$y = int(os_to_tile($northing));
}
return ($name, $x, $y);
}
# P is easting or northing
# BL is bottom left tile reference of displayed map
sub os_to_px {
my ($p, $bl) = @_;
return tile_to_px(os_to_tile($p), $bl);
}
# Convert tile co-ordinates to pixel co-ordinates from top right of map
# BL is bottom left tile reference of displayed map
sub tile_to_px {
my ($p, $bl) = @_;
$p = 508 - 254 * ($p - $bl);
$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 - $pin if $invert; # image submits measured from top down
return $pin_tile + $pin / 254;
}
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('%U', @s) eq strftime('%U', @t)) {
$tt = "$tt, " . strftime('%A', @s);
} elsif (strftime('%Y', @s) eq strftime('%Y', @t)) {
$tt = "$tt, " . strftime('%A %e %B', @s);
} else {
$tt = "$tt, " . strftime('%a %e %B %Y', @s);
}
return $tt;
}