diff 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
line wrap: on
line diff
--- a/lib/Test/Nginx.pm
+++ b/lib/Test/Nginx.pm
@@ -12,6 +12,10 @@ use strict;
 use base qw/ Exporter /;
 
 our @EXPORT = qw/ log_in log_out http http_get http_head /;
+our @EXPORT_OK = qw/ http_gzip_request http_gzip_like /;
+our %EXPORT_TAGS = (
+	gzip => [ qw/ http_gzip_request http_gzip_like / ]
+);
 
 ###############################################################################
 
@@ -275,6 +279,61 @@ sub http($;%) {
 
 ###############################################################################
 
+sub http_gzip_request {
+	my ($url) = @_;
+	my $r = http(<<EOF);
+GET $url HTTP/1.1
+Host: localhost
+Connection: close
+Accept-Encoding: gzip
+
+EOF
+}
+
+sub http_content {
+	my ($text) = @_;
+
+	return undef if !defined $text;
+
+	if ($text !~ /(.*?)\x0d\x0a?\x0d\x0a?(.*)/ms) {
+		return undef;
+	}
+
+	my ($headers, $body) = ($1, $2);
+
+	if ($headers !~ /Transfer-Encoding: chunked/i) {
+		return $body;
+	}
+
+	my $content = '';
+	while ($body =~ /\G\x0d?\x0a?([0-9a-f]+)\x0d\x0a?/gcmsi) {
+		my $len = hex($1);
+		$content .= substr($body, pos($body), $len);
+		pos($body) += $len;
+	}
+
+	return $content;
+}
+
+sub http_gzip_like {
+	my ($text, $re, $name) = @_;
+
+	SKIP: {
+		eval { require IO::Uncompress::Gunzip; };
+		Test::More->builder->skip(
+			"IO::Uncompress::Gunzip not installed", 1) if $@;
+
+		my $in = http_content($text);
+		my $out;
+
+		IO::Uncompress::Gunzip::gunzip(\$in => \$out);
+
+		Test::More->builder->like($out, $re, $name);
+	}
+}
+
+###############################################################################
+
 1;
 
 ###############################################################################