File: read.t

package info (click to toggle)
libapache2-mod-perl2 2.0.4-7%2Bsqueeze1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 9,896 kB
  • ctags: 3,820
  • sloc: perl: 56,663; ansic: 14,001; makefile: 93; sh: 38
file content (51 lines) | stat: -rw-r--r-- 1,111 bytes parent folder | download | duplicates (5)
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
use strict;
use warnings FATAL => 'all';

use Apache::Test;
use Apache::TestRequest;

use File::Spec::Functions qw(catfile);

plan tests => 1;

#force test to go over http, since this doesn't work with t/TEST -ssl
Apache::TestRequest::scheme('http');

my $location = "/TestApache__read";

my $socket = Apache::TestRequest::vhost_socket('default');

my $file = catfile Apache::Test::vars('serverroot'), "..", 'Makefile';

open my $fh, $file or die "open $file: $!";
my $data = join '', <$fh>;
close $fh;

my $size = length $data;

for my $string ("POST $location http/1.0",
                "Content-length: $size",
                "") {
    my $line = "$string\r\n";
    syswrite $socket, $line, length($line);
}

my $written = 0;
my $bufsiz = 240;

my $sleeps = 2;

while ($written < length($data)) {
    my $remain = length($data) - $written;
    my $len = $remain > $bufsiz ? $bufsiz : $remain;
    $written += syswrite $socket, $data, $len, $written;
    sleep 1 if $sleeps-- > 0;
}

while (<$socket>) {
    last if /^\015?\012$/; #skip over headers
}

my $return = join '', <$socket>;

ok $data eq $return;