-
Notifications
You must be signed in to change notification settings - Fork 15
/
06-input.t
136 lines (122 loc) · 3.8 KB
/
06-input.t
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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
#!perl
use warnings;
use strict;
use Test::More tests => 53;
use Test::Fatal;
use Fcntl qw/SEEK_CUR SEEK_SET SEEK_END/;
use lib 't'; use Utils;
BEGIN { use_ok('Feersum') };
my ($socket,$port) = get_listen_socket();
ok $socket, "made listen socket";
ok $socket->fileno, "has a fileno";
my $evh = Feersum->new();
my $cv = AE::cv;
$evh->use_socket($socket);
$evh->request_handler(sub {
my $r = shift;
my $env = $r->env();
my $cl = $env->{CONTENT_LENGTH};
my $input = $env->{'psgi.input'};
ok blessed($input) && $input->can('read'), "got input handle";
my ($body,$read);
$body = undef;
if ($env->{HTTP_X_CLIENT} == 1) {
$read = $input->read($body, 1);
is $body, 't', "got first letter";
is $read, 1, "read just one byte";
$read = $input->read($body, $cl);
is $body, 'testing partial reads', "buffer has whole body now";
is $read, $cl-1, "read the rest of the content";
$read = $input->read($body, 1);
is $read, 0, "EOF";
}
elsif ($env->{HTTP_X_CLIENT} == 2) {
$read = $input->read($body, $env->{CONTENT_LENGTH});
is $read, $env->{CONTENT_LENGTH}, "read whole body";
is length($body), $env->{CONTENT_LENGTH}, "buffer has whole body";
is $body, 'testing slurp';
$read = $input->read($body, 1);
is $read, 0, "EOF";
}
elsif ($env->{HTTP_X_CLIENT} == 3) {
$read = $input->read($body, 999, -6);
is $read, 6, "read w/ too-big offset";
is $body, 'offset', "got the last word";
$body .= ' ';
$read = $input->read($body, 7, 5);
is $read, 7, "read again w/ offset";
is $body, 'offset testing', "got both words";
}
elsif ($env->{HTTP_X_CLIENT} == 4) {
ok $input->seek(0,SEEK_CUR), "can always seek to cur";
ok $input->seek(5, SEEK_SET);
$read = $input->read($body, 3);
is $read, 3;
is $body, 'and', "seek_set worked";
ok !$input->seek(-1, SEEK_CUR), "can't seek back";
ok $input->seek(1, SEEK_CUR), "can seek forward";
ok $input->seek(-7, SEEK_END), "can seek from end"; # 'find it'
ok !$input->seek(-8, SEEK_END), "can seek back from end";
$body = '';
$read = $input->read($body, 4);
is $read, 4;
is $body, 'find';
ok !$input->seek(-1, SEEK_CUR), "can't seek back";
$read = $input->read($body, 3);
is $body, 'find it';
}
else {
fail "don't know about client $env->{HTTP_X_CLIENT}";
}
is exception {
$input->close();
}, undef, 'closed handle';
$r->send_response(200, ['Content-Type' => 'text/plain'], [uc $body]);
pass "sent response";
});
$cv->begin;
my $w = simple_client POST => "/uppercase",
headers => { 'X-Client' => 1 },
body => 'testing partial reads',
timeout => 3,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, 'ok';
is $body, 'TESTING PARTIAL READS', 'uppercased partial';
$cv->end;
};
$cv->begin;
my $w2 = simple_client POST => "/uppercase",
headers => { 'X-Client' => 2 },
body => 'testing slurp',
timeout => 3,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, 'ok';
is $body, 'TESTING SLURP', 'uppercased slurp';
$cv->end;
};
$cv->begin;
my $w3 = simple_client POST => "/uppercase",
headers => { 'X-Client' => 3 },
body => 'blah testing offset',
timeout => 3,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, 'ok';
is $body, 'OFFSET TESTING', 'uppercased and reversed';
$cv->end;
};
$cv->begin;
my $w4 = simple_client POST => "/uppercase",
headers => { 'X-Client' => 4 },
body => 'seek and you shall find it',
timeout => 3,
sub {
my ($body, $headers) = @_;
is $headers->{Status}, 200, 'ok';
is $body, 'FIND IT', 'uppercased seeking';
$cv->end;
};
$cv->recv;
pass "all done";