help,my upload script is bugged part 2

pip has asked for the wisdom of the Perl Monks concerning the following question:

Hello, 1st off thanks to zentara, DamnDirtyApe, grep and adrianh for their excellent inputs in regards to my problem with an upload script. Would zentara (or anyone interested) be be so kind helping me to point out where to put the jpeg and gif exclusions in this script as I am really a novice and just don't know. And perhaps include in the script a note to the user that if they try to upload another format that only gif and jpgs are allowed? Thanks again for the help pip

zentara wrote:
Here this upload script might suit your purpose. I'll leave it up
to you to add the filtering for gif, and jpgs. It should be obvious
where it goes.
[download]

#!/usr/bin/perl -wT
use strict;
use CGI;
my $q = new CGI;
#The max size of the uploaded file:
$CGI::POST_MAX = 1024 * 1024 * 30;
my $maxfile = $CGI::POST_MAX;
#The folder with the uploaded files:
my $outfolder = "uploads";

&upload;
#######################################################
sub upload {
my ($filen, $ext);
#Print the start of the page:
$| = 1;
print <<eof;
Content-type: text/html

Uploading the file...
<body><html>
eof
my $file = $q->upload('file');
my $filename = $file;
$filename =~ s/^.*\///g;
$filename =~ s/^.*\\//g;
$filename =~ s/\-/_/g;
$filename =~ s/^\.*//g;
$filename =~ s/ /_/g;
my $allpath = $file;
if ($filename =~ /\./) {
$filen = $`;
$ext = $';
}

my $maxtries=4;
for (my $i=1; $i < $maxtries; $i++) {
if (-e "$outfolder/$filename") {
$filename = $filen . "_" . $i . '.' . $ext;
}
}

#Create the file on the server, and print the "." on the page:
open(OUT, ">$outfolder/$filename")
or die "Can't open $outfolder/$file for writing. - $!";
binmode OUT;
while(read($file, my $buffer, 4096)){;
print OUT $buffer;
}
close OUT;

my $filesize = -s "$outfolder/$filename";
$filesize = (int(($filesize / 1024) * 10) / 10);
$filesize = "$filesize KB";

#Print on the browser:
my $script = 'http://zentara.zentara.net/~zentara/up2.html';
print <<eof;
<br><br>
The file $filename was successfully uploaded!<br>
The file has $filesize.<br>
<div class="center">
<a href="$script">Go back if you want to upload one more file.</a>
&nbsp; &nbsp;
<a href="http://zentara.zentara.net/~zentara">Go to home page!</a>
</body></html>
eof

#End the subroutine
}
[download]

Comment on help,my upload script is bugged part 2 Select or Download Code

Replies are listed 'Best First'.
Re: help,my upload script is bugged part 2 by zentara (Cardinal) on Aug 12, 2002 at 12:42 UTC
Add this code. Also notice my $script is now assigned twice, just move that to the top of the upload sub, it will make the script a bit shorter. ....... ......... Uploading the file... <body><html> eof my $file = $q->upload('file'); my $filename = $file; #add starts here if ($filename !~ /(.gif\|.jpeg\|.jpg)$/){ print 'Files must be gif,jpeg, or jpg.<br>Please reselect<br>'; my $script = 'http://zentara.zentara.net/~zentara/up2.html'; print "<a href=$script>'Try again,please.'</a>"; exit; } #add ends $filename =~ s/^.\///g; $filename =~ s/^.\\//g; $filename =~ s/\-/_/g; $filename =~ s/^\.*//g; $filename =~ s/ /_/g; my $allpath = $file; if ($filename =~ /\./) { $filen = $`; $ext = $'; } ....... ....... [download]	[reply] [d/l]
Re: help,my upload script is bugged part 2 by Anonymous Monk on Aug 12, 2002 at 15:00 UTC
Note: This has nothing to do with your problem, just something to look into. Consider using 'tr' instead of 's', for character conversions: `$xxx =~ s/ /_/g; $xxx =~ tr/ /_/;` [download]	[reply] [d/l]
Re: help,my upload script is bugged part 2 by pip (Novice) on Aug 13, 2002 at 11:33 UTC
Thanks zentara, for helping again #pip	[reply]