Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Re^4: Poorly written script

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


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

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.


Comment on Re^4: Poorly written script
Download Code
Re^5: Poorly written script
by graff (Chancellor) on Feb 11, 2008 at 14:52 UTC
    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.)

      Problem is there isnt always four picture files, sometimes its 3, maybe 1,2 or even none. Doesnt your loop assume there is always going to be all four image files?

      Also I do believe it does keep those upto 4 image files in RAM for the next page to be completed. This is the first page to list items where they upload the images, after image upload is done they go on to the item listing form, where they choose thier category and it isnt until they submit the next page do these images get assigned thier item number and appropiate destination in the file tree.

      Also, the script use to have the "use strict;" at the top of all the files, about 2 years ago when I moved the site to the dedicated server the hosting company (godaddy) told me I had to change it to "use Carp;" to work on thier systems. It worked fine for two years until last week when these problems started.

        Check for the files the same way you do now, just do it in the loop. Maybe something like:

        while ($filehandle = get_next_file()) { ... }

        So you spin off your "check if the file exists" and "open the file" code into a new function, and keep doing the loop while there are more files to find.

        the script use to have the "use strict;" at the top of all the files, about 2 years ago when I moved the site to the dedicated server the hosting company (godaddy) told me I had to change it to "use Carp;" to work on thier systems.

        use strict and use Carp are not mutually exclusive, they do not conflict with each other, you can have them both in the same script at the same time, and it would be a good idea to do so.

        I admire any hosting operation that recommends using Carp. (Whether you also use the "fatals to browser" option is something you should be allowed to decide on your own, but normally you only use that during development, not in a "production" version). I cannot understand (and would hardly believe) that they would also insist on removing "use strict".

        By the way, if they want you to use Carp, you should actually invoke its functions at suitable points in your script (i.e. where errors occur) -- just putting use Carp; at the top accomplishes nothing unless you actually call some of its functions.

        I do believe it does keep those upto 4 image files in RAM for the next page to be completed.

        You should probably study the manual for CGI more closely, and focus on the section that describes "CREATING A FILE UPLOAD FIELD". You should also check to see what version of CGI is being used by the host server -- your code may have been written for an older version of CGI (pre-2.47), because you include your own "upload()" function, but as of v2.47, there is an "upload()" function defined within CGI.pm (I'm looking at v3.33 that came with perl 5.8.8). Make sure you study the manual that goes with the version you are using.

        I'm not personally familiar with file-upload operations in CGI, and I don't quite follow what your "upload" subroutine is doing (or whether the CGI built-in "upload()" is supposed to do the same thing), but it should not be the case that the image files being uploaded by your clients would all be memory resident while the script is running. The server should be storing the uploaded files to a temp directory, and your method of copying their contents to permanent files appears to be keeping the memory load to a minimum.

        Still, you need to check the CGI manual very carefully about file uploads. (The inclusion of "use strict" has an important impact, too. Read about it.)

        Problem is there isnt always four picture files, sometimes its 3, maybe 1,2 or even none. Doesnt your loop assume there is always going to be all four image files?

        As suggested by the previous reply, this is not a problem. In fact, here's what I was thinking of when I made the suggestion about the loop -- this is a version of (most of) your code, with "use strict" put back in, a nod to "File::Basename" (which is handy for your case), and a pass through perltidy (though I have made some of my own adjustments to some of the indents, and fiddled with the arrangements of some of the print statements):

        That is based on the version you posted, it compiles with strict and warnings enabled, and it covers everything except your "upload()" and "error()" subroutines. (Your "upload()" sub would undergo a similar amount of shortening by using a loop over the elements of the "%uploads_done" hash, which is populated in the "for" loop that I'm suggesting here.)

        There are still likely to be problems -- the code you posted seems to be using bunch of different stuff in a "%config" hash even though you only assign one thing to that hash ($config{header}); there are a few other variables being used without anything being assigned to them ($method and $action -- but CGI probably provides sensible defaults for these). And assuming your "upload()" sub does something different from the CGI built-in "upload()", your sub should probably be given a different name. Also, the idea of using a template system of some sort would help.

        Final summary: I'm still not sure any of this addresses your problem with memory consumption, unless you find something that needs fixing about your handling of the file uploads. You may still need to add some diagnostics to find out what's going on with the memory usage.

Re^5: Poorly written script
by amarquis (Curate) on Feb 11, 2008 at 15:01 UTC

    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?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://667333]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (7)
As of 2014-11-24 12:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (141 votes), past polls