Gossamer Forum
Home : General : Perl Programming :

Wait for file upload write, then finish

Quote Reply
Wait for file upload write, then finish

I am trying to accept a file upload, and respond in 2 parts.

First send a header and a message that file is writing.

Second add the message the file has finished writing.


#! usr/local/bin/perl -w

#$| = 1; # Tried and blah !
use CGI

my $cgi
= new CGI;
my $dir
= "/temp";

my $file
= $cgi->param('File_Upload');

print $cgi
"File has started writing to disk\n";

=~m/^.*(\\|\/)(.*)/; # strip the remote path and keep the filename
my $name
= $2;
(LOCAL, ">$dir/$name") or die $!;

(<$file>) {
print LOCAL $_
close LOCAL
"$file has finished writing to disk ... thank you.\n";

But the first message and the second message arrive at the client before the file is written to disk.

How to have the 2nd print wait until the file is finished writing to disk ?


Quote Reply
Re: [kode] Wait for file upload write, then finish In reply to
You're sure it appears directly on the screen?

The problem with my code, and that's the reason i started about a progress bar, is that if takes *long* before something is displayed to the user. If processes the complete file first and then displays the success-page.

This is the code I have: (it's based on links 2.0 add.cgi with the following extra code). I know it's 'old code' but it works fine. (exept the missing progress bar Wink) Maybe it's some use for your problem?! (I have no idea.)

### the main part ###

local (%in) = &get_file_and_form();
# local (%in) = &parse_form(); # TO BYPASS UPLOAD-FEATURE

### The upload-part ###

# Redirect user to error OR success page.
if ($status eq "ok") {

# Save any attachments.
if ($in{'FILE_CONTENT'}) {
if (length($in{'FILE_CONTENT'}) < 600000) {
my ($extension) = $in{'FILE_NAME'} =~ /(\.[^\.]+)$/;
my $file_name = $in{$db_key} . lc($extension);
if ($file_name =~ /\.cgi$|\.pl$|\.js$|\.vbs$|\.bat$|\.com$|\.exe$/i) {
$attachment_email_url = "Error: Bestandformaat ($extension) niet toegestaan.";
} else {
$attachment_email_url = qq|<a href="
$in{$db_cols[$db_attachment_name]} = $file_name;
open (FILE, ">/home/domainname/html/site1/data/$in{$db_cols[$db_attachment_name]}")
or &cgierr ("Can't save attachment: $in{$db_cols[$db_attachment_name]}. Reason: $!");
print FILE $in{'FILE_CONTENT'};
close FILE;
} else {
$attachment_email_url = "Error: Alleen bestanden < 500 kB toegestaan.";

## The upload part

sub get_file_and_form {
# --------------------------------------------------------
# Code taken from WWWThreads 3.2 based off of work by Steve Hsueh
# and Rick Baker. (Needs a Mozilla 4+ browser)
my ($i, $loc, $key, $val, $input, %ATTACH, $f,$header, $header_body, $len, $buf);

if( $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/ ) {
if ($ENV{'REQUEST_METHOD'} eq "GET") { $input = $ENV{'QUERY_STRING'}; }
elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
$len = 0; $input = '';
while( $len != $ENV{'CONTENT_LENGTH'} ) {
$buf = '';
$len += sysread(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
$input .= $buf;
my $boundary = '--'.$1;
my @list = split(/$boundary/, $input);

# For some reason there are always 2 extra, that are empty
my $size = @list - 2;

for $x (1 .. $size) {
$header_body = $list[$x];
$header_body =~ /\r\n\r\n|\n\n/;
# Here we split the header and body
$header = $`;
my $body = $';
$body =~ s/\r\n$//;
# Now we try to get the file name
my $name = $header;
my $blah;
$name =~ /name=\"(.+)"/;
($name,$blah) = split(/"/,$1);
$ATTACH{'NAME'} = $name;
# If the form name is not attach, then we need to parse this like
# regular form data and we need to remove any field with "---" as a
# value as this denotes an empty SELECT field.
if ($name ne "Attachment") {
$body =~ tr/+/ /;
$body =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if ($body ne "---") {
exists $ATTACH{$name} ? ($ATTACH{$name} .= "~~$body") : ($ATTACH{$name} = $body);
# Otherwise it is an attachment and we need to finish it up
else {

$header =~ /filename=\"(.+)\"/;
$ATTACH{'FILE_NAME'} =~ s/\"//g;
$ATTACH{'FILE_NAME'} =~ s/\s//g;

for $i ($x .. $list[$i]) {
$list[$i] =~ s/^.+name=$//;
$list[$i] =~ /\"(\w+)\"/;
$ATTACH{$1} = $';
return %ATTACH;
else {
return &parse_form();

Last edited by:

cK: May 30, 2002, 2:24 AM
Quote Reply
Re: [kode] Wait for file upload write, then finish In reply to
You could try non-parsed headers, but if there were a truly humongous file to be uploaded, the browser might timeout. See my post about half a page below about nph.
Quote Reply
Re: [oldmoney] Wait for file upload write, then finish In reply to
Thanks ck and oldmoney,

I tried both suggestions and some more.

Guess I will have to put my pc back in the box and return for a refund. Frown