Slow Responding SSI from older perl script

[Elsa734]

I use server side include cgi files to deliver dynamic content to my shtml pages, however I beleive they may slow the load time of my pages. I believe there are much faster ways to do what these ssi files do using more upto date scripting, something to do with the way it collects information to be displayed. Im hoping to get some feedback on this, and to overall speed up my ssi. Im posting the code for one of several of these types of files, with the thinking that if I can see one I will be able to figure out the changes for other similar files. The main differences of these files is the area of information that is collected and the size and way its displayed, I can figure out the display parts with some trial and error, however some notes on the areas of how its collecting the information would be helpful to help me understand how & where its looking for the information.

<code>
#!/usr/bin/perl
use Carp;
use vars qw(%config %category %form %supercat);
require "/var/

http://www/vhosts/mysite.com/cgi-bin/auction/categories.cgi";

require "/var/

http://www/vhosts/mysite.com/cgi-bin/auction/timeleft.cgi";

local %config;
$config{'basepath'} = '/var/

http://www/vhosts/mysite.com/cgi-bin/auction/';

$config{'htmlpages'} = '

http://www.mysite.com';

$config{'colortablehead'} = '#E6E6E6';
$config{'colortablehead0'} = '#E6E6E6';
$config{'colortablehead1'} = '#E6E6E6';
$config{'colortablehead2'} = '#E6E6E6';
$config{'colortablehead3'} = '#E6E6E6';
$config{'colortablehead4'} = '#E6E6E6';
$config{'colortablehead5'} = '#E6E6E6';
$config{'colortablehead6'} = '#E6E6E6';
$config{'colortablehead7'} = '#E6E6E6';
$config{'colortablehead8'} = '#E6E6E6';
$config{'colortablehead9'} = '#E6E6E6';
$config{'colortablehead10'} = '#EEEEEE';
$config{'colortablehead10T'} = '#E6E6E6';
$config{'colortablehead10B'} = '#EEEEEE';
$config{'colortablehead11'} = '#E6E6E6';
$config{'colortablehead12'} = '#E6E6E6';
$config{'colortablehead13A'} = '#FFFFBF';
$config{'colortablehead13B'} = '#FFFFBF';
$config{'colortablehead13C'} = '#FFFF8C';
$config{'colortablehead13D'} = '#FFFF8C';
$config{'colortablehead13E'} = '#FFFF00';
$config{'colortablehead13F'} = '#FFFF00';
$config{'specialtext0'} = '#FF0000';
$config{'specialtext1'} = '#FF0000';
$config{'specialtext2'} = '#FF0000';
$config{'text'} = '#000000';
$config{'text0'} = '#000000';
$config{'text1'} = '#000000';
$config{'text2'} = '#000000';
$config{'text3'} = '#000000';
$config{'text4'} = '#000000';
$config{'text5'} = '#000000';
$config{'text6'} = '#000000';
$config{'text7'} = '#000000';
$config{'text8'} = '#000000';
$config{'text9'} = '#000000';
$config{'text10'} = '#FF0000';
$config{'text10T'} = '#000000';
$config{'text10B'} = '#000000';
$config{'text12'} = '#000000';
$config{'text13A'} = '#000000';
$config{'text13C'} = '#000000';
$config{'text13E'} = '#000000';
$config{'colortablebody'} = '#E6E6E6';
$config{'colortablebody1'} = '#EFEFEF';
$config{'bordercolor'} = '#0000FF';
$config{'bordercolor1'} = '#000000';
$config{'odd_row_color'} = '#FFFFFF';
$config{'even_row_color'} = '#EEEEEE';
$config{'currency'} = '$';
$config{'currency2'} = 'U.S.';
$config{'currency3'} = 'dollar';
$config{'disp_max'} = 20;

##################################
# SSI Gallery on front page
# Randomly gathers current items posted to gallery

