This is a developer site; things might break at any time, and councils are not sent emails (they\'d get annoyed!).
'; } return $html; } =item footer =cut sub footer { return <' : '';
$html .= '';
if (mySociety::Config::get('STAGING_SITE')) {
$html .= 'Navigation
EOF
}
=item error_page Q MESSAGE
=cut
sub error_page ($$) {
my ($q, $message);
my $html = header($q, title=>"Error")
. $q->p($message)
. footer();
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 $px = defined($params{px}) ? $params{px}-254 : 0;
my $py = defined($params{py}) ? 254-$params{py} : 0;
my $x = $params{x}<=0 ? 0 : $params{x};
my $y = $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);
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;
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 drag_x = $px; var drag_y = $py;
$params{pre}
$img_type alt="NW map tile" id="t2.2" name="tile_$tl" src="$tl_src" style="top:0px; left:0px;">$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:0px;">$img_type alt="SE map tile" id="t3.3" name="tile_$br" src="$br_src" style="top:$imgh; left:$imgw;">
$params{pins}
EOF
$out .= compass($q, $x, $y);
$out .= <
© Crown copyright. All rights reserved.
Department for Constitutional Affairs 100037819 2007
$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 = '' 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;
}
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, x=>undef, y=>undef);
return <
EOF
}
# 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 while $pin < 0;
$pin = 254 - $pin if $invert; # image submits measured from top down
return $pin_tile + $pin / 254;
}
# send_email TO (NAME) TEMPLATE-NAME PARAMETERS
sub send_email {
my ($email, $name, $thing, %h) = @_;
my $template = "$thing-confirm";
$template = File::Slurp::read_file("$FindBin::Bin/../templates/emails/$template");
my $to = $name ? [[$email, $name]] : $email;
mySociety::EvEl::send({
_template_ => $template,
_parameters_ => \%h,
From => [mySociety::Config::get('CONTACT_EMAIL'), 'FixMyStreet'],
To => $to,
}, $email);
my $out;
my $action = ($thing eq 'alert') ? 'confirmed' : 'posted';
$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 $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('%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;
}
# 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;
}
}
# Simply so I can gettext the code without making the locale stuff all work
sub _ {
return $_[0];
}
sub display_problem_text {
my ($q, $problem) = @_;
my $out = $q->h1(ent($problem->{title}));
# Display information about problem
$out .= 'Reported ';
$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 .= '
';
$out .= ent($problem->{detail});
$out .= '
';
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
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 .= 'Posted by ' . ent($row->{name});
} else {
$out .= "Posted anonymously";
}
$out .= " at " . prettify_epoch($row->{created});
$out .= ', marked fixed' if ($row->{mark_fixed});
$out .= ', reopened' if ($row->{mark_open});
$out .= '';
$out .= '
' . ent($row->{text}) . '';
}
$out .= '';
}
return $out;
}
1;
';
if (mySociety::Config::get('STAGING_SITE')) {
$html .= '
Navigation
EOF } =item error_page Q MESSAGE =cut sub error_page ($$) { my ($q, $message); my $html = header($q, title=>"Error") . $q->p($message) . footer(); 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 $px = defined($params{px}) ? $params{px}-254 : 0; my $py = defined($params{py}) ? 254-$params{py} : 0; my $x = $params{x}<=0 ? 0 : $params{x}; my $y = $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); 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; 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 drag_x = $px; var drag_y = $py;
$params{pre}
';
$out .= '';
return $out unless $_ && $_->{id} && $col ne 'blue';
my $url = NewURL($q, id=>$_->{id}, x=>undef, y=>undef);
$out = '' . $out . '';
return $out;
}
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, x=>undef, y=>undef);
return <
EOF
}
# 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 while $pin < 0;
$pin = 254 - $pin if $invert; # image submits measured from top down
return $pin_tile + $pin / 254;
}
# send_email TO (NAME) TEMPLATE-NAME PARAMETERS
sub send_email {
my ($email, $name, $thing, %h) = @_;
my $template = "$thing-confirm";
$template = File::Slurp::read_file("$FindBin::Bin/../templates/emails/$template");
my $to = $name ? [[$email, $name]] : $email;
mySociety::EvEl::send({
_template_ => $template,
_parameters_ => \%h,
From => [mySociety::Config::get('CONTACT_EMAIL'), 'FixMyStreet'],
To => $to,
}, $email);
my $out;
my $action = ($thing eq 'alert') ? 'confirmed' : 'posted';
$out = <Nearly Done! Now check your email...
$img_type alt="NW map tile" id="t2.2" name="tile_$tl" src="$tl_src" style="top:0px; left:0px;">$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:0px;">$img_type alt="SE map tile" id="t3.3" name="tile_$br" src="$br_src" style="top:$imgh; left:$imgw;"> $params{pins}
EOF
$out .= compass($q, $x, $y);
$out .= <$img_type alt="SW map tile" id="t3.2" name="tile_$bl" src="$bl_src" style="top:$imgh; left:0px;">$img_type alt="SE map tile" id="t3.3" name="tile_$br" src="$br_src" style="top:$imgh; left:$imgw;"> $params{pins}
© Crown copyright. All rights reserved. Department for Constitutional Affairs 100037819 2007
$params{post} EOF $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 = '' 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;
}
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, x=>undef, y=>undef);
return <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 $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('%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; } # 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; } } # Simply so I can gettext the code without making the locale stuff all work sub _ { return $_[0]; } sub display_problem_text { my ($q, $problem) = @_; my $out = $q->h1(ent($problem->{title})); # Display information about problem $out .= 'Reported '; $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 .= '
'; $out .= ent($problem->{detail}); $out .= '
'; if ($problem->{photo}) { $out .= '';
$out .= '
';
}
return $out;
}
1;
Updates
'; foreach my $row (@$updates) { $out .= "{id}\">";
if ($row->{name}) {
$out .= 'Posted by ' . ent($row->{name});
} else {
$out .= "Posted anonymously";
}
$out .= " at " . prettify_epoch($row->{created});
$out .= ', marked fixed' if ($row->{mark_fixed});
$out .= ', reopened' if ($row->{mark_open});
$out .= '';
$out .= '
' . ent($row->{text}) . '
';
}
$out .= '' . ent($row->{text}) . '