diff options
Diffstat (limited to 'perllib/Page.pm')
| -rw-r--r-- | perllib/Page.pm | 601 |
1 files changed, 0 insertions, 601 deletions
diff --git a/perllib/Page.pm b/perllib/Page.pm deleted file mode 100644 index 4db72bbdb..000000000 --- a/perllib/Page.pm +++ /dev/null @@ -1,601 +0,0 @@ -#!/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 <a href="mailto:%s">email us</a> 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 '<br><br>', split m{\n}, $msg; - - print "Status: 500\nContent-Type: text/html; charset=utf-8\n\n", - qq(<html><head><title>$somethingwrong</title></head></html>), - q(<body>), - qq(<h1>$somethingwrong</h1>), - qq(<p>$trylater</p>), - q(<hr>), - qq(<p>$errortext</p>), - qq(<blockquote class="errortext">$msg_br</blockquote>), - q(</body></html>); -} - -=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} = '<link rel="alternate" type="application/rss+xml" title="' . $params{rss}[0] . '" href="' . $params{rss}[1] . '">'; - } - - my $home = !$params{title} && $ENV{SCRIPT_NAME} eq '/index.cgi' && !$ENV{QUERY_STRING}; - $vars{heading_element_start} = $home ? '<h1 id="header">' : '<div id="header"><a href="/">'; - $vars{heading} = _('Fix<span id="my">My</span>Street'); - $vars{heading_element_end} = $home ? '</h1>' : '</a></div>'; - - 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(_(<<EOF), $action, $worry); -#<h1>Nearly Done! Now check your email...</h1> -#<p>The confirmation email <strong>may</strong> take a few minutes to arrive — <em>please</em> be patient.</p> -#<p>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.</p> -#<p>You must now click the link in the email we've just sent you — -#if you do not, %s.</p> -#<p>(Don't worry — %s)</p> -#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('', <FP>); - close FP; - } - unlink $filename; - return $photo; -} - -1; |