This package contains utility programs used (and abandoned) by several generations of questions on this site (freshman chemistry), the pchem site, and the advanced graduate student site.
package CAT2p4pchem;
#extended to return true if qnd is good answer, for use
# in chem prelab multiquestion mode.
# April 10, 2000 adding one and two digit integer answer
# and changing qnd so that
# 1) 2 sig figs possible, x.yE etc., DONE
# 2) answer judged as a percent????
# 3) power of ten warning given
#WORK started (IV/10/2000)
# adding full reporting capabilities, may 2000
#above WORK ended (DATE)
use CGI ':standard';
use CGI::Carp qw(fatalsToBrowser);
#use diagnostics;
use Text::Wrap;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(send_memo rno round qnd mc time_stamp save_vars exam_qnd
our_time text_in txt_in login_report report comment1 help qxd);
sub new{
my $this = {}; #create anonymous hash and #self points to it
bless $this; # connect the hash to CATutils
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]);
}
A rounding subroutine
sub round {
#
# rounds first argument to length of second
#
shift;
return(int($_[0]*10**$_[1])/10**$_[1]);
}
A "help" subroutine which prints textual help, and records the student's having asked for help.
sub help{
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 $text = $_[3];# text to be written
my $filename = $_[4];#student_file text, which might be a URL
print $text;
$tempfile = ">>../".$filename.".dat";
&report("HELP ".$question.":".$var,$stu_ans,$ans,$tempfile);
}#end of sub help
iSubroutine examination query: exam_qnd.
sub exam_qnd
# 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=1 means one digit after decimal point,
# n=2 means two digits after decimal point,
# n=3 means three digits, anything else
# is nonesense
my $filename = $_[5];#student_file text, which might be a URL
# this is where we will ultimately write out the record for this student
#this is where we have a flag for future use
my $flag = $_[6];
# if flag = 1 not set yet, left for future possibilities
my $debug = 'false';
$question = $query->script_name();
$vv1 = rindex($question,"\/");
$len = length($question);
$question = substr($question,$vv1+1,$len-$vv1).localtime();#remove directory
if ($debug eq "true"){print "<br>question(1) = $question <br>";}
$tempfile = ">>../".$filename.".dat";
my($power_0,$s10,$s20,$xa0,$ya0,$za0,$za01,$t100,$t10,$stu_ans,$v_1,$v_2);
print "<P> Choose your answer in scientific notation,
e.g., ±1.000x<font color=red>10<sup>±00</sup></font><br>",
$query->scrolling_list($var.'s10',
['+','-'],'+'),
$query->popup_menu($var.'xa0',
['1','2','3','4','5','6','7','8','9'],'1'),
"<STRONG>.</STRONG> ",
$query->popup_menu($var.'ya0',
['0','1','2','3','4','5','6','7','8','9'],'0');
if ($n >=2){print
$query->popup_menu($var.'za0',
['0','1','2','3','4','5','6','7','8','9'],'0');}
if ($n == 3){print
$query->popup_menu($var.'za01',
['0','1','2','3','4','5','6','7','8','9'],'0')};
print " x 10<sup>{</sup>";
print $query->scrolling_list($var.'s20',
['+','-',],'+'),
$query->popup_menu($var.'t100',
['0','1','2','3','4','5','6','7','8','9'],'0'),
$query->popup_menu($var.'t10',
['0','1','2','3','4','5','6','7','8','9'],'0');
print "<sup>}</sup>";
#print "<br> n = $n";
if ($query->param($var.'xa0')) {
$xa0 = $query->param($var.'xa0');
$ya0 = $query->param($var.'ya0');
$za0 = $query->param($var.'za0');
$za01 = $query->param($var.'za01');
if($n == 3){$stu_ans = $xa0+(100*$ya0+10*$za0+$za01)/1000}
elsif($n == 2)
{$stu_ans = $xa0+(10*$ya0+$za0)/100}
elsif($n == 1) {
$stu_ans = $xa0+($ya0)/10}
else{
$stu_ans = $xa0+(100*$ya0+10*$za0+$za01)/1000
}
if ($debug eq "true"){
print <<EOF;
<br> xa0 = $xa0
<br> ya0 = $ya0
<br> za0 = $za0
<br>za01 = $za01
<br> student constructed $stu_ans = $xa0+(10*$ya0+$za0)/100
<br>stu_ans = $stu_ans
EOF
}
$s10 = $query->param($var.'s10');
$s20 = $query->param($var.'s20');
if ($s10 eq "-"){$stu_ans = - $stu_ans};
$t10 = $query->param($var.'t10');
$t100 = $query->param($var.'t100');
$power_0 = $t100*10+$t10;
if ($s20 eq "-"){$power_0 = - $power_0};
$stu_ans = $stu_ans * (10 ** $power_0);
$mantissa_ans = $ans*10**(-$power_0);
$mantissa_stu_ans = $stu_ans/(10**$power_0);
$v_1 = abs(($stu_ans - $ans) );#absolute error
if($ans<0){#looking to find the last digit which might be off by one
$v1 = substr($ans,0,$n+3)
} else {
$v1 = substr($ans,0,$n+2)
}
#print "<br> truncated answer = ",$v1;
$v_mantissa = abs(($mantissa_stu_ans - $mantissa_ans) );#absolute error
$v_2 = abs($v_mantissa);#absolute error scaled.
if ($n == 2){$crit = .009}
elsif ($n == 1){$crit = .09}
else{$crit = 0.001}
if($debug eq "true"){
print <<EOF;
<br> mantissa_ans = $mantissa_ans
<br> mantissa_stu_ans = $mantissa_stu_ans
<br> v_1 = $v_1
<br> v_mantissa = $v_mantissa
<br> v_2 = $v_2
<br> criterion = $crit
<br> ans = $ans
<br> stu_ans = $stu_ans
EOF
}
#print "</sub>";
if ($v_2 < $crit){
print " <font color=green>was <EM>Right! </EM>.
<IMG SRC=../icons/check.gif><font color=black>";
&report("RIGHT ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
return 1;
}
elsif ($v_2 < 2*$crit) {
print "<blink> might be <EM>Right,</EM> i.e., it appears close to the
expected answer.</blink>";
&report("APPROX".$question." QND:".$var,$stu_ans,$ans,$tempfile);
return 0 if ($flag == 1);
}
elsif(abs($stu_ans/$ans) <= 1/10 ||
abs($stu_ans/$ans) >= 10){
print "<blink><br>It would appear that there is a power of ten
discrepency between your answer and the expected answer.</blink>";
&report("PowTen".$question." QND:".$var,$stu_ans,$ans,$tempfile);
return 0 if ($flag == 1);
}
elsif ($stu_ans*$ans <0){
print "<br> student answer = ",$stu_ans;
print "<br> answer = ",$ans;
&report("SIGN ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
print "<blink> differs in sign from the expected answer.</blink>";
return 0 if ($flag == 1);
}
else{
#here us the point at which to check for help (above)
for ($i = 0 ; $i <=$eell ; $i++){
$ourans = $wrong[$i];
$ouranseval = eval($ourans);
$mantissa_ans = $ouranseval*10**(-$power_0);
$mantissa_stu_ans = $stu_ans/(10**$power_0);
print "our ans = $ourans and evaluated = $ouranseval";
$v_1 = abs(($stu_ans - $ans) );#absolute error
$v_mantissa = abs(($mantissa_stu_ans - $mantissa_ans) );#absolute error
$v_2 = abs($v_mantissa);#absolute error scaled.
# print "<br>Your answer was recorded as ",$stu_ans,".";
# print "<br>$ouranseval and $stu_ans , $test";
# print "<br>crit , $crit";
if ($v_2 < $crit){
print "<blink><font color=red><br> $response[$i] </blink></font>";}
}
print "<br>Your answer, $stu_ans , <font color=red> appears to be <EM>Wrong! </EM>.
<IMG SRC=../icons/checkno.gif><font color=black>";
&report("WRONG ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
return 0 if ($flag == 1);
}
};#end of if($query->param($var.'xa0'))
};#end of exam_qnd
Subroutine qnd which is the main query for a numerical answer, in this case, with 3 significant figures.
sub qnd
# Dec 2000 changed return to be 0 if OK, else 1
# 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=1 means one digit after decimal point,
# n=2 means two digits after decimal point,
# n=3 means three digits, anything else
# is nonesense
my $filename = $_[5];#student_file text, which might be a URL
# this is where we will ultimately write out the record for this student
#this is where we start the new material, to add lists of errors and
# error responses
my $addressOfList;# = $_[6];
# $el = 0;
# $eell = 1;
# until (@$addressOfList[$el] == ""){
# $wrong[$eell] = @$addressOfList[$el];
# $response[$eell] = @$addressOfList[$el+1];
# $el = $el +2;
# $eell++;
# }
# $eell--;#count of number of error responses given by teacher.
# my $debug = 'false';
my $debug = 'false';
$question = $query->script_name();
$vv1 = rindex($question,"\/");
$len = length($question);
$t = localtime();
if($debug eq "true"){
print "<br> vv1 = $vv1 and length = ",length($question);
print "<br> time = $t";
print "<br> answer regarded as correct = $ans ";
}
$question = substr($question,$vv1+1,$len-$vv1)."-".localtime();#this chops off /cgi...
if ($debug eq "true"){print "<br>question = $question <br>";}
$tempfile = ">>../".$filename.".std";
my($power_0,$s10,$s20,$xa0,$ya0,$za0,$za01,$t100,$t10,$stu_ans,$v_1,$v_2);
print "<P> Choose your answer in scientific notation,
e.g., ±1.000x<font color=red>10<sup>±00</sup></font><br>",
$query->scrolling_list($var.'s10',
['+','-'],'+'),
$query->popup_menu($var.'xa0',
['1','2','3','4','5','6','7','8','9'],'1'),
"<STRONG>.</STRONG> ",
$query->popup_menu($var.'ya0',
['0','1','2','3','4','5','6','7','8','9'],'0');
if ($n >=2){print
$query->popup_menu($var.'za0',
['0','1','2','3','4','5','6','7','8','9'],'0');}
if ($n == 3){print
$query->popup_menu($var.'za01',
['0','1','2','3','4','5','6','7','8','9'],'0')};
print "<font color=red size=+1><STRONG> x 10</STRONG><sup>{ </font>",
$query->scrolling_list($var.'s20',
['+','-',],'+'),
$query->popup_menu($var.'t100',
['0','1','2','3','4','5','6','7','8','9'],'0'),
$query->popup_menu($var.'t10',
['0','1','2','3','4','5','6','7','8','9'],'0'),
"<font color=red><STRONG>}</STRONG></font></sup></font>";
if ($query->param($var.'xa0')) {
$xa0 = $query->param($var.'xa0');
$ya0 = $query->param($var.'ya0');
if($n >=2){
$za0 = $query->param($var.'za0');}
if($n == 3){$za01 = $query->param($var.'za01')};
if($n == 3){$stu_ans = $xa0+(100*$ya0+10*$za0+$za01)/1000}
elsif($n == 2)
{$stu_ans = $xa0+(10*$ya0+$za0)/100}
else {
$stu_ans = $xa0+($ya0)/10}
if ($debug eq "true"){
print <<EOF;
<br> xa0 = $xa0
<br> ya0 = $ya0
<br> za0 = $za0
<br>za01 = $za01
<br> student constructed $stu_ans = $xa0+(10*$ya0+$za0)/100
<br>stu_ans = $stu_ans
EOF
}
$s10 = $query->param($var.'s10');
$s20 = $query->param($var.'s20');
if ($s10 eq "-"){$stu_ans = - $stu_ans};
$t10 = $query->param($var.'t10');
$t100 = $query->param($var.'t100');
$power_0 = $t100*10+$t10;
if ($s20 eq "-"){$power_0 = - $power_0};
$stu_ans = $stu_ans * (10 ** $power_0);
$mantissa_ans = $ans*10**(-$power_0);
$mantissa_stu_ans = $stu_ans/(10**$power_0);
$v_1 = abs(($stu_ans - $ans) );#absolute error
if($ans<0){#looking to find the last digit which might be off by one
$v1 = substr($ans,0,$n+3)
} else {
$v1 = substr($ans,0,$n+2)
}
#print "<br> truncated answer = ",$v1;
$v_mantissa = abs(($mantissa_stu_ans - $mantissa_ans) );#absolute error
$v_2 = abs($v_mantissa);#absolute error scaled.
if ($n == 2){$crit = .009}
elsif ($n == 1){$crit = .09}
else{$crit = 0.001}
if($debug eq "true"){
print <<EOF;
<br> mantissa_ans = $mantissa_ans
<br> mantissa_stu_ans = $mantissa_stu_ans
<br> v_1 = $v_1
<br> v_mantissa = $v_mantissa
<br> v_2 = $v_2
<br> criterion = $crit
<br> ans = $ans
<br> stu_ans = $stu_ans
EOF
}
if ($v_2 < $crit){
print " <font color=green>was <EM>Right! </EM>.
<IMG SRC=../icons/check.gif><font color=black>";
&report("RIGHT ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
return 1;
}
elsif ($v_2 < 2*$crit) {
$percent = round(abs((($stu_ans-$ans)/$ans)*100),2);
print "<blink> might be <EM>Right,</EM> i.e., it appears close
( within about $percent \% ) of the
expected answer .</blink>";
&report("APPROX".$question." QND:".$var,$stu_ans,$ans,$tempfile);
return 0;
}
elsif(abs($stu_ans/$ans) <= 1/10 ||
abs($stu_ans/$ans) >= 10){
print "<blink><br>It would appear that there is a power of ten
discrepency between your answer and the expected answer.</blink>";
&report("PowTen".$question." QND:".$var,$stu_ans,$ans,$tempfile);
return 0;
}
elsif ($stu_ans*$ans <0){
print "<br> student answer = ",$stu_ans;
print "<br> answer = ",$ans;
&report("SIGN ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
print "<blink> differs in sign from the expected answer.</blink>";
return 0;
}
else{
#here us the point at which to check for help (above)
for ($i = 0 ; $i <=$eell ; $i++){
$ourans = $wrong[$i];
$ouranseval = eval($ourans);
$mantissa_ans = $ouranseval*10**(-$power_0);
$mantissa_stu_ans = $stu_ans/(10**$power_0);
$v_1 = abs(($stu_ans - $ans) );#absolute error
$v_mantissa = abs(($mantissa_stu_ans - $mantissa_ans) );#absolute error
$v_2 = abs($v_mantissa);#absolute error scaled.
if ($debug eq "true"){
print "our ans = $ourans and evaluated = $ouranseval";
print "<br>Your answer was recorded as ",$stu_ans,".";
print "<br>$ouranseval and ", $stu_ans , $test ;
}
print "<br>crit , $crit" if ($debug eq "true");
if ($v_2 < $crit){
print "<blink><font color=red><br> $response[$i] </blink></font>";}
}
print "<br>Your answer, $stu_ans , <font color=red> appears to be <EM>Wrong! </EM>.
<IMG SRC=../icons/checkno.gif><font color=black>";
&report("WRONG ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
if($query->param($var.'Give_The_Answer') eq 'on'){
print "<br>The expected answer is ".
&round_up_to_exponent($ans,$n);
&report("GIVEN ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
}
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;# this is the one line help thing
}
return 0;
}
};#end of if($query->param($var.'xa0'))
};#end of qnd
qxd
sub qxd
# Dec 2000 changed return to be 0 if OK, else 1
# 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=1 means one digit after decimal point,
# n=2 means two digits after decimal point,
# n=3 means three digits, anything else
# is nonesense
my $filename = $_[5];#student_file text, which might be a URL
# this is where we will ultimately write out the record for this student
#this is where we start the new material, to add lists of errors and
# error responses
my $addressOfList;# = $_[6];
# $el = 0;
# $eell = 1;
# until (@$addressOfList[$el] == ""){
# $wrong[$eell] = @$addressOfList[$el];
# $response[$eell] = @$addressOfList[$el+1];
# $el = $el +2;
# $eell++;
# }
# $eell--;#count of number of error responses given by teacher.
my $debug = 'false';
$debug = 'true';
$question = $query->script_name();
$vv1 = rindex($question,"\/");
$len = length($question);
$t = localtime();
# if($debug eq "true"){
# print "<br> vv1 = $vv1 and length = ",length($question);
# print "<br> time = $t";
# }
$question = substr($question,$vv1+1,$len-$vv1)."-".localtime();#this chops off /cgi...
if ($debug eq "true"){print "<br>question = $question <br>";}
$tempfile = ">>../".$filename.".std";
print "<p>Enter your answer here:<font size=+1>",
$query->textfield($var.'1','',10,30),
"* 10<sup><sup>",
$query->textfield($var.'2','',3,3),
"</sup></sup><p></font>";
my($power_0,$s10,$s20,$xa0,$ya0,$za0,$za01,$t100,$t10,$stu_ans,$v_1,$v_2);
if ($query->param($var.'1')) {
$xa0 = $query->param($var.'1');
$t10 = $query->param($var.'2');
$stu_ans = $xa0*10**($t10);
if ($debug eq "true"){
print <<EOF;
<br> xa0 = $xa0
<br> t10 = $t10
<br> n = $n
EOF
}
# $t10 = $query->param($var.'t10');#use for power of ten????
# $t100 = $query->param($var.'t100');
# $power_0 = $t100*10+$t10;
# if ($s20 eq "-"){$power_0 = - $power_0};
# $stu_ans = $stu_ans * (10 ** $power_0);
# $mantissa_ans = $ans*10**(-$power_0);
# $mantissa_stu_ans = $stu_ans/(10**$power_0);
$crit = abs((($stu_ans-$ans)/$ans)*(10**$n));
$percent = round(abs((($stu_ans-$ans)/$ans)*100),2);
my $variance = 1/$n;
if ($debug eq "true"){
print <<EOF;
<br> variance allowed for n=$n = 1/$n = $variance
<br>crit = $crit
<br>stu_ans = $stu_ans
<br>ans = $ans
EOF
}
if ($crit < $variance){#
print " <font color=green>was <EM>Right! </EM>.
<IMG SRC=../icons/check.gif><font color=black>";
&report("RIGHT ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
return 0;
}
elsif ($crit < 2*$variance) {
#remove $percent = round(abs((($stu_ans-$ans)/$ans)*100),2);
print "<blink> might be <EM>Right,</EM> i.e., it appears close
(i.e., within ~ $percent % of the expected answer).
</blink>";
&report("APPROX".$question." QND:".$var,$stu_ans,$ans,$tempfile);
return 1;
}
elsif(abs($stu_ans/$ans) <= 1/10 ||
abs($stu_ans/$ans) >= 10){
print "<blink><br>It would appear that there is a power of ten
discrepency between your answer and the expected answer.</blink>";
&report("PowTen".$question." QND:".$var,$stu_ans,$ans,$tempfile);
return 1;
}
elsif ($stu_ans*$ans <0){
print "<br> student answer = ",$stu_ans;
print "<br> answer = ",$ans;
&report("SIGN ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
print "<blink> differs in sign from the expected answer.</blink>";
return 1;
}
else{
#here us the point at which to check for help (above)
for ($i = 0 ; $i <=$eell ; $i++){
$ourans = $wrong[$i];
$ouranseval = eval($ourans);
$mantissa_ans = $ouranseval*10**(-$power_0);
$mantissa_stu_ans = $stu_ans/(10**$power_0);
$v_1 = abs(($stu_ans - $ans) );#absolute error
$v_mantissa = abs(($mantissa_stu_ans - $mantissa_ans) );#absolute error
$v_2 = abs($v_mantissa);#absolute error scaled.
if ($debug eq "true"){
print "our ans = $ourans and evaluated = $ouranseval";
print "<br>Your answer was recorded as ",$stu_ans,".";
print "<br>$ouranseval and ", $stu_ans , $test ;
}
print "<br>crit , $crit" if ($debug eq "true");
if ($v_2 < $crit){
print "<blink><font color=red><br> $response[$i] </blink></font>";}
}
print "<br>Your answer, $stu_ans , <font color=red> appears to be <EM>Wrong! </EM>.
<IMG SRC=../icons/checkno.gif><font color=black>";
&report("WRONG ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
if($query->param($var.'Give_The_Answer') eq 'on'){
print "<br>The expected answer is ".
&round_up_to_exponent($ans,$n);
&report("GIVEN ".$question." QND:".$var,$stu_ans,$ans,$tempfile);
}
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;# this is the one line help thing
}
return 1;
}
};#end of if($query->param($var.'xa0'))
};#end of qxd
Subroutine mc, a multiple choice query.
sub mc
# 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 $number = $_[3];# this the number of answers in the choice
my $n = $_[4];# this is the number of the correct answer
my $filename = $_[5];
$tempfile = ">>../".$filename.".dat";
$question = $query->script_name();
$vv1 = rindex($question,"\/");
$len = length($question);
$question = substr($question,$vv1+1,$len-$vv1).localtime();#this chops off voh/cgi...
my $h1 = $_[6];#this is the first answer choice
my $h2 = $_[7];#this is the second answer choice
my $h3 = $_[8];#this is the third answer choice
my $h4 = $_[9];#this is the fourth answer choice
my $h5 = $_[10];#this is the fifth answer choice
my $h6 = $_[11];#this is the sixth answer choice
my $debug = 'false';
#print "in mc, number = ",$number;
#my $n;
if($number eq '5'){
print "<P>", $query->scrolling_list($var,
[$h1,$h2,$h3,$h4,$h5],' ');}
elsif($number eq '4'){
print "<P>", $query->scrolling_list($var,
[$h1,$h2,$h3,$h4],' ');}
elsif($number eq '3'){
print "<P>", $query->scrolling_list($var,
[$h1,$h2,$h3],' ');}
elsif($number eq '2'){
print "<P>", $query->scrolling_list($var,
[$h1,$h2],' ');}
else{
print "<P>", $query->scrolling_list($var,
[$h1,$h2,$h3,$h4,$h5,$h6],' ');}
if ($query->param($var) ne '') {
$xa0 = $query->param($var);
$v = 5+$_[4];#changed April 20, 2000
if($xa0 eq $_[$v]){
print " <font color=green>was <EM>Right! </EM>.
<IMG SRC=../icons/check.gif><font color=black>";
#&report("RIGHT ".$question."(MC):".$var,$v,$xa0,$tempfile);
return 1;
}
else {
print " <font color=red>appears to be <EM>Wrong! </EM>.
<IMG SRC=../icons/checkno.gif><font color=black>";
#&report("WRONG ".$question."(MC):".$var,$v,$xa0,$temfile);
return 0;
}
}
}
Subroutine comment elicits a response from the student. I would not use this anymore, since mailing is always a problem, and opening up your web site to unrestricted text brings out the worst in some people.
sub comment1{
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
my $filename = $_[3];
if ($filename eq ""){print "<br><font color=red size=+1>You must enter two names in the first two fields of this examination!</font>";
}
$tempfile = ">>../".$filename.".dat";
print "<br>You may comment on this question here if you wish:<br>";
print $query->textarea($var,'',3,60);
if ($query->param($var) ne ""){
$comment = $query->param($var);
open (OUTFILE, $tempfile);
print ( OUTFILE wrap("\t","","student comment on question ",$var," = ",$comment,"\n"));
print wrap ("\t","","<br>student comment on question ",$filename," = ",$comment,"<br>");
close OUTFILE ;
return $comment;
}
}#end of comment
login_report
sub login_report{
#print "<br>",@_;
my $query = $_[0];
my $rightWrong = $_[2];#login message
my $answer = $_[3];
my $correct = $_[4];
my $filename = $_[5];#this was called using a value of tempfile
my $debug = "false";
if($debug eq "true"){
print "<br>in report (0), $query";
print "<br>in report (2), $rightWrong";
print "<br>in report (3),answer $answer";
print "<br>in report (4),correct $correct";
print "<br>in report (5), $filename";
print "<br>Writing file $filename<br>";
}
open (OUTFILE, ">>".$filename);
print OUTFILE $rightWrong," date: ",&my_time,
"\n" ;
close OUTFILE ;
}
report
#
sub report{
my $rightWrong = $_[0];
my $answer = $_[1];
my $correct = $_[2];
my $filename = $_[3];#this was called using a value of tempfile
# last argument not used. tempfile passed in common
my $debug = "false";
if($debug eq "true"){
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 ;
}
#
our_time
sub our_time{
%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");
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
print "<br> ", $hour,":",$min,":",$sec,": ",$weekday{$wday},", ",$MONTH{$mon}," ",$mday,", ",1900+$year;
}#end of our_time
my_time
sub my_time{
%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");
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
return($hour,":",$min,":",$sec,": ",$weekday{$wday},", ",$MONTH{$mon}," ",$mday,", ",1900+$year);
}#end of our_time
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
($device,$inode,$mode,$nblink,$quid,$gid,$rdev,$size,$atime,
$mtime,$ctime,$blksize,$blocks) = stat($filename);
%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");
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
# if ($year le 50){$pre = "20"} else {$pre = "19"};
print "The last time this file was changed (edited) was ", $weekday{$wday},", ",$MONTH{$mon}," ",$mday;
# there is a problem with the year, so the hell with it, Jan 2000
}#end of time_stamp
Subroutine text_in allows students to answer with text. Again, I would not use this any more.
sub text_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 $student_file = $_[5];#student_file text, which might be a URL
my $debug = 'false';
$tempfile = ">>../".$filename.".dat";
$question = $query->script_name();
$vv1 = rindex($question,"\/");
$len = length($question);
print "<br>",$query->textfield($var.'text_in','',$n,10*$n);
if ($query->param($var.'text_in')){
$text = $query->param($var.'text_in');
$text =~ s/\\//gi;
$text =~ s/\$//gi;
$text =~ s/\#//gi;
$text =~ s/\~//gi;
$text =~ s/\^/**/gi;
# $v2 = abs(($v1-$ans)/$ans);
#print "<br>text = $text<br>";
#print "<br>v1 = $v1<br>";
#print "<br>ans = $ans<br>";
if (($text eq $ans)||(lc($text) eq lc($ans))){
print " <font color=green><EM>Right! </EM>.
<IMG SRC=../icons/check.gif><font color=black>";
&report("RIGHT ".$question."TEXT".$var."stud=",$text,$ans,$tempfile);
return 1;
}
else{
print " <font color=red><EM>Wrong! </EM>.
<IMG SRC=../icons/checkno.gif><font color=black>";
&report("WRONG "."TEXT".$var."stud=",$text,$ans,$tempfile);
return 0;
}
}
}
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 $filename = $_[5];#student_file text
my $debug = 'false';
$tempfile = ">>../".$filename.".dat";
print "<br><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>";}
# print "<br>txt = $txt";
$v1 = eval($txt);
$evalans= eval($ans);
$v2 = abs(($v1-$evalans)/$evalans);
# 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>";
&report("RIGHT "."TXT :".$var,$evalans,$ans,$tempfile);
return 1;
}
else{
print " <font color=red><EM>appears to be incorrect. </EM>.
<IMG SRC=../icons/checkno.gif><font color=black>";
&report("WRONG "."TXT :".$var,$evalans,$ans,$tempfile);
return 0;
}
}
}
round_up_to_exponent
sub round_up_to_exponent {
local ($val, $exp) = @_;
local ($tmp,$i,$tmp1,$tmp2);
#sprintf("\%.${exp}f", $val);
$tmp = sprintf("\%.${exp}E", $val);
if(index($tmp,"E+00") != -1){$tmp = $tmp =
substr($tmp,0,length($tmp)-4);
}
$i = index($tmp,"E");
if ($i != -1){
$tmp1 = substr($tmp,0,length($tmp)-4);
$tmp2 = substr($tmp,$i+1);
return($tmp1."x10<sup>".$tmp2."</sup>");
}
# print "<br>tmp = $tmp";
return $tmp;
}
Subroutine send_memo. Again, I suggest not using this kind of thing.
sub send_memo{
my ($query) = $_[1];# this seems to work 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'));
#print $query->dump;
$faculty_id = $query->param('owner');
$student_id = $query->param('name');
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
if ($year le 50){$pre = "20"} else {$pre = "19"};
print "<hr>";
print <<EOF;
If you wish to enter into a technical discussion (with me or others) and need
to use mathematical notation, consider using <a href=http://web.uconn.edu/~cdavid/cgi-bin/techwiki.pl>techwiki</a>
which allows technical/mathematical notation, but assumes that you separately
e-mail me (or others) saying that you've deposited something there which
you want me (or others) to read.
<br>If you just wish to write to me directly, without mathematical notation,
then please use the form below:
<hr>
EOF
# print "<img src=../icons/mailbox.gif>";
print "If you wish to comment to C. W. David about
this question, assumptions you are making, inconsistencies in the
phraseology of the question, objections to the question, etc., etc., etc.,
you may use this space for that purpose.";
print "<font color=red>";
print "Please include your e-mail (in the form like mine, i.e., Carl.David\@uconn.edu) address explicitly. Thank you.";
print "</font>";
print "<br>e-mail addresss = ",$query->textfield($var.'eadd','',60,20);
# print " @ $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 either here or above!)
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') ) {
open (FACULTY,">>../Master_teacher.dat")|| print
"<br> Master_teacher.dat, Faculty File Troubles Encountered, please report to instructor";
$comments = $query->param($var.'comments').localtime()."\n\nEND OF COMMENTS\n\n";
$comments = $comments."-".$question;
$eadd = $query->param($var.'eadd');
$string = localtime().":".$comments.":from->".$eadd ;
print FACULTY wrap("\t","","<",$query->script_name(),">,<",$student_id,">, comments=",$comments,"\n");
close(FACULTY);
$question = $query->script_name();
$sender = $query->remote_host();
$mailprog = '/usr/lib/sendmail';
$recipient = 'david\@uconn.edu';
open (MAIL, "|$mailprog $recipient") || die "Can't open $mailprog!\n";
$string = "Subject: WWW comments (Forms submission)\n";
$string = $string."Comments about the Freshman Chemistry server:\n";
$string = $string."Student name: $student_id\n";
$string = $string."Question: $question\n";
$string = $string."e-mail account = $eadd \n";
$string = $string."SENDER: $sender \n";
$string = $string.":".localtime().":";
$string = $string.$comments;
print MAIL wrap("\t","",$string."\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);
print $query->param($var.'comments','');
# Make the person feel good for writing to us
print STDOUT "<img src=../icons/postboxandhand.gif>";
print STDOUT "Thank you for sending comments to C. W. David.";
print STDOUT "<img src=../icons/emailed.gif>";
# ------------------------------------------------------------
blank_response
# 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 the <A HREF=\"/~cdavid/\">home page</A>, if you want.<P>";
exit;
}
}
}#end of subroutine
#STOP end of send menu routines
true/false
sub tf{
# 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 either 'True' or 'False'
my $filename = $_[4];
$tempfile = ">>../".$filename.".dat";
$question = $query->script_name();
$vv1 = rindex($question,"\/");
$len = length($question);
$question = substr($question,$vv1+1,$len-$vv1).localtime();
print $query->popup_menu( $var,['True','False'],'');
if ($query->param($var)) {
if ($query->param($var) eq $ans){
print " <font color=green>was <EM>Right! </EM>.
<IMG SRC=../icons/check.gif></font>";
&report("RIGHT ".$question."(TF):".$var,"",$ans,$tempfile);
return 1;
}
else {
print " <font color=red>appears to be <EM>Wrong! </EM>.
<IMG SRC=../icons/checkno.gif></font>";
&report("WRONG ".$question."(TF):".$var,"",$ans,$tempfile);
return 0;
}
}
}
Subroutine save vars, which I suggest you drop, as did I.
sub save_vars{
shift;#takes out the reference of the module
$query = $_[0];
shift;
my $var_string = $_[0];
my $pointer_to_var_string = $_[1];
$var_string = "'".$var_string."'";#make quoted
# my $a = $$pointer_to_var_string;#variable passed by pointer $_[1]
if ($query->param($var_string) eq ''){
$query->param($var_string,$$pointer_to_var_string);#if first
}
print $query->hidden($var_string,$$pointer_to_var_string);
$$pointer_to_var_string = $query->param($var_string);
# print "<br> in save, value = ",$query->param($var_string)," for var = $var_string";
}
The original design, twenty+ years ago, had me keeping data on students as
they worked the various problems. The idea was to use this data for
improvement of the questions, as I learned about their errors.
Now-a-days, I think that most people would create a data base and record
results, errors, comments, etc., in such a data base, so that TA's and
lecturers could inspect the data base for information relative to their own students
without having to log into the server, i.e., using some web page which
allowed querys of the student data base.
I am too old to care about such things.