--- loncom/homework/grades.pm 2004/11/23 14:37:33 1.232
+++ loncom/homework/grades.pm 2005/02/12 03:14:44 1.244
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.232 2004/11/23 14:37:33 albertel Exp $
+# $Id: grades.pm,v 1.244 2005/02/12 03:14:44 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -973,6 +973,7 @@ sub sub_page_kw_js {
my $iconpath = $request->dir_config('lonIconsURL');
&commonJSfunctions($request);
my $docopen=&Apache::lonhtmlcommon::javascript_docopen();
+ $docopen=~s/^document\.//;
$request->print(<<SUBJAVASCRIPT);
<script type="text/javascript" language="javascript">
@@ -1689,6 +1690,7 @@ KEYWORDS
&Apache::lonnet::allowuploaded('/adm/grades',$file);
$lastsubonly.='<br /><a href="'.$file.'" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border=0"> '.$file.'</a>';
}
+ $lastsubonly.='<br />';
}
$lastsubonly.='<b>Submitted Answer: </b>'.
&cleanRecord($subval,$responsetype,$symb,$partid,
@@ -2402,9 +2404,6 @@ sub viewgrades {
my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'1');
my $ctr = 0;
foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
- my $uname = $_;
- $uname=~s/:/_/;
- $result.='<input type="hidden" name="ctr'.$ctr.'" value="'.$uname.'" />'."\n";
$ctr++;
$result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},
$_,$$fullname{$_},\@parts,\%weight,$ctr);
@@ -2428,18 +2427,21 @@ sub viewstudentgrade {
my ($uname,$udom) = split(/:/,$student);
$student=~s/:/_/;
my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
- my $result='<tr bgcolor="#ffffdd"><td align="right">'.$ctr.' </td><td> '.
+ my $result='<tr bgcolor="#ffffdd"><td align="right">'.
+ '<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'.
+ "\n".$ctr.' </td><td> '.
'<a href="javascript:viewOneStudent(\''.$uname.'\',\''.$udom.
'\')"; TARGET=_self>'.$fullname.'</a> '.
'<font color="#999999">('.$uname.($ENV{'user.domain'} eq $udom ? '' : ':'.$udom).')</font></td>'."\n";
foreach my $apart (@$parts) {
my ($part,$type) = &split_part_type($apart);
my $score=$record{"resource.$part.$type"};
+ $result.='<td align="middle">';
if ($type eq 'awarded') {
my $pts = $score eq '' ? '' : $score*$$weight{$part};
$result.='<input type="hidden" name="'.
'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
- $result.='<td align="middle"><input type="text" name="'.
+ $result.='<input type="text" name="'.
'GD_'.$student.'_'.$part.'_awarded" '.
'onChange="javascript:changeSelect(\''.$part.'\',\''.$student.
'\')" value="'.$pts.'" size="4" /></td>'."\n";
@@ -2448,7 +2450,7 @@ sub viewstudentgrade {
$status = 'nothing' if ($status eq '');
$result.='<input type="hidden" name="'.'GD_'.$student.'_'.
$part.'_solved_s" value="'.$status.'" />'."\n";
- $result.='<td align="middle"> <select name="'.
+ $result.=' <select name="'.
'GD_'.$student.'_'.$part.'_solved" '.
'onChange="javascript:changeOneScore(\''.$part.'\',\''.$student.'\')" >'."\n";
$result.= (($status eq 'excused') ? '<option> </option><option selected="on">excused</option>'
@@ -2459,7 +2461,7 @@ sub viewstudentgrade {
$result.='<input type="hidden" name="'.
'GD_'.$student.'_'.$part.'_'.$type.'_s" value="'.$score.'" />'.
"\n";
- $result.='<td align="middle"><input type="text" name="'.
+ $result.='<input type="text" name="'.
'GD_'.$student.'_'.$part.'_'.$type.'" '.
'value="'.$score.'" size="4" /></td>'."\n";
}
@@ -2653,15 +2655,17 @@ sub csvupload_javascript_reverse_associa
function verify(vf) {
var foundsomething=0;
var founduname=0;
+ var foundID=0;
var founddomain=0;
for (i=0;i<=vf.nfields.value;i++) {
tw=eval('vf.f'+i+'.selectedIndex');
- if (i==0 && tw!=0) { founduname=1; }
- if (i==1 && tw!=0) { founddomain=1; }
- if (i!=0 && i!=1 && tw!=0) { foundsomething=1; }
+ if (i==0 && tw!=0) { foundID=1; }
+ if (i==1 && tw!=0) { founduname=1; }
+ if (i==2 && tw!=0) { founddomain=1; }
+ if (i!=0 && i!=1 && i!=2 && tw!=0) { foundsomething=1; }
}
- if (founduname==0 || founddomain==0) {
- alert('You need to specify at both the username and domain');
+ if ((founduname==0 && foundID==0) || founddomain==0) {
+ alert('You need to specify the domain and either the username or ID');
return;
}
if (foundsomething==0) {
@@ -2691,15 +2695,17 @@ sub csvupload_javascript_forward_associa
function verify(vf) {
var foundsomething=0;
var founduname=0;
+ var foundID=0;
var founddomain=0;
for (i=0;i<=vf.nfields.value;i++) {
tw=eval('vf.f'+i+'.selectedIndex');
- if (tw==1) { founduname=1; }
- if (tw==2) { founddomain=1; }
- if (tw>2) { foundsomething=1; }
+ if (tw==1) { foundID=1; }
+ if (tw==2) { founduname=1; }
+ if (tw==3) { founddomain=1; }
+ if (tw>3) { foundsomething=1; }
}
- if (founduname==0 || founddomain==0) {
- alert('You need to specify at both the username and domain');
+ if ((founduname==0 && foundID==0) || founddomain==0) {
+ alert('You need to specify the domain and either the username or ID');
return;
}
if (foundsomething==0) {
@@ -2766,13 +2772,18 @@ ENDPICK
sub csvupload_fields {
my ($url,$symb) = @_;
my (@parts) = &getpartlist($url,$symb);
- my @fields=(['username','Student Username'],['domain','Student Domain']);
+ my @fields=(['ID','Student ID'],
+ ['username','Student Username'],
+ ['domain','Student Domain']);
foreach my $part (sort(@parts)) {
my @datum;
my $display=&Apache::lonnet::metadata($url,$part.'.display');
my $name=$part;
if (!$display) { $display = $name; }
@datum=($name,$display);
+ if ($name=~/^stores_(.*)_awarded/) {
+ push(@fields,['stores_'.$1.'_points',"Points [Part: $1]"]);
+ }
push(@fields,\@datum);
}
return (@fields);
@@ -2897,10 +2908,15 @@ sub csvuploadassign {
my $countdone=0;
foreach my $grade (@gradedata) {
my %entries=&Apache::loncommon::record_sep($grade);
- my $username=$entries{$fields{'username'}};
- $username=~s/\s//g;
my $domain=$entries{$fields{'domain'}};
$domain=~s/\s//g;
+ my $username=$entries{$fields{'username'}};
+ $username=~s/\s//g;
+ if (!$username) {
+ my $id=$entries{$fields{'ID'}};
+ my %ids=&Apache::lonnet::idget($domain,$id);
+ $username=$ids{$id};
+ }
if (!exists($$classlist{"$username:$domain"})) {
push(@skipped,"$username:$domain");
next;
@@ -2910,16 +2926,33 @@ sub csvuploadassign {
push(@notallowed,"$username:$domain");
next;
}
+ my %points;
my %grades;
foreach my $dest (keys(%fields)) {
- if ($dest eq 'username' || $dest eq 'domain') { next; }
- if ($entries{$fields{$dest}} eq '') { next; }
- my $store_key=$dest;
- $store_key=~s/^stores/resource/;
- $store_key=~s/_/\./g;
- $grades{$store_key}=$entries{$fields{$dest}};
+ if ($dest eq 'ID' || $dest eq 'username' ||
+ $dest eq 'domain') { next; }
+ if ($entries{$fields{$dest}} =~ /^\s*$/) { next; }
+ if ($dest=~/stores_(.*)_points/) {
+ my $part=$1;
+ my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight',
+ $symb,$domain,$username);
+ my $pcr=$entries{$fields{$dest}} / $wgt;
+ my $award='correct_by_override';
+ $grades{"resource.$part.awarded"}=$pcr;
+ $grades{"resource.$part.solved"}=$award;
+ $points{$part}=1;
+ } else {
+ if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} }
+ if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} }
+ my $store_key=$dest;
+ $store_key=~s/^stores/resource/;
+ $store_key=~s/_/\./g;
+ $grades{$store_key}=$entries{$fields{$dest}};
+ }
}
+ if (! %grades) { push(@skipped,"$username:$domain no data to store"); }
$grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}";
+# &Apache::lonnet::logthis(" storing ".(join('-',%grades)));
&Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'},
$domain,$username);
$request->print('.');
@@ -3058,7 +3091,8 @@ sub getSymbMap {
my $minder = 0;
# Gather every sequence that has problems.
- my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 1);
+ my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); },
+ 1,0,1);
for my $sequence ($navmap->getById('0.0'), @sequences) {
if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) {
my $title = $minder.'.'.$sequence->compTitle();
@@ -3137,7 +3171,7 @@ sub displayPage {
if($curRes == $iterator->BEGIN_MAP) { $depth++; }
if($curRes == $iterator->END_MAP) { $depth--; }
- if (ref($curRes) && $curRes->is_problem()) {
+ if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) {
my $parts = $curRes->parts();
my $title = $curRes->compTitle();
my $symbx = $curRes->symb();
@@ -3794,25 +3828,49 @@ sub scantron_parse_scanline {
my $currentquest=substr($questions,0,$$scantron_config{'Qlength'});
substr($questions,0,$$scantron_config{'Qlength'})='';
if (length($currentquest) < $$scantron_config{'Qlength'}) { next; }
- my @array=split($$scantron_config{'Qon'},$currentquest,-1);
- if (length($array[0]) eq $$scantron_config{'Qlength'}) {
- $record{"scantron.$questnum.answer"}='';
- if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
- push(@{$record{"scantron.missingerror"}},$questnum);
- }
+ if ($$scantron_config{'Qon'} eq 'letter') {
+ if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} ||
+ $currentquest !~ /^[A-Z]$/) {
+ $record{"scantron.$questnum.answer"}='';
+ if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
+ push(@{$record{"scantron.missingerror"}},$questnum);
+ }
+ } else {
+ $record{"scantron.$questnum.answer"}=$currentquest;
+ }
+ } elsif ($$scantron_config{'Qon'} eq 'number') {
+ if (!$currentquest || $currentquest eq $$scantron_config{'Qoff'} ||
+ $currentquest !~ /^\d$/) {
+ $record{"scantron.$questnum.answer"}='';
+ if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
+ push(@{$record{"scantron.missingerror"}},$questnum);
+ }
+ } else {
+ $record{"scantron.$questnum.answer"}=
+ $alphabet[$currentquest-1];
+ }
} else {
- $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])];
+ my @array=split($$scantron_config{'Qon'},$currentquest,-1);
+ if (length($array[0]) eq $$scantron_config{'Qlength'}) {
+ $record{"scantron.$questnum.answer"}='';
+ if (!&scan_data($scan_data,"$whichline.no_bubble.$questnum")) {
+ push(@{$record{"scantron.missingerror"}},$questnum);
+ }
+ } else {
+ $record{"scantron.$questnum.answer"}=
+ $alphabet[length($array[0])];
+ }
+ if (scalar(@array) gt 2) {
+ push(@{$record{'scantron.doubleerror'}},$questnum);
+ my @ans=@array;
+ my $i=length($ans[0]);shift(@ans);
+ while ($#ans) {
+ $i+=length($ans[0])+1;
+ $record{"scantron.$questnum.answer"}.=$alphabet[$i];
+ shift(@ans);
+ }
+ }
}
- if (scalar(@array) gt 2) {
- push(@{$record{'scantron.doubleerror'}},$questnum);
- my @ans=@array;
- my $i=length($ans[0]);shift(@ans);
- while ($#ans) {
- $i+=length($ans[0])+1;
- $record{"scantron.$questnum.answer"}.=$alphabet[$i];
- shift(@ans);
- }
- }
}
$record{'scantron.maxquest'}=$questnum;
return \%record;
@@ -3977,14 +4035,28 @@ sub scantron_do_warning {
if (!$symb) {return '';}
my $default_form_data=&defaultFormData($symb,$url);
$r->print(&scantron_form_start().$default_form_data);
- my $warning=&scantron_warning_screen('Validate Records');
- $r->print(<<STUFF);
+ if ( $ENV{'form.selectpage'} eq '' ||
+ $ENV{'form.scantron_selectfile'} eq '' ||
+ $ENV{'form.scantron_format'} eq '' ) {
+ $r->print("<p>You have forgetten to specify some information. Please go Back and try again.</p>");
+ if ( $ENV{'form.selectpage'} eq '') {
+ $r->print('<p><font color="red">You have not selected a Sequence to grade</font></p>');
+ }
+ if ( $ENV{'form.scantron_selectfile'} eq '') {
+ $r->print('<p><font color="red">You have not selected a file that contains the student\'s response data.</font></p>');
+ }
+ if ( $ENV{'form.scantron_format'} eq '') {
+ $r->print('<p><font color="red">You have not selected a the format of the student\'s response data.</font></p>');
+ }
+ } else {
+ my $warning=&scantron_warning_screen('Validate Records');
+ $r->print(<<STUFF);
$warning
<input type="submit" name="submit" value="Validate Records" />
<input type="hidden" name="command" value="scantron_validate" />
-</form>
STUFF
- $r->print("<br />".&show_grading_menu_form($symb,$url)."</body></html>");
+ }
+ $r->print("</form><br />".&show_grading_menu_form($symb,$url)."</body></html>");
return '';
}
@@ -4285,6 +4357,12 @@ sub scantron_get_correction {
$r->print(" in scanline $i <pre>".
$line."</pre> \n");
}
+ my $message="<p>The ID on the form is <tt>".
+ $$scan_record{'scantron.ID'}."</tt><br />\n".
+ "The name on the paper is ".
+ $$scan_record{'scantron.LastName'}.",".
+ $$scan_record{'scantron.FirstName'}."</p>";
+
$r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
$r->print('<input type="hidden" name="scantron_line" value="'.$i.'" />'."\n");
if ($error =~ /ID$/) {
@@ -4293,11 +4371,7 @@ sub scantron_get_correction {
} elsif ($error eq 'duplicateID') {
$r->print("The encoded ID has also been used by a previous paper $arg</p>\n");
}
- $r->print("<p>The ID on the form is <tt>".
- $$scan_record{'scantron.ID'}."</tt><br />\n");
- $r->print("The name on the paper is ".
- $$scan_record{'scantron.LastName'}.",".
- $$scan_record{'scantron.FirstName'}."</p>");
+ $r->print($message);
$r->print("<p>How should I handle this? <br /> \n");
$r->print("\n<ul><li> ");
#FIXME it would be nice if this sent back the user ID and
@@ -4317,11 +4391,7 @@ sub scantron_get_correction {
}
$r->print("<p>The CODE on the form is <tt>'".
$$scan_record{'scantron.CODE'}."'</tt><br />\n");
- $r->print("<p>The ID on the form is <tt>".
- $$scan_record{'scantron.ID'}."</tt><br />\n");
- $r->print("The name on the paper is ".
- $$scan_record{'scantron.LastName'}.",".
- $$scan_record{'scantron.FirstName'}."</p>");
+ $r->print($message);
$r->print("<p>How should I handle this? <br /> \n");
$r->print("\n<br /> ");
my $i=0;
@@ -4364,6 +4434,7 @@ ENDSCRIPT
$r->print("<p>There have been multiple bubbles scanned for a some question(s)</p>\n");
$r->print('<input type="hidden" name="scantron_questions" value="'.
join(',',@{$arg}).'" />');
+ $r->print($message);
$r->print("<p>Please indicate which bubble should be used for grading</p>");
foreach my $question (@{$arg}) {
my $selected=$$scan_record{"scantron.$question.answer"};
@@ -4371,6 +4442,7 @@ ENDSCRIPT
}
} elsif ($error eq 'missingbubble') {
$r->print("<p>There have been <b>no</b> bubbles scanned for some question(s)</p>\n");
+ $r->print($message);
$r->print("<p>Please indicate which bubble should be used for grading</p>");
$r->print("Some questions have no scanned bubbles\n");
$r->print('<input type="hidden" name="scantron_questions" value="'.
@@ -4524,7 +4596,7 @@ sub scantron_get_maxbubble {
my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
&Apache::lonnet::delenv('form.counter');
foreach my $resource (@resources) {
- my $result=&Apache::lonnet::ssi($resource->src());
+ my $result=&Apache::lonnet::ssi($resource->src().'?symb='.&Apache::lonnet::escape($resource->symb()));
}
&Apache::lonnet::delenv('scantron\.');
my $envfile=$ENV{'user.environment'};
@@ -4808,7 +4880,6 @@ DOWNLOAD
#
#-------------------------------------------------------------------
-
#-------------------------- Menu interface -------------------------
#
#--- Show a Grading Menu button - Calls the next routine ---
@@ -4861,6 +4932,7 @@ sub gradingmenu {
if (!checkReceiptNo(formname,'notOK')) { return false;}
formname.submit();
}
+ if (val < 7) formname.submit();
}
function checkReceiptNo(formname,nospace) {
@@ -4913,7 +4985,7 @@ GRADINGMENUJS
($saveSec eq $_ ? 'selected="on"':'').'>'.$_.'</option>'."\n";
}
}
- $result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="on"' : ''). '>all</select> ';
+ $result.= '<option value="all" '.($saveSec eq 'all' ? 'selected="on"' : ''). '>all</option></select> ';
$result.=&mt('Student Status').':</b>'.&Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,undef);
@@ -4965,6 +5037,9 @@ GRADINGMENUJS
'-<input type="text" name="receipt" size="4" onChange="javascript:checkReceiptNo(this.form,\'OK\')">'.
'</td></tr>'."\n";
}
+ $result.='<tr bgcolor="#ffffe6"valign="top"><td colspan="2">'.
+ '<input type="button" onClick="javascript:this.form.action=\'/adm/helper/resettimes.helper\';this.form.submit();'.
+ '" value="'.&mt('Manage').'" /> access times.</td></tr>'."\n";
$result.='</form></td></tr></table>'."\n".
'</td></tr></table>'."\n".