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
|
use strict;
use warnings;
use Furl;
use Test::TCP;
use Test::Requires qw(Plack::Request HTTP::Body), 'Plack';
use Plack::Loader;
use Test::More;
use Plack::Request;
use File::Temp;
use Fcntl qw/:seek/;
my @data = (
['get', [], sub { }],
['get', [['X-Foo' => 'bar']], sub { is $_->header('X-Foo'), 'bar'; }],
['head', [], sub { }],
['head', [['X-Foo' => 'bar']], sub { is $_->header('X-Foo'), 'bar'; }],
['post', [[], 'doya'], sub { is $_->content_length, 4; is $_->content, 'doya' }],
['post', [undef, 'doya'], sub { is $_->content_length, 4; is $_->content, 'doya' }],
['post', [[], ['do' => 'ya']], sub { is $_->content_length, 5; is $_->content, 'do=ya' }],
['post', [[], {'do' => 'ya'}], sub { is $_->content_length, 5; is $_->content, 'do=ya' }],
['post', [[], ['do' => 'ya', '=foo=' => 'bar baz']],
sub {
my $c = 'do=ya&%3Dfoo%3D=bar%20baz';
is $_->content_length, length($c);
is $_->content, $c;
},
],
['put', [[], 'doya'], sub { is $_->content_length, 4; is $_->content, 'doya' }],
['put', [undef, 'doya'], sub { is $_->content_length, 4; is $_->content, 'doya' }],
['put', [[], ['do' => 'ya']], sub { is $_->content_length, 5; is $_->content, 'do=ya' }],
['put', [[], {'do' => 'ya'}], sub { is $_->content_length, 5; is $_->content, 'do=ya' }],
['put', [[], ['do' => 'ya', '=foo=' => 'bar baz']],
sub {
my $c = 'do=ya&%3Dfoo%3D=bar%20baz';
is $_->content_length, length($c);
is $_->content, $c;
},
],
['delete', [], sub { }],
['delete', [['X-Foo' => 'bar']], sub { is $_->header('X-Foo'), 'bar'; }],
['delete', [undef, 'doya'], sub { is $_->content_length, 4; is $_->content, 'doya'; }],
);
test_tcp(
client => sub {
my $port = shift;
my $furl = Furl->new();
my $url = "http://127.0.0.1:$port";
my @d = @data;
while (my $row = shift @d) {
my ($method, $args) = @$row;
note "-- $method";
my $res = $furl->$method($url, @$args);
is $res->status, 200, "client: status by $method()"
or die "BAD: " . join(', ', $res->status, $res->message, $res->content);
}
done_testing;
},
server => sub {
my $port = shift;
my @d = @data;
Plack::Loader->auto( port => $port )->run(sub {
while (my $row = shift @d) {
my $env = shift;
my $row = shift @data;
my ($method, $args, $code) = @$row;
local $_ = Plack::Request->new($env);
is uc($_->method), uc($method), 'server: method';
$code->();
return [
200,
[ 'Content-Length' => 2 ],
['OK']
];
}
});
}
);
|
