Gossamer Forum: General: Perl Programming: Wait for file upload write, then finish

Hello

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.

Code:
 
 
#! 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->header(); 
print "File has started writing to disk\n"; 
 
$file=~m/^.*(\\|\/)(.*)/; # strip the remote path and keep the filename 
my $name = $2; 
open(LOCAL, ">$dir/$name") or die $!; 
 
while(<$file>) { 
print LOCAL $_; 
} 
close LOCAL; 
print "$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 ?

Thanks

Kode

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="http://www.domainname.nl/data_admin/$file_name">http://www.domainname.nl/data_admin/$file_name</a>|;
$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;
$ATTACH{'FILE_CONTENT'} = $body;
# 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'} = $1;
$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();
}
}

Wait for file upload write, then finish

Last edited by: