1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
#!/usr/bin/perl -w -I../../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 OPTION_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
# RSS
# Whatever I've missed!
my $rcsid = ''; $rcsid .= '$Id: test-run,v 1.6 2009-07-16 14:56:02 matthew 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;
my @actions = ('report', 'update', 'questionnaire', 'alert', 'static');
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',
'static' => 'check static pages',
);
date_print("Set up web test harness...");
my ($wth, $action, $verbose, $pause, $multispawn) = mySociety::WebTestHarness::setup({
actions => \@actions,
actions_desc => \%actions_desc,
dbname => 'BCI',
'sql_extra' => '../db/alert_types.sql',
});
$multispawn = 1;
# Set up options
my $base_url = mySociety::Config::get('BASE_URL');
$base_url =~ m#^http://(.+)/?$#;
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';
}
# 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 and sign pledges, and so on
# Print log line with date
sub date_print {
$_ = shift;
print scalar localtime() . " $_\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 PledgeBank think is today. Call with no
# parameters to reset it to the actual today.
sub set_pb_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();
}
# 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);
}
#############################################################################
sub do_report {
$wth->browser_get($base_url);
}
sub do_update {
}
#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();
|