print "Content-type: text/html\n\n";
print "<div align=center><center><table border=0 cellpadding=0 cellspacing=0 width=100%>\n";
my $key;
my $s = 1;
my $pagebreak = int $form{pb} || 17;
my ($icount, $pcount) = (0,0);
foreach $key (sort keys %category) {
opendir THEDIR, "$config{'basepath'}$key" || die "Unable to open directory: $!";
my @allfiles = readdir THEDIR;
closedir THEDIR;
my $file;
@allfiles = get_random( \@allfiles, $config{'disp_max'}) if $#allfiles >= $config{'disp_max'};
foreach $file (sort { int($a) <=> int($b) } @allfiles) {
if (-T "$config{'basepath'}$key/$file") {
open THEFILE, "$config{'basepath'}$key/$file";
my ($title, $reserve, $inc, $desc, $image1, $image2, $image3, $image4, $thumb1, $thumb2, $thumb3, $thumb4, $dutch, $qty, $bold, $highlight, $feat, $catfeat, $grabber, $relist, $buyit, $gallery, $counter, $ship1, $ship2, $ship3, $ship4, $ship5, $shipcost, $location, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, $pay9, $paypal, $idata1, $idata2, $idata3, $idata4, $idata5, $idata6, $idata7, $idata8, $idata9, @bids) = <THEFILE>;
my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $qtysold) = &read_bid($bids[$#bids]);
my ($selleralias, $selleremail, $sellerbid, $sellertime, $selleradd1, $selleradd2, $selleradd3) = &read_bid($bids[0]);
close THEFILE;
chomp($title, $reserve, $inc, $desc, $image1, $image2, $image3, $image4, $thumb1, $thumb2, $thumb3, $thumb4, $dutch, $qty, $bold, $highlight, $feat, $catfeat, $grabber, $relist, $buyit, $gallery, $counter, $ship1, $ship2, $ship3, $ship4, $ship5, $shipcost, $location, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, $pay9, $paypal, $idata1, $idata2, $idata3, $idata4, $idata5, $idata6, $idata7, $idata8, $idata9, @bids);
my @lastbid = split(/\[\]/,$bids[$#bids]);
$file =~ s/\.dat//;
my @closetime = localtime int($file);
my $timeleft = &timeleft($file);
$closetime[4]++;
my $imagedisp = "<IMG SRC=$thumb1 BORDER=0 width=95>";
if ($gallery eq "Yes") {
if(++$icount > $pagebreak){$icount=1; $pcount++} next if $pcount != $form{page};

print "\n<td width=20\% height=150 align=center valign=bottom><font face=arial size=2><table width=80 height=80 bgcolor=000000><tr><br><br><td align=center><A HREF=$config{'htmlpages'}/cgi-bin/auction/auction.cgi\?category=$key\&item=$file>$imagedisp</a></td></tr></table><FONT SIZE=1 FACE=ARIAL>Current Bid: $config{'currency'}$bid</font><br><FONT SIZE=1 FACE=ARIAL>Closes: $timeleft</font></td>\n" if ($thumb1);
if ($s==1) {
print "\n </tr>";
$s = 1;
}
else {
$s++;
}
}
}
}
}
if ($s > 1 && $s < 1) {
print "\n </TR>\n";
}
if ($icount <= 0){
print "<tr><td align=center valign=top height=225><font face=arial size=2><B><br>No items in category.</B></center></font></td></tr>";
}
print "</table>";
print "<div align=center><center><table border=0 cellpadding=0 cellspacing=0 width=100%></td></tr></table></center></div>\n";
print "<br><font face=arial size=2><div align=center><center><table border=0 cellpadding=0 cellspacing=0 width=100%><tr><td align=right width=90%><font size=2><a href=$config{'htmlpages'}/cgi-bin/auction/auction.cgi\?action=gallery>More Gallery!</a>&nbsp;&nbsp;&nbsp;&nbsp;</font></td></tr></table></center></div>\n";
# print "<font face=arial size=2><div align=center><center><table border=0 cellpadding=0 cellspacing=0 width=100%><tr><td width=100% bgcolor=E8E8E8 height=3></td></tr></table></center></div><br>\n";


#-#############################################
# Sub: Read Bid Information (bid_string)
# Reads an item file

sub read_bid {
my $bid_string = shift;
my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $qtysold) = split(/\[\]/,$bid_string);
return ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $qtysold);
}

#-#############################################
# Sub: Get Random Item Data
# Written by: Dieter Werner
# Copyright by: Dieter Werner
#-#############################################
sub get_random {
my ($array, $cnt) = @_;
my ($val, $i, $j);
my @random;
my $noe = @$array;

$cnt = $noe if $cnt > $noe;
for ($i = @$array; --$i {
$j = int rand ($i + 1);
next if $i == $j;
@$array[$i, $j] = @$array[$j, $i];
}
while ($val = pop @$array) {
if ($cnt > 0) {
push @random, $val;
--$cnt;
}
}

return @random;
}

1;


</code>

 

[travs69]

I don't see anything in this page that should be terribly slow (not that it probably couldn't be improved).

I do see it requiring these to files
require "/var/

http://www/vhosts/mysite.com/cgi-bin/auction/categories.cgi";

require "/var/

http://www/vhosts/mysite.com/cgi-bin/auction/timeleft.cgi";

and it looks to me like maybe you are querying ebay for different auctions and what's going on?

it's possible that the slowness is coming from one of those.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Travis - Those who say it cannot be done are usually interrupted by someone else doing it; Give the wrong symptoms, get the wrong solutions;

 

[KevinADC]

It ain't the fact it is SSI although that could slow things down a little bit. It's just terribly slow code.

------------------------------------------
- Kevin, perl coder unexceptional!

 

[Elsa734]

OHHHH You said the bad word. You meant to say GREEDBAY.

But you are somewhat right, we run an auction site, BiddersSite.com and it does work alot like that big other site you mentioned. We like to think better. Were popular in the Metro Detroit Area where we now enjoy almost 20,000 members.

Thank you for looking over that snippet of code for me, I actually have another snippet that is my second suspect of my memory drain problems. 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. I hope to find help in optimizing this and bringing it upto date in coding technics, however Im a newbie and while Ive been reading alot of perl help docs for the last week, Im a long ways from making it right and would appreciate your guidance.

Here we go...

<code>
#!/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><br><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 cellspacing=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{'currency'}$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 Upload\" button only once,<br>Image Upload can take up to 5 seconds per image you upload.<br>Your images will appear below when finished.</font></center></p>";
print "<hr width=80% size=1 color=$config{'bordercolor'}>";
umask(000); # UNIX file permission junk
mkdir("$config{'imageuploaddir'}", 0777) unless (-d "$config{'imageuploaddir'}");

$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=FF0000><p>Error - The image file size is too large\!</font></p>\n";
print "<p><font face=arial size=2>Sorry but your upload image 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("Can 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 format not supported.</b><p>$uploadfile1</p><b>Upload has failed.</b></font></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("Can 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 format not supported.</b><p>$uploadfile2</p><b>Upload has failed.</b></font></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("Can 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 format not supported.</b><p>$uploadfile3</p><b>Upload has failed.</b></font></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("Can 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 format not supported.</b><p>$uploadfile4</p><b>Upload has failed.</b></font></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><hr 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><hr 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><hr 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><hr 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\"></center>";
print "</form>";
}
}

#-###################################################
# Error

sub error {

@error=@_;
print "<center><font face=arial size=2><b>@error</center></font></b>";
exit;
}

1;

</code>

Perhaps there is something I can trade for you help, while scripting isnt my thing, im a dynamite graffic designer.

 

[Elsa734]

TO KEVIN ADC

Your comment is exactly what the technician from the hosting company said to me. "Your code is fine, just these days theres much faster way to do this"

That is what Im addressing here, Im looking to streamline the code, make it work faster and more upto date.

 

[travs69]

You might want to think of hiring a perl programmer

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Travis - Those who say it cannot be done are usually interrupted by someone else doing it; Give the wrong symptoms, get the wrong solutions;

 

[travs69]

All the code just looks like something I personally would have written 2-3 years ago, and I'm not that good.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Travis - Those who say it cannot be done are usually interrupted by someone else doing it; Give the wrong symptoms, get the wrong solutions;

 

[Elsa734]

Yep, that is the hopes, if I can find someone that is capable. These are just some small snippets. The real project would be to rewrite most of the code, 100s of files, but for now just trying to fix the worst of the bunch.

 

[KevinADC]

Sorry, I am not interested in helping with every-auction based scripts. I was an active contributor that that script years ago and I have no desire to revisit that creaky old script ever again. What you have is an obsolete program, it will never be fast and will always be subject to security issues because lots of the code was written by people that had no idea or concept of how to write secure code. I am sorry to see it is still in use. Read the sad story:

http://www.everysoft.com/

------------------------------------------
- Kevin, perl coder unexceptional!

 

[ChrisHunt]

$config{'colortablehead'} = '#E6E6E6';
$config{'colortablehead0'} = '#E6E6E6';
$config{'colortablehead1'} = '#E6E6E6';
$config{'colortablehead2'} = '#E6E6E6';
$config{'colortablehead3'} = '#E6E6E6';
$config{'colortablehead4'} = '#E6E6E6';
... etc ...

While you're in the rewriting business, you might want to look into using CSS to define your colours instead of a forest of <font> elements and bgcolor attributes.

-- Chris Hunt
Webmaster & Tragedian
Extra Connections Ltd