#!/usr/bin/perl # # Page.pm: # Various HTML stuff for the FixMyStreet 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.230 2010-01-15 17:08:55 matthew Exp $ # package Page; use strict; use Carp; use mySociety::CGIFast qw(-no_xhtml); use Encode; use Error qw(:try); use File::Slurp; use HTTP::Date; # time2str use Image::Magick; use Image::Size; use IO::String; use POSIX qw(strftime); use URI::Escape; use Text::Template; use Template; use Memcached; use Problems; use Cobrand; use mySociety::Config; use mySociety::DBHandle qw/dbh/; use mySociety::Email; use mySociety::EvEl; use mySociety::Locale; use mySociety::MaPit; use mySociety::TempFiles; use mySociety::WatchUpdate; use mySociety::Web qw(ent); BEGIN { (my $dir = __FILE__) =~ s{/[^/]*?$}{}; mySociety::Config::set_file("$dir/../conf/general"); } # Under the BEGIN so that the config has been set. use FixMyStreet::Map; my $lastmodified; sub do_fastcgi { my ($func, $lm, $binary) = @_; try { my $W = new mySociety::WatchUpdate(); while (my $q = new mySociety::Web(unicode => 1)) { next if $lm && $q->Maybe304($lm); $lastmodified = $lm; microsite($q); my $str_fh = IO::String->new; my $old_fh = select($str_fh); &$func($q); select($old_fh) if defined $old_fh; print $binary ? ${$str_fh->string_ref} : encode_utf8(${$str_fh->string_ref}); 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'); my $trylater = sprintf(_('Please try again later, or email us to let us know.'), $contact_email); my $somethingwrong = _("Sorry! Something's gone wrong."); my $errortext = _("The text of the error was:"); my $msg_br = join '

', split m{\n}, $msg; print "Status: 500\nContent-Type: text/html; charset=utf-8\n\n", qq($somethingwrong), q(), qq(

$somethingwrong

), qq(

$trylater

), q(
), qq(

$errortext

), qq(
$msg_br
), 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'; my $allowed_cobrands = Cobrand::get_allowed_cobrands(); foreach my $cobrand (@{$allowed_cobrands}){ $q->{site} = $cobrand if $host =~ /$cobrand/; } my $lang; $lang = 'cy' if $host =~ /cy/; $lang = 'en-gb' if $host =~ /^en\./; Cobrand::set_lang_and_domain(get_cobrand($q), $lang, 1); FixMyStreet::Map::set_map_class($q->param('map')); Problems::set_site_restriction($q); Memcached::set_namespace(mySociety::Config::get('BCI_DB_NAME') . ":"); } =item get_cobrand Q Return the cobrand for a query =cut sub get_cobrand { my $q = shift; my $cobrand = ''; $cobrand = $q->{site} if $q->{site} ne 'fixmystreet'; return $cobrand; } =item base_url_with_lang Q REVERSE EMAIL Return the base URL for the site. Reverse the language component if REVERSE is set to one. If EMAIL is set to one, return the base URL to use in emails. =cut sub base_url_with_lang { my ($q, $reverse, $email) = @_; my $base; my $cobrand = get_cobrand($q); if ($email) { $base = Cobrand::base_url_for_emails($cobrand, Cobrand::extra_data($cobrand, $q)); } else { $base = Cobrand::base_url($cobrand); } return $base unless $q->{site} eq 'emptyhomes'; my $lang = $mySociety::Locale::lang; if ($reverse && $lang eq 'en-gb') { $base =~ s{http://}{$&cy.}; } elsif ($reverse) { $base =~ s{http://}{$&en.}; } elsif ($lang eq 'cy') { $base =~ s{http://}{$&cy.}; } else { $base =~ s{http://}{$&en.}; } return $base; } =item template_root Returns the path from which template files will be read. =cut sub template_root($;$) { my ($q, $fallback) = @_; return '/../templates/website/' if $q->{site} eq 'fixmystreet' || $fallback; return '/../templates/website/cobrands/' . $q->{site} . '/'; } =item template_vars QUERY PARAMS Return a hash of variables that can be substituted into header and footer templates. QUERY is the incoming request PARAMS contains a few things used to generate variables, such as lang, title, and rss. =cut sub template_vars ($%) { my ($q, %params) = @_; my %vars; my $host = base_url_with_lang($q, undef); my $lang_url = base_url_with_lang($q, 1); $lang_url .= $ENV{REQUEST_URI} if $ENV{REQUEST_URI}; my $site_title = Cobrand::site_title(get_cobrand($q)); $site_title = _('FixMyStreet') unless $site_title; %vars = ( 'report' => _('Report a problem'), 'reports' => _('All reports'), 'alert' => _('Local alerts'), 'faq' => _('Help'), 'about' => _('About us'), 'site_title' => $site_title, 'host' => $host, 'lang_code' => $params{lang}, 'lang' => $params{lang} eq 'en-gb' ? 'Cymraeg' : 'English', 'lang_url' => $lang_url, 'title' => $params{title}, 'rss' => '', map_js => $params{js} || '', robots => $params{robots}, ); if ($params{rss}) { $vars{rss} = ''; } my $home = !$params{title} && $ENV{SCRIPT_NAME} eq '/index.cgi' && !$ENV{QUERY_STRING}; $vars{heading_element_start} = $home ? '

