2.07KiB; Perl | 2017-11-06 16:05:05+01 | Statements 64 | SLOC 73
1
#!perl -w
2
3
# Check CGI::Buffer correctly sets the Last-Modified header when requested
4
5
use strict;
6
use warnings;
7
use Test::Most;
8
use Test::TempDir::Tiny;
9
use DateTime;
10
# use Test::NoWarnings;	# HTML::Clean has them
11
12
BEGIN {
13
	use_ok('CGI::Buffer');
14
}
15
16
TEST: {
17
	LAST_MODIFIED: {
18
		delete $ENV{'REMOTE_ADDR'};
19
		delete $ENV{'HTTP_USER_AGENT'};
20
		delete $ENV{'NO_CACHE'};
21
		delete $ENV{'NO_STORE'};
22
23
		ok(CGI::Buffer::can_cache() == 1);
24
		ok(CGI::Buffer::is_cached() == 0);
25
26
		my $test_count = 13;
27
28
		SKIP: {
29
			eval {
30
				require CHI;
31
32
				CHI->import();
33
			};
34
35
			if($@) {
36
				$test_count = 4;
37
				skip 'CHI required to test', 1 if $@;
38
			}
39
40
			my $filename = tempdir() . 'last_mod.t';
41
			open(my $tmp, '>', $filename);
42
			print $tmp "use strict;\n";
43
			print $tmp "use CGI::Buffer;\n";
44
			print $tmp "use CHI;\n";
45
			print $tmp "my \$hash = {};\n";
46
			print $tmp "my \$c = CHI->new(driver => 'Memory', datastore => \$hash);\n";
47
			print $tmp "CGI::Buffer::init({cache => \$c, cache_key => 'foo'});\n";
48
			print $tmp "print \"Content-type: text/html; charset=ISO-8859-1\";\n";
49
			print $tmp "print \"\\n\\n\";\n";
50
			print $tmp "print \"<HTML><BODY>   Hello World</BODY></HTML>\\n\";\n";
51
52
			open(my $fin, '-|', "$^X -Iblib/lib " . $filename);
53
54
			my $keep = $_;
55
			undef $/;
56
			my $output = <$fin>;
57
			$/ = $keep;
58
59
			close $fin;
60
			close $tmp;
61
62
			ok($output !~ /^Content-Encoding: gzip/m);
63
			ok($output !~ /^ETag: "/m);
64
65
			my ($headers, $body) = split /\r?\n\r?\n/, $output, 2;
66
67
			ok($headers =~ /^Last-Modified:\s+(.+)/m);
68 1
			my $date = $1;
69
			ok(defined($date));
70
71
			ok($headers =~ /^Content-Length:\s+(\d+)/m);
72 1
			my $length = $1;
73
			ok(defined($length));
74
75
			ok($body =~ /^<HTML><BODY>   Hello World<\/BODY><\/HTML>/m);
76
			ok(CGI::Buffer::is_cached() == 0);
77
78
			ok(length($body) eq $length);
79
80
			eval {
81
				require DateTime::Format::HTTP;
82
83
				DateTime::Format::HTTP->import();
84
			};
85
86
			if($@) {
87
				skip 'DateTime::Format::HTTP required to test everything', 1 if $@;
88
			} else {
89
				my $dt = DateTime::Format::HTTP->parse_datetime($date);
90
				ok($dt <= DateTime->now());
91
			}
92
		}
93
		done_testing($test_count);
94
	}
95
}