The code below (server addresses Xed out for security) has been used on my
website for years, but it does seem to misbehave on rare occasions, so I have a
few questions on how I might improve it. I apologize in advance for my
amateurish coding; I’m a high school teacher who cannot afford hiring help, so
I bought a bunch of O’Reilly books and plunged in bravely. The heavy commenting
is because I don’t often work on the code and need the reminders of why I am
doing things!
This code serves multiple choice questions to students, stores their answer and
other statistics, and emails me when the test is completed. It almost always
works well, but there are exceptions which puzzle me.
First: Sometimes a test will exit early, sending me the result although the
student did not make it through all the questions. Once this happened to the
same student twice. I don’t think students are hacking my code because this has
happened only to relatively unsophisticated individuals.
Second: In one case, although I cannot verify this, the student claimed that
she had answered a lot of questions that got lost. Perhaps I need to save
multiple copies of their score results and delete the old ones only after a
successful completion? Perhaps I need to save data in text files and only
append them? General strategies for structuring and securing data are way above
my skill level, I’m afraid. My host offers mySQL, but when I bought a book on
it I discovered that it had a steep and scary learning curve!
Third: On one occasion my sever emailed me a student’s result twice in quick
succession (one second apart according to Header values). One of the Received
headers contained “by mx13.futurequest.net” and the other had “mx14” instead of
“13”. This is not actually a problem for me like the anomaly above, but I am
curious about it.
And of course I welcome any and all suggestions, however small, on how to
improve my code and even the strategies I am struggling to use, and I don’t
mind you being blunt about it. You folks are a treasure of useful feedback and
I am grateful for whatever you offer!
Rick
#!/usr/bin/perl
# student_poser3
use strict;
#use warnings; commented out because one of my comparisons issue a warning
use CGI; $CGI::DISABLE_UPLOADS = 1; $CGI::POST_MAX = 102_400;
use DB_File; # module for Berkeley DBM w/ DB_HASH file type
use Fcntl qw( :DEFAULT :flock );
use CGI::Carp qw ( fatalsToBrowser );
use HTML::Template;
use Net::SMTP;
my $q = new CGI; #Get parameters from the calling form
my $course_file = $q->param( "course_file" );
my $student_id = $q->param( "student_id" );
my $n = $q->param( "n"
); # 0 if from OPEN page
my $answer = $q->param( "submit_answer" ); # undef if
from OPEN page
&convert_answer; # Converts answer to: a, b, c, d, or 0
# Declare some global values
my $n_next; # the question that should be served next
my $fraction_complete; # fraction of test completed
my $fraction_correct; # fraction of answers correctly answer (including partial
credit)
my @analysis; # List of student responses used in congrats subroutine
my %progress_hash;
my $progfile = "/xxx/xxxx/xxx/data/students/$student_id/p_$course_file";
die "There is no file called $progfile: $!\n" unless -e $progfile;
my $db = tie %progress_hash, 'DB_File', $progfile or die "Can't tie
progress_hash to $progfile: $!\n";
my $fd = $db->fd(); # get a file descriptor
open PROGFILE, "+<&=$fd" or die "Can't safely open $progfile : $!\n";
flock ( PROGFILE, LOCK_EX ) or die "Unable to acquire exclusive lock on
$progfile: $!\n";
undef $db;
my $name_full = $progress_hash{ name_full };
my $date_started = $progress_hash{ date_started };
my $n_max = $progress_hash{ n_max }; #
Number of questions in course
my $n_last = $progress_hash{ n_last }; # Last n
answered
my $string_of_wrongs = $progress_hash{ string_of_wrongs };
&determine_n_next; # the incoming response, if any, must match this
# otherwise it is the next question to
be served
if ( $n ne $n_next ) {$n = 0} # If this n is not expected, ignore this
submission
my %course_hash;
my $coursefile = "/xxx/xxxx/xxx/data/courses/$course_file";
die "There is no file called $coursefile: $!\n" unless -e $coursefile;
my $db2 = tie %course_hash, 'DB_File', $coursefile, O_RDONLY or die
"Can't tie course_hash to $coursefile: $!\n";
my $fd2 = $db2->fd(); # get a file descriptor
open COURSEFILE, "<&=$fd2" or die "Can't safely open $coursefile for
reading: $!\n";
flock ( COURSEFILE, LOCK_SH ) or die "Can't acquire a shared lock on
$coursefile: $!";
undef $db2;
if ( $n ne "0" ) { # If there is an answer in the submission
&score_submission; # score and record it,
&determine_n_next; # then re-determine n_next
}
if ($n_next > $n_max) {
&serve_congratulations; # If there are no more questions left, close up
shop
} else {
&serve_question; # otherwise, serve the next question
}
untie %progress_hash; close PROGFILE;
untie %course_hash; close COURSEFILE;
exit;
sub convert_answer {
SWITCH: {
if ($answer eq "Choose First Option" ) { $answer = "a"; last
SWITCH; }
if ($answer eq "Choose Second Option" ) { $answer = "b"; last
SWITCH; }
if ($answer eq "Choose Third Option" ) { $answer = "c"; last
SWITCH; }
if ($answer eq "Choose Fourth Option" ) { $answer = "d"; last
SWITCH; }
$answer = ""; # From OPEN page there is no answer
}
}
sub determine_n_next {
# Capture the numeric and "h" parts of the last recorded answer
my $num; if ($n_last =~ /(\d+)/) { $num = $1 }
my $h;if ($n_last =~ /(h)/ ) { $h = $1 }
if ( $string_of_wrongs =~ /_$n_last\_|$n_last$/ and $h ne "h") {
# If wrong and not helped,
$n_next = $n_last . "h"
# give help
} else {
# otherwise
$n_next = $num + 1
# next question
}
}
sub score_submission {
# Capture the numeric and "h" parts of this question
my $num; if ($n =~ /(\d+)/) { $num = $1 }
my $h; if ($n =~ /(h)/ ) { $h = $1 }
&update_tally($num) unless (exists $progress_hash{tally_no_help} or
exists $progress_hash{tally_w_help});
my $correct_bool = 1; # default assumes answer was correct
$progress_hash{$n} = $answer; # store student's answer
$progress_hash{n_last} = $n; # store the number of question just
answered
$progress_hash{"time_$n"} = &get_time;
if ( $answer ne $course_hash{"cO_$num"} ) { # check answer with
numeric part of $n
$progress_hash{string_of_wrongs} .= "_$n";
$correct_bool = 0;
}
# Update two variables used by &determine_n_next
$n_last = $progress_hash{n_last};
$string_of_wrongs = $progress_hash{string_of_wrongs};
# subroutine to tally older progress files
&update_tally unless (exists $progress_hash{tally_no_help} or exists
$progress_hash{tally_w_help});
# Tally points earned
if ( $correct_bool == 1 and $h ne "h" ) { # If answer is right
and no help, give credit
$progress_hash{tally_no_help} += 1
}
if ( $correct_bool == 1 and $h eq "h" ) { # If answer is right
but with help, give half credit
$progress_hash{tally_w_help} += .5
}
# Store statistics on progress
$progress_hash{fraction_complete} = $num / $n_max;
$progress_hash{fraction_correct} = ($progress_hash{tally_no_help} +
$progress_hash{tally_w_help}) / $num;
}
sub serve_question {
my $percent_complete = int (100 * $progress_hash{fraction_complete});
if ($percent_complete == 100) {$percent_complete = 99}; # Keep 100 from
appearing before last question
my $percent_correct = int ( 100 * $progress_hash{fraction_correct} );
my $num; if ($n_next =~ /(\d+)/) { $num = $1 } # strip off h if there
is one
my $help_bool; if ($n_next =~ /(h)/ ) { $help_bool = 1 } # Serve help
with question
# Get params for next question
my $course_name = $course_hash{'course_name' };
my $Qn = $course_hash{'Qn_' . "$num" };
my $Oa = $course_hash{'Oa_' . "$num" };
my $Ob = $course_hash{'Ob_' . "$num" };
my $Oc = $course_hash{'Oc_' . "$num" };
my $Od = $course_hash{'Od_' . "$num" };
my $topic = $course_hash{'topic_' . "$num" };
my $hp = $course_hash{'hp_' . "$num" };
# Choose template file
my $tmpl = new HTML::Template( filename =>
'/xxx/xxxx/xxx/www/templates/student_poser3.html' );
# Assign template parameters
$tmpl->param( name_full => $name_full
);
$tmpl->param( course_name => $course_name
);
$tmpl->param( course_file => $course_file
);
$tmpl->param( percent_complete => $percent_complete );
$tmpl->param( percent_correct => $percent_correct );
$tmpl->param( student_id => $student_id
);
$tmpl->param( date_started => $date_started
);
$tmpl->param( n => $n_next
);
$tmpl->param( Qn => $Qn
);
$tmpl->param( Oa => $Oa
);
$tmpl->param( Ob => $Ob
);
$tmpl->param( Oc => $Oc
);
$tmpl->param( Od => $Od
);
$tmpl->param( topic => $topic
);
$tmpl->param( hp => $hp
);
$tmpl->param( help_bool => $help_bool
);
print "Content-type: text/html\n\n",
$tmpl->output;
}
sub serve_congratulations {
my $percent_correct_final = sprintf("%.1f", 100 *
$progress_hash{fraction_correct}) ;
my $course_name = $course_hash{course_name};
my $date_ended = &get_date; $progress_hash{date_ended} = $date_ended;
&define_analysis;
# Produce email
my $from = 'liblea...@libertylearning.com';
my $site = 'libertylearning.com';
my $smtp_host = 'mail.libertylearning.com';
my $to = 'liblea...@libertylearning.com';
my $smtp = Net::SMTP->new($smtp_host, Hello => $site);
$smtp->mail($from);
$smtp->to($to);
$smtp->data( );
$smtp->datasend("From: LibLearn CGI\n");
$smtp->datasend("To: $to\n");
$smtp->datasend("Date: $date_ended\n");
$smtp->datasend("Subject: $course_file $percent_correct_final
$name_full\n");
$smtp->datasend("\n");
$smtp->datasend("\t$percent_correct_final\t$percent_correct_final\n");
$smtp->datasend("$student_id\t$student_id\t$student_id\n");
foreach (@analysis) {$smtp->datasend("$_\n")};
$smtp->dataend( );
$smtp->quit;
# Choose template file
my $tmpl = new HTML::Template( filename =>
'/xxx/xxxx/xxx/www/templates/student_congrats.html' );
# Assign template parameters
$tmpl->param( name_full => $name_full
);
$tmpl->param( course_name => $course_name
);
$tmpl->param( date_started =>
$date_started );
$tmpl->param( date_ended => $date_ended
);
$tmpl->param( percent_correct_final =>
$percent_correct_final );
print "Content-type: text/html\n\n",
$tmpl->output;
chdir "/xxx/xxxx/xxx/data/students/$student_id/";
rename "p_$course_file", "a_$course_file" or die "Can't rename to a_";
}
sub update_tally {
my $num = shift @_; # num is the current question number (not yet
scored)
$num -= 1; # Knock off one to get number of questions answered already
$string_of_wrongs = $progress_hash{string_of_wrongs} . "_"; # Append _
to help with matching
my @wrongs = split /_/, $string_of_wrongs;
shift @wrongs; # First element is blank because of a leading underscore
my $number_correct = $num - scalar @wrongs; # answers attempted less
wrong answers
if ( $number_correct < 0 ) { $number_correct = 0}
$progress_hash{tally_no_help} = $number_correct;
}
sub get_time {
my $temp_time = time();
if ($temp_time <100) {$temp_time = time()}; # try again if time
function malfunctioned
$temp_time;
}
sub get_date {
my ( undef, undef, undef, $day, $mon, $year, undef, undef, undef ) =
localtime &get_time;
$year += 1900;
$mon += 1;
my $formatted_date = "$mon/$day/$year";
$formatted_date
}
sub define_analysis {
my @n_list; # Prepare a list of all answered questions (n's)
foreach (keys %progress_hash) {
if (/^\d/) {push @n_list, $_}; # Get all the keys that begin
with a digit (n's)
}
@n_list = sort {$a <=> $b || $a cmp $b} @n_list;
my %timelapse; # Prepare a hash of how long it took to answer each
question.
my $previous_stamp = 0;
foreach ( @n_list ) {
$timelapse{$_} = $progress_hash{"time_$_"} - $previous_stamp;
$previous_stamp = $progress_hash{"time_$_"};
}
$timelapse{1} = "-"; # Can't tell how long it took to answer first
question
my $string_of_wrongs = $progress_hash{string_of_wrongs} . "_"; # Append
_ to help with matching later
#my @wrongs = split /_/, $string_of_wrongs;
#shift @wrongs; # First element is blank because of a leading _
#my %wrong_answers; # to store the answer (if wrong) of every answered
question
#my $err;
#foreach (sort {$a <=> $b || $a cmp $b} keys %progress_hash) {
# if ( @wrongs =~/ ($progress_hash{$_}) / ) {$err =
"$progress_hash{$_}"} else {$err = ""};
# $wrong_answers{$_} = $err;
#}
my $count = $progress_hash{n_last};
if ($count =~ /(\d+)/) { $count = $1 } # strip off h if there
is one
my @nh_list; # This array will contain h's
for EVERY question,
foreach (1 .. $count) { # allowing blanks for unused helps
push @nh_list, $_; # e.g. 1, 1h, 2, 2h, ..
push @nh_list, $_ . "h"
}
my %wrong_answers; # to store the answer (if wrong) of every question
including h's
my $err;
foreach (@nh_list) {
if ( $string_of_wrongs =~ /_($_)_/ ) {$err =
"$progress_hash{$_}"} else {$err = ""};
$wrong_answers{$_} = $err;
}
foreach (@nh_list) {
if ( ! defined $progress_hash{$_} )
{ push @analysis , "$_" }
else { push @analysis , "$_" . "\t" . "$wrong_answers{$_}" .
"\t" . "$timelapse{$_}" }
}
}
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
