path: root/bin/test-run

#!/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('<h1>' . $messages[1] . '</h1>');
        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': '<a title=\"My test problem\"");
}

sub do_update {
    set_base_url('');
    my $postcode = 'ME15 6RS';
    my $messages = english_fms_messages();
    my $x_coord = 3570;
    my $y_coord = 969;
    submit_report($postcode, $x_coord, $y_coord, 575794, 156256, 1, undef, $messages, '');
    $wth->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();