$CGI::Simple::POST_MAX
= 1048576;
$CGI::Simple::DISABLE_UPLOADS
= 0;
__PACKAGE__->mk_accessors(
'cgi'
);
sub
finalize_headers {
my
$c
=
shift
;
my
%headers
= (
-nph
=> 1 );
$headers
{-status} =
$c
->response->status
if
$c
->response->status;
for
my
$name
(
$c
->response->headers->header_field_names ) {
$headers
{
"-$name"
} =
$c
->response->headers->header(
$name
);
}
my
@cookies
;
while
(
my
(
$name
,
$cookie
) =
each
%{
$c
->response->cookies } ) {
push
@cookies
,
$c
->cgi->cookie(
-name
=>
$name
,
-value
=>
$cookie
->{value},
-expires
=>
$cookie
->{expires},
-domain
=>
$cookie
->{domain},
-path
=>
$cookie
->{path},
-secure
=>
$cookie
->{secure} || 0
);
}
$headers
{-cookie} = \
@cookies
if
@cookies
;
print
$c
->cgi->header(
%headers
);
}
sub
finalize_output {
my
$c
=
shift
;
print
$c
->response->output;
}
sub
prepare_connection {
my
$c
=
shift
;
$c
->req->hostname(
$c
->cgi->remote_host );
$c
->req->address(
$c
->cgi->remote_addr );
}
sub
prepare_cookies {
shift
->req->cookies( { CGI::Cookie->fetch } ) }
sub
prepare_headers {
my
$c
=
shift
;
$c
->req->method(
$c
->cgi->request_method );
for
my
$header
(
$c
->cgi->http ) {
(
my
$field
=
$header
) =~ s/^HTTPS?_//;
$c
->req->headers->header(
$field
=>
$c
->cgi->http(
$header
) );
}
$c
->req->headers->header(
'Content-Type'
=>
$c
->cgi->content_type );
$c
->req->headers->header(
'Content-Length'
=>
$c
->cgi->content_length );
}
sub
prepare_parameters {
my
$c
=
shift
;
my
%vars
=
$c
->cgi->Vars;
while
(
my
(
$key
,
$value
) =
each
%vars
) {
my
@values
=
split
"\0"
,
$value
;
$vars
{
$key
} =
@values
<= 1 ?
$values
[0] : \
@values
;
}
$c
->req->parameters( {
%vars
} );
}
sub
prepare_path {
my
$c
=
shift
;
my
$base
;
{
my
$scheme
=
$ENV
{HTTPS} ?
'https'
:
'http'
;
my
$host
=
$ENV
{HTTP_HOST} ||
$ENV
{SERVER_NAME};
my
$port
=
$ENV
{SERVER_PORT} || 80;
my
$path
=
$ENV
{SCRIPT_NAME} ||
'/'
;
$base
= URI->new;
$base
->scheme(
$scheme
);
$base
->host(
$host
);
$base
->port(
$port
);
$base
->path(
$path
);
$base
=
$base
->canonical->as_string;
}
my
$path
=
$ENV
{PATH_INFO} ||
'/'
;
$path
=~ s/^\///;
$c
->req->base(
$base
);
$c
->req->path(
$path
);
}
sub
prepare_request {
shift
->cgi( CGI::Simple->new ) }
sub
prepare_uploads {
my
$c
=
shift
;
for
my
$name
(
$c
->cgi->upload ) {
next
unless
defined
$name
;
$c
->req->uploads->{
$name
} = {
fh
=>
$c
->cgi->upload(
$name
),
size
=>
$c
->cgi->upload_info(
$name
,
'size'
),
type
=>
$c
->cgi->upload_info(
$name
,
'mime'
)
};
}
}
sub
run {
shift
->handler }
1;