My script is OUT OF CONTROL!

jmrhid...@yahoo.com

unread,

Sep 13, 2012, 6:42:53 PM9/13/12

to begi...@perl.org

Hi, and thanks for volunteering to help!

I installed the following script last year and it seemed to be working fine.
Yesterday, however, my hosting service took down my site because the script was
tying up so much of their server resources that it was a threat to their
business. One of the folks I talked to there said he thought it was starting
multiple copies of itself that were never terminated. The logs didn't show the
script being accessed more than a few times a day on average.

I would appreciate help debugging this thing:

****************************************************************************************************************************

#!/usr/local/bin/perl
# use warnings;
# use strict;
# use diagnostics;

use CGI;
my $cgi=new CGI;
my ($topic, $score, $lastnum, $answer, $anum, $bnum, $cnum, $dnum, $enum,
$smarts, $playlevel, $c_topic, $c_smarts, $c_playlevel, $c_score, $c_lastnum,
$c_goodans, $stimulus, $texta, $textb, $textc, $textd, $texte, $defnum, $smiley,
$feedback, $goodans, $restart, @data, @cat, @term, @def, @story, @candidate,
@termnum, $sound);
my $instructions = "(Click the button next to the best response)";
my $ops = 0;

use diagnostics;

# GET COOKIES
$topic = $cgi->cookie('topic');
$smarts = $cgi->cookie('smarts');
$playlevel = $cgi->cookie('playlevel');
$score = $cgi->cookie('score');
$lastnum = $cgi->cookie('lastnum');
$goodans = $cgi->cookie('goodans');

# IF NEW CATEGORY THEN (RE)START TUTORIAL, ELSE GET USER ANSWER
if ($cgi->param('Category')) {
$restart = 1;
$topic = $cgi->param('Category');
$smarts = 0;
$playlevel = 0;
$score = 0;
$lastnum = 0;
}
elsif ($cgi->param('Answer')) { $answer = $cgi->param('Answer'); }
elsif ($cgi->param('Next')) { $restart = 1; }

