Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
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>&nbsp;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.

In reply to Re^4: Poorly written script by Baffled
in thread Poorly written script by Baffled

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (4)
As of 2024-06-22 22:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.