package Upload;
use strict;
use warnings;
use Encode;
use URL::PercentEncode qw(percent_encode_c percent_encode_b);
sub htescape ($) {
my $s = $_[0];
$s =~ s/&/&/g;
$s =~ s/\"/"/g;
$s =~ s/</g;
$s =~ s/>/>/g;
return $s;
}
sub process ($$) {
my ($class, $app) = @_;
if ($app->http->request_method eq 'POST') {
my $http = $app->http;
$http->response_mime_type->set_value ('text/html');
$http->response_mime_type->set_param (charset => 'utf-8');
$http->send_response_body_as_text (q{
Uploaded data
Params
});
my $body_params = $http->request_body_params;
for my $name (keys %$body_params) {
$http->send_response_body_as_text
(sprintf q{- } . (htescape decode 'utf-8', $name) .
join '', map { q{
- } . htescape decode 'utf-8', $_ } @{$body_params->{$name}});
}
$http->send_response_body_as_text (q{
Uploaded files
});
my $uploads = $http->request_uploads;
for my $name (keys %$uploads) {
$http->send_response_body_as_text (q{- } . htescape $name);
for my $upload (@{$uploads->{$name}}) {
$http->send_response_body_as_text
(sprintf q{
- %s (size %d)},
(htescape $upload->mime_type->as_bytes),
(percent_encode_b scalar $upload->as_f->slurp),
htescape $upload->filename,
htescape $upload->size);
}
}
$http->send_response_body_as_text (q{
});
} else {
$app->send_html (q{
Upload
});
}
} # process
1;
## License: Public Domain.