diff options
| -rw-r--r-- | perllib/FixMyStreet/App.pm | 37 | ||||
| -rw-r--r-- | perllib/FixMyStreet/App/Controller/Report/New.pm | 39 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Cobrand/Default.pm | 23 | ||||
| -rw-r--r-- | perllib/FixMyStreet/DB/Result/Comment.pm | 1 | ||||
| -rw-r--r-- | perllib/FixMyStreet/DB/Result/Problem.pm | 1 | ||||
| -rw-r--r-- | perllib/FixMyStreet/FakeQ.pm | 60 | ||||
| -rw-r--r-- | perllib/Page.pm | 534 | ||||
| -rw-r--r-- | perllib/Problems.pm | 13 | ||||
| -rwxr-xr-x | t/Page.t | 55 | ||||
| -rw-r--r-- | t/fakeq.t | 24 |
10 files changed, 41 insertions, 746 deletions
diff --git a/perllib/FixMyStreet/App.pm b/perllib/FixMyStreet/App.pm index ec7ec3ff0..09a8609fe 100644 --- a/perllib/FixMyStreet/App.pm +++ b/perllib/FixMyStreet/App.pm @@ -11,7 +11,6 @@ use mySociety::Email; use mySociety::EmailUtil; use mySociety::Random qw(random_bytes); use FixMyStreet::Map; -use FixMyStreet::FakeQ; use URI; use URI::QueryParam; @@ -133,11 +132,6 @@ sub _get_cobrand { my $cobrand = $cobrand_class->new( { request => $c->req } ); - # create the cobrand explicitly passing in the site. Avoids the chicken and - # egg situation where one needs to be created first. Should disappear when - # all instances of the old '$q' are gone. - $cobrand->fake_q( $c->fake_q( { site => $cobrand->moniker } ) ); - return $cobrand; } @@ -390,37 +384,6 @@ sub uri_for_email { return URI->new($email_uri); } -=head2 fake_q - - $q = $c->fake_q(); # normal usage - $q = $c->fake_q( { site => 'cobrand_moniker' } ); # when creating - -Returns a faked up object that behaves as the old code expects the old '$q' to -behave. Object is cached for the request. See L<FixMyStreet::FakeQ> for more -details. - -The first time fake_q is called you need to pass in 'site' explicitly. This -should normally be done automatically when the cobrand is first loaded. - -=cut - -sub fake_q { - my $c = shift; - my $args = shift; - - return $c->stash->{fakeq} # - ||= $c->_get_fake_q($args); -} - -sub _get_fake_q { - my $c = shift; - my $args = shift || {}; - - $args->{params} ||= $c->req->parameters; - - return FixMyStreet::FakeQ->new($args); -} - =head1 SEE ALSO L<FixMyStreet::App::Controller::Root>, L<Catalyst> diff --git a/perllib/FixMyStreet/App/Controller/Report/New.pm b/perllib/FixMyStreet/App/Controller/Report/New.pm index 3e71cb0bd..c14b7e9b1 100644 --- a/perllib/FixMyStreet/App/Controller/Report/New.pm +++ b/perllib/FixMyStreet/App/Controller/Report/New.pm @@ -6,6 +6,7 @@ BEGIN { extends 'Catalyst::Controller'; } use FixMyStreet::Geocode; use Encode; +use Image::Magick; use Sort::Key qw(keysort); use List::MoreUtils qw(uniq); use HTML::Entities; @@ -13,6 +14,7 @@ use mySociety::MaPit; use Path::Class; use Utils; use mySociety::EmailUtil; +use mySociety::TempFiles; =head1 NAME @@ -737,7 +739,7 @@ sub process_photo_upload : Private { # convert the photo into a blob (also resize etc) my $photo_blob = - eval { Page::process_photo( $upload->fh, $args->{rotate_photo} ) }; + eval { _process_photo( $upload->fh, $args->{rotate_photo} ) }; if ( my $error = $@ ) { my $format = _( "That image doesn't appear to have uploaded correctly (%s), please try again." @@ -987,6 +989,41 @@ sub redirect_to_around : Private { return $c->res->redirect($around_uri); } +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; +} + __PACKAGE__->meta->make_immutable; 1; diff --git a/perllib/FixMyStreet/Cobrand/Default.pm b/perllib/FixMyStreet/Cobrand/Default.pm index a2d1bc0bb..e02b208dc 100644 --- a/perllib/FixMyStreet/Cobrand/Default.pm +++ b/perllib/FixMyStreet/Cobrand/Default.pm @@ -11,7 +11,7 @@ use mySociety::MaPit; =head2 new my $cobrand = $class->new; - my $cobrand = $class->new( { request => $c->req, fake_q => $c->fake_q } ); + my $cobrand = $class->new( { request => $c->req } ); Create a new cobrand object, optionally setting the web request. @@ -55,27 +55,6 @@ sub is_default { return $self->moniker eq 'default'; } -=head2 fake_q - - $fake_q = $cobrand->fake_q; - $new_fake_q = $cobrand->fake_q($new_fake_q); - -Often the cobrand needs access to the request so we add it at the start by -passing it to ->new. If the request has not been set and you call this (or a -method that needs it) then it croaks. This is probably because you are trying to -use a request-related method out of a request-context. - -=cut - -sub fake_q { - my $self = shift; - $self->{fake_q} = shift if @_; - - return $self->{fake_q} - || croak "No fake_q has been set" - . " - should you be calling this method outside of a web request?"; -} - =head2 path_to_web_templates $path = $cobrand->path_to_web_templates( ); diff --git a/perllib/FixMyStreet/DB/Result/Comment.pm b/perllib/FixMyStreet/DB/Result/Comment.pm index 40801306b..68175dead 100644 --- a/perllib/FixMyStreet/DB/Result/Comment.pm +++ b/perllib/FixMyStreet/DB/Result/Comment.pm @@ -72,6 +72,7 @@ __PACKAGE__->belongs_to( # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:71bSUgPf3uW607g2EGl/Vw use DateTime::TimeZone; +use Image::Size; use Moose; use namespace::clean -except => [ 'meta' ]; diff --git a/perllib/FixMyStreet/DB/Result/Problem.pm b/perllib/FixMyStreet/DB/Result/Problem.pm index c3b387710..c3475e31c 100644 --- a/perllib/FixMyStreet/DB/Result/Problem.pm +++ b/perllib/FixMyStreet/DB/Result/Problem.pm @@ -104,6 +104,7 @@ __PACKAGE__->has_many( # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:U3aYCRwE4etekKaHdhEkIw use DateTime::TimeZone; +use Image::Size; use Moose; use namespace::clean -except => [ 'meta' ]; diff --git a/perllib/FixMyStreet/FakeQ.pm b/perllib/FixMyStreet/FakeQ.pm deleted file mode 100644 index 19f5ab32b..000000000 --- a/perllib/FixMyStreet/FakeQ.pm +++ /dev/null @@ -1,60 +0,0 @@ -package FixMyStreet::FakeQ; - -use strict; -use warnings; -use Carp; - -=head1 NAME - -FixMyStreet::FakeQ - adaptor object to ease code transition - -=head1 DESCRIPTION - -The old code uses '$q' everywhere - partly to passaround which cobrand is in -use, partly to give access to the request query parameters and partly as a -scratch pad. - -This object lets us fake this behaviour in a structured way so that the new -Catalyst based code can call the old CGI code with no need for changes. - -Eventually it will be phased out. - -=head1 METHODS - -=head2 new - - $fake_q = FixMyStreet::FakeQ->new( $args ); - -Create a new FakeQ object. Checks that 'site' argument is present and corrects -it if needed. - -=cut - -sub new { - my $class = shift; - my $args = shift || {}; - - croak "required argument 'site' missing" unless $args->{site}; - $args->{site} = 'fixmystreet' if $args->{site} eq 'default'; - - $args->{params} ||= {}; - - return bless $args, $class; -} - -=head2 param - - $val = $fake_q->param( 'key' ); - -Behaves much like CGI's ->param. Returns value if found, or undef if not. - -=cut - -sub param { - my $self = shift; - my $key = shift; - - return $self->{params}->{$key}; -} - -1; diff --git a/perllib/Page.pm b/perllib/Page.pm index 4db72bbdb..c2a4bb38f 100644 --- a/perllib/Page.pm +++ b/perllib/Page.pm @@ -1,520 +1,21 @@ #!/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); @@ -563,39 +64,4 @@ sub _part { } } -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; diff --git a/perllib/Problems.pm b/perllib/Problems.pm index b742932c1..c1430b540 100644 --- a/perllib/Problems.pm +++ b/perllib/Problems.pm @@ -27,19 +27,6 @@ sub site_restriction { return $site_restriction_hash; } -sub set_site_restriction { - my $q = shift; - my $site = $q->{site}; - if ($site ne 'fixmystreet'){ - my $cobrand = Page::get_cobrand($q); - my $cobrand_data = Cobrand::extra_data($cobrand, $q); - ($site_restriction, $site_key) = Cobrand::site_restriction($cobrand, $cobrand_data); - } else { - $site_restriction = ''; - $site_key = 0; - } -} - # Set the site restrictions using the new cobrand style - no need to special # case 'fixmystreet' as default cobrand takes care of that. sub set_site_restriction_with_cobrand_object { diff --git a/t/Page.t b/t/Page.t deleted file mode 100755 index 9331d4ef9..000000000 --- a/t/Page.t +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/perl -w -# -# Page.t: -# Tests for the Page functions -# -# Copyright (c) 2009 UK Citizens Online Democracy. All rights reserved. -# Email: louise@mysociety.org; WWW: http://www.mysociety.org/ -# -# $Id: Page.t,v 1.12 2009-12-09 13:34:36 louise Exp $ -# - -use strict; -use warnings; -use Test::More tests => 4; -use Test::Exception; - -use FindBin; -use lib "$FindBin::Bin"; -use lib "$FindBin::Bin/../perllib"; -use lib "$FindBin::Bin/../commonlib/perllib"; - -use Page; -use FixMyStreet::Geocode; -use mySociety::MockQuery; -use mySociety::Locale; - -sub mock_query(){ - my $q = new MockQuery('mysite'); - return $q; -} - -sub set_lang($) { - my $lang = shift; - mySociety::Locale::negotiate_language($lang); - mySociety::Locale::gettext_domain('FixMyStreet'); - mySociety::Locale::change(); -} - -sub test_base_url_with_lang { - set_lang('en-gb,English,en_GB'); - my $q = mock_query(); - my $url = Page::base_url_with_lang($q); - ok($url eq 'http://mysite.example.com', 'Basic url rendered ok'); - - $q = new MockQuery('emptyhomes'); - $url = Page::base_url_with_lang($q); - like($url, qr/http:\/\/en\.emptyhomes\./, 'Empty homes url with lang returned ok'); - - $url = Page::base_url_with_lang($q, 1); - like($url, qr/http:\/\/cy\.emptyhomes\./, 'Empty homes url with lang reversed returned ok'); - -} - - -ok(test_base_url_with_lang() == 1, 'Ran all tests for base_url_with_lang'); diff --git a/t/fakeq.t b/t/fakeq.t deleted file mode 100644 index ae7c6d98b..000000000 --- a/t/fakeq.t +++ /dev/null @@ -1,24 +0,0 @@ -use strict; -use warnings; - -use Test::More; - -use_ok 'FixMyStreet::FakeQ'; - -# create a new object and check that it returns what we want. -my $fake_q = FixMyStreet::FakeQ->new( - { - params => { foo => 'bar' }, # - site => 'boing' - } -); - -is $fake_q->{site}, 'boing', 'got site verbatim'; -is $fake_q->param('foo'), 'bar', 'got set param'; -is $fake_q->param('not_set'), undef, 'got undef for not set param'; - -# check that setting site to 'default' gets translated to fixmystreet -is FixMyStreet::FakeQ->new( { site => 'default' } )->{site}, 'fixmystreet', - "'default' site becomes 'fixmystreet'"; - -done_testing(); |