class Frame::Server
:isa(Net::Async::HTTP::Server::PSGI)
:does(Frame::Base);
field
$plack_handler
:mutator;
method _init :
override
(
$params
) {
$$params
{handle_class} =
"Frame::Server::Protocol"
;
$$params
{request_class} =
"Frame::Server::Request"
;
$self
->IO::Async::Listener::_init(
$params
)
}
sub
_responder (
$req
,
$res
) {
my
(
$status
,
$headers
,
$body
) =
@$res
;
my
@lines
= (
"@{[ $req->protocol ]} $status @{[ HTTP::Status::status_message($status) ]}"
);
my
$res_headers
= Hash::MultiValue->new;
my
$write_headers
=
sub
{
my
$c
=
'close'
;
if
(
$req
->keep_alive) {
$c
=
'keep-alive'
;
$req
->{conn}->restart_timeout(
'keep_alive'
);
}
push
@lines
,
sprintf
"Connection: $c"
unless
$req
->protocol eq
'HTTP/1.1'
&&
$c
eq
'keep-alive'
;
foreach
my
$key
(
$res_headers
->
keys
) {
push
@lines
,
"$key: "
.
join
','
,
$res_headers
->get_all(
$key
)
}
$req
->
write
(
join
CRLF, (
@lines
, CRLF))
};
my
$has_content_length
= 0;
my
$use_chunked_transfer
;
while
(
my
(
$key
,
$val
) =
splice
@$headers
, 0, 2) {
$res_headers
->set(
$key
=>
$val
);
$has_content_length
= 1
if
$key
eq
"Content-Length"
;
$use_chunked_transfer
++
if
$key
eq
"Transfer-Encoding"
and
$val
eq
"chunked"
}
if
(!
defined
$body
) {
croak
'Responder given no body in void context'
unless
defined
wantarray
;
unless
(
$has_content_length
) {
push
@lines
,
'Transfer-Encoding: chunked'
;
$use_chunked_transfer
++
}
$write_headers
->();
return
$use_chunked_transfer
?
Net::Async::HTTP::Server::PSGI::ChunkWriterStream->new(
$req
) :
Net::Async::HTTP::Server::PSGI::WriterStream->new(
$req
)
}
elsif
(
ref
$body
eq
'ARRAY'
) {
unless
(
$has_content_length
) {
my
$len
= 0;
my
$found_undef
;
$len
+=
length
(
$_
// (
$found_undef
++,
""
) )
for
@$body
;
carp
"Found undefined value in PSGI body"
if
$found_undef
;
push
@lines
,
"Content-Length: $len"
}
$write_headers
->();
$req
->
write
(
$_
)
for
@$body
;
$req
->done
}
else
{
unless
(
$has_content_length
) {
push
@lines
,
'Transfer-Encoding: chunked'
;
$use_chunked_transfer
++;
}
$write_headers
->();
if
(
$use_chunked_transfer
) {
$req
->
write
(
sub
{
return
unless
defined
$body
;
local
$/ = \8192;
my
$buffer
=
$body
->getline;
defined
$buffer
and
return
sprintf
(
"%X${\CRLF}%s${\CRLF}"
,
length
$buffer
,
$buffer
);
$body
->
close
;
undef
$body
;
return
"0${\CRLF}${\CRLF}"
})
}
else
{
$req
->
write
(
sub
{
local
$/ = \8192;
my
$buffer
=
$body
->getline;
defined
$buffer
and
return
$buffer
;
$body
->
close
;
return
undef
})
}
$req
->done
}
}
method on_accept (
$conn
) {
$self
->SUPER::on_accept(
$conn
);
my
%timer_args_base
= (
remove_on_expire
=> 1,
on_expire
=>
sub
(
$self
) {
dmsg
"$conn"
,
"$self"
,
$self
if
$ENV
{FRAME_DEBUG};
$conn
->_flush_requests;
$conn
->
close
}
);
foreach
my
$key
(
qw/req_header read keep_alive inactivity/
) {
my
$field
=
"$key\_timeout"
;
$conn
->
$field
(IO::Async::Timer::Countdown->new(
%timer_args_base
,
delay
=>
$plack_handler
->
$field
,
notifier_name
=>
$field
));
$self
->loop->add(
$conn
->
$field
);
$conn
->
$field
->start
unless
$key
eq
'keep_alive'
;
my
$asdf
=
$conn
->
$field
;
dmsg
"$conn"
,
"$asdf"
,
$asdf
->notifier_name
if
$ENV
{FRAME_DEBUG}
}
$conn
}
method on_request (
$req
) {
my
$env
=
$$req
{req};
my
$res
= Plack::Util::run_app
$$self
{app},
$env
;
my
$responder
=
sub
{ _responder(
$req
,
$res
) };
ref
$res
eq
'ARRAY'
?
$responder
->()
:
ref
$responder
eq
'CODE'
?
$res
->(
$responder
)
:
die
"Bad response: $res"
;
$self
->loop->stop
if
$$env
{
'psgix.harakiri.commit'
}
}
1