#!/usr/bin/perl -w -I../commonlib/perllib
#
# test-run:
# Test harness for FixMyStreet. Makes sure we haven't broken the code.
#
# Requires:
# * ../conf/general file set up for FixMyStreet, and matching the below requirements
# * apache configured to serve ../web on BASE_URL
# * a database with name ending "_testharness"; this script will drop and remake the
# database, so make sure it is never used for anything important
# * email addresses (email_n below) configured to pipe to ./test-mailin with fast
# local delivery
#
# Copyright (c) 2009 UK Citizens Online Democracy. All rights reserved.
# Email: matthew@mysociety.org; WWW: http://www.mysociety.org/
# TODO
# Admin
# Whatever I've missed!
my $rcsid = ''; $rcsid .= '$Id: test-run,v 1.28 2009-11-12 14:37:25 louise Exp $';
use strict;
require 5.8.0;
use FindBin;
use mySociety::Config;
mySociety::Config::set_file('../conf/general');
use mySociety::DBHandle qw(dbh);
use mySociety::WebTestHarness;
use Test::Harness;
use File::Find;
use lib "$FindBin::Bin/../perllib";
use Cobrand;
use FixMyStreet::Geocode;
use Utils;
my @actions = ('report', 'update', 'questionnaire', 'alert', 'static', 'cobrand', 'unit', 'eha_alert', 'import', 'rss');
my %actions_desc = (
'report' => 'report a problem',
'update' => 'leave an update on a report',
'questionnaire' => 'receive and answer a questionnaire or two',
'alert' => 'sign up for a local alert, and an update alert, check they arrive',
'eha_alert' => 'sign up for an eha alert, check cobranding and localization',
'static' => 'check static pages',
'cobrand' => 'check cobranding',
'unit' => 'run the unit tests',
'import' => 'check the ability to programmatically import a problem',
'rss' => 'check RSS feeds',
);
date_print("Set up web test harness...");
my ($wth, $action, $verbose, $pause, $multispawn) = mySociety::WebTestHarness::setup({
actions => \@actions,
actions_desc => \%actions_desc,
dbname => 'FMS',
'sql_extra' => ['../db/alert_types.sql'],
});
$multispawn = 1;
# Set up options
our $base_url;
sub set_base_url($) {
my $cobrand = shift;
$base_url = mySociety::Config::get('BASE_URL');
$base_url =~ m#^http://(.+)/?$#;
$base_url = $1;
$base_url = "http://" . $cobrand . $base_url;
}
set_base_url('');
die "domain conf not consistent" if (mySociety::Config::get('BASE_URL') ne $base_url);
my $email_domain = mySociety::Config::get('EMAIL_DOMAIN');
my $contact_email = mySociety::Config::get('CONTACT_EMAIL');
my $test_email_prefix = mySociety::Config::get('TEST_EMAIL_PREFIX');
sub email_n { my $n = shift; return "$test_email_prefix+$n\@$email_domain"; }
sub name_n { my $n = shift; return ($n % 100 == 0) ? "Rachel Reporter $n" : "Peter Person $n"; }
#############################################################################
# Main code
# Setup error log watching
$wth->log_watcher_self_test($base_url . "/test.cgi?error=1", "Illegal division by zero");
sleep(1); # XXX Without this, the above/below suck in one error line but not the other?!
my $errors = $wth->_log_watcher_get_errors(); # As Perl has two error lines.
# Run the reports
foreach (@actions) {
next unless $action->{$_};
date_print($actions_desc{$_}) if $actions_desc{$_};
do_report() if $_ eq 'report';
do_update() if $_ eq 'update';
do_questionnaire() if $_ eq 'questionnaire';
do_alert() if $_ eq 'alert';
do_static() if $_ eq 'static';
do_cobrand() if $_ eq 'cobrand';
do_unit() if $_ eq 'unit';
do_eha_alert() if $_ eq 'eha_alert';
do_import() if $_ eq 'import';
do_rss() if $_ eq 'rss';
}
# Check for any unhandled mails or errors
call_send_emails();
$wth->email_check_none_left();
$wth->log_watcher_check();
if ($action->{'all'}) {
print "Everything completed successfully\n";
} else {
print "Tests completed successfully\n";
}
#############################################################################
# Functions to make reports, and so on
# Print log line with date
sub date_print {
print scalar localtime() . ' ' . shift() . "\n";
}
# Print what we're doing
sub comment {
my $comment = shift;
date_print(" $comment") if $verbose > 0;
}
sub verbose {
my $comment = shift;
date_print(" $comment") if $verbose > 1;
}
# display_url URL
# Print the URL if in verbose mode. If --pause set, also print it and
# wait for RETURN to be pressed.
sub display_url {
my ($circumstance, $url) = @_;
$wth->email_check_url($url);
date_print("$circumstance: " . $url . "\n") if $verbose > 1 || $pause;
if ($pause) {
print "Press RETURN to continue";
readline(*STDIN);
}
}
# Change the date that all parts of FixMyStreet think is today. Call with no
# parameters to reset it to the actual today.
sub set_fms_date {
my $new_date = shift;
if (defined($new_date)) {
dbh()->do('delete from debugdate');
dbh()->do('insert into debugdate (override_today) values (?)', {}, $new_date);
} else {
dbh()->do('delete from debugdate');
}
dbh()->commit();
}
# Database functions
sub do_something_databasey {
my ($param) = @_;
dbh()->do('update something set foo = 1 where bar = ?', {}, $param);
dbh()->commit();
}
sub create_fake_contact {
my ($area_id) = @_;
dbh()->do("INSERT INTO contacts (area_id, email, editor, whenedited, note, confirmed, deleted)
VALUES (?, ?, 'fake-import', ms_current_timestamp(), 'Fake import', 't', 'f')",
{}, $area_id, $contact_email);
}
# Call all the email sending scripts
sub call_send_emails {
$wth->multi_spawn($multispawn, "./send-reports " . ($verbose > 1 ? qw(--verbose) : ''), $verbose);
$wth->multi_spawn($multispawn, "./send-alerts", $verbose);
$wth->multi_spawn($multispawn, "./send-questionnaires " . ($verbose > 1 ? qw(--verbose) : ''), $verbose);
}
# Load the EHA alert types
sub load_eha_schema {
$wth->database_drop_reload('../db/schema.sql');
$wth->database_load_schema('../db/alert_types_eha.sql');
$wth->database_cycle_sequences(200);
}
# Load the basic alert types
sub load_basic_schema {
$wth->database_drop_reload('../db/schema.sql');
$wth->database_load_schema('../db/alert_types.sql');
$wth->database_cycle_sequences(200);
}
sub english_fms_messages {
my @messages = ('Problems in this area',
'Reporting a problem',
'Now check your email',
'Confirm your problem on FixMyStreet',
'to confirm the problem',
'successfully confirmed your problem');
return \@messages;
}
sub submit_postcode{
my $cobrand = shift;
my $postcode = shift;
my $next_text = shift;
set_base_url($cobrand);
$wth->browser_get($base_url);
$wth->browser_submit_form(form_name => 'postcodeForm',
fields => { pc => $postcode},
);
$wth->browser_check_contents($next_text);
}
sub submit_report {
my ($postcode, $x, $y, $easting, $northing, $user_num, $council, $texts, $cobrand ) = @_;
my @messages = @{$texts};
# convert easting, northing to lat lon
my ( $latitude, $longitude ) =
Utils::convert_en_to_latlon( $easting, $northing );
submit_postcode($cobrand, $postcode, $messages[0]);
{
# Writing values to hidden fields, so switching
# off errors in a local context
local $^W = 0;
# WWW::Mechanize doesn't like the added tile coords, so
# just post them
$wth->browser_post($base_url,
{ pc => $postcode,
x => $x,
y => $y,
'tile_' . $x . '.' . $y . '.x' => 221,
'tile_' . $x . '.' . $y . '.y' => 158,
submit_map => 1});
$wth->browser_check_contents('
' . $messages[1] . '
');
my $fields = { submit_map => 1,
x => $x,
y => $y,
pc => $postcode,
council => -1,
latitude => $latitude,
longitude => $longitude,
title => 'My test problem',
detail => 'Detail of my test problem',
anonymous => 1,
name => name_n($user_num),
email => email_n($user_num),
phone => '555 5555'};
if ($cobrand eq 'cy.emptyhomes.') {
$fields->{category} = "Bloc cyfan o fflatiau gwag";
} elsif ($postcode =~ /^(SW|SE)/) {
# London needs a category
$fields->{category} = "Street sign";
}
if ($council){
$fields->{council} = $council;
}
$wth->browser_submit_form(form_name => 'mapForm',
button => 'submit_problem',
fields => $fields
);
}
$wth->browser_check_contents($messages[2]);
my $confirmation_email = $wth->email_get_containing(
'%Subject: '. $messages[3] .
'%To: "'.name_n($user_num).'" <'.email_n($user_num).'>'.
'%' . $messages[4] . '%');
die "Message confirmation link not found" if ($confirmation_email !~ m#^\s*($base_url.*$)#m);
print "Message confirm URL is $1\n" if $verbose > 1;
$wth->browser_get($1);
$wth->browser_check_contents($messages[5]);
}
#############################################################################
sub do_report {
my $postcode = 'SW1A 0AA';
my $messages = english_fms_messages();
my $x_coord = 3287;
my $y_coord = 1113;
submit_report($postcode, $x_coord, $y_coord, 530268, 179545, 1, undef, $messages, '');
# Check that the report is now available through the AJAX interface
$wth->browser_get($base_url . "/ajax?sx=$x_coord;sy=$y_coord;x=$x_coord;y=$y_coord;all_pins=");
$wth->browser_check_contents("'pins': 'browser_follow_link(text => 'view the problem on this site');
$wth->browser_submit_form(with_fields => { name => name_n(1),
rznvy => email_n(1),
update => "my test update",
fixed => 1 });
$wth->browser_check_contents('Nearly Done!');
my $confirmation_email = $wth->email_get_containing(
'%Subject: Confirm your update on FixMyStreet'.
'%To: "' . name_n(1) . '" <' .email_n(1).''.
'%to confirm the update%');
die "Alert confirmation link not found" if ($confirmation_email !~ m#^\s*($base_url.*$)#m);
print "Message confirm URL is $1\n" if $verbose > 1;
$wth->browser_get($1);
$wth->browser_check_contents("Thanks, glad to hear it's been fixed!");
}
sub do_import {
set_base_url('');
my $import_url = $base_url . "/import";
$wth->browser_get($import_url);
$wth->browser_check_contents("You may inject problem reports into FixMyStreet programatically");
$wth->browser_post($import_url,
{ service => "Web Test Harness",
id => "Test run",
subject => "Programmatically submitted problem",
detail => "This problem was submitted through the problem interface",
name => name_n(6),
email => email_n(6),
phone => '555 5555',
easting => 530375.1,
northing => 179503 } );
# Check for the success response
$wth->browser_check_contents("SUCCESS");
my $confirmation_email = $wth->email_get_containing(
'%Subject: Confirm your report on FixMyStreet' .
'%To: "'.name_n(6).'" <'.email_n(6).'>'.
'%confirm the report%');
die "Message confirmation link not found" if ($confirmation_email !~ m#^\s*($base_url.*$)#m);
print "Message confirm URL is $1\n" if $verbose > 1;
$wth->browser_get($1);
$wth->browser_check_contents('not yet been sent');
}
sub do_questionnaire {
my $council_id = 2514;
my $council_name = "Birmingham City Council";
# set up a fake contact record for a council
create_fake_contact($council_id);
# submit a problem report
set_fms_date('2009-11-01');
my $postcode = 'B14';
my $messages = english_fms_messages();
submit_report($postcode, 2529, 1738, 407903, 280322, 5, $council_id, $messages, '');
# send emails (for the report)
call_send_emails();
# check for the report
my $report_email = $wth->email_get_containing(
'%Subject: Problem Report: My test problem'.
'%To: "' . $council_name . '" <' . $contact_email . '>'.
'%A user of FixMyStreet has submitted the following report %');
# set the date four weeks ahead
set_fms_date('2009-11-30');
# send emails (for the questionnaire)
call_send_emails();
# check for a questionnaire
my $questionnaire_email = $wth->email_get_containing(
'%Subject: Questionnaire about your problem on FixMyStreet'.
'%To: "' . name_n(5) . '" <'. email_n(5) .'>'.
'%From: FixMyStreet <' . $contact_email . '>'.
'%you left a problem on %');
}
sub do_alert {
# sign up for alerts in an area
my $postcode = 'EH1 2NG';
my $x = 2015;
my $y = 4175;
my $e = 325066;
my $n = 673533;
my ( $lat, $lon ) = (55.948967, -3.201478);
my $messages = english_fms_messages();
submit_postcode('', $postcode, 'Problems in this area');
$wth->browser_follow_link(text => 'Email me new local problems');
$wth->browser_submit_form(form_name => 'alerts',
fields => {feed => "local:$lat:$lon",
rznvy => email_n(2)} );
$wth->browser_check_contents('Nearly Done!');
my $confirmation_email = $wth->email_get_containing(
'%Subject: Confirm your alert on FixMyStreet'.
'%To: '.email_n(2).''.
'%to confirm the alert%');
die "Alert confirmation link not found" if ($confirmation_email !~ m#^\s*($base_url.*$)#m);
print "Message confirm URL is $1\n" if $verbose > 1;
$wth->browser_get($1);
$wth->browser_check_contents('successfully confirmed your alert');
# create and confirm a new problem in the area
submit_report($postcode, $x, $y, $e, $n, 3, undef, $messages, '');
# run the alert script
call_send_emails();
# expect an update
my $update_email = $wth->email_get_containing(
'%Subject: New nearby problems'.
'%To: '.email_n(2).
'%The following nearby problems%');
# should have an unsubscribe link
die "Unsubscribe link not found" if ($update_email !~ m#^\s*($base_url/A/.*?)\s#m);
print "Message unsubscribe URL is $1\n" if $verbose > 1;
$wth->browser_get($1);
$wth->browser_check_contents('You have successfully deleted your alert.');
}
sub do_eha_alert {
# sign up for alerts in an area
my $postcode = 'EH1 2NG';
my $x = 2015; my $e = 325066;
my $y = 4175; my $n = 673533;
my ( $lat, $lon ) = (55.948967, -3.201478);
my @texts = ('Eiddo gwag yn yr ardal hon',
'Adrodd am eiddo gwag',
'Nawr, gwiriwch eich e-bost',
'Cadarnhau eich adroddiad am eiddo gwag',
'Cliciwch ar y ddolen isod i gadarnhau\'r adroddiad am eiddo gwag',
'Diolch am roi gwybod am eiddo gwag');
submit_postcode('cy.emptyhomes.', $postcode, $texts[0]);
$wth->browser_follow_link(text => 'Anfonwch fanylion eiddo gwag lleol newydd ataf i drwy\'r e-bost');
$wth->browser_submit_form(form_name => 'alerts',
fields => {feed => "local:$lat:$lon",
rznvy => email_n(4)} );
$wth->browser_check_contents($texts[2]);
my $confirmation_email = $wth->email_get_containing(
'%Subject: Cadarnhau eich rhybudd'.
'%To: '.email_n(4).''.
'%isod i gadarnhau\'r rhybudd yr ydych%');
die "Alert confirmation link not found" if ($confirmation_email !~ m#^\s*($base_url.*$)#m);
print "Message confirm URL is $1\n" if $verbose > 1;
$wth->browser_get($1);
$wth->browser_check_contents('Rydych wedi cadarnhau\'ch hysbysiad yn llwyddiannus.');
# create and confirm a new problem in the area
submit_report($postcode, $x, $y, $e, $n, 3, undef, \@texts, 'cy.emptyhomes.');
# run the alert script
call_send_emails();
# expect an update
my $update_email = $wth->email_get_containing(
'%Subject: Eiddo gwag cyfagos newydd ar '.
'%To: '.email_n(4).
'%Mae\'r eiddo gwag cyfagos%');
}
sub do_cobrand {
set_base_url('emptyhomes.');
$wth->browser_get($base_url);
$wth->browser_check_contents("Empty Homes Agency");
$wth->browser_check_contents("Report and view empty properties");
# Check language setting
set_base_url('cy.emptyhomes.');
$wth->browser_get($base_url);
$wth->browser_check_contents("Empty Homes Agency");
$wth->browser_check_contents("Adrodd am eiddo gwag a gweld y rhain");
# Run tests in any TestHarness.pm files in for Cobrands
my $allowed_cobrands = Cobrand::get_allowed_cobrands();
foreach my $cobrand (@{$allowed_cobrands}){
my $cobrand_class = ucfirst($cobrand);
my $class = "Cobrands::" . $cobrand_class . "::TestHarness";
comment "Looking for tests for $cobrand_class";
eval "use $class";
my $test_handle;
eval{ $test_handle = $class->new($wth, $verbose, $multispawn); };
next if $@;
comment "Running tests for $cobrand_class";
foreach my $test_function ($test_handle->test_functions()){
$test_handle->$test_function();
}
}
}
sub do_unit {
use File::Find;
my $testdir = '../t';
my @files;
find(sub { push(@files, $File::Find::name) if /\.t$/ }, $testdir);
runtests(@files);
}
sub do_static {
set_base_url('');
$wth->browser_get($base_url);
$wth->browser_follow_link(text => 'All reports');
$wth->browser_follow_link(text => 'Cheltenham Borough Council');
$wth->browser_follow_link(text => 'see more details');
$wth->browser_follow_link(text => 'Help');
$wth->browser_follow_link(text => 'Contact');
$wth->browser_submit_form(
with_fields => {
name => 'Mr Test Example',
em => email_n(1),
subject => 'This is a test message.',
message => 'FixMyStreet rocks!',
}
);
$wth->email_get_containing('%This is a test message%');
}
# Check RSS feeds redirect to the right places and so on.
# Just checks header, doesn't check any contents.
sub do_rss {
my %redirects = (
# should always go to lat lon, except postcode (actually, query string)
'/rss/n/406886,289126' => '/rss/l/52.499994,-1.899993',
'/rss/2524/1779' => '/rss/l/52.480294,-1.896931',
'/rss/pc/SW1A1AA' => '/rss/pc/SW1A1AA',
'/rss/l/52.5/-1.9' => '/rss/l/52.5/-1.9',
# go to reports
'/rss/area/Birmingham' => '/rss/reports/Birmingham',
'/rss/area/Birmingham/Lozells' => '/rss/reports/Birmingham/Lozells+and+East+Handsworth',
);
my $error_count = 0;
foreach my $from ( sort keys %redirects ) {
my $to = $redirects{$from};
$wth->browser_get( $base_url . $from );
my ($got) = $wth->browser_uri() =~ m{(/rss/.*)$};
next if $got eq $to;
warn "RSS redirect from '$from' to '$to' failed - got '$got'";
$error_count++;
}
die "Found errors doing redirect - aborting" if $error_count;
$wth->browser_get($base_url . '/rss/l/52.5/-1.94');
$wth->browser_check_contents('New local problems on FixMyStreet');
$wth->browser_get($base_url . '/rss/reports/Birmingham');
$wth->browser_check_contents('New problems to Birmingham City Council on FixMyStreet');
$wth->browser_get($base_url . '/rss/reports/Birmingham/Lozells');
$wth->browser_check_contents('New problems for Birmingham City Council within Lozells ward on FixMyStreet');
$wth->browser_get($base_url . '/rss/area/Gloucestershire');
$wth->browser_check_contents('New problems within Gloucestershire\'s boundary on FixMyStreet');
}
#browser_get(URL)
#browser_follow_link(text_regex => qr//)
#browser_check_contents(qr// | '')
#browser_check_no_contents("successful");
#browser_submit_form(form_name => '', fields => '', button => '')
#browser_content();
#email_get_containing( '%To: "' . name_n(3) . '" <' . email_n(3) . '>%From: "' . name_n(0) . '"%You signed this pledge after this message%Love and kisses%');
#email_check_none_left();