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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
package TestModperl::request_rec_perlio_api;
# this test is relevant only when the PerlIO STDIN/STDOUT are used (when
# $Config{useperlio} is defined.)
use strict;
use warnings FATAL => 'all';
use Apache2::RequestIO ();
use Apache2::RequestRec ();
use Apache::Test;
use File::Spec::Functions qw(catfile catdir);
use Apache2::Const -compile => 'OK';
sub handler {
my $r = shift;
$r->args eq 'STDIN' ? test_STDIN($r) : test_STDOUT($r);
return Apache2::Const::OK;
}
sub test_STDIN {
my $r = shift;
{
# read the first 10 POST chars
my $data;
read STDIN, $data, 10;
print STDOUT $data;
}
{
# re-open STDIN to something else, and then see if we don't
# lose any chars when we restore it to the POST stream
open my $stdin, "<&STDIN" or die "Can't dup STDIN: $!";
open STDIN, "<", __FILE__
or die "failed to open STDIN as 'in memory' file : $!";
my $data;
read STDIN, $data, length("# please");
print STDOUT $data;
close STDIN;
open STDIN, "<&", $stdin or die "failed to restore STDIN: $!";
}
{
# read the last 10 POST chars
my $data;
read STDIN, $data, 10;
print STDOUT $data;
}
}
sub test_STDOUT {
my $r = shift;
local $| = 0;
print STDOUT "life is hard ";
my $vars = Apache::Test::config()->{vars};
my $target_dir = catdir $vars->{documentroot}, 'perlio';
my $file = catfile $target_dir, "apache_stdout";
# re-open STDOUT to something else, and then see if we can
# continue printing to the client via STDOUT, after restoring it
open my $stdout, ">&STDOUT" or die "Can't dup STDOUT: $!";
# this should flush the above print to STDOUT
open STDOUT, ">", $file or die "Can't open $file: $!";
print STDOUT "and then ";
close STDOUT;
# flush things that went into the file as STDOUT
open STDOUT, ">&", $stdout or die "failed to restore STDOUT: $!";
open my $fh, $file or die "Can't open $file: $!";
local $\;
print <$fh>;
# cleanup
unlink $file;
# close the dupped fh
close $stdout;
print "you die! ";
# now close it completely and restore it, without using any dupped
# filehandle
close STDOUT;
open STDOUT, ">:Apache2", $r
or die "can't open STDOUT via :Apache2 layer : $!";
print "next you reincarnate...";
}
1;
__DATA__
SetHandler perl-script
|
