CGI-Pure
view release on metacpan or search on metacpan
# Constructor.
sub new {
my ($class, @params) = @_;
# Create object.
my $self = bless {}, $class;
# CRLF separator.
$self->{'crlf'} = undef;
# Disable upload.
$self->{'disable_upload'} = 1;
# Init.
$self->{'init'} = undef;
# Parameter separator.
$self->{'par_sep'} = q{&};
# Use a post max of 100K ($POST_MAX),
# set to -1 ($POST_MAX_NO_LIMIT) for no limits.
$self->{'post_max'} = $POST_MAX;
foreach my $param ($self->param) {
foreach my $value ($self->param($param)) {
push @pairs, $self->_uri_escape($param).q{=}.
$self->_uri_escape($value);
}
}
return join $self->{'par_sep'}, @pairs;
}
# Upload file from tmp.
sub upload {
my ($self, $filename, $writefile) = @_;
if ($ENV{'CONTENT_TYPE'} !~ m/^multipart\/form-data/ismx) {
err 'File uploads only work if you specify '.
'enctype="multipart/form-data" in your form.';
}
if (! $filename) {;
if ($writefile) {
err 'No filename submitted for upload to '.
"'$writefile'.";
}
return $self->{'.filehandles'}
? keys %{$self->{'.filehandles'}} : ();
}
my $fh = $self->{'.filehandles'}->{$filename};
if ($fh) {
# Get ready for reading.
seek $fh, 0, 0;
while (read $fh, $buffer, $BLOCK_SIZE) {
print {$out} $buffer;
}
if (! close $out) {
err "Cannot close file '$writefile': $!.";
}
$self->{'.filehandles'}->{$filename} = undef;
undef $fh;
} else {
err "No filehandle for '$filename'. ".
'Are uploads enabled (disable_upload = 0)? '.
'Is post_max big enough?';
}
return;
}
# Return informations from uploaded files.
sub upload_info {
my ($self, $filename, $info) = @_;
if ($ENV{'CONTENT_TYPE'} !~ m/^multipart\/form-data/ismx) {
err 'File uploads only work if you '.
'specify enctype="multipart/form-data" in your '.
'form.';
}
if (! $filename) {
return keys %{$self->{'.tmpfiles'}};
}
if ($info =~ m/mime/ims) {
return $self->{'.tmpfiles'}->{$filename}->{'mime'}
}
return $self->{'.tmpfiles'}->{$filename}->{'size'};
return @new_values;
}
# Save file from multiform.
sub _save_tmpfile {
my ($self, $boundary, $filename, $got_data_length, $data) = @_;
my $fh;
my $CRLF = $self->_crlf;
my $file_size = 0;
if ($self->{'disable_upload'}) {
err '405 Not Allowed - File uploads are disabled.';
} elsif ($filename) {
eval {
require IO::File;
};
if ($EVAL_ERROR) {
err "500 IO::File is not available $EVAL_ERROR.";
}
$fh = new_tmpfile IO::File;
if (! $fh) {
err '500 IO::File can\'t create new temp_file.';
read STDIN, $data, $BLOCK_SIZE;
if (! $data) {
$data = $EMPTY_STR;
}
$got_data_length += length $data;
if ("$buffer$data" =~ m/$boundary/ms) {
$data = $buffer.$data;
last;
}
# BUG: Fixed hanging bug if browser terminates upload part way.
if (! $data) {
undef $fh;
err '400 Malformed multipart, no terminating '.
'boundary.';
}
# We do not have partial boundary so print to file if valid $fh.
print {$fh} $buffer;
$file_size += length $buffer;
}
=head1 SYNOPSIS
use CGI::Pure;
my $cgi = CGI::Pure->new(%parameters);
$cgi->append_param('par', 'value');
my @par_value = $cgi->param('par');
$cgi->delete_param('par');
$cgi->delete_all_params;
my $query_string = $cgi->query_string;
$cgi->upload('filename', '~/filename');
my $mime = $cgi->upload_info('filename', 'mime');
my $query_data = $cgi->query_data;
=head1 METHODS
=over 8
=item C<new(%parameters)>
Constructor
=over 8
=item * C<disable_upload>
Disables file upload.
Default value is 1.
=item * C<init>
Initialization variable.
May be:
- CGI::Pure object.
- Hash with params.
- Query string.
Default is undef.
=item C<query_data()>
Gets query data from server.
There is possible only for enabled 'save_data' flag.
=item C<query_string()>
Returns actual query string.
=item C<upload($filename, [$write_to])>
Upload file from tmp.
upload() returns array of uploaded filenames.
upload($filename) returns handler to uploaded filename.
upload($filename, $write_to) uploads temporary '$filename' file to
'$write_to' file.
=item C<upload_info($filename, [$info])>
Returns informations from uploaded files.
upload_info() returns array of uploaded files.
upload_info('filename') returns size of uploaded 'filename' file.
upload_info('filename', 'mime') returns mime type of uploaded 'filename' file.
=back
=head1 ERRORS
new():
400 Malformed multipart, no terminating boundary.
400 No boundary supplied for multipart/form-data.
405 Not Allowed - File uploads are disabled.
413 Request entity too large: %s bytes on STDIN exceeds post_max !
500 Bad read! wanted %s, got %s.
500 IO::File can\'t create new temp_file.
500 IO::File is not available %s.
Bad parameter separator '%s'.
From Class::Utils::set_params():
Unknown parameter '%s'.
append_param():
Parameter '%s' has bad value.
upload():
Cannot close file '%s': %s.
Cannot write file '%s': %s.
File uploads only work if you specify enctype="multipart/form-data" in your form.
No filehandle for '%s'. Are uploads enabled (disable_upload = 0)? Is post_max big enough?
No filename submitted for upload to '$writefile'.
upload_info():
File uploads only work if you specify enctype="multipart/form-data" in your form.
=head1 EXAMPLE1
use strict;
use warnings;
use CGI::Pure;
# Object.
SYNOPSIS
use CGI::Pure;
my $cgi = CGI::Pure->new(%parameters);
$cgi->append_param('par', 'value');
my @par_value = $cgi->param('par');
$cgi->delete_param('par');
$cgi->delete_all_params;
my $query_string = $cgi->query_string;
$cgi->upload('filename', '~/filename');
my $mime = $cgi->upload_info('filename', 'mime');
my $query_data = $cgi->query_data;
METHODS
"new(%parameters)"
Constructor
* "disable_upload"
Disables file upload.
Default value is 1.
* "init"
Initialization variable.
May be:
- CGI::Pure object.
- Hash with params.
- Query string.
Default is undef.
params('param', 'val1', 'val2') sets parameter 'param' to 'val1' and 'val2'
values.
"query_data()"
Gets query data from server.
There is possible only for enabled 'save_data' flag.
"query_string()"
Returns actual query string.
"upload($filename, [$write_to])"
Upload file from tmp.
upload() returns array of uploaded filenames.
upload($filename) returns handler to uploaded filename.
upload($filename, $write_to) uploads temporary '$filename' file to
'$write_to' file.
"upload_info($filename, [$info])"
Returns informations from uploaded files.
upload_info() returns array of uploaded files.
upload_info('filename') returns size of uploaded 'filename' file.
upload_info('filename', 'mime') returns mime type of uploaded 'filename' file.
ERRORS
new():
400 Malformed multipart, no terminating boundary.
400 No boundary supplied for multipart/form-data.
405 Not Allowed - File uploads are disabled.
413 Request entity too large: %s bytes on STDIN exceeds post_max !
500 Bad read! wanted %s, got %s.
500 IO::File can\'t create new temp_file.
500 IO::File is not available %s.
Bad parameter separator '%s'.
From Class::Utils::set_params():
Unknown parameter '%s'.
append_param():
Parameter '%s' has bad value.
upload():
Cannot close file '%s': %s.
Cannot write file '%s': %s.
File uploads only work if you specify enctype="multipart/form-data" in your form.
No filehandle for '%s'. Are uploads enabled (disable_upload = 0)? Is post_max big enough?
No filename submitted for upload to '$writefile'.
upload_info():
File uploads only work if you specify enctype="multipart/form-data" in your form.
EXAMPLE1
use strict;
use warnings;
use CGI::Pure;
# Object.
my $query_string = 'par1=val1;par1=val2;par2=value';
my $cgi = CGI::Pure->new(
( run in 2.066 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )