Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Re: Poorly written script

by Thelonius (Priest)
on Feb 11, 2008 at 05:17 UTC ( [id://667322]=note: print w/replies, xml ) Need Help??


in reply to Poorly written script

It hard to see how it could use quite so much memory, but there are a couple of obvious ways to reduce what it does use.

First, you are building an array to hold all the names of the text files in each directory, when all you need is the count. So you should just count in a loop. I notice that the readdir documentation in perlfunc only shows an example of readdir in list context, but for this purpose, a loop is better. If there is some huge directory with 100,000 files, that could use a lot of memory, but that seems unlikely.

Second, although this is probably a minor point, where you say foreach $key (sort keys %category), the sort is causing an array of all the keys to be built. Since this is unnecessary for this use, you can just leave the sort out. 

#!/usr/bin/perl
use Carp;
use strict;
use vars qw(%config %category %form %super);
require "/var/www/vhosts/mysite.com/cgi-bin/categories.cgi";
$config{'basepath'} = '/var/www/vhosts/mysite.com/cgi-bin/';
$config{'bluedir'} = 'register';

sub count_text_files {
  my ($dirname) = @_;
  my $result = 0;
  if (!opendir DIR, $dirname) {
    carp "Cannot open $dirname: $!\n";
    return 0;
  }
  while (defined(my $file = readdir DIR)) {
    if (-T "$dirname/$file") {
      ++$result;
    }
  }
  close DIR;
  return $result;
}

my $key;
my $numusers = 1;       
$numusers += count_text_files("$config{'basepath'}$config{'bluedir'}")
+;


my $totalfiles = 100;
foreach $key (keys %category) {
  $totalfiles += count_text_files("$config{'basepath'}$key");
}

[download]

Replies are listed 'Best First'.
Re^2: Poorly written script
by Baffled (Acolyte) on Feb 11, 2008 at 06:09 UTC
    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.
[reply]
      Well, just post it to Seekers. I'm going to bed soon, but somebody'll probably reply.
[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;

        [download]
        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.
[reply]
[d/l]

In Section Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: note [id://667322]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others rifling through the Monastery: (5)
As of 2024-04-23 17:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found