if ($topic) { # RUN TUTORIAL

if ($answer and ($playlevel > 3)) {

# SUBSTITUTE SPACE FOR '+' IN $answer
$_ = $answer;
s/\+/ /g;
$answer = $_;

# RTRIM $answer AND MAKE SURE IT'S ALL LOWER CASE
$answer =~ s/\s+$//;
$answer = lc($answer);

# FIX FRENCH CHARACTERS

if ($answer eq "deja entendu") { $answer = "déjà entendu"; }
elsif ($answer eq "deja vu") { $answer = "déjà vu"; }
elsif ($answer eq "deja vecu") { $answer = "déjà vécu"; }
elsif ($answer eq "folie a deux") { $answer = "folie à deux"; }
elsif ($answer eq "jamais vecu") { $answer = "jamais vécu"; }
elsif ($answer eq "d%e9j%e0 entendu") { $answer = "déjà entendu"; }
elsif ($answer eq "d%e9j%e0 vu") { $answer = "déjà vu"; }
elsif ($answer eq "d%e9j%e0 v%e9cu") { $answer = "déjà vécu"; }
elsif ($answer eq "folie %e0 deux") { $answer = "folie à deux"; }
elsif ($answer eq "jamais v%e9cu") { $answer = "jamais vécu"; }

} # END PLAYLEVEL 4

# LOAD DATA
open FH, "/home1/theinfp0/public_html/psychdef/tutorial.fil" or die $!;
while (<FH>) {
if ($topic eq "REVIEW") { $termnum[$ops++] = $_; }
elsif (/$topic/) { $termnum[$ops++] = $_; }
}
close FH;

$defnum = $ops; # NUMBER OF TERMS IN DATA SET

# PARSE $_ TO GET $term(32) $cat(16) $def(64) $story(128) via @data:
$ops = 0;
foreach (@termnum) {
@data = /(.{16})/g;
$cat[$ops] = $data[0];
$term[$ops] = $data[1].$data[2];
$def[$ops] = $data[3].$data[4].$data[5].$data[6];
$story[$ops] =
$data[7].$data[8].$data[9].$data[10].$data[11].$data[12].$data[13].$data[14];

# RIGHT TRIM STRINGS
$cat[$ops] =~ s/\s+$//;
$term[$ops] =~ s/\s+$//;
$def[$ops] =~ s/\s+$//;
$story[$ops++] =~ s/\s+$//;
}

# EVALUATE RESPONSE AND PROVIDE FEEDBACK, ADJUSTING SCORES

if ($answer and ($answer ne $goodans)) { $answer = 0; }

if ($answer) {
$smarts++;
$score = ++$score + $playlevel;
$smiley = "1"; # SUCCESS
$feedback = "You got it right!";
}
else {
$smarts-- unless $restart;
$feedback = "Better study this!";
}

if ($smarts < -4) { $playlevel--; $smarts = 0; }
elsif ($smarts > 4) { $playlevel++; $smarts = 0; }

# NEXT QUESTION

if ($answer or $restart) { # AVOID CHANGING $lastnum FOR WRONG ANSWER
if ($playlevel < 1) {
while (1) {
$termnum[0] = int(rand($defnum));
last unless ($termnum[0] == $lastnum);
}
$lastnum = $termnum[0];
$stimulus = $term[$termnum[0]];
$candidate[0] = $def[$termnum[0]];
while (1) {
$termnum[1] = int(rand($defnum));
last unless ($termnum[1] == $termnum[0]);
}
$candidate[1] = $def[$termnum[1]];
$anum = int(rand(2));
$bnum = abs($anum - 1);
$texta = $candidate[$anum];
$textb = $candidate[$bnum];
if ($texta eq $candidate[0]) { $goodans = "A"; }
else { $goodans = "B"; }
}

elsif ($playlevel == 1) {
while (1) {
$termnum[0] = int(rand($defnum));
last unless ($termnum[0] == $lastnum);
}
$lastnum = $termnum[0];
$stimulus = $def[$termnum[0]];
$candidate[0] = $term[$termnum[0]];
while (1) {
$termnum[1] = int(rand($defnum));
last unless ($termnum[1] == $termnum[0]);
}
$candidate[1] = $term[$termnum[1]];
while (1) {
$termnum[2] = int(rand($defnum));
last unless (($termnum[2] == $termnum[1]) || ($termnum[2] ==
$termnum[0]));

}
$candidate[2] = $term[$termnum[2]];
$anum = int(rand(3));
if ($anum == 0) {$goodans = "A";}
while (1) {
$bnum = int(rand(3));
last unless ($bnum == $anum);
}
if ($bnum == 0) {$goodans = "B";}
$cnum = 3 - ($anum + $bnum);
if ($cnum == 0) {$goodans = "C";}
$texta = $candidate[$anum];
$textb = $candidate[$bnum];
$textc = $candidate[$cnum];
}

elsif ($playlevel == 2) {
while (1) {
$termnum[0] = int(rand($defnum));
last unless ($termnum[0] == $lastnum);
}
$lastnum = $termnum[0];
$stimulus = $term[$termnum[0]];
$candidate[0] = $def[$termnum[0]];
while (1) {
$termnum[1] = int(rand($defnum));
last unless ($termnum[1] == $termnum[0]);
}
$candidate[1] = $def[$termnum[1]];
while (1) {
$termnum[2] = int(rand($defnum));
last unless (($termnum[2] == $termnum[1]) || ($termnum[2] ==
$termnum[0]));

}
$candidate[2] = $def[$termnum[2]];
while (1) {
$termnum[3] = int(rand($defnum));
last unless (($termnum[3] == $termnum[2]) || ($termnum[3] ==
$termnum[1]) || ($termnum[3] == $termnum[0]));

}
$candidate[3] = $def[$termnum[3]];
$anum = int(rand(4));
if ($anum == 0) {$goodans = "A";}
while (1) {
$bnum = int(rand(4));
last unless ($bnum == $anum);
}
if ($bnum == 0) {$goodans = "B";}
while (1) {
$cnum = int(rand(4));
last unless (($cnum == $bnum) || ($cnum == $anum));
}
if ($cnum == 0) {$goodans = "C";}
$dnum = 6 - ($anum + $bnum + $cnum);
if ($dnum == 0) {$goodans = "D";}
$texta = $candidate[$anum];
$textb = $candidate[$bnum];
$textc = $candidate[$cnum];
$textd = $candidate[$dnum];
}

elsif ($playlevel == 3) {
while (1) {
$termnum[0] = int(rand($defnum));
last unless ($termnum[0] == $lastnum);
}
$lastnum = $termnum[0];
$stimulus = $story[$termnum[0]];
$candidate[0] = $term[$termnum[0]];
while (1) {
$termnum[1] = int(rand($defnum));
last unless ($termnum[1] == $termnum[0]);
}
$candidate[1] = $term[$termnum[1]];
while (1) {
$termnum[2] = int(rand($defnum));
last unless (($termnum[2] == $termnum[1]) || ($termnum[2] ==
$termnum[0]));

}
$candidate[2] = $term[$termnum[2]];
while (1) {
$termnum[3] = int(rand($defnum));
last unless (($termnum[3] == $termnum[2]) || ($termnum[3] ==
$termnum[1]) || ($termnum[3] == $termnum[0]));

}
$candidate[3] = $term[$termnum[3]];
while (1) {
$termnum[4] = int(rand($defnum));
last unless (($termnum[4] == $termnum[3]) || ($termnum[4] ==
$termnum[2]) || ($termnum[4] == $termnum[1]) || ($termnum[4] == $termnum[0]));

}
$candidate[4] = $term[$termnum[4]];
$anum = int(rand(5));
if ($anum == 0) {$goodans = "A";}
while (1) {
$bnum = int(rand(5));
last unless ($bnum == $anum);
}
if ($bnum == 0) {$goodans = "B";}
while (1) {
$cnum = int(rand(5));
last unless (($cnum == $bnum) || ($cnum == $anum));
}
if ($cnum == 0) {$goodans = "C";}
while (1) {
$dnum = int(rand(5));
last unless (($dnum == $cnum) || ($dnum == $bnum) || ($dnum == $anum));
}
if ($dnum == 0) {$goodans = "D";}
$enum = 10 - ($anum + $bnum + $cnum + $dnum);
if ($enum == 0) {$goodans = "E";}
$texta = $candidate[$anum];
$textb = $candidate[$bnum];
$textc = $candidate[$cnum];
$textd = $candidate[$dnum];
$texte = $candidate[$enum];
}

elsif ($playlevel > 3) {
while (1) {
$termnum[0] = int(rand($defnum));
last unless ($termnum[0] == $lastnum);
}
$lastnum = $termnum[0];
$anum = int(rand(2));
if ($anum) { $stimulus = $story[$termnum[0]]; }
else { $stimulus = $def[$termnum[0]]; }
$goodans = $term[$termnum[0]];
$instructions = "Type the correct term, then press SEND!";
}

} # END OF NEW QUESTION

# PRINT RESPONSE:

$c_topic =
$cgi->cookie(-name=>'topic',-value=>$topic,-expires=>'+1d',-path=>'/');
$c_score =
$cgi->cookie(-name=>'score',-value=>$score,-expires=>'+1d',-path=>'/');
$c_smarts =
$cgi->cookie(-name=>'smarts',-value=>$smarts,-expires=>'+1d',-path=>'/');
$c_playlevel =
$cgi->cookie(-name=>'playlevel',-value=>$playlevel,-expires=>'+1d',-path=>'/');
$c_lastnum =
$cgi->cookie(-name=>'lastnum',-value=>$lastnum,-expires=>'+1d',-path=>'/');
$c_goodans =
$cgi->cookie(-name=>'goodans',-value=>$goodans,-expires=>'+1d',-path=>'/');

print "Set-Cookie: $c_topic\n";
print "Set-Cookie: $c_score\n";
print "Set-Cookie: $c_smarts\n";
print "Set-Cookie: $c_playlevel\n";
print "Set-Cookie: $c_lastnum\n";
print "Set-Cookie: $c_goodans\n";

print $cgi->header;

print<<QWERTYUIOP;

http://www.w3.org/TR/REC-html40/loose.dtd\">

<HTML>
<HEAD>
<META HTTP-EQUIV="CONTENT-TYPE" CONTENT="text/html; charset=windows-1252">
<TITLE>PsychDef Tutorial</TITLE>
<META NAME="GENERATOR" CONTENT="OpenOffice.org 3.3,(Win32)">
<META NAME="CREATED" CONTENT="0;0">
<META NAME="CHANGEDBY" CONTENT="John M Rathbun MD">
<META NAME="CHANGED" CONTENT="20110531;20073739">
<META NAME="DESCRIPTION" CONTENT="Psych Glossary Tutorial 254 Behavioral
Health Terms Memorized Easily Painless Learning">

<STYLE TYPE="text/css">

</STYLE>

</HEAD>

enctype="application/x-www-form-urlencoded">

<H1><FONT SIZE=5>Select Category:</FONT></H1>

<P><SELECT NAME="Category" SIZE=10 STYLE="width: 1.43in; height:
2.33in; font-family: 'Garamond'; font-size: 14pt">
<OPTION VALUE="Consciousness">Consciousness
<OPTION VALUE="Defenses">Defenses
<OPTION VALUE="Emotion">Emotion
<OPTION VALUE="Intellect">Intellect
<OPTION VALUE="Memory">Memory
<OPTION VALUE="Movement">Movement
<OPTION VALUE="Perception">Perception
<OPTION VALUE="Speech">Speech
<OPTION VALUE="Thinking">Thinking
<OPTION VALUE="REVIEW">REVIEW</OPTION>
</SELECT></P>
<DIV ALIGN=LEFT>

</DIV></FORM></TD>

QWERTYUIOP

if ($restart) { # THIS IS EITHER A NEW TOPIC OR FOLLOWS A WRONG ANSWER:

print<<QWERTYUIOP;
<P><BR><BR><BR></P>
<P ALIGN=LEFT><FONT SIZE=3><B>$instructions</B></FONT></P>
<P ALIGN=LEFT><FONT SIZE=4><B>$stimulus</B></FONT></P>
<DIV ALIGN=LEFT>
QWERTYUIOP

if ($playlevel < 4) {

print<<QWERTYUIOP;
$texta
$textb
QWERTYUIOP

if ($textc) {
print<<QWERTYUIOP;
$textc
QWERTYUIOP
}

if ($textd) {
print<<QWERTYUIOP;
$textd
QWERTYUIOP
}

if ($texte) {
print<<QWERTYUIOP;
$texte
QWERTYUIOP
}

} # END PLAYLEVEL < 4

else{ # PLAYLEVEL > 3
print<<QWERTYUIOP;

<input type="text" name="Answer" size="32"><br><br>
<input type="submit" value="SEND">
</form>
QWERTYUIOP
} # END PLAYLEVEL > 3

} # END RESTART/RECOVERY

elsif ($smiley) { # CORRECT ANSWER

print<<QWERTYUIOP;
<P><BR><BR><BR></P>

<h1>=>$feedback<=</h1><br>
<h2>Your score is $score</h2>

<P ALIGN=LEFT><FONT SIZE=3><B>$instructions</B></FONT></P>
<P ALIGN=LEFT><FONT SIZE=4><B>$stimulus</B></FONT></P>
<DIV ALIGN=LEFT>
QWERTYUIOP

if ($playlevel < 4) {

print<<QWERTYUIOP;
$texta
$textb
QWERTYUIOP

if ($textc) {
print<<QWERTYUIOP;
$textc
QWERTYUIOP
}

if ($textd) {
print<<QWERTYUIOP;
$textd
QWERTYUIOP
}

if ($texte) {
print<<QWERTYUIOP;
$texte
QWERTYUIOP
}

} # END PLAYLEVEL < 4

else{ # PLAYLEVEL > 3
print<<QWERTYUIOP;

<input type="text" name="Answer" size="32"><br><br>
<input type="submit" value="SEND">
</form>
QWERTYUIOP
} # END PLAYLEVEL > 3

} # END CORRECT ANSWER

else { # WRONG ANSWER!

$sound = "$term[$lastnum]";

if ($sound eq "déjà entendu") { $sound = "d%e9j%e0 entendu"; }
elsif ($sound eq "déjà vu") { $sound = "d%e9j%e0 vu"; }
elsif ($sound eq "déjà vécu") { $sound = "d%e9j%e0 v%e9cu"; }
elsif ($sound eq "folie à deux") { $sound = "folie %e0 deux"; }
elsif ($sound eq "jamais vécu") { $sound = "jamais v%e9cu"; }

$sound = $sound."\.mp3";

print<<QWERTYUIOP;
<P><BR><BR><BR></P>

<h1>=>$feedback<=</h1><br><br>

<H1 CLASS="western">Term: <FONT COLOR="#94006b">$term[$lastnum]</FONT></H1>
<H2 CLASS="western">Category: <FONT COLOR="#94006b"><FONT FACE="Garamond,
serif"><FONT SIZE=5><SPAN STYLE="font-style:
normal">$cat[$lastnum]</SPAN></FONT></FONT></FONT></H2>
<H2 CLASS="western">Definition: <FONT COLOR="#94006b"><FONT FACE="Garamond,
serif"><FONT SIZE=5><SPAN STYLE="font-style:
normal">$def[$lastnum]</SPAN></FONT></FONT></FONT></H2>
<H2 CLASS="western">Vignette: <FONT COLOR="#94006b"><FONT FACE="Garamond,
serif"><FONT SIZE=5><SPAN STYLE="font-style:
normal">$story[$lastnum]</SPAN></FONT></FONT></FONT></H2>

QWERTYUIOP
} # END WRONG ANSWER

print "</DIV></TD></TR></TABLE></BODY></HTML>\n";

} # TUTORIAL ENDS HERE

