You're missing a } at the end of sub bye_bye.
You have use CGI, but apparently are not using CGI, since the part at the beginning does all the input processing itself?
Use strict and use warnings should always be on. The following variables are global and should have their scope set:
$BASE_PATH, $LINE, $bRead, $buffer, $content_type, $delete_file, $dir_name, $file_name, $folder, $interval, $len, $max_upload, $mes, $name, $ofh, $pair, $post_prog, $sessionid, $size, $submit, $user_dir, $user_level, $value, %form, @pairs
And there are various warnings as well, that I'm not going to bother fixing. You ought to be able to.
It's best to never lock the file you're trying to process. Hash (or add some suffix to) the file path, then create and lock a file with that hash as the file name. Do your processing on the file. Unlock the hash. This allows you to, for instance, open a file for read, read the number, close it, open the file for write, write the updated number, close it - without losing your lock. I really don't like the way you seem to be doing it.
As for overwriting your directory, I still haven't figured out why that's happening, but you might try printing all the paths you open for write or read/write and see if any of them is the wrong path. If that doesn't identify the problem, about all I can suggest is sectioning your program into a number of smaller subs with clearly identified input, output, and processing objectives, and testing each one to make sure it does what it's supposed to. | [reply] |
Give code. I don't see why halting the upload would delete a folder, unless you're overwriting the folder with your upload. | [reply] |
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 ################################################
| [reply] [d/l] |