in reply to Uploading images with CGI.pm

Here's mine:

(on the page)

<FORM action="upload_action.asp" method="post" enctype="multipart/form +-data"> File on your machine to upload: <INPUT TYPE="file" NAME="file">
(in the script)
my $len= $Request->TotalBytes(); my $input= $Request->BinaryRead ($len); # parse the stuff my $stuff= parse_multipart ($input); undef $input; # recover memory ASAP my $filename= $stuff->{filename}{'#body'}; # ... make sure the filename is OK. tr[\\/:][$]; # could do more. # write it out. unless (open FILE, ">" . $Server->MapPath ("uploads/$filename")) { $Response->Write ("The filename \"" . $Server->HTMLEncode($fil +ename) . "\" could not be opened for writing. Hit the BACK button an +d edit the form, and try again."); exit; } binmode FILE; print FILE $stuff->{file}{'#body'}; my $size= length $stuff->{file}{'#body'}; delete $stuff->{file}; #recover the memory ASAP. close FILE; if (open FILE, ">" . $Server->MapPath ("uploads/$filename.comment" +)) { print FILE "Comment for \"$filename\": $stuff->{comment}{'#body +'}\n"; print FILE "Email: $stuff->{email}{'#body'}\n"; print FILE "Name: $stuff->{name}{'#body'}\n"; close FILE; } # return a list of parts. # each part is a hash containing the header information # The "filename" included in the Content-Disposition line is indexed a +s "#filename". # body is indexed as "#body". # everything else indexed as header name up to (not including) the ':' # index by the name found in the Content-Disposition line. sub parse_multipart { my $input= shift; my %result; #first determine the delimiter $input =~ m/^--(.*?)\r?\n/sg; my $delimiter= $1; print "Delimiter is: [$delimiter]\n"; print "pos: ", pos($input), "\n"; #than split (watch for trailing newline or "--"), include leading new +line in delimiter. while ($input =~ /\G(.*?)\r?\n--$delimiter(--|\r?\n)/sg) { my ($content,$endmark) = ($1, $2); #further parse each part. my %data; my ($header, $name); ($header, $data{'#body'})= split (/\r?\n\r?\n/, $content, 2); foreach my $line (split (/\r?\n/, $header)) { if ($line =~ /^Content-Disposition:/) { ($name) = $line =~ /\Wname="(.*?)"/; my ($filename) = $line =~ /filename="(.*?)"/; $data{'#filename'}= $filename if defined $filename; } else { my ($tag,$value)= split (/:\s/, $line, 2); $data{$tag}= $value; } } $result{$name}= \%data; last if $endmark eq '--'; # by definition, ignore anything after + this. } return \%result; }