--- loncom/homework/grades.pm 2007/06/15 21:21:16 1.405
+++ loncom/homework/grades.pm 2007/07/24 21:21:31 1.423
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.405 2007/06/15 21:21:16 www Exp $
+# $Id: grades.pm,v 1.423 2007/07/24 21:21:31 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -41,7 +41,6 @@ use Apache::Constants qw(:common);
use Apache::lonlocal;
use Apache::lonenc;
use String::Similarity;
-use lib '/home/httpd/lib/perl';
use LONCAPA;
use POSIX qw(floor);
@@ -94,6 +93,7 @@ sub get_symb {
return ();
}
}
+ &Apache::lonenc::check_decrypt(\$symb);
return ($symb);
}
@@ -493,7 +493,7 @@ sub jscriptNform {
' }'."\n".
'</script>'."\n";
$jscript.= '<form action="/adm/grades" method="post" name="onestudent">'."\n".
- '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
+ '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
'<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n".
'<input type="hidden" name="Status" value="'.$env{'form.Status'}.'" />'."\n".
@@ -618,7 +618,7 @@ sub verifyreceipt {
if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) {
$contents.='<tr bgcolor="#ffffe6"><td> '."\n".
'<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
- '\')"; TARGET=_self>'.$$fullname{$_}.'</a> </td>'."\n".
+ '\');" target="_self">'.$$fullname{$_}.'</a> </td>'."\n".
'<td> '.$uname.' </td>'.
'<td> '.$udom.' </td>';
if ($receiptparts) {
@@ -743,7 +743,7 @@ LISTJAVASCRIPT
'<input type="hidden" name="showgrading" value="'.$env{'form.showgrading'}.'" /><br />'."\n".
'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
'<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n".
- '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
+ '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
'<input type="hidden" name="saveStatusOld" value="'.$saveStatus.'" />'."\n";
if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) {
@@ -1752,7 +1752,7 @@ sub submission {
'<input type="hidden" name="refresh" value="off" />'."\n".
'<input type="hidden" name="studentNo" value="" />'."\n".
'<input type="hidden" name="gradeOpt" value="" />'."\n".
- '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
+ '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
'<input type="hidden" name="showgrading" value="'.$env{'form.showgrading'}.'" />'."\n".
'<input type="hidden" name="vProb" value="'.$env{'form.vProb'}.'" />'."\n".
'<input type="hidden" name="vAns" value="'.$env{'form.vAns'}.'" />'."\n".
@@ -1793,10 +1793,10 @@ sub submission {
#
$request->print(<<KEYWORDS);
<b>Keyword Options:</b>
-<a href="javascript:keywords(document.SCORE)"; TARGET=_self>List</a>
+<a href="javascript:keywords(document.SCORE);" target="_self">List</a>
<a href="#" onMouseDown="javascript:getSel(); return false"
CLASS="page">Paste Selection to List</a>
-<a href="javascript:kwhighlight()"; TARGET=_self>Highlight Attribute</a><br /><br />
+<a href="javascript:kwhighlight();" target="_self">Highlight Attribute</a><br /><br />
KEYWORDS
#
# Load the other essays for similarity check
@@ -1922,7 +1922,7 @@ KEYWORDS
' <b>Collaborative submission by:</b> '.
'<a href="javascript:viewSubmitter(\''.
$env{"form.$uname:$udom:$partid:submitted_by"}.
- '\')"; TARGET=_self>'.
+ '\');" target="_self">'.
$$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />';
$request->print($submitby);
next;
@@ -2000,7 +2000,7 @@ KEYWORDS
if ($env{'form.showgrading'} eq '' || (!&canmodify($usec))) {
my $toGrade.='<input type="button" value="Grade Student" '.
'onClick="javascript:checksubmit(this.form,\'Grade Student\',\''
- .$counter.'\');" TARGET=_self> '."\n" if (&canmodify($usec));
+ .$counter.'\');" target="_self" /> '."\n" if (&canmodify($usec));
$toGrade.='</td></tr></table></td></tr></table>'."\n";
if (($env{'form.command'} eq 'submission') ||
($env{'form.command'} eq 'processGroup' && $counter == $total)) {
@@ -2024,7 +2024,7 @@ KEYWORDS
$result='<input type="hidden" name="includemsg'.$counter.'" value="" />'."\n".
'<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n";
$result.=' <a href="javascript:msgCenter(document.SCORE,'.$counter.
- ',\''.$msgfor.'\')"; TARGET=_self>'.
+ ',\''.$msgfor.'\');" target="_self">'.
&mt('Compose message to student').(scalar(@col_fullnames) >= 1 ? 's' : '').'</a><label> ('.
&mt('incl. grades').' <input type="checkbox" name="withgrades'.$counter.'" /></label>)'.
'<img src="'.$request->dir_config('lonIconsURL').
@@ -2076,7 +2076,7 @@ KEYWORDS
my $endform='<table border="0"><tr><td>'."\n";
$endform.='<input type="button" value="Save & Next" '.
'onClick="javascript:checksubmit(this.form,\'Save & Next\','.
- $total.','.scalar(@partlist).');" TARGET=_self> '."\n";
+ $total.','.scalar(@partlist).');" target="_self" /> '."\n";
my $ntstu ='<select name="NTSTU">'.
'<option>1</option><option>2</option>'.
'<option>3</option><option>5</option>'.
@@ -2085,9 +2085,9 @@ KEYWORDS
$ntstu =~ s/<option>$nsel</<option selected="selected">$nsel</;
$endform.=$ntstu.'student(s) ';
$endform.='<input type="button" value="Previous" '.
- 'onClick="javascript:checksubmit(this.form,\'Previous\');" TARGET=_self> '."\n".
+ 'onClick="javascript:checksubmit(this.form,\'Previous\');" target="_self" /> '."\n".
'<input type="button" value="Next" '.
- 'onClick="javascript:checksubmit(this.form,\'Next\');" TARGET=_self> ';
+ 'onClick="javascript:checksubmit(this.form,\'Next\');" target="_self" /> ';
$endform.='(Next and Previous (student) do not save the scores.)'."\n" ;
$endform.="<input type='hidden' value='".&get_increment().
"' name='increment' />";
@@ -2169,18 +2169,10 @@ sub processHandGrade {
}
my $includemsg = $env{'form.includemsg'.$ctr};
my ($subject,$message,$msgstatus) = ('','','');
- my $restitle = &Apache::lonnet::gettitle($symb);
- my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl',
- $symb,$udom,$uname);
- my ($feedurl,$baseurl,$showsymb,$messagetail);
- $feedurl = &Apache::lonnet::clutter($url);
- if ($encrypturl =~ /^yes$/i) {
- $baseurl = &Apache::lonenc::encrypted($feedurl,1);
- $showsymb = &Apache::lonenc::encrypted($symb,1);
- } else {
- $baseurl = $feedurl;
- $showsymb = $symb;
- }
+ my $restitle = &Apache::lonnet::gettitle($symb);
+ my ($feedurl,$showsymb) =
+ &get_feedurl_and_symb($symb,$uname,$udom);
+ my $messagetail;
if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) {
$subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/);
unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); }
@@ -2193,12 +2185,12 @@ sub processHandGrade {
if ($env{'form.withgrades'.$ctr}) {
$message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt;
$messagetail = " for <a href=\"".
- $baseurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
+ $feedurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
}
$msgstatus =
&Apache::lonmsg::user_normal_msg($uname,$udom,$subject,
$message.$messagetail,
- undef,$baseurl,undef,
+ undef,$feedurl,undef,
undef,undef,$showsymb,
$restitle);
$request->print('<br />'.&mt('Sending message to [_1]:[_2]',$uname,$udom).': '.
@@ -2215,26 +2207,16 @@ sub processHandGrade {
if ($errorflag eq 'not_allowed') {
$request->print("<span class=\"LC_error\">".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."</span>");
next;
- } else {
- if ($message ne '') {
- $encrypturl=
- &Apache::lonnet::EXT('resource.0.encrypturl',
- $symb,$udom,$collaborator);
- if ($encrypturl =~ /^yes$/i) {
- $baseurl = &Apache::lonenc::encrypted($feedurl,1);
- $showsymb = &Apache::lonenc::encrypted($symb,1);
- } else {
- $baseurl = $feedurl;
- $showsymb = $symb;
- }
- if ($env{'form.withgrades'.$ctr}) {
- $messagetail = " for <a href=\"".
+ } elsif ($message ne '') {
+ my ($baseurl,$showsymb) =
+ &get_feedurl_and_symb($symb,$collaborator,
+ $udom);
+ if ($env{'form.withgrades'.$ctr}) {
+ $messagetail = " for <a href=\"".
$baseurl."?symb=$showsymb\">$env{'form.probTitle'}</a>";
-
- }
- $msgstatus =
- &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle);
}
+ $msgstatus =
+ &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle);
}
}
}
@@ -2588,28 +2570,31 @@ sub handback_files {
$message .= "<strong>".&Apache::lonnet::gettitle($symb)."</strong><br />";
$message .= ' The returned file(s) are named: '. $file_msg;
$message .= " and can be found in your portfolio space.";
- my $url = (&Apache::lonnet::decode_symb($symb))[2];
- my $feedurl = &Apache::lonnet::clutter($url);
- my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl',
- $symb,$domain,$stuname);
- my ($baseurl,$showsymb);
- if ($encrypturl =~ /^yes$/i) {
- $baseurl = &Apache::lonenc::encrypted($feedurl,1);
- $showsymb = &Apache::lonenc::encrypted($symb,1);
- } else {
- $baseurl = $feedurl;
- $showsymb = $symb;
- }
+ my ($feedurl,$showsymb) =
+ &get_feedurl_and_symb($symb,$domain,$stuname);
my $restitle = &Apache::lonnet::gettitle($symb);
my $msgstatus =
&Apache::lonmsg::user_normal_msg($stuname,$domain,$subject.
' (File Returned) ['.$restitle.']',$message,undef,
- $baseurl,undef,undef,undef,$showsymb,$restitle);
+ $feedurl,undef,undef,undef,$showsymb,$restitle);
}
}
return;
}
+sub get_feedurl_and_symb {
+ my ($symb,$uname,$udom) = @_;
+ my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
+ $url = &Apache::lonnet::clutter($url);
+ my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl',
+ $symb,$udom,$uname);
+ if ($encrypturl =~ /^yes$/i) {
+ &Apache::lonenc::encrypted(\$url,1);
+ &Apache::lonenc::encrypted(\$symb,1);
+ }
+ return ($url,$symb);
+}
+
sub get_submitted_files {
my ($udom,$uname,$partid,$respid,$record) = @_;
my @files;
@@ -2970,7 +2955,7 @@ sub viewgrades {
#beginning of class grading form
$result.= '<form action="/adm/grades" method="post" name="classgrade">'."\n".
- '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
+ '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
'<input type="hidden" name="command" value="editgrades" />'."\n".
'<input type="hidden" name="section" value="'.$env{'form.section'}.'" />'."\n".
'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
@@ -3037,7 +3022,7 @@ sub viewgrades {
$result.='</table>'.'</td></tr></table>'.'</td></tr></table>'."\n".
'<input type="hidden" name="totalparts" value="'.$ctsparts.'" />';
$result.='<input type="button" value="Revert to Default" '.
- 'onClick="javascript:resetEntry('.$ctsparts.');" TARGET=_self>';
+ 'onClick="javascript:resetEntry('.$ctsparts.');" target="_self" />';
#table listing all the students in a section/class
#header of table
@@ -3088,7 +3073,7 @@ sub viewgrades {
$result.='</table></td></tr></table>';
$result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n";
$result.='<input type="button" value="Save" '.
- 'onClick="javascript:submit();" TARGET=_self /></form>'."\n";
+ 'onClick="javascript:submit();" target="_self" /></form>'."\n";
if (scalar(%$fullname) eq 0) {
my $colspan=3+scalar(@parts);
$result='<span class="LC_warning">There are no students in section "'.$env{'form.section'}.
@@ -3108,7 +3093,7 @@ sub viewstudentgrade {
'<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'.
"\n".$ctr.' </td><td> '.
'<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
- '\')"; TARGET=_self>'.$fullname.'</a> '.
+ '\');" target="_self">'.$fullname.'</a> '.
'<span class="LC_internal_info">('.$uname.($env{'user.domain'} eq $udom ? '' : ':'.$udom).')</span></td>'."\n";
$student=~s/:/_/; # colon doen't work in javascript for names
foreach my $apart (@$parts) {
@@ -3472,6 +3457,7 @@ sub csvuploadmap_header {
my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
my $checked=(($env{'form.noFirstLine'})?' checked="checked"':'');
my $ignore=&mt('Ignore First Line');
+ $symb = &Apache::lonenc::check_encrypt($symb);
$request->print(<<ENDPICK);
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
<h3><span class="LC_info">Uploading Class Grades</span></h3>
@@ -3566,6 +3552,7 @@ sub upcsvScores_form {
my $upload=&mt("Upload Scores");
my $upfile_select=&Apache::loncommon::upfile_select_html();
my $ignore=&mt('Ignore First Line');
+ $symb = &Apache::lonenc::check_encrypt($symb);
$result.=<<ENDUPFORM;
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
<input type="hidden" name="symb" value="$symb" />
@@ -3840,7 +3827,7 @@ LISTJAVASCRIPT
$result.='<form action="/adm/grades" method="post" name="displayPage">'."\n";
$result.=' <b>Problems from:</b> <select name="selectpage">'."\n";
- my ($titles,$symbx) = &getSymbMap($request);
+ my ($titles,$symbx) = &getSymbMap();
my ($curpage) =&Apache::lonnet::decode_symb($symb);
# my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb);
# my $type=($curpage =~ /\.(page|sequence)/);
@@ -3874,7 +3861,7 @@ LISTJAVASCRIPT
$result.='<input type="hidden" name="section" value="'.$getsec.'" />'."\n".
'<input type="hidden" name="Status" value="'.$env{'form.Status'}.'" />'."\n".
'<input type="hidden" name="command" value="displayPage" />'."\n".
- '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
+ '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."<br />\n";
$result.=' <b>'.&mt('Use CODE:').' </b>'.
@@ -3922,7 +3909,6 @@ LISTJAVASCRIPT
}
sub getSymbMap {
- my ($request) = @_;
my $navmap = Apache::lonnavmaps::navmap->new();
my %symbx = ();
@@ -3998,7 +3984,7 @@ sub displayPage {
'<input type="hidden" name="student" value="'.$env{'form.student'}.'" />'."\n".
'<input type="hidden" name="page" value="'.$pageTitle.'" />'."\n".
'<input type="hidden" name="title" value="'.$env{'form.title'}.'" />'."\n".
- '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
+ '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
'<input type="hidden" name="overRideScore" value="no" />'."\n".
'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n";
@@ -4367,18 +4353,53 @@ sub updateGradeByPage {
#
#------ start of section for handling grading by page/sequence ---------
+=pod
+
+=head1 Bubble sheet grading routines
+
+ (For this documentation 'scanline' refers to the full line of characters
+ from the file that we are parsing 'bubble line' refers to the data
+ representing the line of bubbles that are on the physical bubble sheet)
+
+=over 4
+
+=cut
+
+
+=pod
+
+=item defaultFormData
+
+ Returns html hidden inputs used to hold context/default values.
+
+ Arguments:
+ $symb - $symb of the current resource
+
+=cut
+
sub defaultFormData {
my ($symb)=@_;
return '
- <input type="hidden" name="symb" value="'.$symb.'" />'."\n".
+ <input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
'<input type="hidden" name="probTitle" value="'.$env{'form.probTitle'}.'" />'."\n";
}
+=pod
+
+=item getSequenceDropDown
+
+ Return html dropdown of possible sequences to grade
+
+ Arguments:
+ $symb - $symb of the current resource
+
+=cut
+
sub getSequenceDropDown {
- my ($request,$symb)=@_;
+ my ($symb)=@_;
my $result='<select name="selectpage">'."\n";
- my ($titles,$symbx) = &getSymbMap($request);
+ my ($titles,$symbx) = &getSymbMap();
my ($curpage)=&Apache::lonnet::decode_symb($symb);
my $ctr=0;
foreach (@$titles) {
@@ -4392,6 +4413,15 @@ sub getSequenceDropDown {
return $result;
}
+
+=pod
+
+=item scantron_filenames
+
+ Returns a list of the scantron files in the current course
+
+=cut
+
sub scantron_filenames {
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
@@ -4407,6 +4437,17 @@ sub scantron_filenames {
return @possiblenames;
}
+=pod
+
+=item scantron_uploads
+
+ Returns html drop-down list of scantron files in current course.
+
+ Arguments:
+ $file2grade - filename to set as selected in the dropdown
+
+=cut
+
sub scantron_uploads {
my ($file2grade) = @_;
my $result= '<select name="scantron_selectfile">';
@@ -4418,6 +4459,15 @@ sub scantron_uploads {
return $result;
}
+=pod
+
+=item scantron_scantab
+
+ Returns html drop down of the scantron formats in the scantronformat.tab
+ file.
+
+=cut
+
sub scantron_scantab {
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
my $result='<select name="scantron_format">'."\n";
@@ -4432,6 +4482,15 @@ sub scantron_scantab {
return $result;
}
+=pod
+
+=item scantron_CODElist
+
+ Returns html drop down of the saved CODE lists from current course,
+ generated from earlier printings.
+
+=cut
+
sub scantron_CODElist {
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
@@ -4446,23 +4505,48 @@ sub scantron_CODElist {
return $namechoice;
}
+=pod
+
+=item scantron_CODEunique
+
+ Returns the html for "Each CODE to be used once" radio.
+
+=cut
+
sub scantron_CODEunique {
my $result='<span style="white-space: nowrap;">
<label><input type="radio" name="scantron_CODEunique"
- value="yes" checked="checked" /> Yes </label>
+ value="yes" checked="checked" />'.&mt('Yes').' </label>
</span>
<span style="white-space: nowrap;">
<label><input type="radio" name="scantron_CODEunique"
- value="no" /> No </label>
+ value="no" />'.&mt('No').' </label>
</span>';
return $result;
}
+=pod
+
+=item scantron_selectphase
+
+ Generates the initial screen to start the bubble sheet process.
+ Allows for - starting a grading run.
+ - downloading exisiting scan data (original, corrected
+ or skipped info)
+
+ - uploading new scan data
+
+ Arguments:
+ $r - The Apache request object
+ $file2grade - name of the file that contain the scanned data to score
+
+=cut
+
sub scantron_selectphase {
my ($r,$file2grade) = @_;
my ($symb)=&get_symb($r);
if (!$symb) {return '';}
- my $sequence_selector=&getSequenceDropDown($r,$symb);
+ my $sequence_selector=&getSequenceDropDown($symb);
my $default_form_data=&defaultFormData($symb);
my $grading_menu_button=&show_grading_menu_form($symb);
my $file_selector=&scantron_uploads($file2grade);
@@ -4470,8 +4554,9 @@ sub scantron_selectphase {
my $CODE_selector=&scantron_CODElist();
my $CODE_unique=&scantron_CODEunique();
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>
@@ -4524,6 +4609,8 @@ SCANTRONFORM
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">
@@ -4569,6 +4656,10 @@ UPLOAD
</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'>
@@ -4603,6 +4694,62 @@ SCANTRONFORM
return
}
+=pod
+
+=item get_scantron_config
+
+ Parse and return the scantron configuration line selected as a
+ hash of configuration file fields.
+
+ Arguments:
+ which - the name of the configuration to parse from the file.
+
+
+ Returns:
+ If the named configuration is not in the file, an empty
+ hash is returned.
+ a hash with the fields
+ name - internal name for the this configuration setup
+ description - text to display to operator that describes this config
+ CODElocation - if 0 or the string 'none'
+ - no CODE exists for this config
+ if -1 || the string 'letter'
+ - a CODE exists for this config and is
+ a string of letters
+ Unsupported value (but planned for future support)
+ if a positive integer
+ - The CODE exists as the first n items from
+ the question section of the form
+ if the string 'number'
+ - The CODE exists for this config and is
+ a string of numbers
+ CODEstart - (only matter if a CODE exists) column in the line where
+ the CODE starts
+ CODElength - length of the CODE
+ IDstart - column where the student ID number starts
+ IDlength - length of the student ID info
+ Qstart - column where the information from the bubbled
+ 'questions' start
+ Qlength - number of columns comprising a single bubble line from
+ the sheet. (usually either 1 or 10)
+ Qon - either a single charater representing the character used
+ to signal a bubble was chosen in the positional setup, or
+ the string 'letter' if the letter of the chosen bubble is
+ in the final, or 'number' if a number representing the
+ chosen bubble is in the file (1->A 0->J)
+ Qoff - the character used to represent that a buble was left blank
+ PaperID - if the scanning process generates a unique number for each
+ sheet scanned the column that this ID number starts in
+ PaperIDlength - number of columns that comprise the unique ID number
+ for the sheet of paper
+ FirstName - column that the firs tname starts in
+ FirstNameLength - number of columns that the first name spans
+
+ LastName - column that the last name starts in
+ LastNameLength - number of columns that the last name spans
+
+=cut
+
sub get_scantron_config {
my ($which) = @_;
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
@@ -4635,6 +4782,25 @@ sub get_scantron_config {
return %config;
}
+=pod
+
+=item username_to_idmap
+
+ creates a hash keyed by student id with values of the corresponding
+ student username:domain.
+
+ Arguments:
+
+ $classlist - 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).
+
+ Returns
+ %idmap - the constructed hash
+
+=cut
+
sub username_to_idmap {
my ($classlist)= @_;
my %idmap;
@@ -4645,8 +4811,50 @@ sub username_to_idmap {
return %idmap;
}
+=pod
+
+=item scatron_fixup_scanline
+
+ Process a requested correction to a scanline.
+
+ Arguments:
+ $scantron_config - hash from &get_scantron_config()
+ $scan_data - hash of correction information
+ (see &scantron_getfile())
+ $line - existing scanline
+ $whichline - line number of the passed in scanline
+ $field - type of change to process
+ (either
+ 'ID' -> correct the student ID number
+ 'CODE' -> correct the CODE
+ 'answer' -> fixup the submitted answers)
+
+ $args - hash of additional info,
+ - 'ID'
+ 'newid' -> studentID to use in replacement
+ of exisiting one
+ - 'CODE'
+ 'CODE_ignore_dup' - set to true if duplicates
+ should be ignored.
+ 'CODE' - is new code or 'use_unfound'
+ if the exisitng unfound code should
+ be used as is
+ - 'answer'
+ 'response' - new answer or 'none' if blank
+ 'question' - the bubble line to change
+
+ Returns:
+ $line - the modified scanline
+
+ Side effects:
+ $scan_data - may be updated
+
+=cut
+
+
sub scantron_fixup_scanline {
my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_;
+
if ($field eq 'ID') {
if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) {
return ($line,1,'New value too large');
@@ -4703,6 +4911,25 @@ sub scantron_fixup_scanline {
return $line;
}
+=pod
+
+=item scan_data
+
+ Edit or look up an item in the scan_data hash.
+
+ Arguments:
+ $scan_data - The hash (see scantron_getfile)
+ $key - shorthand of the key to edit (actual key is
+ scatronfilename_key).
+ $data - New value of the hash entry.
+ $delete - If true, the entry is removed from the hash.
+
+ Returns:
+ The new value of the hash table field (undefined if deleted).
+
+=cut
+
+
sub scan_data {
my ($scan_data,$key,$value,$delete)=@_;
my $filename=$env{'form.scantron_selectfile'};
@@ -4713,11 +4940,63 @@ sub scan_data {
return $scan_data->{$filename.'_'.$key};
}
+=pod
+
+=item scantron_parse_scanline
+
+ Decodes a scanline from the selected 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 of extra information about the scanline
+ (see scantron_getfile for more information)
+ just_header - True if should not process question answers but only
+ the stuff to the left of the answers.
+ Returns:
+ Hash containing the result of parsing the scanline
+
+ Keys are all proceeded by the string 'scantron.'
+
+ CODE - the CODE in use for this scanline
+ useCODE - 1 if the CODE is invalid but it usage has been forced
+ by the operator
+ CODE_ignore_dup - 1 if the CODE is a duplicated use when unique
+ CODEs were selected, but the usage has been
+ forced by the operator
+ ID - student ID
+ PaperID - if used, the ID number printed on the sheet when the
+ paper was scanned
+ FirstName - first name from the sheet
+ LastName - last name from the sheet
+
+ if just_header was not true these key may also exist
+
+ missingerror - a list of bubbled line numbers that had a blank bubble
+ that is considered an error (if the operator had already
+ okayed a blank bubble line as really being blank then
+ that bubble line number won't appear here.
+ doubleerror - a list of bubbled line numbers that had more than one
+ bubble filled in and has not been corrected by the
+ operator
+ maxquest - the number of the last bubble line that was parsed
+
+ (<number> starts at 1)
+ <number>.answer - zero or more letters representing the selected
+ letters from the scanline for the bubble line
+ <number>.
+ if blank there was either no bubble or there where
+ multiple bubbles, (consult the keys missingerror and
+ doubleerror if this is an error condition)
+
+=cut
+
sub scantron_parse_scanline {
- my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_;
+ my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_;
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 ||
@@ -4747,7 +5026,7 @@ sub scantron_parse_scanline {
$record{'scantron.LastName'}=
substr($data,$$scantron_config{'LastName'}-1,
$$scantron_config{'LastNamelength'});
- if ($justHeader) { return \%record; }
+ if ($just_header) { return \%record; }
my @alphabet=('A'..'Z');
my $questnum=0;
@@ -4820,6 +5099,24 @@ sub scantron_parse_scanline {
return \%record;
}
+=pod
+
+=item scantron_add_delay
+
+ Adds an error message that occurred during the grading phase to a
+ queue of messages to be shown after grading pass is complete
+
+ Arguments:
+ $delayqueue - arrary ref of hash ref of erro messages
+ $scanline - the scanline that caused the error
+ $errormesage - the error message
+ $errorcode - a numeric code for the error
+
+ Side Effects:
+ updates the $dealyqueue to have a new hash ref of the error
+
+=cut
+
sub scantron_add_delay {
my ($delayqueue,$scanline,$errormessage,$errorcode)=@_;
push(@$delayqueue,
@@ -4828,6 +5125,12 @@ sub scantron_add_delay {
);
}
+=pod
+
+=item scantron_find_student
+
+=cut
+
sub scantron_find_student {
my ($scantron_record,$scan_data,$idmap,$line)=@_;
my $scanID=$$scantron_record{'scantron.ID'};
@@ -4842,6 +5145,12 @@ sub scantron_find_student {
return undef;
}
+=pod
+
+=item scantron_filter
+
+=cut
+
sub scantron_filter {
my ($curres)=@_;
@@ -4858,6 +5167,12 @@ sub scantron_filter {
return 0;
}
+=pod
+
+=item scantron_process_corrections
+
+=cut
+
sub scantron_process_corrections {
my ($r) = @_;
my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
@@ -4915,12 +5230,24 @@ sub scantron_process_corrections {
}
}
+=pod
+
+=item reset_skipping_status
+
+=cut
+
sub reset_skipping_status {
my ($scanlines,$scan_data)=&scantron_getfile();
&scan_data($scan_data,'remember_skipping',undef,1);
&scantron_putfile(undef,$scan_data);
}
+=pod
+
+=item start_skipping
+
+=cut
+
sub start_skipping {
my ($scan_data,$i)=@_;
my %remembered=split(':',&scan_data($scan_data,'remember_skipping'));
@@ -4932,6 +5259,12 @@ sub start_skipping {
&scan_data($scan_data,'remember_skipping',join(':',%remembered));
}
+=pod
+
+=item should_be_skipped
+
+=cut
+
sub should_be_skipped {
my ($scanlines,$scan_data,$i)=@_;
if ($env{'form.scantron_options_redo'} !~ /^redo_/) {
@@ -4947,6 +5280,12 @@ sub should_be_skipped {
return 1;
}
+=pod
+
+=item remember_current_skipped
+
+=cut
+
sub remember_current_skipped {
my ($scanlines,$scan_data)=&scantron_getfile();
my %to_remember;
@@ -4960,6 +5299,12 @@ sub remember_current_skipped {
&scantron_putfile(undef,$scan_data);
}
+=pod
+
+=item check_for_error
+
+=cut
+
sub check_for_error {
my ($r,$result)=@_;
if ($result ne 'ok' && $result ne 'not_found' ) {
@@ -4967,6 +5312,12 @@ sub check_for_error {
}
}
+=pod
+
+=item scantron_warning_screen
+
+=cut
+
sub scantron_warning_screen {
my ($button_text)=@_;
my $title=&Apache::lonnet::gettitle($env{'form.selectpage'});
@@ -4999,6 +5350,12 @@ $CODElist
STUFF
}
+=pod
+
+=item scantron_do_warning
+
+=cut
+
sub scantron_do_warning {
my ($r)=@_;
my ($symb)=&get_symb($r);
@@ -5030,6 +5387,12 @@ STUFF
return '';
}
+=pod
+
+=item scantron_form_start
+
+=cut
+
sub scantron_form_start {
my ($max_bubble)=@_;
my $result= <<SCANTRONFORM;
@@ -5047,6 +5410,12 @@ SCANTRONFORM
return $result;
}
+=pod
+
+=item scantron_validate_file
+
+=cut
+
sub scantron_validate_file {
my ($r) = @_;
my ($symb)=&get_symb($r);
@@ -5130,6 +5499,13 @@ STUFF
return '';
}
+
+=pod
+
+=item scantron_remove_file
+
+=cut
+
sub scantron_remove_file {
my ($which)=@_;
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
@@ -5144,6 +5520,13 @@ sub scantron_remove_file {
return &Apache::lonnet::removeuserfile($cname,$cdom,$file);
}
+
+=pod
+
+=item scantron_remove_scan_data
+
+=cut
+
sub scantron_remove_scan_data {
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
@@ -5166,6 +5549,13 @@ sub scantron_remove_scan_data {
return $result;
}
+
+=pod
+
+=item scantron_getfile
+
+=cut
+
sub scantron_getfile {
#FIXME really would prefer a scantron directory
my $cname=$env{'course.'.$env{'request.course.id'}.'.num'};
@@ -5198,6 +5588,12 @@ sub scantron_getfile {
return (\%scanlines,\%scan_data);
}
+=pod
+
+=item lonnet_putfile
+
+=cut
+
sub lonnet_putfile {
my ($contents,$filename)=@_;
my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
@@ -5207,6 +5603,12 @@ sub lonnet_putfile {
}
+=pod
+
+=item scantron_putfile
+
+=cut
+
sub scantron_putfile {
my ($scanlines,$scan_data) = @_;
#FIXME really would prefer a scantron directory
@@ -5227,6 +5629,12 @@ sub scantron_putfile {
&Apache::lonnet::put('nohist_scantrondata',$scan_data,$cdom,$cname);
}
+=pod
+
+=item scantron_get_line
+
+=cut
+
sub scantron_get_line {
my ($scanlines,$scan_data,$i)=@_;
if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; }
@@ -5235,6 +5643,12 @@ sub scantron_get_line {
return $scanlines->{'orig'}[$i];
}
+=pod
+
+=item scantron_todo_count
+
+=cut
+
sub get_todo_count {
my ($scanlines,$scan_data)=@_;
my $count=0;
@@ -5246,6 +5660,12 @@ sub get_todo_count {
return $count;
}
+=pod
+
+=item scantron_put_line
+
+=cut
+
sub scantron_put_line {
my ($scanlines,$scan_data,$i,$newline,$skip)=@_;
if ($skip) {
@@ -5256,6 +5676,12 @@ sub scantron_put_line {
$scanlines->{'corrected'}[$i]=$newline;
}
+=pod
+
+=item scantron_clear_skip
+
+=cut
+
sub scantron_clear_skip {
my ($scanlines,$scan_data,$i)=@_;
if (exists($scanlines->{'skipped'}[$i])) {
@@ -5265,6 +5691,12 @@ sub scantron_clear_skip {
return 0;
}
+=pod
+
+=item scantron_filter_not_exam
+
+=cut
+
sub scantron_filter_not_exam {
my ($curres)=@_;
@@ -5281,6 +5713,12 @@ sub scantron_filter_not_exam {
return 0;
}
+=pod
+
+=item scantron_validate_sequence
+
+=cut
+
sub scantron_validate_sequence {
my ($r,$currentphase) = @_;
@@ -5304,6 +5742,12 @@ sub scantron_validate_sequence {
return (0,$currentphase+1);
}
+=pod
+
+=item scantron_validate_ID
+
+=cut
+
sub scantron_validate_ID {
my ($r,$currentphase) = @_;
@@ -5366,6 +5810,12 @@ sub scantron_validate_ID {
return (0,$currentphase+1);
}
+=pod
+
+=item scantron_get_correction
+
+=cut
+
sub scantron_get_correction {
my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_;
@@ -5469,7 +5919,8 @@ ENDSCRIPT
$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");
@@ -5489,32 +5940,89 @@ ENDSCRIPT
}
+=pod
+
+=item scantron_bubble_selector
+
+ Generates the html radiobuttons to correct a single bubble line
+ possibly showing the exisiting the selected bubbles if known
+
+ Arguments:
+ $r - Apache request object
+ $scan_config - hash from &get_scantron_config()
+ $quest - number of the bubble line to make a corrector for
+ $selected - array of letters of previously selected bubbles
+ $lines - if present, number of bubble lines to show
+
+=cut
+
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>');
}
+=pod
+
+=item num_matches
+
+=cut
+
sub num_matches {
my ($orig,$code) = @_;
my @code=split(//,$code);
@@ -5526,6 +6034,12 @@ sub num_matches {
return $same;
}
+=pod
+
+=item scantron_get_closely_matching_CODEs
+
+=cut
+
sub scantron_get_closely_matching_CODEs {
my ($allcodes,$CODE)=@_;
my @CODEs;
@@ -5536,6 +6050,12 @@ sub scantron_get_closely_matching_CODEs
return ($#CODEs,$CODEs[-1]);
}
+=pod
+
+=item get_codes
+
+=cut
+
sub get_codes {
my ($old_name, $cdom, $cnum) = @_;
if (!$old_name) {
@@ -5558,6 +6078,12 @@ sub get_codes {
return %allcodes;
}
+=pod
+
+=item scantron_validate_CODE
+
+=cut
+
sub scantron_validate_CODE {
my ($r,$currentphase) = @_;
my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
@@ -5609,6 +6135,12 @@ sub scantron_validate_CODE {
return (0,$currentphase+1);
}
+=pod
+
+=item scantron_validate_doublebubble
+
+=cut
+
sub scantron_validate_doublebubble {
my ($r,$currentphase) = @_;
#get student info
@@ -5632,6 +6164,12 @@ sub scantron_validate_doublebubble {
return (0,$currentphase+1);
}
+=pod
+
+=item scantron_get_maxbubble
+
+=cut
+
sub scantron_get_maxbubble {
if (defined($env{'form.scantron_maxbubble'}) &&
$env{'form.scantron_maxbubble'}) {
@@ -5658,6 +6196,12 @@ sub scantron_get_maxbubble {
return $env{'form.scantron_maxbubble'};
}
+=pod
+
+=item scantron_validate_missingbubbles
+
+=cut
+
sub scantron_validate_missingbubbles {
my ($r,$currentphase) = @_;
#get student info
@@ -5690,6 +6234,30 @@ sub scantron_validate_missingbubbles {
return (0,$currentphase+1);
}
+=pod
+
+=item scantron_process_students
+
+ Routine that does the actual grading of the bubble sheet information.
+
+ The parsed scanline hash is added to %env
+
+ Then foreach unskipped scanline it does an &Apache::lonnet::ssi()
+ foreach resource , with the form data of
+
+ 'submitted' =>'scantron'
+ 'grade_target' =>'grade',
+ 'grade_username'=> username of student
+ 'grade_domain' => domain of student
+ 'grade_courseid'=> of course
+ 'grade_symb' => symb of resource to grade
+
+ This triggers a grading pass. The problem grading code takes care
+ of converting the bubbled letter information (now in %env) into a
+ valid submission.
+
+=cut
+
sub scantron_process_students {
my ($r) = @_;
my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});
@@ -5794,6 +6362,14 @@ SCANTRONFORM
return '';
}
+=pod
+
+=item scantron_upload_scantron_data
+
+ Creates the screen for adding a new bubble sheet data file to a course.
+
+=cut
+
sub scantron_upload_scantron_data {
my ($r)=@_;
$r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'}));
@@ -5830,6 +6406,15 @@ UPLOAD
return '';
}
+=pod
+
+=item scantron_upload_scantron_data_save
+
+ Adds a provided bubble information data file to the course if user
+ has the correct privileges to do so.
+
+=cut
+
sub scantron_upload_scantron_data_save {
my($r)=@_;
my ($symb)=&get_symb($r,1);
@@ -5885,6 +6470,14 @@ sub scantron_upload_scantron_data_save {
return '';
}
+=pod
+
+=item valid_file
+
+ Vaildates that the requested bubble data file has exists in the course.
+
+=cut
+
sub valid_file {
my ($requested_file)=@_;
foreach my $filename (sort(&scantron_filenames())) {
@@ -5893,6 +6486,16 @@ sub valid_file {
return 0;
}
+=pod
+
+=item scantron_download_scantron_data
+
+ Shows a list of the three internal files (original, corrected,
+ skipped) for a specific bubble sheet data file that exists in the
+ course.
+
+=cut
+
sub scantron_download_scantron_data {
my ($r)=@_;
my $default_form_data=&defaultFormData(&get_symb($r,1));
@@ -5929,6 +6532,12 @@ DOWNLOAD
return '';
}
+=pod
+
+=back
+
+=cut
+
#-------- end of section for handling grading scantron forms -------
#
#-------------------------------------------------------------------
@@ -5939,7 +6548,7 @@ DOWNLOAD
sub show_grading_menu_form {
my ($symb)=@_;
my $result.='<br /><form action="/adm/grades" method="post">'."\n".
- '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
+ '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
'<input type="hidden" name="saveState" value="'.$env{'form.saveState'}.'" />'."\n".
'<input type="hidden" name="command" value="gradingmenu" />'."\n".
'<input type="submit" name="submit" value="Grading Menu" />'."\n".
@@ -6014,7 +6623,7 @@ GRADINGMENUJS
my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'});
$result.='<form action="/adm/grades" method="post" name="gradingMenu">'."\n".
- '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
+ '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n".
'<input type="hidden" name="handgrade" value="'.$hdgrade.'" />'."\n".
'<input type="hidden" name="probTitle" value="'.$probTitle.'" />'."\n".
'<input type="hidden" name="command" value="" />'."\n".
@@ -6130,53 +6739,63 @@ sub init_perm {
}
sub gather_clicker_ids {
- my %clickerids=();
+ my %clicker_ids;
my $classlist = &Apache::loncoursedata::get_classlist();
# Set up a couple variables.
- my $usernameidx = &Apache::loncoursedata::CL_SNAME();
- my $domainidx = &Apache::loncoursedata::CL_SDOM();
+ my $username_idx = &Apache::loncoursedata::CL_SNAME();
+ my $domain_idx = &Apache::loncoursedata::CL_SDOM();
- foreach my $student (keys %$classlist) {
+ foreach my $student (keys(%$classlist)) {
- my $username = $classlist->{$student}->[$usernameidx];
- my $domain = $classlist->{$student}->[$domainidx];
+ my $username = $classlist->{$student}->[$username_idx];
+ my $domain = $classlist->{$student}->[$domain_idx];
my $clickers =
- (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1];
+ (&Apache::lonnet::userenvironment($domain,$username,'clickers'))[1];
foreach my $id (split(/\,/,$clickers)) {
- $id=~s/^0+//;
- if (exists($clickerids{$id})) {
- $clickerids{$id}.=','.$username.':'.$domain;
+ $id=~s/^[\#0]+//;
+ $id=~s/[\-\:]//g;
+ if (exists($clicker_ids{$id})) {
+ $clicker_ids{$id}.=','.$username.':'.$domain;
} else {
- $clickerids{$id}=$username.':'.$domain;
+ $clicker_ids{$id}=$username.':'.$domain;
}
}
}
- return %clickerids;
+ return %clicker_ids;
}
sub gather_adv_clicker_ids {
- my %clickerids=();
+ my %clicker_ids;
my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my %coursepersonnel=&Apache::lonnet::get_course_adv_roles($cdom.'/'.$cnum);
- foreach my $element (sort keys %coursepersonnel) {
+ foreach my $element (sort(keys(%coursepersonnel))) {
foreach my $person (split(/\,/,$coursepersonnel{$element})) {
my ($puname,$pudom)=split(/\:/,$person);
my $clickers =
- (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1];
+ (&Apache::lonnet::userenvironment($pudom,$puname,'clickers'))[1];
foreach my $id (split(/\,/,$clickers)) {
- $id=~s/^0+//;
- if (exists($clickerids{$id})) {
- $clickerids{$id}.=','.$puname.':'.$pudom;
- } else {
- $clickerids{$id}=$puname.':'.$pudom;
- }
+ $id=~s/^[\#0]+//;
+ $id=~s/[\-\:]//g;
+ if (exists($clicker_ids{$id})) {
+ $clicker_ids{$id}.=','.$puname.':'.$pudom;
+ } else {
+ $clicker_ids{$id}=$puname.':'.$pudom;
+ }
}
}
}
- return %clickerids;
+ return %clicker_ids;
+}
+
+sub clicker_grading_parameters {
+ return ('gradingmechanism' => 'scalar',
+ 'upfiletype' => 'scalar',
+ 'specificid' => 'scalar',
+ 'pcorrect' => 'scalar',
+ 'pincorrect' => 'scalar');
}
sub process_clicker {
@@ -6192,16 +6811,33 @@ sub process_clicker {
$result.=' <b>'.&mt('Specify a file containing the clicker information for this resource').
'.</b></td></tr>'."\n";
$result.='<tr bgcolor=#ffffe6><td>'."\n";
+# Attempt to restore parameters from last session, set defaults if not present
+ my %Saveable_Parameters=&clicker_grading_parameters();
+ &Apache::loncommon::restore_course_settings('grades_clicker',
+ \%Saveable_Parameters);
+ if (!$env{'form.pcorrect'}) { $env{'form.pcorrect'}=100; }
+ if (!$env{'form.pincorrect'}) { $env{'form.pincorrect'}=100; }
+ if (!$env{'form.gradingmechanism'}) { $env{'form.gradingmechanism'}='attendance'; }
+ if (!$env{'form.upfiletype'}) { $env{'form.upfiletype'}='iclicker'; }
+
+ my %checked;
+ foreach my $gradingmechanism ('attendance','personnel','specific') {
+ if ($env{'form.gradingmechanism'} eq $gradingmechanism) {
+ $checked{$gradingmechanism}="checked='checked'";
+ }
+ }
+
my $upload=&mt("Upload File");
my $type=&mt("Type");
my $attendance=&mt("Award points just for participation");
my $personnel=&mt("Correctness determined from response by course personnel");
- my $specific=&mt("Correctness determined from response with clicker ID");
+ my $specific=&mt("Correctness determined from response with clicker ID(s)");
my $pcorrect=&mt("Percentage points for correct solution");
my $pincorrect=&mt("Percentage points for incorrect solution");
- my $selectform=&Apache::loncommon::select_form('iclicker','upfiletype',
- ('iclicker' => 'i>clicker'));
-
+ my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype',
+ ('iclicker' => 'i>clicker',
+ 'interwrite' => 'interwrite PRS'));
+ $symb = &Apache::lonenc::check_encrypt($symb);
$result.=<<ENDUPFORM;
<script type="text/javascript">
function sanitycheck() {
@@ -6249,13 +6885,13 @@ function sanitycheck() {
<input type="hidden" name="saveState" value="$env{'form.saveState'}" />
<input type="file" name="upfile" size="50" />
<br /><label>$type: $selectform</label>
-<br /><label>$attendance: <input type="radio" name="gradingmechanism" value="attendance" checked="checked" onClick="sanitycheck()" /></label>
-<br /><label>$personnel: <input type="radio" name="gradingmechanism" value="personnel" onClick="sanitycheck()" /></label>
-<br /><label>$specific: <input type="radio" name="gradingmechanism" value="specific" onClick="sanitycheck()" /></label>
-<input type="text" name="specificid" size="15" />
-<input type="hidden" name="waschecked" value="attendance" />
-<br /><label>$pcorrect: <input type="text" name="pcorrect" size="4" value="100" onChange="sanitycheck()" /></label>
-<br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="100" onChange="sanitycheck()" /></label>
+<br /><label>$attendance: <input type="radio" name="gradingmechanism" value="attendance" $checked{'attendance'} onClick="sanitycheck()" /></label>
+<br /><label>$personnel: <input type="radio" name="gradingmechanism" value="personnel" $checked{'personnel'} onClick="sanitycheck()" /></label>
+<br /><label>$specific: <input type="radio" name="gradingmechanism" value="specific" $checked{'specific'} onClick="sanitycheck()" /></label>
+<input type="text" name="specificid" value="$env{'form.specificid'}" size="20" />
+<input type="hidden" name="waschecked" value="$env{'form.gradingmechanism'}" />
+<br /><label>$pcorrect: <input type="text" name="pcorrect" size="4" value="$env{'form.pcorrect'}" onChange="sanitycheck()" /></label>
+<br /><label>$pincorrect: <input type="text" name="pincorrect" size="4" value="$env{'form.pincorrect'}" onChange="sanitycheck()" /></label>
<br /><input type="button" onClick="javascript:checkUpload(this.form);" value="$upload" />
</form>
ENDUPFORM
@@ -6269,78 +6905,299 @@ sub process_clicker_file {
my ($r)=@_;
my ($symb)=&get_symb($r);
if (!$symb) {return '';}
+
+ my %Saveable_Parameters=&clicker_grading_parameters();
+ &Apache::loncommon::store_course_settings('grades_clicker',
+ \%Saveable_Parameters);
+
my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) {
- $result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>';
- return $result.&show_grading_menu_form($symb);
+ $result.='<span class="LC_error">'.&mt('You need to specify a clicker ID for the correct answer').'</span>';
+ return $result.&show_grading_menu_form($symb);
}
- my %clickerids=&gather_clicker_ids();
- my %correctids=();
+ my %clicker_ids=&gather_clicker_ids();
+ my %correct_ids;
if ($env{'form.gradingmechanism'} eq 'personnel') {
- %correctids=&gather_adv_clicker_ids();
+ %correct_ids=&gather_adv_clicker_ids();
}
if ($env{'form.gradingmechanism'} eq 'specific') {
- my $correctid=$env{'form.specificid'};
- $correctid=~tr/a-z/A-Z/;
- $correctid=~s/\s//gs;
- $correctid=~s/^0+//;
- $correctids{$correctid}='specified';
+ foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {;
+ $correct_id=~tr/a-z/A-Z/;
+ $correct_id=~s/\s//gs;
+ $correct_id=~s/^[\#0]+//;
+ $correct_id=~s/[\-\:]//g;
+ if ($correct_id) {
+ $correct_ids{$correct_id}='specified';
+ }
+ }
}
if ($env{'form.gradingmechanism'} eq 'attendance') {
- $result.=&mt('Score based on attendance only');
+ $result.=&mt('Score based on attendance only');
} else {
- my $number=0;
- $result.='<h3>'.&mt('Correctness determined by the following IDs').'</h3>';
- foreach my $id (sort(keys(%correctids))) {
- $result.='<tt>'.$id.'</tt> - ';
- if ($correctids{$id} eq 'specified') {
- $result.=&mt('specified');
- } else {
- my ($uname,$udom)=split(/\:/,$correctids{$id});
- $result.=&Apache::loncommon::plainname($uname,$udom);
- }
- $result.='<br />';
- $number++;
- }
- if ($number==0) {
- $result.='<span class="LC_error">'.&mt('No IDs found to determine correct answer').'</span>';
- return $result.&show_grading_menu_form($symb);
- }
+ my $number=0;
+ $result.='<p><b>'.&mt('Correctness determined by the following IDs').'</b>';
+ foreach my $id (sort(keys(%correct_ids))) {
+ $result.='<br /><tt>'.$id.'</tt> - ';
+ if ($correct_ids{$id} eq 'specified') {
+ $result.=&mt('specified');
+ } else {
+ my ($uname,$udom)=split(/\:/,$correct_ids{$id});
+ $result.=&Apache::loncommon::plainname($uname,$udom);
+ }
+ $number++;
+ }
+ $result.="</p>\n";
+ if ($number==0) {
+ $result.='<span class="LC_error">'.&mt('No IDs found to determine correct answer').'</span>';
+ return $result.&show_grading_menu_form($symb);
+ }
}
if (length($env{'form.upfile'}) < 2) {
- $result.="<span class=\"LC_error\">Error:</span> The file you attempted to upload, <tt>".&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"')."</tt>, contained no information. Please check that you entered the correct filename.";
+ $result.=&mt('[_1] Error: [_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.',
+ '<span class="LC_error">',
+ '</span>',
+ '<span class="LC_filename">'.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'</span>');
return $result.&show_grading_menu_form($symb);
}
- my %contents=();
+
+# Were able to get all the info needed, now analyze the file
+
+ $result.=&Apache::loncommon::studentbrowser_javascript();
+ $symb = &Apache::lonenc::check_encrypt($symb);
+ my $heading=&mt('Scanning clicker file');
+ $result.=(<<ENDHEADER);
+<br /><table width="100%" border="0"><tr><td bgcolor="#777777">
+<table width="100%" border="0"><tr bgcolor="#e6ffff"><td>
+<b>$heading</b></td></tr><tr bgcolor=#ffffe6><td>
+<form method="post" action="/adm/grades" name="clickeranalysis">
+<input type="hidden" name="symb" value="$symb" />
+<input type="hidden" name="command" value="assignclickergrades" />
+<input type="hidden" name="probTitle" value="$env{'form.probTitle'}" />
+<input type="hidden" name="saveState" value="$env{'form.saveState'}" />
+<input type="hidden" name="gradingmechanism" value="$env{'form.gradingmechanism'}" />
+<input type="hidden" name="pcorrect" value="$env{'form.pcorrect'}" />
+<input type="hidden" name="pincorrect" value="$env{'form.pincorrect'}" />
+ENDHEADER
+ my %responses;
+ my @questiontitles;
my $errormsg='';
my $number=0;
if ($env{'form.upfiletype'} eq 'iclicker') {
- ($errormsg,$number,%contents)=&iclicker_eval();
- $result.=$errormsg;
+ ($errormsg,$number)=&iclicker_eval(\@questiontitles,\%responses);
+ }
+ if ($env{'form.upfiletype'} eq 'interwrite') {
+ ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses);
+ }
+ $result.='<br />'.&mt('Found [_1] question(s)',$number).'<br />'.
+ '<input type="hidden" name="number" value="'.$number.'" />'.
+ &mt('Awarding [_1] percent for correct and [_2] percent for incorrect responses',
+ $env{'form.pcorrect'},$env{'form.pincorrect'}).
+ '<br />';
+# Remember Question Titles
+# FIXME: Possibly need delimiter other than ":"
+ for (my $i=0;$i<$number;$i++) {
+ $result.='<input type="hidden" name="question:'.$i.'" value="'.
+ &HTML::Entities::encode($questiontitles[$i],'"&<>').'" />';
+ }
+ my $correct_count=0;
+ my $student_count=0;
+ my $unknown_count=0;
+# Match answers with usernames
+# FIXME: Possibly need delimiter other than ":"
+ foreach my $id (keys(%responses)) {
+ if ($correct_ids{$id}) {
+ $result.="\n".'<input type="hidden" name="correct:'.$correct_count.':'.$correct_ids{$id}.'" value="'.$responses{$id}.'" />';
+ $correct_count++;
+ } elsif ($clicker_ids{$id}) {
+ $result.="\n".'<input type="hidden" name="student:'.$clicker_ids{$id}.'" value="'.$responses{$id}.'" />';
+ $student_count++;
+ } else {
+ $result.="\n<hr />".&mt('Unregistered Clicker')." <tt>".$id."</tt><br />";
+ $result.="\n".'<input type="hidden" name="unknown:'.$id.'" value="'.$responses{$id}.'" />'.
+ "\n".&mt("Username").": <input type='text' name='uname".$id."' /> ".
+ "\n".&mt("Domain").": ".
+ &Apache::loncommon::select_dom_form($env{'course.'.$env{'request.course.id'}.'.domain'},'udom'.$id).' '.
+ &Apache::loncommon::selectstudent_link('clickeranalysis','uname'.$id,'udom'.$id);
+ $unknown_count++;
+ }
}
+ $result.='<hr />'.
+ &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count);
+ if ($env{'form.gradingmechanism'} ne 'attendance') {
+ if ($correct_count==0) {
+ $errormsg.="Found no correct answers answers for grading!";
+ } elsif ($correct_count>1) {
+ $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>';
+ }
+ }
+ if ($errormsg) {
+ $result.='<br /><span class="LC_error">'.&mt($errormsg).'</span>';
+ } else {
+ $result.='<br /><input type="submit" name="finalize" value="'.&mt('Finalize Grading').'" />';
+ }
+ $result.='</form></td></tr></table>'."\n".
+ '</td></tr></table><br /><br />'."\n";
return $result.&show_grading_menu_form($symb);
}
sub iclicker_eval {
+ my ($questiontitles,$responses)=@_;
+ my $number=0;
+ my $errormsg='';
+ foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
+ my %components=&Apache::loncommon::record_sep($line);
+ my @entries=map {$components{$_}} (sort(keys(%components)));
+ if ($entries[0] eq 'Question') {
+ for (my $i=3;$i<$#entries;$i+=6) {
+ $$questiontitles[$number]=$entries[$i];
+ $number++;
+ }
+ }
+ if ($entries[0]=~/^\#/) {
+ my $id=$entries[0];
+ my @idresponses;
+ $id=~s/^[\#0]+//;
+ for (my $i=0;$i<$number;$i++) {
+ my $idx=3+$i*6;
+ push(@idresponses,$entries[$idx]);
+ }
+ $$responses{$id}=join(',',@idresponses);
+ }
+ }
+ return ($errormsg,$number);
+}
+
+sub interwrite_eval {
+ my ($questiontitles,$responses)=@_;
my $number=0;
my $errormsg='';
+ my $skipline=1;
+ my $questionnumber=0;
+ my %idresponses=();
foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) {
- chomp($line);
- foreach my $quoted ($line=~/\,\s*\"([^\"]*)\"\s*\,/g) {
- my $replace=$quoted;
- $replace=~s/\,//g;
- &Apache::lonnet::logthis($quoted.' - '.$replace.'<br />');
- $line=~s/\,\s*\"\Q$quoted\E\"\s*\,/,$replace,/gs;
+ my %components=&Apache::loncommon::record_sep($line);
+ my @entries=map {$components{$_}} (sort(keys(%components)));
+ if ($entries[1] eq 'Time') { $skipline=0; next; }
+ if ($entries[1] eq 'Response') { $skipline=1; }
+ next if $skipline;
+ if ($entries[0]!=$questionnumber) {
+ $questionnumber=$entries[0];
+ $$questiontitles[$number]=&mt('Question [_1]',$questionnumber);
+ $number++;
+ }
+ my $id=$entries[4];
+ $id=~s/^[\#0]+//;
+ $id=~s/^v\d*\://i;
+ $id=~s/[\-\:]//g;
+ $idresponses{$id}[$number]=$entries[6];
+ }
+ foreach my $id (keys %idresponses) {
+ $$responses{$id}=join(',',@{$idresponses{$id}});
+ $$responses{$id}=~s/^\s*\,//;
+ }
+ return ($errormsg,$number);
+}
+
+sub assign_clicker_grades {
+ my ($r)=@_;
+ my ($symb)=&get_symb($r);
+ if (!$symb) {return '';}
+# See which part we are saving to
+ my ($partlist,$handgrade,$responseType) = &response_type($symb);
+# FIXME: This should probably look for the first handgradeable part
+ my $part=$$partlist[0];
+# Start screen output
+ my ($result) = &showResourceInfo($symb,$env{'form.probTitle'});
+
+ my $heading=&mt('Assigning grades based on clicker file');
+ $result.=(<<ENDHEADER);
+<br /><table width="100%" border="0"><tr><td bgcolor="#777777">
+<table width="100%" border="0"><tr bgcolor="#e6ffff"><td>
+<b>$heading</b></td></tr><tr bgcolor=#ffffe6><td>
+ENDHEADER
+# Get correct result
+# FIXME: Possibly need delimiter other than ":"
+ my @correct=();
+ my $gradingmechanism=$env{'form.gradingmechanism'};
+ my $number=$env{'form.number'};
+ if ($gradingmechanism ne 'attendance') {
+ foreach my $key (keys(%env)) {
+ if ($key=~/^form\.correct\:/) {
+ my @input=split(/\,/,$env{$key});
+ for (my $i=0;$i<=$#input;$i++) {
+ if (($correct[$i]) && ($input[$i]) &&
+ ($correct[$i] ne $input[$i])) {
+ $result.='<br /><span class="LC_warning">'.
+ &mt('More than one correct result given for question "[_1]": [_2] versus [_3].',
+ $env{'form.question:'.$i},$correct[$i],$input[$i]).'</span>';
+ } elsif ($input[$i]) {
+ $correct[$i]=$input[$i];
+ }
+ }
+ }
}
- my @entries=split(/\,/,$line);
- if ($entries[0] eq 'Question') {
- for (my $i=3;$i<$#entries;$i+=6) {
- $number++;
- $errormsg.='<br />'.$entries[$i];
+ for (my $i=0;$i<$number;$i++) {
+ if (!$correct[$i]) {
+ $result.='<br /><span class="LC_error">'.
+ &mt('No correct result given for question "[_1]"!',
+ $env{'form.question:'.$i}).'</span>';
}
}
+ $result.='<br />'.&mt("Correct answer: [_1]",join(', ',map { ($_?$_:'-') } @correct));
}
- return ($errormsg,$number);
+# Start grading
+ my $pcorrect=$env{'form.pcorrect'};
+ my $pincorrect=$env{'form.pincorrect'};
+ my $storecount=0;
+ foreach my $key (keys(%env)) {
+ my $user='';
+ if ($key=~/^form\.student\:(.*)$/) {
+ $user=$1;
+ }
+ if ($key=~/^form\.unknown\:(.*)$/) {
+ my $id=$1;
+ if (($env{'form.uname'.$id}) && ($env{'form.udom'.$id})) {
+ $user=$env{'form.uname'.$id}.':'.$env{'form.udom'.$id};
+ }
+ }
+ if ($user) {
+ my @answer=split(/\,/,$env{$key});
+ my $sum=0;
+ for (my $i=0;$i<$number;$i++) {
+ if ($answer[$i]) {
+ if ($gradingmechanism eq 'attendance') {
+ $sum+=$pcorrect;
+ } else {
+ if ($answer[$i] eq $correct[$i]) {
+ $sum+=$pcorrect;
+ } else {
+ $sum+=$pincorrect;
+ }
+ }
+ }
+ }
+ my $ave=$sum/(100*$number);
+# Store
+ my ($username,$domain)=split(/\:/,$user);
+ my %grades=();
+ $grades{"resource.$part.solved"}='correct_by_override';
+ $grades{"resource.$part.awarded"}=$ave;
+ $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
+ my $returncode=&Apache::lonnet::cstore(\%grades,$symb,
+ $env{'request.course.id'},
+ $domain,$username);
+ if ($returncode ne 'ok') {
+ $result.="<br /><span class=\"LC_error\">Failed to save student $username:$domain. Message when trying to save was ($returncode)</span>";
+ } else {
+ $storecount++;
+ }
+ }
+ }
+# We are done
+ $result.='<br />'.&mt('Successfully stored grades for [_1] student(s).',$storecount).
+ '</td></tr></table>'."\n".
+ '</td></tr></table><br /><br />'."\n";
+ return $result.&show_grading_menu_form($symb);
}
sub handler {
@@ -6414,6 +7271,8 @@ sub handler {
$request->print(&process_clicker($request));
} elsif ($command eq 'processclickerfile' && $perm{'mgr'}) {
$request->print(&process_clicker_file($request));
+ } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) {
+ $request->print(&assign_clicker_grades($request));
} elsif ($command eq 'csvform' && $perm{'mgr'}) {
$request->print(&upcsvScores_form($request));
} elsif ($command eq 'csvupload' && $perm{'mgr'}) {