view release on metacpan or  search on metacpan

Pure.pm  view on Meta::CPAN

				$self->_add_param($param, $filename);

				# Filehandle.
				if ($fh) {
					$self->{'.filehandles'}->{$filename}
						= $fh;
				}

				# Information about file.
				if ($size) {
					$self->{'.tmpfiles'}->{$filename} = {
						'size' => $size,
						'mime' => $mime,
					};
				}
				next BOUNDARY;
			}
			if ($data !~ s/^\Q$header\E(.*?)$CRLF(?=$boundary)//s) {
				next READ;
			}
# XXX /x
#			if ($data !~ s/^
#					\Q$header\E
#					(.*?)
#					$CRLF
#					(?=$boundary)
#				//msx) {
#
#				next READ;
#			}
			my $param_value;
			if ($self->{'utf8'}) {
				$param_value = decode_utf8($1);
			} else {
				$param_value = $1;
			}
			$self->_add_param($param, $param_value);
		}
	}

	# Length of data.
	return $got_data_length;
}

# Parse params from data.
sub _parse_params {
	my ($self, $data) = @_;
	if (! defined $data) {
		return ();
	}

	# Parse params.
	my $pairs_hr = parse_query_string($data);
	foreach my $key (keys %{$pairs_hr}) {

		# Value processing.
		my $value;
		if ($self->{'utf8'}) {
			if (ref $pairs_hr->{$key} eq 'ARRAY') {
				my @decoded = ();
				foreach my $val (@{$pairs_hr->{$key}}) {
					push @decoded, decode_utf8($val);
				}
				$value = \@decoded;
			} else {
				$value = decode_utf8($pairs_hr->{$key});
			}
		} else {
			$value = $pairs_hr->{$key};
		}

		# Add parameter.
		$self->_add_param($key, $value);
	}
	return;
}

# Remove undefined values.
sub _remove_undef {
	my (@values) = @_;

	my @new_values = grep { defined $_ } @values;

	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.';
		}
	}
	binmode $fh;
	while (1) {
		my $buffer = $data;
		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.';