' : '

' : ''; return \%vars; } =item template Q [PARAM VALUE ...] Return the correct template given PARAMs =cut sub template($%){ my ($q, %params) = @_; my $template; if ($params{template}){ $template = $params{template}; }else{ $template = $q->{site}; } return $template; } =item template_include Return HTML for a template, given a template name, request, template root, and any parameters needed. =cut sub template_include { my ($template, $q, $template_root, %params) = @_; (my $file = __FILE__) =~ s{/[^/]*?$}{}; my $template_file = $file . $template_root . $template; $template_file = $file . template_root($q, 1) . $template unless -e $template_file; return undef unless -e $template_file; $template = Text::Template->new( TYPE => 'STRING', # Don't use FILE, because we need to make sure it's Unicode characters SOURCE => decode_utf8(File::Slurp::read_file($template_file)), DELIMITERS => ['{{', '}}'], ); return $template->fill_in(HASH => \%params); } =item tt2_template_include $html = tt2_template_include( 'header', $q, $vars ); Return HTML for a template, given a template name, request, and any parameters needed. This uses the TT2 templates that the Catalyst port uses. Intended to prevent having duplicate headers and footers whilst the migration is in progress. =cut sub _tt2_template_include_path { my $q = shift; # work out where the emplate dir is relative to the current file ( my $project_dir = __FILE__ ) =~ s{/[^/]*?$}{}; my $template_root = "$project_dir/../templates/web"; # tidy up the '/foo/..' cruft 1 while $template_root =~ s{[^/]+/../}{}; my @paths = (); push @paths, "$template_root/$q->{site}" if $q->{site}; # cobrand push @paths, "$template_root/default"; # fallback # warn "template path: $_" for @paths; return \@paths; } sub tt2_template_include { my ( $template, $q, $params ) = @_; # check that the template is 'header.html' or 'footer.html' - this is for # transition only unless ( $template eq 'header.html' || $template eq 'footer.html' ) { warn "template not '(header|footer).html': '$template'"; return undef; } # create the template object my $tt2 = Template->new( { INCLUDE_PATH => _tt2_template_include_path($q), ENCODING => 'utf8', } ); # add/edit bits on the params to suit new templates $params->{loc} = sub { return _(@_) }; # create the loc function for i18n $params->{legacy_title} = ( $params->{title} || '' ) . ( $params->{site_title} || '' ); $params->{legacy_rss} = delete $params->{rss}; # fake parts of the config that the templates need $params->{c}{config}{STAGING_SITE} = mySociety::Config::get('STAGING_SITE'); $params->{c}{req}{uri}{path} = $ENV{REQUEST_URI}; my $html = ''; $tt2->process( $template, $params, \$html ); return $html; } =item header Q [PARAM VALUE ...] $html = Page::header( $q, %params ); Return HTML for the top of the page, given %params ('title' is required). Also prints the HTTP headers for the page to STDOUT. =cut sub header ($%) { my ( $q, %params ) = @_; # get the context my $context = $params{context}; # get default header parameters for the cobrand my $default_params = Cobrand::header_params( get_cobrand($q), $q, %params ); my %default_params = %{$default_params}; %params = ( %default_params, %params ); # check that all the params given ar allowed my %permitted_params = map { $_ => 1 } ( 'title', 'rss', 'expires', 'lastmodified', 'template', 'cachecontrol', 'context', 'status_code', 'robots', 'js', ); foreach ( keys %params ) { croak "bad parameter '$_'" if ( !exists( $permitted_params{$_} ) ); } # create the HTTP header 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; $head{'-Cache-Control'} = $params{cachecontrol} if $params{cachecontrol}; $head{'-status'} = $params{status_code} if $params{status_code}; print $q->header(%head); # mangle the title $params{title} ||= ''; $params{title} .= ' - ' if $params{title}; $params{title} = ent( $params{title} ); # get the language $params{lang} = $mySociety::Locale::lang; # produce the html my $vars = template_vars( $q, %params ); my $html = tt2_template_include( 'header.html', $q, $vars ); my $cache_val = $default_params{cachecontrol}; return $html; } =item footer =cut sub footer { my ( $q, %params ) = @_; my $pc = $q->param('pc') || ''; $pc = '?pc=' . URI::Escape::uri_escape_utf8($pc) if $pc; %params = ( %params, pc => $pc, ); my $html = tt2_template_include( 'footer.html', $q, \%params ); return $html; } =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; } # send_email TO (NAME) TEMPLATE-NAME PARAMETERS # TEMPLATE-NAME is a full filename here. sub send_email { my ($q, $recipient_email_address, $name, $template, %h) = @_; $template = File::Slurp::read_file("$FindBin::Bin/../templates/emails/$template"); my $to = $name ? [[$recipient_email_address, $name]] : $recipient_email_address; my $cobrand = get_cobrand($q); my $sender = Cobrand::contact_email($cobrand); my $sender_name = Cobrand::contact_name($cobrand); $sender =~ s/team/fms-DO-NOT-REPLY/; # Can send email either via EvEl (if configured) or via local MTA on # machine. If EvEl fails (server down etc) fall back to local sending my $email_building_args = { _template_ => _($template), _parameters_ => \%h, From => [ $sender, _($sender_name) ], To => $to, }; my $email_sent_successfully = 0; if ( my $EvEl_url = mySociety::Config::get('EVEL_URL') ) { eval { mySociety::EvEl::send( $email_building_args, $recipient_email_address ); $email_sent_successfully = 1; }; warn "ERROR: sending email via '$EvEl_url' failed: $@" if $@; } # If not sent through EvEL, or EvEl failed if ( !$email_sent_successfully ) { my $email = mySociety::Locale::in_gb_locale { mySociety::Email::construct_email( $email_building_args ); }; my $send_email_result = mySociety::EmailUtil::send_email( $email, $sender, $recipient_email_address ); $email_sent_successfully = !$send_email_result; # invert result } # Could not send email - die if ( !$email_sent_successfully ) { throw Error::Simple( "Could not send email to '$recipient_email_address' " . "using either EvEl or local MTA." ); } } # send_confirmation_email TO (NAME) TEMPLATE-NAME PARAMETERS # TEMPLATE-NAME is currently one of problem, update, alert, tms #sub send_confirmation_email { # my ($q, $recipient_email_address, $name, $thing, %h) = @_; # # my $file_thing = $thing; # $file_thing = 'empty property' if $q->{site} eq 'emptyhomes' && $thing eq 'problem'; # Needs to be in English # my $template = "$file_thing-confirm"; # # send_email($q, $recipient_email_address, $name, $template, %h); # # my ($action, $worry); # if ($thing eq 'problem') { # $action = _('your problem will not be posted'); # $worry = _("we'll hang on to your problem report while you're checking your email."); # } elsif ($thing eq 'update') { # $action = _('your update will not be posted'); # $worry = _("we'll hang on to your update while you're checking your email."); # } elsif ($thing eq 'alert') { # $action = _('your alert will not be activated'); # $worry = _("we'll hang on to your alert while you're checking your email."); # } elsif ($thing eq 'tms') { # $action = 'your expression of interest will not be registered'; # $worry = "we'll hang on to your expression of interest while you're checking your email."; # } # # my $out = sprintf(_(<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, %s.

#

(Don't worry — %s)

#EOF # # my $cobrand = get_cobrand($q); # my %vars = ( # action => $action, # worry => $worry, # url_home => Cobrand::url($cobrand, '/', $q), # ); # my $cobrand_email = Page::template_include('check-email', $q, Page::template_root($q), %vars); # return $cobrand_email if $cobrand_email; # return $out; #} sub prettify_epoch { my ($s, $short) = @_; 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, " . decode_utf8(strftime('%A', @s)); } elsif ($short) { $tt = "$tt, " . decode_utf8(strftime('%e %b %Y', @s)); } elsif (strftime('%Y', @s) eq strftime('%Y', @t)) { $tt = "$tt, " . decode_utf8(strftime('%A %e %B %Y', @s)); } else { $tt = "$tt, " . decode_utf8(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, _('%d week'), _('%d weeks'), \@out); _part(\$s, 60*60*24, _('%d day'), _('%d days'), \@out); _part(\$s, 60*60, _('%d hour'), _('%d hours'), \@out); _part(\$s, 60, _('%d minute'), _('%d minutes'), \@out); return join(', ', @out); } sub _part { my ($s, $m, $w1, $w2, $o) = @_; if ($$s >= $m) { my $i = int($$s / $m); push @$o, sprintf(mySociety::Locale::nget($w1, $w2, $i), $i); $$s -= $i * $m; } } sub process_photo { my $fh = shift; my $import = shift; my $blob = join('', <$fh>); close $fh; my ($handle, $filename) = mySociety::TempFiles::named_tempfile('.jpeg'); print $handle $blob; close $handle; my $photo = Image::Magick->new; my $err = $photo->Read($filename); unlink $filename; 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 ($fh, $filename) = mySociety::TempFiles::named_tempfile('.jpeg'); print $fh $photo; close $fh; my $out = `jhead -se -autorot $filename`; if ($out) { open(FP, $filename) or throw Error::Simple($!); $photo = join('', ); close FP; } unlink $filename; return $photo; } 1;