Ok here you go:
#!/usr/bin/perl
use CGI qw/:standard/;
$config{'header2'} =<<"EOF";
<HEAD>
<TITLE>$config{'sitename'} Item Listing Pages</TITLE>
</HEAD>
<FONT FACE=ARIAL><BODY TEXT=#000000 BGCOLOR=#FFFFFF LINK=#0000FF VLINK
+=#800080 ALINK=#FF0000>
<a href=/index.shtml><img border=0 src=/images/logo.gif></a><br><br><b
+r><br>
EOF
@ext = qw(jpeg jpg gif bmp);
$| = 1;
$match = 0;
$encoding = 'multipart/form-data';
$q = new CGI;
print "Content-type: text/html\n\n";
print $config{'header2'};
print "<div align=center><center><table border=0 cellpadding=0 cellspa
+cing=0 width=100% bordercolor=$config{'bordercolor'}>";
print "<tr><td width=100% bgcolor=$config{'colortablehead'} height=30>
+<b> Select your picture(s) to upload (@ext - $config{'imagesize'
+} kb maximum)</b></td></tr></table></center></div><br>";
print $q->startform($method,$action,$encoding);
print "<center><font face=arial size=2><b>Upload Charge $config{'curre
+ncy'}$config{'textuploadcharge'} - Image 1: </b></font>";
print $q->filefield(-name=>'upload_file1', -default=>'starting value',
+ -size=>50, -maxlength=>180);
print "<br><font face=arial size=2><b>Upload Charge $config{'currency'
+}$config{'textuploadcharge2'} - Image 2: </b></font>";
print $q->filefield(-name=>'upload_file2', -default=>'starting value',
+ -size=>50, -maxlength=>180);
print "<br><font face=arial size=2><b>Upload Charge $config{'currency'
+}$config{'textuploadcharge3'} - Image 3: </b></font>";
print $q->filefield(-name=>'upload_file3', -default=>'starting value',
+ -size=>50, -maxlength=>180);
print "<br><font face=arial size=2><b>Upload Charge $config{'currency'
+}$config{'textuploadcharge4'} - Image 4: </b></font>";
print $q->filefield(-name=>'upload_file4', -default=>'starting value',
+ -size=>50, -maxlength=>180);
print "<br>";
print $q->submit(-name=>'button_name', -value=>'Upload Image(s)');
print "</center>";
print $q->endform;
print "<hr width=80% size=1 color=$config{'bordercolor'}>";
print "<center><p><font face=arial size=2>Please click the \"Image Upl
+oad\" button only once,<br>Image Upload can take up to 5 seconds per
+image you upload.<br>Your images will appear below when finished.</fo
+nt></center></p>";
print "<hr width=80% size=1 color=$config{'bordercolor'}>";
umask(000); # UNIX file permission junk
mkdir("$config{'imageuploaddir'}", 0777) unless (-d "$config{'imageupl
+oaddir'}");
$file1 = $form{'upload_file1'};
$file2 = $form{'upload_file2'};
$file3 = $form{'upload_file3'};
$file4 = $form{'upload_file4'};
$uploadfile1 = $q->param('upload_file1');
$uploadfile2 = $q->param('upload_file2');
$uploadfile3 = $q->param('upload_file3');
$uploadfile4 = $q->param('upload_file4');
if ($ENV{'CONTENT_LENGTH'} >= $config{'imagesize'} * 1024) {
print "<p><div align=center><font face=arial size=2 color=FF
+0000><p>Error - The image file size is too large\!</font></p>\n";
print "<p><font face=arial size=2>Sorry but your upload imag
+e size can not be over $config{'imagesize'}k.</font></p>\n";
exit 0;
}
if ($uploadfile1){
$uploadfile1 =~ /\w:[\\[\w- ]*\\]*([\w- ]*.\w{1,3})$/g;
$file1 = $1;
foreach $ext (@ext){
if (grep /$ext$/i,$uploadfile1){
$match = 1;
$type = $ext;
}
}
if ($match){
$newimage = ($config{'closedays2'} * 86400 + time);
$file1 = "$newimage.$type";
undef $bytesread;
open(OUTFILE, ">$config{'imageuploaddir'}/$file1")||&error("Ca
+n not open $config{'imageuploaddir'}/$file1. $!");
binmode OUTFILE;
while ($bytesread=read($uploadfile1,$buffer,1024)) {
print OUTFILE $buffer;
}
close (OUTFILE);
sleep 2; # Wait 2 seconds
}
else {
&error("<center><font face=arial size=2><b>Image forma
+t not supported.</b><p>$uploadfile1</p><b>Upload has failed.</b></fon
+t></center>");
}
}
if ($uploadfile2){
$uploadfile2 =~ /\w:[\\[\w- ]*\\]*([\w- ]*.\w{1,3})$/g;
$file2 = $1;
foreach $ext (@ext){
if (grep /$ext$/i,$uploadfile2){
$match = 1;
$type=$ext;
}
}
if ($match){
$newimage = ($config{'closedays2'} * 86400 + time);
$file2 = "$newimage.$type";
undef $bytesread;
open(OUTFILE, ">$config{'imageuploaddir'}/$file2")||&error("Ca
+n not open $config{'imageuploaddir'}/$file2. $!");
binmode OUTFILE;
while ($bytesread=read($uploadfile2,$buffer,1024)) {
print OUTFILE $buffer;
}
close (OUTFILE);
sleep 2; # Wait 2 seconds
}
else {
&error("<center><font face=arial size=2><b>Image forma
+t not supported.</b><p>$uploadfile2</p><b>Upload has failed.</b></fon
+t></center>");
}
}
if ($uploadfile3){
$uploadfile3 =~ /\w:[\\[\w- ]*\\]*([\w- ]*.\w{1,3})$/g;
$file3 = $1;
foreach $ext (@ext){
if (grep /$ext$/i,$uploadfile3){
$match = 1;
$type=$ext;
}
}
if ($match){
$newimage = ($config{'closedays2'} * 86400 + time);
$file3 = "$newimage.$type";
undef $bytesread;
open(OUTFILE, ">$config{'imageuploaddir'}/$file3")||&error("Ca
+n not open $config{'imageuploaddir'}/$file3. $!");
binmode OUTFILE;
while ($bytesread=read($uploadfile3,$buffer,1024)) {
print OUTFILE $buffer;
}
close (OUTFILE);
sleep 2; # Wait 2 seconds
}
else {
&error("<center><font face=arial size=2><b>Image forma
+t not supported.</b><p>$uploadfile3</p><b>Upload has failed.</b></fon
+t></center>");
}
}
if ($uploadfile4){
$uploadfile4 =~ /\w:[\\[\w- ]*\\]*([\w- ]*.\w{1,3})$/g;
$file4 = $1;
foreach $ext (@ext){
if (grep /$ext$/i,$uploadfile4){
$match = 1;
$type = $ext;
}
}
if ($match){
$newimage = ($config{'closedays2'} * 86400 + time);
$file4 = "$newimage.$type";
undef $bytesread;
open(OUTFILE, ">$config{'imageuploaddir'}/$file4")||&error("Ca
+n not open $config{'imageuploaddir'}/$file4. $!");
binmode OUTFILE;
while ($bytesread=read($uploadfile4,$buffer,1024)) {
print OUTFILE $buffer;
}
close (OUTFILE);
sleep 2; # Wait 2 seconds
}
else {
&error("<center><font face=arial size=2><b>Image forma
+t not supported.</b><p>$uploadfile4</p><b>Upload has failed.</b></fon
+t></center>");
}
}
if ($file1){
&upload;
}
#-###################################################
# Image Upload
sub upload {
if ($match){
print "<table align=center width=100% border=0 cellspacing
+=0 cellpadding=0>";
print "<tr><td align=center width=100%>";
print "<FORM ACTION=\"$config{'scripturl'}/cgi-bin/auction
+/auction.cgi?action=uploaddone\&IMAGE1=$file1\" METHOD=POST>";
if ($file1){
print "<center><b><font face=arial size=2>Image file 1:</b
+>: $file1</center>\n";
print "<center><font face=arial size=2>$uploadfile1 <br><b
+>Upload Complete Image 1.</b></font></center>\n";
print "<p><img src=$config{'imageuploadurl'}/$file1></p><h
+r width=80% size=1 color=$config{'bordercolor'}>";
}
if ($file2){
print "<center><b><font face=arial size=2>Image file 2:</b
+>: $file2</center>\n";
print "<center><font face=arial size=2>$uploadfile2 <br><b
+>Upload Complete Image 2.</b></font></center>\n";
print "<p><img src=$config{'imageuploadurl'}/$file2></p><h
+r width=80% size=1 color=$config{'bordercolor'}>";
}
if ($file3){
print "<center><b><font face=arial size=2>Image file 3:</b
+>: $file3</center>\n";
print "<center><font face=arial size=2>$uploadfile3 <br><b
+>Upload Complete Image 3.</b></font></center>\n";
print "<p><img src=$config{'imageuploadurl'}/$file3></p><h
+r width=80% size=1 color=$config{'bordercolor'}>";
}
if ($file4){
print "<center><b><font face=arial size=2>Image file 4:</b
+>: $file4</center>\n";
print "<center><font face=arial size=2>$uploadfile4 <br><b
+>Upload Complete Image 4.</b></font></center>\n";
print "<p><img src=$config{'imageuploadurl'}/$file4></p><h
+r width=80% size=1 color=$config{'bordercolor'}>";
}
if ($file1){
print "<input type=hidden name=IMAGE1 value=$file1>";
print "<input type=hidden name=THUMB1 value=$file1>";
}
if ($file2){
print "<input type=hidden name=IMAGE2 value=$file2>";
}
if ($file3){
print "<input type=hidden name=IMAGE3 value=$file3>";
}
if ($file4){
print "<input type=hidden name=IMAGE4 value=$file4>";
}
print "</td></tr></table>";
print "<center><p><font face=arial size=2>If the image(s)
+are correct. Click \"Continue\".</font></center></p>";
print "<center><p><font face=arial size=2><font face=arial
+ size=2>If they are not correct, use your browsers back button to try
+ again.</font></center></p>";
print "<center><input type=submit value=\"Continue\"></cen
+ter>";
print "</form>";
}
}
#-###################################################
# Error
sub error {
@error=@_;
print "<center><font face=arial size=2><b>@error</center></font></
+b>";
exit;
}
1;
The purpose of this page is that it allows our users to upload upto 4 images for thier auctions. When more than a couple of people start using it the site slows, again the hosting service claims its poorly written and causes memory leaks.
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.