root/trunk/t/lib/MungoTestUtils.pm

Revision 78, 6.2 kB (checked in by clinton, 4 years ago)

Expand and update i18n tests, tid10737 tid10892 trac23

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 is_deeply)];
12 use Test::WWW::Mechanize qw();
13 use File::Temp qw(tempfile);
14
15
16 =head2 perform_page_tests('/01-foo/', \%tests);
17
18 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).
19
20 %tests should have keys that are pages under the base (.asp will be appended). 
21 Values may be either strings or hashrefs.  If a string, it is taken to be the regex
22 against which to match the page.  If a hashref, these keys are available:
23
24 =over
25
26 =item like
27
28 Regex to match against the page content.
29
30 =item status
31
32 HTTP status code, default 200.
33
34 =item todo
35
36 Boolean.  If true, this page's tests are marked TODO.
37
38 =item query
39
40 String, staring with '?'.  Will be appended as query string.
41
42 =back
43
44 =cut
45
46 push @EXPORT, 'perform_page_tests';
47 sub perform_page_tests {
48     my $base = shift;
49     my $tests = shift;
50     my $test_count_ref = shift;
51
52     foreach my $test_page (sort keys %$tests) { # Sort is so the order is repeatable
53         my $info = $tests->{$test_page};
54         unless (ref($info) eq 'HASH') {
55             $info = { like => $info };
56         }
57         next if $info->{hardskip};
58         $info->{page} ||= $test_page;
59         $info->{base} = $base;
60         $info->{label} ||= $test_page;
61         $info->{status} ||= 200;
62
63         my $todo    = $info->{todo} || 0;
64
65         if ($todo) {
66           TODO: {
67                 local $TODO = $todo;
68                 do_one_page_test($info, $test_count_ref);
69             }
70         } else {
71             do_one_page_test($info, $test_count_ref);
72         }
73     }
74 }
75 sub do_one_page_test {
76     my $info = shift;
77     my $test_count_ref = shift;
78     my $qs      = $info->{query} || '';
79     my $page    = $info->{page};
80     my $label   = $info->{label};
81
82     my $url = $info->{base} . $page . '.asp' . $qs;
83     my %opts = %{$info->{request_options} || {}};
84
85     my $response = GET $url, %opts;
86   TODO: {
87         local $TODO = $info->{status} == 500 ? 'awaiting fix on trac17' : $TODO;
88         is($response->code, $info->{status}, "$label should have HTTP status $info->{status}");
89         $$test_count_ref++;
90     }
91
92     # Header check
93     if ($info->{header}) {
94         my ($name, $value) = @{$info->{header}};
95         my $saw = $response->header($name);
96         is($saw, $value, "$label should have header value on response");
97         $$test_count_ref++;
98     }
99
100     # Content Checks
101     my $content = $response->content();
102     if ($info->{like}) {
103         like($content, $info->{like}, "$label should have correct content");
104         $$test_count_ref++;
105     }
106     if ($info->{unlike}) {
107         unlike($content, $info->{unlike}, "$label should not have incorrect content");
108         $$test_count_ref++;
109     }
110     unlike($content, qr{(<\%)|(\%>)}, "$label should not contain mungo start or end tags ");
111     $$test_count_ref++;
112
113     # Did an error occur?
114     if ($info->{error_regex}) {
115         like($content, $info->{error_regex}, "$label should be a Mungo error with the correct content");
116         $$test_count_ref++;
117     } else {
118         # No error should have occurred.
119         unlike($content, qr{Error in Include}, "$label should not appear to be a Mungo Include Error");
120         $$test_count_ref++;
121     }
122
123     # Eval-Dumper Test
124     if ($info->{eval_dump}) {
125         my $expected = $info->{eval_dump};
126         my $got;
127         eval $content;
128         is($@, '', "$label should eval its response without error");
129         $$test_count_ref++;
130
131         is_deeply($got, $expected, "$label should have the correct dumpered data");
132         $$test_count_ref++;
133     }
134
135     # Permit custom hooks, too
136     $info->{extra_tests} ||= [];
137     $info->{extra_tests} = ref($info->{extra_tests}) eq 'ARRAY' ? $info->{extra_tests} : [ $info->{extra_tests} ];
138     foreach my $extra_test_hook (@{$info->{extra_tests}}) {
139         $extra_test_hook->($info, $response, $test_count_ref);
140     }
141 }
142
143 =head2 $str = get_url_base();
144
145 Returns a string like 'http://localhost:8529', on which
146 the test server is running.
147
148 =cut
149
150 push @EXPORT, 'get_url_base';
151 sub get_url_base {
152     my $cfg = Apache::Test::config();
153     #print Dumper($cfg);
154     my $url = $cfg->{vars}->{scheme}
155       . '://'
156         . $cfg->{vars}->{remote_addr}
157           . ':'
158             . $cfg->{vars}->{port};
159
160     return $url;
161 }
162
163 =head2 $mech = make_mech();
164
165 Creates and returns a Test::WWW::Mechanize object.  It will be primed with the
166 base URL to be that of the test server.
167
168 =cut
169
170 push @EXPORT, 'make_mech';
171 sub make_mech {
172     my $mech = Test::WWW::Mechanize->new
173       (
174        cookie_jar => {},  # enable cookies
175        max_redirect => 0, # don't automatically follow redirects
176       );
177
178     # Do one fetch to set the internal URL base
179     $mech->get(get_url_base);
180
181     return $mech;
182 }
183
184 =head2 $path = make_dummy_file($size_in_bytes, $binary);
185
186 Makes a file filled with random numbers.  Returns the absolute path to the file.
187
188 =cut
189
190 push @EXPORT, 'make_dummy_file';
191 sub make_dummy_file {
192     my $desired_size = shift;
193     my $binary = shift || 0;
194     my $handle = File::Temp->new(UNLINK => 0); # Set to 0 to leave the file hanging around
195     #my $handle = File::Temp->new(UNLINK => 1);
196     my $name = $handle->filename();
197
198     unless ($desired_size) {
199         close $handle;
200         return $name;
201     }
202     my $begin = "BEGIN MARKER\n";
203     my $begin_length = length($begin);
204     my $end = "END MARKER\n";
205     $desired_size = $desired_size - length($begin) - length($end);
206     print $handle $begin;
207     if ($binary) {
208         $desired_size--; # Needed because echo will add a newline before and after
209         close $handle;
210         system("/bin/dd if=/dev/urandom of=$name count=$desired_size bs=1 seek=$begin_length conv=fsync status=noxfer 2> /dev/null");
211         system("/bin/echo '$end' >> $name");
212     } else {
213         my $remaining = $desired_size;
214         while ($remaining >= 10240) {
215             print $handle ('X' x 10239) . "\n";
216             $remaining -= 10240;
217         }
218         print $handle 'X' x $remaining;
219         print $handle $end;
220         close $handle;
221     }
222
223     return $name;
224 }
225
226 1;
Note: See TracBrowser for help on using the browser.