view release on metacpan or  search on metacpan

ParseFormData.pm  view on Meta::CPAN

	my $time = shift;
	my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime($time);
	my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
	my @weekday = qw(Sun Mon Tue Wed Thu Fri Sat);
	return sprintf("%3s, %02d-%3s-%04d %02d:%02d:%02d GMT", $weekday[$wday], $mday, $months[$mon], $year+1900, $hour, $min, $sec);
}

sub upload {
	my $self = shift;
	my $name = shift || "";
	return($name ? @{$self->pnotes('upload')->{$name}} : keys(%{$self->pnotes('upload')}));
}

sub parse_content {
	my $r = shift;
	my $args = shift;

	my $buf = "";
	$r->setup_client_block;
	$r->should_client_block or return '';
	my $ct = $r->headers_in->get('content-type');

	if($args->{'disable_uploads'} && index($ct, "multipart/form-data") > -1) {
		my $error_str = "[Apache::ParseFormData] file upload forbidden";
		$r->notes->set("error-notes" => $error_str);
		$r->log_error($error_str);
		return(Apache::FORBIDDEN);
	}
	my $rm = $r->remaining;
	if($args->{'post_max'} && ($rm > $args->{'post_max'})) {
		my $pm = $args->{'post_max'};
		my $error_str = "[Apache::ParseFormData] entity too large ($rm, max=$pm)";
		$r->notes->set("error-notes" => $error_str);
		$r->log_error($error_str);
		return(Apache::HTTP_REQUEST_ENTITY_TOO_LARGE);
	}
	if($ct =~ /^multipart\/form-data; boundary=(.+)$/) {
		my $boundary = $1;
		my $lenbdr = length("--$boundary");
		$r->get_client_block($buf, $lenbdr+2);
		$buf = substr($buf, $lenbdr);
		$buf =~ s/[\n\r]+//;
		my $iter = -1;
		my @data = ();
		&multipart_data($r, $args, \@data, $boundary, BUFFLENGTH, 1, $buf, $iter);
		my %uploads = ();
		for(@data) {
			if(exists($_->{'headers'}->{'content-disposition'})) {
				my @a = split(/ *; */, $_->{'headers'}->{'content-disposition'});
				if(shift(@a) eq "form-data") {
					if(scalar(@a) == 1) {
						my ($key) = ($a[0] =~ /name=\"([^\"]+)\"/);
						$r->param($key => $_->{'values'} || "");
					} else {
						(ref($_->{'values'}) eq "ARRAY") or next;
						my ($fh, $path) = @{$_->{'values'}};
						seek($fh, 0, 0);
						my %hash = (
							filename => "",
							type     => exists($_->{'headers'}->{'content-type'}) ? $_->{'headers'}->{'content-type'} : "",
							size     => ($fh->stat())[7],
						);
						my $param = "";
						for(@a) {
							my ($name, $value) = (/([^=]+)=\"([^\"]+)\"/);
							if($name eq "name") {
								$uploads{$value} = [$fh, $path];
								$param = $value;
							} else {
								$hash{$name} = $value;
							}
						}
						$r->param($param => \%hash);
					}
				}
			}
		}
		$r->pnotes('upload' => \%uploads);
	} else {
		my $len = $r->headers_in->get('content-length');
		$r->get_client_block($buf, $len);
		&_parse_query($r, $buf) if($buf);
	}
	return(Apache::OK);
}

sub extract_headers {
	my $raw = shift;
	my %hash = ();
	for(split(/\r?\n/, $raw)) {
		s/[\r\n]+$//;
		$_ or next;
		my ($h, $v) = split(/ *: */, $_, 2);
		$hash{lc($h)} = $v;
	}
	$_[0] = \%hash;
	return(exists($hash{'content-type'}));
}

sub output_data {
	my $dest = shift;
	my $data = shift;

	if(ref($dest->{values}) eq "ARRAY") {
		my $fh = $dest->{values}->[0];
		print $fh $data;
	} else { $dest->{values} .= $data; }
}

sub new_tmp_file {
	my $temp_dir = shift;
	my $data = shift;

	my $path = "";
	my $fh;
	my $i = 0;
	do {
		$i < 3 or last;
		my $name = tmpnam(); 
		$name = (split("/", $name))[-1];
		$path = join("/", $temp_dir, $name);