[LON-CAPA-cvs] cvs: loncom /homework grades.pm
foxr
lon-capa-cvs-allow@mail.lon-capa.org
Thu, 19 Jul 2007 09:53:00 -0000
This is a MIME encoded message
--foxr1184838780
Content-Type: text/plain
foxr Thu Jul 19 05:53:00 2007 EDT
Modified files:
/loncom/homework grades.pm
Log:
First steps towards modifying the scantron validation stage to understand
problems may require more than one line of bubbles. This is part of
BZ 4074 -- the hard part.
--foxr1184838780
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20070719055300.txt"
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.421 loncom/homework/grades.pm:1.422
--- loncom/homework/grades.pm:1.421 Fri Jul 6 19:17:28 2007
+++ loncom/homework/grades.pm Thu Jul 19 05:52:59 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.421 2007/07/06 23:17:28 www Exp $
+# $Id: grades.pm,v 1.422 2007/07/19 09:52:59 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -4354,6 +4354,8 @@
#
#------ start of section for handling grading by page/sequence ---------
+# Create the hidden field entries used to hold context/default values.
+
sub defaultFormData {
my ($symb)=@_;
return '
@@ -4362,6 +4364,8 @@
'<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";
}
+# Make a drop down of the sequences
+
sub getSequenceDropDown {
my ($request,$symb)=@_;
my $result='<select name="selectpage">'."\n";
@@ -4379,6 +4383,8 @@
return $result;
}
+# Returns a list of the scantron files that have been uploaded to date.
+
sub scantron_filenames {
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
@@ -4394,6 +4400,9 @@
return @possiblenames;
}
+# Returns the html required for a drop-down list of scantron
+# files that have been uploaded.
+
sub scantron_uploads {
my ($file2grade) = @_;
my $result= '<select name="scantron_selectfile">';
@@ -4405,6 +4414,9 @@
return $result;
}
+# Returns the html for a drop down list of the scantron formats in the
+# scantronformat.tab file.
+
sub scantron_scantab {
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
my $result='<select name="scantron_format">'."\n";
@@ -4419,6 +4431,9 @@
return $result;
}
+# Returns the html for the options in the
+# saved codes dropdown.
+
sub scantron_CODElist {
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
@@ -4433,6 +4448,8 @@
return $namechoice;
}
+# Returns the HTML for "Each CODE to be used once" radio.
+
sub scantron_CODEunique {
my $result='<span style="white-space: nowrap;">
<label><input type="radio" name="scantron_CODEunique"
@@ -4444,6 +4461,11 @@
</span>';
return $result;
}
+#
+# Display the first scantron file selection form.
+# Paramters:
+# r - The apache request object
+# file2grade - The name of the scantron file to be graded(?).
sub scantron_selectphase {
my ($r,$file2grade) = @_;
@@ -4459,6 +4481,9 @@
my $result;
#FIXME allow instructor to be able to download the scantron file
# and to upload it,
+
+ # Chunk of form to prompt for a file to grade and how:
+
$result.= <<SCANTRONFORM;
<table width="100%" border="0">
<tr>
@@ -4511,6 +4536,8 @@
if (&Apache::lonnet::allowed('usc',$env{'request.role.domain'}) ||
&Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
+ # Chunk of form to prompt for a scantron file upload.
+
$r->print(<<SCANTRONFORM);
<tr>
<td bgcolor="#777777">
@@ -4556,6 +4583,10 @@
</tr>
SCANTRONFORM
}
+
+ # Chunk of the form that prompts to view a scoring office file,
+ # corrected file, skipped records in a file.
+
$r->print(<<SCANTRONFORM);
<tr>
<form action='/adm/grades' name='scantron_download'>
@@ -4590,6 +4621,14 @@
return
}
+# Parse and return the scantron configuration line selected as a
+# hash of configuration file fields.
+#
+# Parameters:
+# which - the name of the configuration to parse from the file.
+# If the named configuration is not in the file, an empty
+# hash is returned.
+
sub get_scantron_config {
my ($which) = @_;
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
@@ -4622,6 +4661,15 @@
return %config;
}
+# creates a hash keyed by student id that conains
+# the corresponding student username:domain.
+# Parameters:
+# reference to the class list hash. This is a hash
+# keyed by student name:domain whose elements are references
+# to arrays containng various chunks of information
+# about the student. (See loncoursedata for more info).
+#
+#
sub username_to_idmap {
my ($classlist)= @_;
my %idmap;
@@ -4631,9 +4679,22 @@
}
return %idmap;
}
+#
+# Make a correction in a scantron line?
+# Parameters:
+# scantron_config - Format of the scantron file
+# scan_data - Hash of line by line info about the scan(?).
+# line - Scantron line to edit?
+# whichline
+# field
+# args - Keyword/value hash of additional parameters.
+#
sub scantron_fixup_scanline {
my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
+ #
+ # ID field, args->{'newid'} is the new value of the ID field.
+ #
if ($field eq 'ID') {
if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
return ($line,1,'New value too large');
@@ -4648,6 +4709,11 @@
&scan_data($scan_data,"$whichline.user",
$args->{'username'}.':'.$args->{'domain'});
}
+ # CODE Field,
+ # args->{CODE_ignore_dup} is true if duplicates should be ignored.
+ # args->{CODE} is new code or 'use_unfound' if an unfound code should
+ # be used as is?
+ #
} elsif ($field eq 'CODE') {
if ($args->{'CODE_ignore_dup'}) {
&scan_data($scan_data,"$whichline.CODE_ignore_dup",'1');
@@ -4663,6 +4729,11 @@
substr($line,$$scantron_config{'CODEstart'}-1,
$$scantron_config{'CODElength'})=$args->{'CODE'};
}
+ #
+ # Edit the answer field.
+ # args->{'response'} - new answer or 'none' if blank.
+ # args->{'question'} - the question (number?)?.
+ #
} elsif ($field eq 'answer') {
my $length=$scantron_config->{'Qlength'};
my $off=$scantron_config->{'Qoff'};
@@ -4689,7 +4760,16 @@
}
return $line;
}
-
+# Edit or look up an item in the scan_data hash.
+# Parameters:
+# scan_data - The hash.
+# key - shorthand of the key to edit (actual key is
+# scatronfilename_key.
+# data - New value of the hash entry.
+# delete - If defined, the entry is removed from the table.
+# Returns:
+# The new value of the hash table field (undefined if deleted).
+#
sub scan_data {
my ($scan_data,$key,$value,$delete)=@_;
my $filename=$env{'form.scantron_selectfile'};
@@ -4699,12 +4779,23 @@
if ($delete) { delete($scan_data->{$filename.'_'.$key}); }
return $scan_data->{$filename.'_'.$key};
}
-
+#
+# Decode a line on the uploaded scantron file:
+# Arguments:
+# line - The text of the scantron file line to process
+# whichline - Line number(?)
+# scantron_config - Hash describing the format of the scantron lines.
+# scan_data - Hash being built up of the entire scantron file.
+# justHeader - True if should not process question answers but only
+# the stuff to the left of the answers.
+# Returns:
+# Hash of data from the line?
+#
sub scantron_parse_scanline {
my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_;
my %record;
- my $questions=substr($line,$$scantron_config{'Qstart'}-1);
- my $data=substr($line,0,$$scantron_config{'Qstart'}-1);
+ my $questions=substr($line,$$scantron_config{'Qstart'}-1); # Answers
+ my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # earlier stuff
if (!($$scantron_config{'CODElocation'} eq 0 ||
$$scantron_config{'CODElocation'} eq 'none')) {
if ($$scantron_config{'CODElocation'} < 0 ||
@@ -5456,7 +5547,8 @@
$r->print("<p>Please indicate which bubble should be used for grading</p>");
foreach my $question (@{$arg}) {
my $selected=$$scan_record{"scantron.$question.answer"};
- &scantron_bubble_selector($r,$scan_config,$question,split('',$selected));
+ &scantron_bubble_selector($r,$scan_config,$question,
+ split('',$selected));
}
} elsif ($error eq 'missingbubble') {
$r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");
@@ -5475,31 +5567,74 @@
$r->print("\n</li></ul>");
}
-
+#
+# Ask the grader to select the actual bubble
+#
+# Arguments:
+# r - Apache request.
+# scan_config - Hash of the scantron format selected.
+# quest - Question being evaluated
+# selected - array of selected bubbles
+# lines - if present, number of bubble lines in questions.
sub scantron_bubble_selector {
- my ($r,$scan_config,$quest,@selected)=@_;
+ my ($r,$scan_config,$quest,@selected, $lines)=@_;
my $max=$$scan_config{'Qlength'};
my $scmode=$$scan_config{'Qon'};
if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; }
- my @alphabet=('A'..'Z');
- $r->print("<table border='1'><tr><td rowspan='2'>$quest</td>");
- for (my $i=0;$i<$max+1;$i++) {
- $r->print("\n".'<td align="center">');
- if ($selected[0] eq $alphabet[$i]) { $r->print('X'); shift(@selected) }
- else { $r->print(' '); }
- $r->print('</td>');
- }
- $r->print('</tr><tr>');
- for (my $i=0;$i<$max;$i++) {
- $r->print("\n".
- '<td><label><input type="radio" name="scantron_correct_Q_'.
- $quest.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");
+
+ if (!defined($lines)) {
+ $lines = 1;
}
- $r->print('<td><label><input type="radio" name="scantron_correct_Q_'.
+ my $total_lines = $lines*2;
+ my @alphabet=('A'..'Z');
+ $r->print("<table border='1'><tr><td rowspan='".$total_lines."'>$quest</td>");
+
+ for (my $l = 0; $l < $lines; $l++) {
+ if ($l != 0) {
+ $r->print('<tr>');
+ }
+
+ # FIXME: This loop probably has to be considerably more clever for
+ # multiline bubbles: User can multibubble by having bubbles in
+ # several lines. User can skip lines legitimately etc. etc.
+
+ for (my $i=0;$i<$max;$i++) {
+ $r->print("\n".'<td align="center">');
+ if ($selected[0] eq $alphabet[$i]) {
+ $r->print('X');
+ shift(@selected) ;
+ } else {
+ $r->print(' ');
+ }
+ $r->print('</td>');
+
+ }
+
+ if ($l == 0) {
+ my $lspan = $total_lines * 2; # 2 table rows per bubble line.
+
+ $r->print('<td rowspan='.$lspan.'><label><input type="radio" name="scantron_correct_Q_'.
$quest.'" value="none" /> No bubble </label></td>');
- $r->print('</tr></table>');
+
+ }
+
+ $r->print('</tr><tr>');
+
+ # FIXME: This may have to be a bit more clever for
+ # multiline questions (different values e.g..).
+
+ for (my $i=0;$i<$max;$i++) {
+ $r->print("\n".
+ '<td><label><input type="radio" name="scantron_correct_Q_'.
+ $quest.'" value="'.$i.'" />'.$alphabet[$i]."</label></td>");
+ }
+ $r->print('</tr>');
+
+
+ }
+ $r->print('</table>');
}
sub num_matches {
--foxr1184838780--