1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
#!perl -w ## no critic (RequireVersionVar)
# This is a simple script that is used by t/gzip.t
use 5.006;
use warnings;
use strict;
use English qw(-no_match_vars);
use CGI::Compress::Gzip;
$CGI::Compress::Gzip::global_give_reason = 1;
$OUTPUT_AUTOFLUSH = 0; # aka $|
# Pull out "-DVAR=val" arguments
while (@ARGV && $ARGV[0] =~ m/\A -D([^=]+)=(.+) \z/xms) {
$ENV{$1} = $2;
shift @ARGV;
}
my ($op, @msg) = @ARGV;
$op ||= q{};
my $cgi = CGI::Compress::Gzip->new(q{});
if ($op eq 'redirect') { ## no critic (ProhibitCascadingIfElse)
print $cgi->redirect(@msg);
} elsif ($op eq 'charset') {
print $cgi->header('text/html; charset=UTF-8');
print @msg;
} elsif ($op eq 'type') {
print $cgi->header(-Type => 'foo/bar');
print @msg;
} elsif ($op eq 'mod_perl') {
# Deliberately initialize this AFTER creating the $cgi instance
$ENV{MOD_PERL} = 1;
print $cgi->header();
print @msg;
} elsif ($op eq 'empty') {
print $cgi->header();
} elsif ($op eq 'doublehead') {
$CGI::HEADERS_ONCE = 1;
print $cgi->header();
print $cgi->header();
print @msg;
} elsif ($op eq 'unbuffer') {
$OUTPUT_AUTOFLUSH = 1; # aka $|
print $cgi->header();
print @msg;
} elsif ($op eq 'fh1') {
my $fh = \*STDOUT;
$cgi->useFileHandle($fh);
print $cgi->header('text/html');
print @msg;
} elsif ($op eq 'fh2') {
$cgi->useFileHandle(\*STDOUT);
print {*STDOUT} $cgi->header('text/html');
print {*STDOUT} @msg;
} elsif ($op eq 'fh3') {
my $fh = \*STDOUT;
$cgi->useFileHandle($fh);
print {$fh} $cgi->header('text/html');
print {$fh} @msg;
} else {
print $cgi->header();
print @msg;
}
|
