Here's the code I'm using:
use CGI;
use Fcntl qw(:DEFAULT :flock);
#---- query vars -----------------------------------------
#---------------------------------------------------------
my @form;
my $form;
$buffer = $ENV{'QUERY_STRING'};
@pairs = split(/&/, $buffer);
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$form{$name} = $value;
#print "<br>name-->>$name || value-->>$value";
}
$submit = $form{'submit'};
$folder = $form{"folder"};
$dir_name = $form{"dir_name"};
$sessionid = $form{'sessionid'};
$file_name = $form{'file_name'};
$user_level = $form{"user_level"};
$delete_file = $form{'delete_file'};
#---------------------------------------------------------
if( $user_level eq 1 ){ $folder = 'incoming'; }
if( $user_level eq 2 ){ $folder = 'outgoing'; }
#----- header info ---------------------------------------
#---------------------------------------------------------
$BASE_PATH = $ENV{'DOCUMENT_ROOT'};
$user_dir = $BASE_PATH . "new_site_users/$dir_name/$folder";
$post_prog = "/usr/bin/POST"; # needs to have LWP module installed - a
+vailable free from CPAN.
$interval=1; # how often to refresh the p
+rogress bar
$max_upload = 30000000; # close enough to 5Mb :-) set this to whatever
+ you feel suitable for you
$content_type = $ENV{'CONTENT_TYPE'};
$len = $ENV{'CONTENT_LENGTH'};
$bRead =0;
$|=1;
#---------------------------------------------------------
sub bye_bye
{
$mes = shift;
print "Content-type: text/html\n\n";
print "<br>$mes<br>\n";
exit;
#### start upload code ##############################################
+##
if( $submit eq 'yes' )
{
#---- file and directory tests----------------------
#---------------------------------------------------
if($len > $max_upload)
{
close (STDIN);
bye_bye("The maximum upload size has been exceeded");
}
unless (-d "$user_dir")
{
print "sorry could not save file to $user_dir";
exit;
}
#---------------------------------------------------
#---- process the file -----------------------------
#---------------------------------------------------
sysopen(FH, "$user_dir/flength", O_RDWR | O_CREAT) or die "c
+an't open numfile: $!";
$ofh = select(FH); $| = 1; select ($ofh);
flock(FH, LOCK_EX) or die "can't write-lock numfile: $!";
seek(FH, 0, 0) or die "can't rewind numfile : $!";
print FH $len;
close(FH);
sleep(1);
open(TMP,">","$user_dir/postdata") or &bye_bye ("can't open
+temp file");
my $i=0;
$ofh = select(TMP); $| = 1; select ($ofh);
while (read (STDIN ,$LINE, 4096) && $bRead < $len )
{
$bRead += length $LINE;
$size = -s "$user_dir/postdata";
select(undef, undef, undef,0.35); # sleep for 0.
+2 of a second.
$i++;
print TMP $LINE;
}
close (TMP);
open(STDIN,"$user_dir/postdata") or die "can't open temp file";
#---------------------------------------------------
}#__endIF__
#### end upload code ################################################
|