root/trunk/t/lib/MungoTestUtils.pm

Revision 76, 6.1 kB (checked in by clinton, 4 years ago)

Single and multivalue cookie tests, tid10737 tid10892

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
84     my $response = GET $url;
85   TODO: {
86         local $TODO = $info->{status} == 500 ? 'awaiting fix on trac17' : $TODO;
87         is($response->code, $info->{status}, "$label should have HTTP status $info->{status}");
88         $$test_count_ref++;
89     }
90
91     # Header check
92     if ($info->{header}) {
93         my ($name, $value) = @{$info->{header}};
94         my $saw = $response->header($name);
95         is($saw, $value, "$label should have header value on response");
96         $$test_count_ref++;
97     }
98
99     # Content Checks
100     my $content = $response->content();
101     if ($info->{like}) {
102         like($content, $info->{like}, "$label should have correct content");
103         $$test_count_ref++;
104     }
105     if ($info->{unlike}) {
106         unlike($content, $info->{unlike}, "$label should not have incorrect content");
107         $$test_count_ref++;
108     }
109     unlike($content, qr{(<\%)|(\%>)}, "$label should not contain mungo start or end tags ");
110     $$test_count_ref++;
111
112     # Did an error occur?
113     if ($info->{error_regex}) {
114         like($content, $info->{error_regex}, "$label should be a Mungo error with the correct content");
115         $$test_count_ref++;
116     } else {
117         # No error should have occurred.
118         unlike($content, qr{Error in Include}, "$label should not appear to be a Mungo Include Error");
119         $$test_count_ref++;
120     }
121
122     # Eval-Dumper Test
123     if ($info->{eval_dump}) {
124         my $expected = $info->{eval_dump};
125         my $got;
126         eval $content;
127         is($@, '', "$label should eval its response without error");
128         $$test_count_ref++;
129
130         is_deeply($got, $expected, "$label should have the correct dumpered data");
131         $$test_count_ref++;
132     }
133
134     # Permit custom hooks, too
135     $info->{extra_tests} ||= [];
136     $info->{extra_tests} = ref($info->{extra_tests}) eq 'ARRAY' ? $info->{extra_tests} : [ $info->{extra_tests} ];
137     foreach my $extra_test_hook (@{$info->{extra_tests}}) {
138         $extra_test_hook->($info, $response, $test_count_ref);
139     }
140
141
142
143 }
144
145 =head2 $str = get_url_base();
146
147 Returns a string like 'http://localhost:8529', on which
148 the test server is running.
149
150 =cut
151
152 push @EXPORT, 'get_url_base';
153 sub get_url_base {
154     my $cfg = Apache::Test::config();
155     #print Dumper($cfg);
156     my $url = $cfg->{vars}->{scheme}
157       . '://'
158         . $cfg->{vars}->{remote_addr}
159           . ':'
160             . $cfg->{vars}->{port};
161
162     return $url;
163 }
164
165 =head2 $mech = make_mech();
166
167 Creates and returns a Test::WWW::Mechanize object.  It will be primed with the
168 base URL to be that of the test server.
169
170 =cut
171
172 push @EXPORT, 'make_mech';
173 sub make_mech {
174     my $mech = Test::WWW::Mechanize->new
175       (
176        cookie_jar => {},  # enable cookies
177        max_redirect => 0, # don't automatically follow redirects
178       );
179
180     # Do one fetch to set the internal URL base
181     $mech->get(get_url_base);
182
183     return $mech;
184 }
185
186 =head2 $path = make_dummy_file($size_in_bytes, $binary);
187
188 Makes a file filled with random numbers.  Returns the absolute path to the file.
189
190 =cut
191
192 push @EXPORT, 'make_dummy_file';
193 sub make_dummy_file {
194     my $desired_size = shift;
195     my $binary = shift || 0;
196     my $handle = File::Temp->new(UNLINK => 0); # Set to 0 to leave the file hanging around
197     #my $handle = File::Temp->new(UNLINK => 1);
198     my $name = $handle->filename();
199
200     unless ($desired_size) {
201         close $handle;
202         return $name;
203     }
204     my $begin = "BEGIN MARKER\n";
205     my $begin_length = length($begin);
206     my $end = "END MARKER\n";
207     $desired_size = $desired_size - length($begin) - length($end);
208     print $handle $begin;
209     if ($binary) {
210         $desired_size--; # Needed because echo will add a newline before and after
211         close $handle;
212         system("/bin/dd if=/dev/urandom of=$name count=$desired_size bs=1 seek=$begin_length conv=fsync status=noxfer 2> /dev/null");
213         system("/bin/echo '$end' >> $name");
214     } else {
215         my $remaining = $desired_size;
216         while ($remaining >= 10240) {
217             print $handle ('X' x 10239) . "\n";
218             $remaining -= 10240;
219         }
220         print $handle 'X' x $remaining;
221         print $handle $end;
222         close $handle;
223     }
224
225     return $name;
226 }
227
228 1;
Note: See TracBrowser for help on using the browser.