root/trunk/t/lib/MungoTestUtils.pm

Revision 60, 2.2 kB (checked in by clinton, 4 years ago)

Added macro to run tests from a hash, tid10737

Line 
1 package MungoTestUtils;
2 use strict;
3 use warnings FATAL => 'all';
4
5 use base 'Exporter';
6 our @EXPORT = ();
7
8
9 use Apache::Test qw();
10 use Apache::TestRequest qw(GET);
11 use Test::More import => [qw(is ok like unlike $TODO)];
12
13 =head2 perform_page_tests('/01-foo/', \%tests);
14
15 Performs 4 tests for each page, by fetching the page and checking the HTTP status (1 test), comparing the page contents to a regex (! test ) and checking to ensure no Mungo tags are present (2 tests).
16
17 %tests should have keys that are pages under the base (.asp will be appended). 
18 Values may be either strings or hashrefs.  If a string, it is taken to be the regex
19 against which to match the page.  If a hashref, these keys are available:
20
21 =over
22
23 =item like
24
25 Regex to match against the page content.
26
27 =item status
28
29 HTTP status code, default 200.
30
31 =item todo
32
33 Boolean.  If true, this page's tests are marked TODO.
34
35 =item query
36
37 String, staring with '?'.  Will be appended as query string.
38
39 =back
40
41 =cut
42
43 push @EXPORT, 'perform_page_tests';
44 sub perform_page_tests {
45     my $base = shift;
46     my $tests = shift;
47
48     foreach my $test_page (sort keys %$tests) { # Sort is so the order is repeatable
49         my $info = $tests->{$test_page};
50         unless (ref($info) eq 'HASH') {
51             $info = { like => $info };
52         }
53         $info->{page} = $test_page;
54         $info->{base} = $base;
55
56         my $todo    = $info->{todo} || 0;
57
58         if ($todo) {
59           TODO: {
60                 local $TODO = $todo;
61                 do_one_page_test($info);
62             }
63         } else {
64             do_one_page_test($info);
65         }
66     }
67 }
68 sub do_one_page_test {
69     my $info = shift;
70     my $qs      = $info->{query} || '';
71     my $status  = $info->{status} || 200;
72     my $pattern = $info->{like};
73     my $page    = $info->{page};
74
75     my $url = $info->{base} . $page . '.asp' . $qs;
76     my $response = GET $url;
77     is($response->code, $status, "Fetch of $url should be HTTP status $status");
78     my $content = $response->content();
79     like($content, $pattern, "Content of $url should be correct");
80     unlike($content, qr{<\%}, "$url should not contain mungo start tag '<\%'");
81     unlike($content, qr{\%>}, "$url should not contain mungo end tag '\%>'");
82 }
83
84 1;
Note: See TracBrowser for help on using the browser.