Mercurial > hg > nginx-tests
comparison lib/Test/Nginx.pm @ 93:5276d85d5040
Tests: add basic gzip tests.
This also includes clearing Accept-Ranges header got from upstream (broken
since 0.7.44).
author | Maxim Dounin <mdounin@mdounin.ru> |
---|---|
date | Tue, 26 May 2009 20:18:05 +0400 |
parents | f2d09159a8f3 |
children | ecff5407867c |
comparison
equal
deleted
inserted
replaced
92:390588796411 | 93:5276d85d5040 |
---|---|
10 use strict; | 10 use strict; |
11 | 11 |
12 use base qw/ Exporter /; | 12 use base qw/ Exporter /; |
13 | 13 |
14 our @EXPORT = qw/ log_in log_out http http_get http_head /; | 14 our @EXPORT = qw/ log_in log_out http http_get http_head /; |
15 our @EXPORT_OK = qw/ http_gzip_request http_gzip_like /; | |
16 our %EXPORT_TAGS = ( | |
17 gzip => [ qw/ http_gzip_request http_gzip_like / ] | |
18 ); | |
15 | 19 |
16 ############################################################################### | 20 ############################################################################### |
17 | 21 |
18 use File::Temp qw/ tempdir /; | 22 use File::Temp qw/ tempdir /; |
19 use IO::Socket; | 23 use IO::Socket; |
273 return $reply; | 277 return $reply; |
274 } | 278 } |
275 | 279 |
276 ############################################################################### | 280 ############################################################################### |
277 | 281 |
282 sub http_gzip_request { | |
283 my ($url) = @_; | |
284 my $r = http(<<EOF); | |
285 GET $url HTTP/1.1 | |
286 Host: localhost | |
287 Connection: close | |
288 Accept-Encoding: gzip | |
289 | |
290 EOF | |
291 } | |
292 | |
293 sub http_content { | |
294 my ($text) = @_; | |
295 | |
296 return undef if !defined $text; | |
297 | |
298 if ($text !~ /(.*?)\x0d\x0a?\x0d\x0a?(.*)/ms) { | |
299 return undef; | |
300 } | |
301 | |
302 my ($headers, $body) = ($1, $2); | |
303 | |
304 if ($headers !~ /Transfer-Encoding: chunked/i) { | |
305 return $body; | |
306 } | |
307 | |
308 my $content = ''; | |
309 while ($body =~ /\G\x0d?\x0a?([0-9a-f]+)\x0d\x0a?/gcmsi) { | |
310 my $len = hex($1); | |
311 $content .= substr($body, pos($body), $len); | |
312 pos($body) += $len; | |
313 } | |
314 | |
315 return $content; | |
316 } | |
317 | |
318 sub http_gzip_like { | |
319 my ($text, $re, $name) = @_; | |
320 | |
321 SKIP: { | |
322 eval { require IO::Uncompress::Gunzip; }; | |
323 Test::More->builder->skip( | |
324 "IO::Uncompress::Gunzip not installed", 1) if $@; | |
325 | |
326 my $in = http_content($text); | |
327 my $out; | |
328 | |
329 IO::Uncompress::Gunzip::gunzip(\$in => \$out); | |
330 | |
331 Test::More->builder->like($out, $re, $name); | |
332 } | |
333 } | |
334 | |
335 ############################################################################### | |
336 | |
278 1; | 337 1; |
279 | 338 |
280 ############################################################################### | 339 ############################################################################### |