else { # IN CASE NO COOKIE WAS RECEIVED
print "content-type: text/html\n\n";
print $cgi->start_html('Oops!');
print $cgi->h2("OOPS! The PsychDef tutorial must keep track of your progress
so it can adjust the difficulty of the questions you see. It does this by
leaving a small text file known as a 'cookie' on your machine. We didn't receive
a cookie from your Internet browser, so we can't continue your tutorial.");
print $cgi->h2("Please enable cookies in your browser settings and try
again. If you're not sure how to do this, you can search your browser's 'Help'
index for 'cookies'.");
print $cgi->h2("If you received this message even though your browser allows
cookies, please e-mail 'cookie-monster (at) theinfosite.org'.");
print $cgi->end_html;
} #END ELSE

# END OF CGI

***************************************************************************************************************************

Sorry I can't find a way to print line numbers!
John M Rathbun MD

Jim Gibson

unread,

Sep 13, 2012, 8:07:43 PM9/13/12

to Perl Beginners

On Sep 13, 2012, at 3:42 PM, jmrhid...@yahoo.com wrote:

> Hi, and thanks for volunteering to help!
>
>
> I installed the following script last year and it seemed to be working fine.
> Yesterday, however, my hosting service took down my site because the script was
> tying up so much of their server resources that it was a threat to their
> business. One of the folks I talked to there said he thought it was starting
> multiple copies of itself that were never terminated. The logs didn't show the
> script being accessed more than a few times a day on average.
>
> I would appreciate help debugging this thing:
>
> ****************************************************************************************************************************

>

> # NEXT QUESTION
>
> if ($answer or $restart) { # AVOID CHANGING $lastnum FOR WRONG ANSWER
> if ($playlevel < 1) {
> while (1) {
> $termnum[0] = int(rand($defnum));
> last unless ($termnum[0] == $lastnum);
> }
> $lastnum = $termnum[0];

You have a number of these while(1) loops, which, if something goes wrong, can loop forever. For example, in the loop above, if $defnum is zero or one and $lastnum is zero, the loop might not terminate (I am not sure exactly what rand(0) returns). Perhaps your data file is corrupted and is causing one of these loops to go into an infinite loop. I doubt that the program is spawning multiple copies, but if every copy started by a CGI call hangs around forever, it might look like it.

You are going to have to try debugging this on some development system. Debugging CGI programs is difficult. You might want to print debugging statements to a log file.

Rob Dixon

unread,

Sep 13, 2012, 8:18:26 PM9/13/12

to begi...@perl.org, jmrhid...@yahoo.com

On 13/09/2012 23:42, jmrhid...@yahoo.com wrote:
>
> I installed the following script last year and it seemed to be working fine.
> Yesterday, however, my hosting service took down my site because the script was
> tying up so much of their server resources that it was a threat to their
> business. One of the folks I talked to there said he thought it was starting
> multiple copies of itself that were never terminated. The logs didn't show the
> script being accessed more than a few times a day on average.
>
> I would appreciate help debugging this thing:

Hi John

You have offered us a collapsed building and asked how to restore it to
somewhere fit to live in

Your program has become a monster, and clearly needs a rewrite

You should be able to understand your own software completely, and
explain every line in it, and when and why it is being executed

Instead I think you have chipped away at an existing program, changing
things here and there until it seems to work OK

Doing this again and again has resulted in the code that you have, where
no one knows why and how it works or how to fix it

Assuming that you don't have the means to write a replacement from
scratch, you should start by reformatting the code so that the
indentation is consistent, correct, and readable

Then you should uncomment the `use strict` and `use warnings` lines, and
declare everything at its first point of use

How you proceed beyond that depends on the behaviour of the new program

I can offer you a reformat, courtesy of `perltidy`, that will help you
on your way

HTH,

Rob

if ($answer eq "deja entendu") { $answer = "d�j� entendu"; }
elsif ($answer eq "deja vu") { $answer = "d�j� vu"; }
elsif ($answer eq "deja vecu") { $answer = "d�j� v�cu"; }
elsif ($answer eq "folie a deux") { $answer = "folie � deux"; }
elsif ($answer eq "jamais vecu") { $answer = "jamais v�cu"; }
elsif ($answer eq "d%e9j%e0 entendu") { $answer = "d�j� entendu"; }
elsif ($answer eq "d%e9j%e0 vu") { $answer = "d�j� vu"; }
elsif ($answer eq "d%e9j%e0 v%e9cu") { $answer = "d�j� v�cu"; }
elsif ($answer eq "folie %e0 deux") { $answer = "folie � deux"; }
elsif ($answer eq "jamais v%e9cu") { $answer = "jamais v�cu"; }

} # END PLAYLEVEL 4

# LOAD DATA
open FH, "/home1/theinfp0/public_html/psychdef/tutorial.fil" or die $!;
while (<FH>) {
if ($topic eq "REVIEW") { $termnum[$ops++] = $_; }
elsif (/$topic/) { $termnum[$ops++] = $_; }
}
close FH;

$defnum = $ops; # NUMBER OF TERMS IN DATA SET

# PARSE $_ TO GET $term(32) $cat(16) $def(64) $story(128) via @data:
$ops = 0;
foreach (@termnum) {
@data = /(.{16})/g;
$cat[$ops] = $data[0];

$term[$ops] = $data[1] . $data[2];
$def[$ops] = $data[3] . $data[4] . $data[5] . $data[6];

$story[$ops] =
$data[7]
. $data[8]
. $data[9]
. $data[10]
. $data[11]
. $data[12]
. $data[13]

. $data[14];

-path => '/'

);
$c_score = $cgi->cookie(
-name => 'score',
-value => $score,
-expires => '+1d',

-path => '/'

);
$c_smarts = $cgi->cookie(
-name => 'smarts',
-value => $smarts,
-expires => '+1d',

-path => '/'

);
$c_playlevel = $cgi->cookie(
-name => 'playlevel',
-value => $playlevel,
-expires => '+1d',

-path => '/'

);
$c_lastnum = $cgi->cookie(
-name => 'lastnum',
-value => $lastnum,
-expires => '+1d',

-path => '/'

);
$c_goodans = $cgi->cookie(
-name => 'goodans',
-value => $goodans,
-expires => '+1d',

-path => '/'

if ($sound eq "d�j� entendu") { $sound = "d%e9j%e0 entendu"; }
elsif ($sound eq "d�j� vu") { $sound = "d%e9j%e0 vu"; }
elsif ($sound eq "d�j� v�cu") { $sound = "d%e9j%e0 v%e9cu"; }
elsif ($sound eq "folie � deux") { $sound = "folie %e0 deux"; }
elsif ($sound eq "jamais v�cu") { $sound = "jamais v%e9cu"; }

$sound = $sound . "\.mp3";

Paul Anderson

unread,

Sep 13, 2012, 10:09:27 PM9/13/12

to Jim Gibson, Perl Beginners

Just checked on my machine, looks like it produces a floating point number between 0 and 1.

--------
Paul Anderson -- VE3HOP

Peter Scott

unread,

Sep 13, 2012, 10:52:04 PM9/13/12

to begi...@perl.org

Set up some test harnesses to run from the command line so you can see
how your script behaves without having to run it through a web server.
Since it gets its input from a cookie, set the environment variable
HTTP_COOKIE to each test value in turn and execute the script. (You'll
get a mess of HTML back that'll be tedious to validate. This is the
point at which you learn about separation of responsibilities and the
Model-View-Controller pattern if you want to improve how you do this in
the future.)

--
Peter Scott
http://www.perlmedic.com/ http://www.perldebugged.com/
http://www.informit.com/store/product.aspx?isbn=0137001274
http://www.oreillyschool.com/certificates/perl-programming.php

John W. Krahn

unread,

Sep 14, 2012, 3:24:53 AM9/14/12

to Perl Beginners

jmrhid...@yahoo.com wrote:
> Hi, and thanks for volunteering to help!
>
>
> I installed the following script last year and it seemed to be working fine.
> Yesterday, however, my hosting service took down my site because the script was
> tying up so much of their server resources that it was a threat to their
> business. One of the folks I talked to there said he thought it was starting
> multiple copies of itself that were never terminated. The logs didn't show the
> script being accessed more than a few times a day on average.
>
> I would appreciate help debugging this thing:

[ snip ]

> # LOAD DATA
> open FH, "/home1/theinfp0/public_html/psychdef/tutorial.fil" or die $!;
> while (<FH>) {
> if ($topic eq "REVIEW") { $termnum[$ops++] = $_; }
> elsif (/$topic/) { $termnum[$ops++] = $_; }
> }
> close FH;
>
> $defnum = $ops; # NUMBER OF TERMS IN DATA SET
>
> # PARSE $_ TO GET $term(32) $cat(16) $def(64) $story(128) via @data:
> $ops = 0;
> foreach (@termnum) {
> @data = /(.{16})/g;
> $cat[$ops] = $data[0];
> $term[$ops] = $data[1].$data[2];
> $def[$ops] = $data[3].$data[4].$data[5].$data[6];
> $story[$ops] =
> $data[7].$data[8].$data[9].$data[10].$data[11].$data[12].$data[13].$data[14];
>
> # RIGHT TRIM STRINGS
> $cat[$ops] =~ s/\s+$//;
> $term[$ops] =~ s/\s+$//;
> $def[$ops] =~ s/\s+$//;
> $story[$ops++] =~ s/\s+$//;
> }

A Perl programmer might write that like:

# LOAD DATA
open FH, "/home1/theinfp0/public_html/psychdef/tutorial.fil" or die $!;
while (<FH>) {

if ($topic eq "REVIEW") { push @termnum, $_; }
elsif (/$topic/) { push @termnum, $_; }
}
close FH;

$defnum = @termnum; # NUMBER OF TERMS IN DATA SET

# PARSE $_ TO GET $term(32) $cat(16) $def(64) $story(128) via @data:

foreach (@termnum) {
my @data = unpack 'A16 A32 A64 A128', $_;
push @cat, $data[ 0 ];
push @term, $data[ 1 ];
push @def, $data[ 2 ];
push @story, $data[ 3 ];

}

> # EVALUATE RESPONSE AND PROVIDE FEEDBACK, ADJUSTING SCORES
>
> if ($answer and ($answer ne $goodans)) { $answer = 0; }
>
> if ($answer) {
> $smarts++;
> $score = ++$score + $playlevel;

Using auto-increment or auto-decrement on a variable that appears more
than ONCE in an expression will result in UNDEFINED behavior.

What did you expect the value of $score to be after this expression?

John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction. -- Albert Einstein