Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 166 lines (142 sloc) 3.911 kB
8419b0b @stash Support IO::Handle-like responses from PSGI handlers.
authored
1 #!perl
2 use warnings;
3 use strict;
5d2d6ce @stash Move IO::Handle pumper into XS
authored
4 use Test::More tests => 33;
8419b0b @stash Support IO::Handle-like responses from PSGI handlers.
authored
5 use lib 't'; use Utils;
6 use File::Temp qw/tempfile/;
7 use Encode qw/decode_utf8/;
8
9 BEGIN { use_ok('Feersum') };
10
11 my ($socket,$port) = get_listen_socket();
12 ok $socket, "made listen socket";
13
14 my $evh = Feersum->new();
15 {
16 no warnings 'redefine';
17 *Feersum::DIED = sub {
18 my $err = shift;
19 fail "Died during request handler: $err";
20 };
21 }
22 $evh->use_socket($socket);
23
24 {
25 package FakeIOHandle;
26 sub new { return bless {lines => $_[1]}, __PACKAGE__ }
27 sub getline {
28 my $self = shift;
5d2d6ce @stash Move IO::Handle pumper into XS
authored
29 Test::More::ok(ref($/) && ${$/} == 4096, '$/ is \4096');
8419b0b @stash Support IO::Handle-like responses from PSGI handlers.
authored
30 return shift @{$self->{lines}};
31 }
32 sub close {}
33 }
34
35 my $APP = <<'EOAPP';
36 my $app = sub {
37 my $env = shift;
38 Test::More::pass "called app";
39 my $io = FakeIOHandle->new([
40 "line one\n",
41 "line two\n"
42 ]);
43 return [200,['Content-Type'=>'text/plain'],$io];
44 };
45 EOAPP
46
47 my $app = eval $APP;
48 ok $app, 'got an app' || diag $@;
49 $evh->psgi_request_handler($app);
50
51 returning_mock: {
52 my $cv = AE::cv;
53
54 $cv->begin;
55 my $h; $h = simple_client GET => '/', sub {
56 my ($body, $headers) = @_;
57 is $headers->{'Status'}, 200, "Response OK";
58 is $headers->{'content-type'}, 'text/plain';
59 is $body, qq(line one\nline two\n);
60 $cv->end;
61 undef $h;
62 };
63
64 $cv->recv;
65 pass "all done app 1";
66 }
67
68 my ($tempfh, $tempname) = tempfile(UNLINK=>1);
69 print $tempfh "temp line one\n";
70 print $tempfh "temp line two\n";
71 close $tempfh;
72
73 my $APP2 = <<'EOAPP';
74 my $app2 = sub {
75 my $env = shift;
76 Test::More::pass "called app2";
77 open my $io, '<', $tempname;
78 return [200,['Content-Type'=>'text/plain'],$io];
79 };
80 EOAPP
81
82 my $app2 = eval $APP2;
83 ok $app2, 'got app 2' || diag $@;
84 $evh->psgi_request_handler($app2);
85
86 returning_glob: {
87 my $cv = AE::cv;
88 $cv->begin;
89 my $h; $h = simple_client GET => '/', sub {
90 my ($body, $headers) = @_;
91 is $headers->{'Status'}, 200, "Response OK";
92 is $headers->{'content-type'}, 'text/plain';
93 is $body, qq(temp line one\ntemp line two\n);
94 $cv->end;
95 undef $h;
96 };
97 $cv->recv;
98 }
99
100 pass "all done app 2";
101
102 my $APP3 = <<'EOAPP';
103 my $app3 = sub {
104 my $env = shift;
105 Test::More::pass "called app3";
106 require IO::File;
107 my $io = IO::File->new($tempname,"r");
108 return [200,['Content-Type'=>'text/plain'],$io];
109 };
110 EOAPP
111
112 my $app3 = eval $APP3;
113 ok $app3, 'got app 3' || diag $@;
114 $evh->psgi_request_handler($app3);
115
116 returning_io_file: {
117 my $cv = AE::cv;
118 $cv->begin;
119 my $h; $h = simple_client GET => '/', sub {
120 my ($body, $headers) = @_;
121 is $headers->{'Status'}, 200, "Response OK";
122 is $headers->{'content-type'}, 'text/plain', "C-T";
123 is $body, qq(temp line one\ntemp line two\n), "body";
124 $cv->end;
125 undef $h;
126 };
127 $cv->recv;
128 }
129
130 pass "all done app 3";
131
132 {
133 open my $fh, '>:encoding(UTF-16LE)',$tempname;
134 print $fh "\x{2603}\n"; # U+2603 SNOWMAN, UTF-8: E2 98 83
135 close $fh;
136 }
137
138 my $APP4 = <<'EOAPP';
139 my $app4 = sub {
140 my $env = shift;
141 Test::More::pass "called app4";
142 open my $io, '<:encoding(UTF-16LE)',$tempname;
143 return [200,['Content-Type'=>'text/plain; charset=UTF-8'],$io];
144 };
145 EOAPP
146
147 my $app4 = eval $APP4;
148 ok $app4, 'got app 4' || diag $@;
149 $evh->psgi_request_handler($app4);
150
151 returning_perlio_layer: {
152 my $cv = AE::cv;
153 $cv->begin;
154 my $h; $h = simple_client GET => '/', sub {
155 my ($body, $headers) = @_;
156 is $headers->{'Status'}, 200, "Response OK";
157 is $headers->{'content-type'}, 'text/plain; charset=UTF-8', "C-T";
158 is decode_utf8($body), qq(\x{2603}\n), "utf8 body";
159 $cv->end;
160 undef $h;
161 };
162 $cv->recv;
163 }
164
165 pass "all done app 4";
Something went wrong with that request. Please try again.