Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things

Re^2: Poorly written script

by Baffled (Acolyte)
on Feb 11, 2008 at 06:09 UTC ( #667329=note: print w/replies, xml ) Need Help??

in reply to Re: Poorly written script
in thread Poorly written script

Thank you so much Thelonius, your totally awesome. Your code worked perfectly, I wast sure if I was supposed to replace the $dirname with something or not. I tried it like it is first and it worked first shot. You really really came to my rescue in a way I never thought of. Solved that problem. I'm torn between asking another question, I dont want to be greedy or a mouch, but being such a novice that I am, is there any chance I could post another snippet of code for you to review, its a upload.cgi that has also been deemed a major drain on memory, especially when more than one user is hits it like on friday nights. What gets me is that since I went to the dedicated server Ive been using this same script for several years without a hiccup, but I guess now adays we have many more users and much more busier and all that makes the system have to do much more processing.

Replies are listed 'Best First'.
Re^3: Poorly written script
by Thelonius (Priest) on Feb 11, 2008 at 06:21 UTC
    Well, just post it to Seekers. I'm going to bed soon, but somebody'll probably reply.
      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.
        Please consider the following steps -- they might not lead directly to a reduction in memory waste, but they will make your code shorter, more legible, and easier to maintain/fix:
        1. Run the source code through perltidy to normalize the indentation of code blocks; do so at intervals if necessary, if you find it difficult to maintain consistent indenting while you edit the script.

        2. Add use strict; at the top, and add "my " in front of the first mentions of variables where necessary. You will find there are some unnecessary lines in your code -- e.g. the four lines of $fileN = $form{'upload_fileN'}; refer to a non-existent hash (%form), and do nothing.

        3. Instead of repeating four blocks for each of "file1, file2, file3, file4", put one block inside a "for" loop (there are a few places in the code where this can be done):
          for my $filestr ( $uploadfile1, $uploadfile2, $uploadfile3, $uploadfil +e4 ) { # use $filestr where your code currently uses $uploadfileN... }
          It would be even easier if you loaded your filename params into an array instead of four distinct scalars -- then you just loop (or grep) over that array.

        4. Wherever you have the same quoted string used in multiple print statements, assign the constant part(s) to a variable, and use the variable in the print statements. (Step 3 will take care of a lot of this, but there may still be more to do.)

        The last two items are simply applying the rule: "don't repeat yourself". When you decide something needs to be changed or fixed, you should only have to do it once, not four (or eight or sixteen) times.

        As for diagnosing the memory consumption, this would be easier if you have shell access to the server, but if you don't have that, look for a way to check on memory consumption within the running script (ask for help on that from your sysadmins, or here at PM -- the approach will probably depend on the server), and have the script write reports to a log file that you can inspect after the script finishes. The reports should be done at different strategic points in the code, and should include time information along with memory size.

        (As it stands, I don't see anything that's an obvious memory no-no, unless all four uploaded files are somehow being held in RAM for reasons that are not evident in your code.)

        I'm sure a more experienced monk will tackle larger issues better than I can (I think your biggest issue might be multiple similar iterations over data that could be done in one loop, but I didn't examine it closely).

        I've found in the past that I can get decent speed gains with very little effort by replacing many repeated print statements with a response string that I keep adding to statement by statement and eventually print.

        Again, in this case you have problems to tackle that overshadow any slowness from repeated prints, but it is food for thought for your other pages/scripts.

        Edit: Graff's post above is great. Besides the speed benefit of going from "do file1, do file2, do file3, etc." to a single pass or a loop is that it will be much easier to modify/extend your code.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://667329]
[Corion]: You'll have to look somewhere esoteric for that. Maybe some tied variable or special dualvar can also trigger that. But it's certainly not a common occurrence
[Corion]: And on 5.20, the following also outputs no find:perl -wle 'for my $x ("\x{2000}".."\ x{1fffff}") { if( $x && ! length $x ) { warn qq(<$x>); warn length $x; die } }'
[Corion]: (this time on Unix)
[hippo]: Understood. I'll have to go through the code and see if it's doing anything fancy with ties, dual-vars or non-scalars. In the end, it's probably a bug though.
[Corion]: Aaah - you should be able to do this with overload, but I would hit somebody really hard if they constructed objects that are true but the empty string, and you not knowing about the domain knowledge where this makes sense

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (14)
As of 2017-07-27 13:34 GMT
Find Nodes?
    Voting Booth?
    I came, I saw, I ...

    Results (413 votes). Check out past polls.