package CGRutils3; #pchem subset TO BE USED FOR COMPUTER GUIDED READING use CGI ':standard'; use Text::Wrap; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(rno,round,txt_in,send_memo,time_stamp,last_edit_stamp,grade_txt,grade_txt2,grade_nmtext,report);
End of preliminaries
%weekday = ("0","Sunday",
"1","Monday",
"2","Tuesday",
"3","Wednesday",
"4","Thursday",
"5","Friday",
"6","Saturday");
%MONTH = ("0","January",
"1","February",
"2","March",
"3","April",
"4","May",
"5","June",
"6","July",
"7","August",
"8","September",
"9","October",
"10","November",
"11","December");
End of some obvious definitions
sub send_memo{
my ($query) = $_[1];# this seems to work only in the newer version of CGI.pm
my $var = $_[2];# this is changed in the calling routine, to provide a unique
# name for variables in this subroutine, where they are concatenated
$student_name = $query->param('name');
$sender = $query->param('remote_host');
print $query->start_form;
print "<hr>";
print $query->hidden('faculty',$query->param('owner'));
print $query->hidden('student',$query->param('name'));
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
if ($year le 50){$pre = "20"} else {$pre = "19"};
print "<img src=../icons/mailbox.gif>";
print "If you wish to comment to C. W. David about
this material, assumptions you (or I) are making, inconsistencies in the
phraseology of the material, objections to the material, etc., etc., etc.,
you may use this space for that purpose.";
print "<font color=red>";
print "Please include your e-mail address explicitly. Thank you.";
print "</font>";
print "<br>e-mail addresss = ",$query->textfield($var.'eadd','',20,20);
print " at $ENV{'REMOTE_HOST'}(";
print "$ENV{'REMOTE_ADDR'})\n";
print $query->textarea($var.'comments','(If you want me to answer you,
you need to include your return address!)e:mail=',10,80);
print "<br>";
print $query->submit($var.'Submit2','Send the comment');
print $query->reset;
print $query->end_form;
if ($query->param($var.'Submit2') ) {
$question = $query->script_name();
$sender = $query->remote_host();
$mailprog = '/usr/lib/sendmail ';
$recipient = 'carl.david\@uconn.edu';
open (MAIL, "|$mailprog $recipient") || die "Can't open $mailprog!\n";
# $savefile = select(STDOUT);
# $saveformat = $~;
# select(MAIL);
$string = "Subject: WWW comments (Forms submission)\n\n";
$string = $string."Comments about the Physical Chemistry server:\n\n";
$string = $string."Student name: $student_id\n\n";
$string = $string."Question: $question\n\n";
$string = $string."e-mail account = $eadd \n\n";
$string = $string."SENDER: $sender \n\n";
$string = $string.$comments;
# $~ = "MULTILINE";
# write MAIL;
print MAIL wrap("\t","","$comments\n\n");
print MAIL "\n------------------------------------------------------------\n";
print MAIL "Server protocol: $ENV{'SERVER_PROTOCOL'}\n";
print MAIL "Remote host: $ENV{'REMOTE_HOST'}\n";
print MAIL "Remote IP address: $ENV{'REMOTE_ADDR'}\n";
close (MAIL);
# select ($savefile);
# $~ = $saveformat;
print $query->param($var.'comments','');
# Make the person feel good for writing to us
print STDOUT "Thank you for sending comments to C. W. David.";
print STDOUT "<img src=../icons/emailed.gif>";
# ------------------------------------------------------------
# subroutine blank_response
sub blank_response
{
print "Your comments appear to be blank, and thus were not sent ";
print "to our webmasters. Please re-enter your comments, or ";
print "Return to Physical Chemistry <A HREF=\"/~cdavid/chem263.html\">home page</A>, if you want.<P>";
exit;
}
}
}#end of subroutine send_memo
1;
A utility required here:
sub new{
my $this = {}; #create anonymous hash and #self points to it
bless $this; # connect the hash toCATutils
return $this;#return the hash reference
}
a random number generator
sub rno {
#
# returns a random number between 0 and 1, with $_[0] digits to the right
# of the decimal point
#
shift;
return (10**$_[0]*rand() % 10**$_[0])/(10**$_[0]);
}
sub round {
#
# rounds first argument to length of second
#
shift;
return(int($_[0]*10**$_[1])/10**$_[1]);
}
txt_in
sub txt_in{
my ($query) = $_[1];# this seems to work only in the newer version of CGI.pm
my $var = $_[2];# this is changed in the calling routine, to provide a unique
# name for variables in this subroutine, where they are concatenated
my $ans = $_[3];# this the answer to be judged
my $n = $_[4];#number of characters in input field, note that 10*this number = total length
my $help = $_[5];#help text, which might be a URL
my $debug = 'false';
print "<hr><font color=red>You may enter an expression or a number here. `^' and `**' both mean exponentiation.";
print "Be careful to observe proper bracketing.</font>";
print "<br>",$query->textfield($var.'txt_in','',$n,10*$n);
if ($query->param($var.'txt_in')){
$txt = $query->param($var.'txt_in');
$txt =~ s/\\//gi;
$txt =~ s/\$//gi;
$txt =~ s/\#//gi;
$txt =~ s/\~//gi;
$txt =~ s/\^/**/gi;
$count = 0;
for ($i=0;$i<length($txt);$i++){
#print "<br>i = ",$i," and count = ",$count, "<br> substr = ",substr($txt,$i,1);
if(substr($txt,$i,1) eq '('){
$count++;
}
elsif(substr($txt,$i,1) eq ')'){
$count--;
if($count < 0){print "<br><font color=red>Bracket error at position </font>",$i;}
}
#print "done with loop one time";
}
if ($count != 0){print "<br><font color=red>Bracket error, more of one kind than another</font>";}
$v1 = eval($txt);
$v2 = abs(($v1-$ans)/$ans);
print "<br>txt = $txt<br>";
print "<br>v1 = $v1<br>";
print "<br>ans = $ans<br>";
$crit = 0.001;
if ($v2 < $crit){
print " <font color=green><EM>Right! </EM>.
<IMG SRC=../icons/check.gif\><font color=black>";
return 1;
}
else{
print " <font color=red><EM>Wrong! </EM>.
<IMG SRC=../icons/checkno.gif\><font color=black>";
if($query->param($var.'Give_The_Answer') eq 'on'){
# print "<br>The expected answer is $ans";
print "<br>The expected answer feature is disabled this semester";
}
print "<br>If you want to see the expected answer, check here and resubmit";
print $query->checkbox(-name=>$var.'Give_The_Answer',,,-label=>'');
return 1;
}
}
}
1;
time_stamp
sub time_stamp{
my ($query) = $_[1];# this seems to work only in the newer version of CGI.pm
my ($filename) = $_[2];# this seems to work only in the newer version of CGI.pm
my ($student_name) = $_[3];# this seems to work only in the newer version of CGI.pm
($device,$inode,$mode,$nblink,$quid,$gid,$rdev,$size,$atime,
$ctime,$mtime,$blksize,$blocks) = stat($filename);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
if ($year le 50){$pre = "20"} else {$pre = "19"};
print "<hr>";
print "<br>$student_name : time_stamp:", $hour,":",$min," ,",$weekday{$wday},", ",$MONTH{$mon}," ",$mday,", ",$pre,$year;
}
1;
This subroutine records the last time the file in question was edited.
sub last_edit_stamp{
my ($query) = $_[1];# this seems to work only in the newer version of CGI.pm
my ($filename) = $_[2];# this seems to work only in the newer version of CGI.pm
@temp = split('/',$filename);
@temp = reverse(@temp);
# print "<br> here is temp[0] ",$temp[0];
# print "<br>stat = ",stat($temp[0]);
# print "<br>",$temp[0];
($device,$inode,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,
$mtime,$ctime,$blksize,$blocks) = stat($temp[0]);
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
if ($year le 80){$pre = "20"} else {$pre = "19"};
print "<br>Last edit: ", $hour,"hrs:",$min,"min, " ,$weekday{$wday},", ",$MONTH{$mon}," ",$mday,", ",$year;
}
1;
This subroutine creates integer response queries
sub integer
# calling sequence, required!!!!!
{
my ($query) = $_[1];# this seems to work only in the newer version of CGI.pm
my $var = $_[2];# this is changed in the calling routine, to provide a unique
# name for variables in this subroutine, where they are concatenated
my $ans = $_[3];# this the answer to be judged
my $n = $_[4];#q2d or q3d? n=2 means two digits after decimal point, n=3 means three digits, anything else
# is nonesense
my $help = $_[5];#help text, which might be a URL
my $debug = 'false';
my($power_0,$s10,$s20,$xa0,$ya0,$za0,$za01,$s20,$t100,$t10,$stu_ans,$v_1,$v_2);
if ($n>3){print "<br><font color=red>Calling error, n>3</font>";
die}
print "<img src=../icons/RAIN_LINE.gif>";
print "<P>What's your answer? ";
print " Choose appropriately and then press the Submit Query button.<P>",
$query->scrolling_list($var.'s10',
['+','-'],'+');
if($n>=1){print $query->popup_menu($var.'xa0',
['0','1','2','3','4','5','6','7','8','9'],'0')};
if($n>=2){print $query->popup_menu($var.'ya0',
['0','1','2','3','4','5','6','7','8','9'],'0')};
if($n==3){print $query->popup_menu($var.'za0',
['0','1','2','3','4','5','6','7','8','9'],'0')};
if ($query->param($var.'xa0')) {
$xa0 = $query->param($var.'xa0');
#print "<br>xa0 = $xa0";
$ya0 = $query->param($var.'ya0');
#print "<br>ya0 = $ya0";
$za0 = $query->param($var.'za0');
#print "<br>za0 = $za0";
if($n==2){$stu_ans = 10*$xa0+$ya0}
elsif($n==3){$stu_ans = 100*$xa0+10*$ya0+$za0}
else {$stu_ans = $xa0};
# if($debug = 'true'){print "<br>student answer before power = $stu_ans";}
$s10 = $query->param($var.'s10');
if ($s10 eq "-"){$stu_ans = - $stu_ans};
$v_1 = abs(($stu_ans - $ans) );#absolute error
# print "<br> DEBUG(integer in CATutils.pm) **** passed answer = $ans<br>....and student answer = $stu_ans
# v_1 = abs(difference) = $v_1";
# print "<br> and v_2 = $v_2 = abs($v_mantissa);#absolute error scaled.";
#comment out the above 3 lines
if ($v_1 < 1){
print " <font color=green>was <EM>Right! </EM>.
<IMG SRC=../icons/check.gif\><font color=black>";
return 1;
}
elsif ($stu_ans*$ans <0){
print "<blink> differs in sign from the expected answer.</blink>";
return -1;
}
else{
print "<font color=red> was <EM>Wrong! </EM>.
<IMG SRC=../icons/checkno.gif\><font color=black>";
if($query->param($var.'Give_The_Answer') eq 'on'){
print "<br>The expected answer is $ans";
# print "<br> This feature is temporarily disabled.";
}
print "<br>If you want to see the expected answer, check here and resubmit";
print $query->checkbox(-name=>$var.'Give_The_Answer',,,-label=>'');
if ($help ne ""){print $help;}
return 1;
}
};#end of if($query->param($var.'xa0'))
};
1;
grade_txt
sub grade_txt
# calling sequence, required!!!!!
{
my ($query) = $_[1];# this seems to work only in the newer version of CGI.pm
# this is a subroutine which gets a query, an answer, a student answer, and a list
# of variables and returns 1 (True) if the student answer is OK, and 0 (False) otherwise.
my $q = $_[2];#passing unique textual identifier
my $prompt = $_[3];#passing a prompt text (question for student)
my $correct = $_[4];#passing the student's answer
my $error_response = $_[5];#response for a wrong answer
my $variables = $_[6];#passing list of variables
my $dump = 0;
my $in_press = 1;
if($dump){
print "<br> query = $query";
print "<br> this is q = $q";
print "<br> prompt = $prompt";
print "<br> correct = $correct";
print "<br> variables = $variables";
print "<br> var = $$variables[0]";
print "<br> var = $$variables[1]";
print "<br> var = $$variables[2]";
print "<br> in_press = $in_press";
}
print "<br> $prompt" ,$query->textfield($q,'',20,100);
# print "<br> here it is :$query->param($q)";
if ($query->param($q)ne ''){
my $ans1 = $query->param($q);
my $saved_stu_ans1 = $ans1;
if($dump){
print $query->dump();
print "<br> ans1 = $ans1";
print "<br> saved_stu_ans1= $saved_stu_ans1";
}
$escape = '?!';
if(substr($ans1,0,length($escape)) eq $escape){print "<br> test mode, answer expected = $correct";}
&CleanUp($ans1);
&CleanUp($correct);
if($dump){
print "<br> ans1 = $ans1";
print "<br> saved_stu_ans1= $saved_stu_ans1";
}
for($i=0;$$variables[$i] ne '';$i++){
$var = $$variables[$i];
if($dump){
print "<br> substitution variable var = $var";
}
$rno = 1+rand();
$ans1 =~ s/$var/$rno/gi;
$correct =~ s/$var/$rno/g;
if($dump){
print "<br> substitution variable var = $$var";
print "<br> after a cycle of substitutions, ans1 = $ans1, and correct = $correct";
}
}#end of for
if($dump){
print "<br> criterion = ",abs(eval($correct)-eval($ans1));
print "<br> correct = ",eval($correct);
print "<br> ans1 = ",eval($ans1);
}
#open (STDERR,">&STDOUT");
#print "my name is $query->param('name')",\$query->param('student');
if(abs(eval($correct) -eval( $ans1)) < 0.0001){
print "<img src=../icons/check.gif>";
#CWD Sept 14, 2000
&mail_one($query->script_name(),$saved_stu_ans1,"correct",$query->param('student'))if ($ans1 ne $escape);
return 1
}
else{
print "<br>You did not submit a correct answer.<br>";
print $error_response;
#CWD Sept 14, 2000
&mail_one($query->script_name(),$saved_stu_ans1,"wrong",$query->param('student'))if ($ans1 ne $escape);
return 0
}
}#end of if param
}#end of subroutine grade_txt
1;
grade_txt2
sub grade_txt2
# calling sequence, required!!!!!
{
my ($query) = $_[1];# this seems to work only in the newer version of CGI.pm
# this is a subroutine which gets a query, an answer, a student answer, and a list
# of variables and returns 1 (True) if the student answer is OK, and 0 (False) otherwise.
my $q = $_[2];#passing unique textual identifier
my $prompt = $_[3];#passing a prompt text (question for student)
my $correct = $_[4];#passing the student's answer
my $error_response = $_[5];#response for a wrong answer
my $variables = $_[6];#passing list of variables
my $dump = 0;
my $in_press = 1;
if($dump){
print "<br> query = $query";
print "<br> this is q = $q";
print "<br> prompt = $prompt";
print "<br> correct = $correct";
print "<br> variables = $variables";
print "<br> var = $$variables[0]";
print "<br> var = $$variables[1]";
print "<br> var = $$variables[2]";
print "<br> in_press = $in_press";
}
print "<br> $prompt" ,$query->textfield($q,'',20,100);
# print "<br> here it is :$query->param($q)";
if ($query->param($q)ne ''){
my $ans1 = $query->param($q);
my $saved_stu_ans1 = $ans1;
if($dump){
print $query->dump();
print "<br> ans1 = $ans1";
print "<br> saved_stu_ans1= $saved_stu_ans1";
}
$escape = '?!';
if(substr($ans1,0,length($escape)) eq $escape){print "<br> test mode, answer expected = $correct";}
&CleanUp($ans1);
&CleanUp($correct);
if($dump){
print "<br> ans1 = $ans1";
print "<br> saved_stu_ans1= $saved_stu_ans1";
}
for($i=0;$$variables[$i] ne '';$i++){
$var = $$variables[$i];
if($dump){
print "<br> substitution variable var = $var";
}
$rno = 1+rand();
$ans1 =~ s/$var/$rno/gi;
$correct =~ s/$var/$rno/g;
if($dump){
print "<br> substitution variable var = $$var";
print "<br> after a cycle of substitutions, ans1 = $ans1, and correct = $correct";
}
}#end of for
if($dump){
print "<br> criterion = ",abs(eval($correct)-eval($ans1));
print "<br> correct = ",eval($correct);
print "<br> ans1 = ",eval($ans1);
}
#open (STDERR,">&STDOUT");
#print "my name is $query->param('name')",\$query->param('student');
if(abs(eval($correct) -eval( $ans1)) < 0.0001){
print "<img src=../icons/check.gif>";
&mail_one($query->script_name(),$saved_stu_ans1,"correct",$query->param('student'))if ($ans1 ne $escape);
return 1
}
else{
print $error_response;
#CWD Sept 14, 2000
&mail_one($query->script_name(),$saved_stu_ans1,"wrong",$query->param('student'))if ($ans1 ne $escape);
return 0
}
}#end of if param
}#end of subroutine grade_txt2
Grading natural math queries
sub grade_nmtext
# calling sequence, required!!!!!
{
my ($query) = $_[1];# this seems to work only in the newer version of CGI.pm
# this is a subroutine which gets a query, an answer, a student
# naturalmath answer, and a list
# of variables and returns 1 (True) if the student answer is OK, and 0 (False) otherwise.
my $var = $_[2];#passing unique textual identifier
my $prompt = $_[3];#passing a prompt text (question for student)
my $correct = $_[4];#passing the correct answer
my $student_ans = $_[5];
my $error_response = $_[6];#response for a wrong answer
my $variables = $_[7];#passing list of variables
my $dump = 0;#false = 0
my $in_press = 1;
$ENV{PATH} = '/usr/local/bin:/usr/local/netpbm';
$TEX_STUFF = "/u/ch351vc/public_html";#slash added in code below
$NMFILE = "$TEX_STUFF/nmfile.dat";
#what follows is from naturalmath.cgi
my $ident = `/usr/bin/date '+%Y-%m-%d-%H-%M-%S'`;
chomp($ident);
$ident .= "-$$";
$ident =~ /^(\d+-\d+-\d+)/;
# my $date = $1;
print '
Enter your response here in "natural math" and press the Submit
below.
<br>
';
print $query->textarea($var.'nmtext','',5,50);
if ($query->param($var.'nmtext')){
$nmtext = $query->param($var.'nmtext');#get the text
open (FP, ">$NMFILE") || die "Could not create $NMFILE";
print FP $nmtext;
close (FP);
open(TEXFILE,"> $TEX_STUFF/afile$ident.nat")||die "unable to open( to write) file";
print TEXFILE $nmtext;
if ($debug eq "true"){print "<br>DEBUG(in CGRutils2.pm) $nmtext <br>"};
close(TEXFILE);
if ($debug eq "true"){print "<br>DEBUG(in CGRutils2.pm) File closed and ready to change directory <br>"};
chdir "$TEX_STUFF";
chmod(0777,"afile*");#worked
#FAILED system "/usr/bin/rm -f afile-*.*;";
#FAILED unlink "afile-*.gif";
opendir(DIR,".");
@file = readdir(DIR);
closedir(DIR);
foreach $file (sort @file){
next if (substr($file,0,5) ne "afile");
# print "<br>file = $file ";
my $b = substr($file,-3);
#print "<br> b = $b";
if($b eq "gif"){unlink $file;}#THIS WORKED
}
# chmod(0777,"*.nat");#worked
if($debug eq "true"){print "<br> ready to do naturalmath stuff<br>"};
# system("pwd");
# system "../cgi-bin/naturalmath -sn afile$ident > /dev/null 2>&1;"
system "$TEX_STUFF/cgi-bin/naturalmath -sn /u/ch351vc/public_html/afile$ident > /dev/null 2>&1;" .
"/usr/bin/chmod a-r /u/ch351vc/public_html/afile$ident.nat;"
# "rm afile$ident.nat;"
.
"latex /u/ch351vc/public_html/afile$ident > /dev/null 2>&1;"
.
"dvips -E /u/ch351vc/public_html/afile$ident.dvi -o /u/ch351vc/public_html/afile$ident.ps > /dev/null 2>&1;"
;
$bounding = `/usr/bin/grep BoundingBox /u/ch351vc/public_html/afile$ident.ps`;
if($debug eq "true"){print "<br>bounding = ($bounding)<br>";}
$bounding =~ /\%\%BoundingBox:\s+(\-?\d+)\s+(\-?\d+)\s+(\-?\d+)\s+(\-?\d+)/;
$bbx=-$1;#$bbx = 110;
$bby=-$2;#$bby = 180;
#print "\n<br>ident = ($ident)<br>\n";
#print "\n<br>bounding = ($bounding)<br>\n";
#print "\n<br>bbx = ($bbx) and bby = ($bby)\n<br>";
$scale = 2;#this seems to have been passed by calling routine
$scale = 1 if ($scale<=1);
$scale = 4 if ($scale>=4);
$scale*=72;#trying to solve why the second equation is so big
# $scale*=172;#this was a guess, but it seems fine for now Apr, 2002
$bbw=int($scale/72*($3-$1)+.999999);
$bbh=int($scale/72*($4-$2)+.999999);
open(GS,
"| /usr/local/bin/gs -q -dSAFER -dNOPAUSE -sDEVICE=ppmraw ".
"-r$scale -g${bbw}x${bbh} -sOutputFile=$TEX_STUFF/afile$ident.ppm".
" > /dev/null"
);
print GS "$bbx $bby translate\n";
print GS "(afile$ident.ps) run\n";
print GS "quit\n";
close(GS);
# system "/usr/local/netpbm/pnmcrop afile$ident.ppm > afile$ident.ppm;" .
system "/usr/local/netpbm/ppmtogif < afile$ident.ppm > afile$ident.gif 2>/dev/null;";
# erase later, after debugging
chdir "$TEX_STUFF";
chmod(0777,"afile$ident.ppm");#
unlink "afile$ident.ppm";
chmod(0777,"afile$ident.nat");#
unlink "afile$ident.nat";
chmod(0777,"afile$ident.ps");#
unlink "afile$ident.ps";
chmod(0777,"afile$ident.log");#
unlink "afile$ident.log";
chmod(0777,"afile$ident.aux");#
unlink "afile$ident.aux";
chmod(0777,"afile$ident.tex");#
unlink "afile$ident.tex";
chmod(0777,"afile$ident.dvi");#
unlink "afile$ident.dvi";
#THIS IS THE END OF THE NATURALMATH MATERIAL.
chdir "$TEX_STUFF";
chmod(0777,"afile$ident.gif");#
#here is my version
print ' <center> ';
print "<img src=http://chemphys.uconn.edu/~ch351vc/afile$ident.gif>";
print ' </center> ';
# unlink "afile$ident.gif";#FAILs to allow img(above) to load
$file_to_erase = "afile$ident.gif";
#print "<br>file to erase = $file_to_erase";
$student_ans = $query->param($var.'nmtext');
$ans1 = $student_ans;#save answer of student in case needed later
$student_ans =~ s/^/(/;#prepend left paren
$correct =~ s/^/(/;
$student_ans =~ s/$/)/;#append right paren
$correct =~ s/$/)/;
$student_ans =~ s/ //g;#remove double blanks
$correct =~ s/ //g;#remove double blanks
$student_ans =~ s/ /\)*\(/g;#replace spaces with multiply
$correct =~ s/ /\)*\(/g;#replace spaces with multiply
$student_ans =~ s/\*\(\)//gi;#remove silly stuff
$correct =~ s/\*\(\)//gi;#remove silly stuff
if($dump){
print "<br> query = $query in CGRutils2(grade_nmtext)";
print "<br> this is q = $q";
print "<br> prompt = $prompt";
print "<br> correct = $correct";
print "<br> student_answer (unedited) = $ans1";
print "<br> student_answer = $student_ans";
print "<br> variables = $variables";
print "<br> var = $$variables[0]";
print "<br> var = $$variables[1]";
print "<br> var = $$variables[2]";
print "<br> in_press = $in_press";
}
$student_ans =~ s/\(\*\)/\(1\)*\(1\)/gi;
$correct =~ s/\(\*\)/\(1\)*\(1\)/gi;# to get explicit multiply right
$student_ans =~ s/\*\/\*/\//gi;#for */* => /
$correct =~ s/\*\/\*/\//gi;
$student_ans =~ s/\*\(\/\)\*/\//gi;#for *(/)* removal
$correct =~ s/\*\(\/\)\*/\//gi;# over -> '/'
$rno = 1+rand();
$student_ans =~ s/\*\(over\)\*/\//gi;
$correct =~ s/\*\(over\)\*/\//gi;# over -> '/'
$rno = 1+rand();
$student_ans =~ s/integral/$rno/gi;
$correct =~ s/integral/$rno/gi;
$rno = 1+rand();
$student_ans =~ s/sum/$rno/gi;
$correct =~ s/sum/$rno/gi;
$rno = 1+rand();
$student_ans =~ s/\(0\)/$rno/gi;
$correct =~ s/\(0\)/$rno/gi;
$rno = 1+rand();
$student_ans =~ s/\(from\)/$rno/gi;
$correct =~ s/\(from\)/$rno/gi;
$rno = 1+rand();
$student_ans =~ s/\(of\)/$rno/gi;
$correct =~ s/\(of\)/$rno/gi;
$rno = 1+rand();
$student_ans =~ s/\(to\)/$rno/gi;
$correct =~ s/\(to\)/$rno/gi;
$rno = 1+rand();
$student_ans =~ s/\(infinity\)/$rno/gi;
$correct =~ s/\(infinity\)/$rno/gi;
$rno = 1+rand();
$student_ans =~ s/\(vec\)/$rno/gi;
$correct =~ s/\(vec\)/$rno/gi;
$rno = 1+rand();
$student_ans =~ s/\(hat\)/$rno/gi;
$correct =~ s/\(hat\)/$rno/gi;
$rno = 1+rand();
$student_ans =~ s/\(dot\)/$rno/gi;
$correct =~ s/\(dot\)/$rno/gi;
$rno = 1+rand();#next four use the same random number
$student_ans =~ s/\(\_\)/$rno/gi;
$student_ans =~ s/\_/*$rno*/gi;#special, since students won't leave spaces
$correct =~ s/\_/*$rno*/gi;#special, since authors won't leave spaces
$student_ans =~ s/\(sub\)/$rno/gi;
$student_ans =~ s/\(sub\)/$rno/gi;
$correct =~ s/\(sub\)/$rno/gi;
$rno = 1+rand();#next four use the same random number
$student_ans =~ s/\(\^\)/$rno/gi;
$correct =~ s/\^/*$rno*/gi;
$student_ans =~ s/\(power\)/$rno/gi;
$correct =~ s/\(power\)/$rno/gi;
$rno = 1+rand();
$student_ans =~ s/\^/**/gi;
$correct =~ s/\^/**/gi;
$student_ans =~ s/\*\(+\)\*/+/gi;#undo damage of spaces on binary operators
$correct =~ s/\*\(+\)\*/+/gi;
$student_ans =~ s/\*\(-\)\*/-/gi;#undo damage of spaces on binary operators
$correct =~ s/\*\(-\)\*/-/gi;
$student_ans =~ s/hbar/\($rno\)/gi;
$correct =~ s/hbar/\($rno\)/gi;
$student_ans =~ s/vec//gi;
$correct =~ s/vec//gi;
$student_ans =~ s/hat//gi;
$correct =~ s/hat//gi;
if($dump){
print "<br> student_answer = $student_ans";
print "<br> correct = $correct";
}
print "<br> student_answer = $student_ans";
print "<br> correct = $correct";
# print "<br> var0 = $$variables[0]";
# print "<br> var1 = $$variables[1]";
# print "<br> var2 = $$variables[2]";
for($j=0;$$variables[$j] ne '';$j++){
$var = $$variables[$j];
# if($dump){
# print "<br> j = $j";
# print "<br> substitution variable var $j = $var";
# print "<br> next substitution variable var = $$variables[$j+1]";
# }
$rno = 1+rand();
$student_ans =~ s/$var/$rno/gi;
$correct =~ s/$var/$rno/gi;
if($dump){
print "<br> substitution variable var = $var";
print "<br> after a cycle of substitutions, student_ans = $student_ans, and correct = $correct";
}
}
$evaluated_correct = eval($correct);
$evaluated_student_ans = eval($student_ans);
#THIS IS JUST WHILE DEBUGGING nmath
print "<br> evaluated correct = $evaluated_correct";
print "<br> correct = $correct";
print "<br> evaluated student_ans = $evaluated_student_ans";
print "<br> student_ans = $student_ans";
#REMOVE ALL SIX OF THESE LINES (above)
#open (STDERR,">&STDOUT");
#print "my name is $query->param('name')",\$query->param('student');
# REMOVE GIF's BEFORE PRINTING JUDGING
chmod(0777,"afile$ident.gif");#
# unlink "afile$ident.gif";
if($evaluated_student_ans ne ''){#needed to prevent blank = blank giving check
if($dump){print "<br>evaluated student answer not blank"};
if(abs($evaluated_correct-$evaluated_student_ans) < 0.0001){
if($dump){print "<br>evaluated student answer OK"};
print "<img src=../icons/check.gif>";
# &mail_one($query->script_name(),$saved_stu_ans1,"correct",$query->param('student'))if ($ans1 ne $escape);
return 1;
}
else{
if ($student_ans ne ' '){
print "<br> <img src=../icons/checkno.gif>";#In FRAMES, NEEDS EXTRA ..
print "Your answer does not agree with the expected one.<br>";
print $error_response;
}
}
#CWD Sept 14, 2000
# &mail_one($query->script_name(),$saved_stu_ans1,"wrong",$query->param('student'))if ($ans1 ne $escape);
return 0
}
}#end of major if param judging (i.e., a response has been made)
}#end of subroutine grade_nmtext
1;
mail_one
sub mail_one{
my $progname = $_[0];#scriptname
$progname = substr($progname,17);
my $stu_ans = $_[1];
my $cwd_ans = $_[2];
my $student_id = $_[3];
# my $remote_ident = $query->remote_ident();
# print $message;
my $mailprog = '/usr/lib/sendmail -t';
my $recipient = 'carl.david\@uconn.edu';
# open (MAIL, "|$mailprog $recipient") || die "Can't open $mailprog!\n";
# print MAIL "From:$_[3]\n";
# print MAIL "Subject: $stu_ans , $cwd_ans , $progname \n\n";
# print MAIL "Successful Computer Guided Reading Report\n";
# print MAIL "Question: $progname\n\n";
# print MAIL "Student ID :", $_[3],"\n\n";
# print MAIL " reading:student answer = $stu_ans; $cwd_ans\n\n";
# print MAIL "===end of message===\n";
# close (MAIL);
open (FP, ">>../$student_id".".chem393dat")
|| die ("Could not append to $student_id file : $!\n");
print FP " CGR( $progname ):stu ans = $stu_ans; cwd ans = $cwd_ans\n";
close(FP);
}#end sub mail_one
1;
CleanUp
sub CleanUp
{
my($v,$count,$i);
$v = $_[0];
if ( $_[0] ne '')
{
$_[0] =~ s/\\//gi;
$_[0] =~ s/\$//gi;
$_[0] =~ s/\#//gi;
$_[0] =~ s/\~//gi;
$_[0] =~ s/\`//gi;
$_[0] =~ s/\^/**/gi;
$_[0] =~ s/qx\{//gi;# remove quote execute
$_[0] =~ s/q\s+x\s+\{//gi;# remove quote execute
$count = 0;
for ($i=0;$i<length($v);$i++){
#print "<br>i = ",$i," and count = ",$count, "<br> substr = ",substr($v,$i,1);
if(substr($v,$i,1) eq '('){
$count++;
}
elsif(substr($v,$i,1) eq ')'){
$count--;
if($count < 0){print "<br><font color=red>Bracket error at position </font>",$i;}
}
#print "done with loop one time";
}
if ($count != 0){print "<br><font color=red>Bracket error, more of one kind than another</font>";}
}
return -1;
}
1;#end of CleanUp
report
sub report{
my $rightWrong = $_[0];
my $answer = $_[1];
my $correct = $_[2];
my $filename = $_[3];#this was called using a value of tempfile
print "<br>in report (0), $_[0]";
print "<br>in report (1), $_[1]";
print "<br>in report (2), $_[2]";
print "<br>in report (3), $_[3]";
print "<br>Writing file $tempfile<br>";
open (OUTFILE, $tempfile);
print ( OUTFILE $rightWrong," stud: ",$answer,
" ans: ",$correct,"\n");
close OUTFILE ;
}