MinimalCGI だと $request->upload が CGI::Simple->upload の wrapper になっているので、他の interface みたいに HTTP::Engine::Request::Upload オブジェクトを返すようにしたかった。
まったく同じにはできなかったけど。
- 同じ name の input (type=file) があると一つしか扱えない
- upload->headers が空っぽ
{
package # hide from pause
HTTP::Engine::Request;
use HTTP::Engine::Request::Upload;
$CGI::Simple::DISABLE_UPLOADS = 0;
$CGI::Simple::POST_MAX = 1024 * 1024 * 10;
sub uploads {
my $self = shift;
$self->{uploads} ||= $self->_prepare_uploads;
}
sub upload {
my $self = shift;
return keys %{ $self->uploads } if @_ == 0;
if (@_ == 1) {
my $upload = shift;
return wantarray ? () : undef unless exists $self->uploads->{$upload};
return (wantarray)
? ( $self->uploads->{$upload} )
: $self->uploads->{$upload};
}
}
sub _prepare_uploads {
my $self = shift;
$self->{cs} ||= CGI::Simple->new();
my $q = $self->{cs};
my %uploads;
for my $name ( keys %{ $q->{".upload_fields"} } ) {
my $filename = $q->{".upload_fields"}->{$name};
my $headers = HTTP::Headers::Fast->new();
$uploads{$name}
= HTTP::Engine::Request::Upload->new(
headers => $headers,
fh => $q->upload($filename),
size => $q->upload_info($filename, 'size'),
filename => $filename,
);
}
return \%uploads;
}
}
{
package # hide from pause
HTTP::Engine::Request::Upload;
no warnings "redefine";
sub copy_to {
my $self = shift;
require File::Copy;
File::Copy::copy( ($self->tempname || $self->fh), @_ );
}
}