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
78
79
|
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
package TestAPI::rflush;
use strict;
use warnings FATAL => 'all';
# this test verifies that rflush flushes bucket brigades
use Apache::Test;
use Apache::TestUtil;
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::Filter ();
use Apache2::Const -compile => qw(OK);
use constant READ_SIZE => 1024;
sub bracket {
my $filter = shift;
my $data = '';
while ($filter->read(my $buffer, 1024)) {
$data .= $buffer;
}
$filter->print("[$data]") if $data;
return Apache2::Const::OK;
}
sub response {
my $r = shift;
$r->content_type('text/plain');
my $args = $r->args || '';
if ($args eq 'nontied') {
# print is now unbuffered
local $| = 1;
$r->print("1"); # send the data in the buffer + flush bucket
$r->print("2"); # send the data in the buffer + flush bucket
# print is now buffered
local $| = 0;
$r->print("3");
$r->rflush; # send the data in the buffer + flush bucket
$r->print("4");
$r->rflush; # send the data in the buffer + flush bucket
$r->print("5");
$r->print("6"); # send the data in the buffer (end of handler)
}
elsif ($args eq 'tied') {
my $oldfh;
# print is now unbuffered ("rflush"-like functionality is
# called internally)
$oldfh = select(STDOUT); $| = 1; select($oldfh);
print "1"; # send the data in the buffer + flush bucket
print "2";
# print is now buffered
$oldfh = select(STDOUT); $| = 0; select($oldfh);
print "3";
print "4";
print "5";
print "6"; # send the data in the buffer (end of handler)
}
Apache2::Const::OK;
}
1;
__DATA__
SetHandler perl-script
PerlModule TestAPI::rflush
PerlResponseHandler TestAPI::rflush::response
PerlOutputFilterHandler TestAPI::rflush::bracket
|
