--- loncom/homework/grades.pm 2011/11/30 23:24:49 1.665 +++ loncom/homework/grades.pm 2013/08/28 04:25:14 1.704 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.665 2011/11/30 23:24:49 raeburn Exp $ +# $Id: grades.pm,v 1.704 2013/08/28 04:25:14 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -54,6 +54,7 @@ use POSIX qw(floor); my %perm=(); +my %old_essays=(); # These variables are used to recover from ssi errors @@ -202,6 +203,7 @@ sub get_display_part { sub reset_caches { &reset_analyze_cache(); &reset_perm(); + &reset_old_essays(); } { @@ -681,7 +683,11 @@ sub compute_points { # sub most_similar { - my ($uname,$udom,$uessay,$old_essays)=@_; + my ($uname,$udom,$symb,$uessay)=@_; + + unless ($symb) { return ''; } + + unless (ref($old_essays{$symb}) eq 'HASH') { return ''; } # ignore spaces and punctuation @@ -698,11 +704,11 @@ sub most_similar { my $scrsid=''; my $sessay=''; # go through all essays ... - foreach my $tkey (keys(%$old_essays)) { + foreach my $tkey (keys(%{$old_essays{$symb}})) { my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); # ... except the same student next if (($tname eq $uname) && ($tdom eq $udom)); - my $tessay=$old_essays->{$tkey}; + my $tessay=$old_essays{$symb}{$tkey}; $tessay=~s/\W+/ /gs; # String similarity gives up if not even limit my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); @@ -712,7 +718,7 @@ sub most_similar { $sname=$tname; $sdom=$tdom; $scrsid=$tcrsid; - $sessay=$old_essays->{$tkey}; + $sessay=$old_essays{$symb}{$tkey}; } } if ($limit>0.6) { @@ -730,7 +736,7 @@ sub most_similar { sub initialverifyreceipt { my ($request,$symb) = @_; &commonJSfunctions($request); - return '<form name="gradingMenu"><input type="submit" value="'.&mt('Verify Receipt Number.').'" />'. + return '<form name="gradingMenu" action=""><input type="submit" value="'.&mt('Verify Receipt Number.').'" />'. &Apache::lonnet::recprefix($env{'request.course.id'}). '-<input type="text" name="receipt" size="4" />'. '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n". @@ -902,17 +908,17 @@ LISTJAVASCRIPT $submission_options.= '<span class="LC_nobreak">'. '<label><input type="radio" name="lastSub" value="lastonly" /> '. - &mt('last submission only').' </label></span>'."\n". + &mt('last submission').' </label></span>'."\n". '<span class="LC_nobreak">'. '<label><input type="radio" name="lastSub" value="last" /> '. - &mt('last submission & parts info').' </label></span>'."\n". + &mt('last submission with details').' </label></span>'."\n". '<span class="LC_nobreak">'. '<label><input type="radio" name="lastSub" value="datesub" checked="checked" /> '. - &mt('by dates and submissions').'</label></span>'."\n". + &mt('all submissions').'</label></span>'."\n". '<span class="LC_nobreak">'. '<label><input type="radio" name="lastSub" value="all" /> '. - &mt('all details').'</label></span>'; - $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Submissions')) + &mt('all submissions with details').'</label></span>'; + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Submissions')) .$submission_options .&Apache::lonhtmlcommon::row_closure(); @@ -1524,17 +1530,15 @@ INNERJS function savedMsgHeader(Nmsg,usrctr,fullname) { var height = 70*Nmsg+250; - var scrollbar = "no"; if (height > 600) { height = 600; - scrollbar = "yes"; } var xpos = (screen.width-600)/2; xpos = (xpos < 0) ? '0' : xpos; var ypos = (screen.height-height)/2-30; ypos = (ypos < 0) ? '0' : ypos; - pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=700,height='+height); + pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars=yes,screenx='+xpos+',screeny='+ypos+',width=700,height='+height); pWin.focus(); pDoc = pWin.document; pDoc.$docopen; @@ -1542,39 +1546,38 @@ INNERJS pDoc.write("<form action=\\"inactive\\" name=\\"msgcenter\\">"); pDoc.write("<input value=\\""+usrctr+"\\" name=\\"usrctr\\" type=\\"hidden\\">"); - pDoc.write("<h3><span class=\\"LC_info\\"> $lt{'comp'}\"+fullname+\"<\\/span><\\/h3><br /><br />"); + pDoc.write("<h1> $lt{'comp'}\"+fullname+\"<\\/h1>"); - pDoc.write('<table border="0" width="100%"><tr><td bgcolor="#777777">'); - pDoc.write('<table border="0" width="100%"><tr bgcolor="#DDFFFF">'); - pDoc.write("<td><b>$lt{'type'}<\\/b><\\/td><td><b>$lt{'incl'}<\\/b><\\/td><td><b>$lt{'mesa'}<\\/td><\\/tr>"); + pDoc.write('<table style="border:1px solid black;"><tr>'); + pDoc.write("<td><b>$lt{'incl'}<\\/b><\\/td><td><b>$lt{'type'}<\\/b><\\/td><td><b>$lt{'mesa'}<\\/td><\\/tr>"); } function displaySubject(msg,shwsel) { pDoc = pWin.document; - pDoc.write("<tr bgcolor=\\"#ffffdd\\">"); - pDoc.write("<td>$lt{'subj'}<\\/td>"); + pDoc.write("<tr>"); pDoc.write("<td align=\\"center\\"><input name=\\"subchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); - pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"60\\" maxlength=\\"80\\"><\\/td><\\/tr>"); + pDoc.write("<td>$lt{'subj'}<\\/td>"); + pDoc.write("<td><input name=\\"msgsub\\" type=\\"text\\" value=\\""+msg+"\\"size=\\"40\\" maxlength=\\"80\\"><\\/td><\\/tr>"); } function displaySavedMsg(ctr,msg,shwsel) { pDoc = pWin.document; - pDoc.write("<tr bgcolor=\\"#ffffdd\\">"); - pDoc.write("<td align=\\"center\\">"+ctr+"<\\/td>"); + pDoc.write("<tr>"); pDoc.write("<td align=\\"center\\"><input name=\\"msgn"+ctr+"\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); + pDoc.write("<td align=\\"center\\">"+ctr+"<\\/td>"); pDoc.write("<td><textarea name=\\"msg"+ctr+"\\" cols=\\"60\\" rows=\\"3\\">"+msg+"<\\/textarea><\\/td><\\/tr>"); } function newMsg(newmsg,shwsel) { pDoc = pWin.document; - pDoc.write("<tr bgcolor=\\"#ffffdd\\">"); - pDoc.write("<td align=\\"center\\">$lt{'new'}<\\/td>"); + pDoc.write("<tr>"); pDoc.write("<td align=\\"center\\"><input name=\\"newmsgchk\\" type=\\"checkbox\\"" +shwsel+"><\\/td>"); + pDoc.write("<td align=\\"center\\">$lt{'new'}<\\/td>"); pDoc.write("<td><textarea name=\\"newmsg\\" cols=\\"60\\" rows=\\"3\\" onchange=\\"javascript:this.form.newmsgchk.checked=true\\" >"+newmsg+"<\\/textarea><\\/td><\\/tr>"); } function msgTail() { pDoc = pWin.document; - pDoc.write("<\\/table>"); + //pDoc.write("<\\/table>"); pDoc.write("<\\/td><\\/tr><\\/table> "); pDoc.write("<input type=\\"button\\" value=\\"$lt{'save'}\\" onclick=\\"javascript:checkInput()\\"> "); pDoc.write("<input type=\\"button\\" value=\\"$lt{'canc'}\\" onclick=\\"self.close()\\"><br /><br />"); @@ -1699,7 +1702,7 @@ sub gradeBox { $wgt = ($wgt > 0 ? $wgt : '1'); my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ? '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt)); - my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n"; + my $data_WGT='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n"; my $display_part= &get_display_part($partid,$symb); my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, [$partid]); @@ -1707,7 +1710,7 @@ sub gradeBox { if ($last_resets{$partid}) { $aggtries = &get_num_tries($record,$last_resets{$partid},$partid); } - $result.=&Apache::loncommon::start_data_table_row(); + my $result=&Apache::loncommon::start_data_table_row(); my $ctr = 0; my $thisweight = 0; my $increment = &get_increment(); @@ -1744,8 +1747,9 @@ sub gradeBox { $result .= - '<td>'.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>'; + '<td>'.$data_WGT.$display_part.'</td><td>'.$radio.'</td><td>'.&mt('or').'</td><td>'.$line.'</td>'; $result.=&Apache::loncommon::end_data_table_row(); + $result.=&Apache::loncommon::start_data_table_row().'<td colspan="6">'; $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n". '<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n". '<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'. @@ -1756,6 +1760,7 @@ sub gradeBox { $aggtries.'" />'."\n"; my $res_error; $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record,\$res_error); + $result.='</td>'.&Apache::loncommon::end_data_table_row(); if ($res_error) { return &navmap_errormsg(); } @@ -1829,14 +1834,27 @@ sub show_problem { $companswer=~s|</form>||g; $companswer=~s|name="submit"|name="would_have_been_submit"|g; } + my $renderheading = &mt('View of the problem'); + my $answerheading = &mt('Correct answer'); + if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { + my $stu_fullname = $env{'form.fullname'}; + if ($stu_fullname eq '') { + $stu_fullname = &Apache::loncommon::plainname($uname,$udom,'lastname'); + } + my $forwhom = &nameUserString(undef,$stu_fullname,$uname,$udom); + if ($forwhom ne '') { + $renderheading = &mt('View of the problem for[_1]',$forwhom); + $answerheading = &mt('Correct answer for[_1]',$forwhom); + } + } $rendered= '<div class="LC_Box">' - .'<h3 class="LC_hcell">'.&mt('View of the problem').'</h3>' + .'<h3 class="LC_hcell">'.$renderheading.'</h3>' .$rendered .'</div>'; $companswer= '<div class="LC_Box">' - .'<h3 class="LC_hcell">'.&mt('Correct answer').'</h3>' + .'<h3 class="LC_hcell">'.$answerheading.'</h3>' .$companswer .'</div>'; my $result; @@ -1938,7 +1956,6 @@ sub submission { '" src="'.$request->dir_config('lonIconsURL'). '/check.gif" height="16" border="0" />'; - my %old_essays; # header info if ($counter == 0) { &sub_page_js($request); @@ -1959,7 +1976,7 @@ sub submission { $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); } - # kwclr is the only variable that is guaranteed to be non blank + # kwclr is the only variable that is guaranteed not to be blank # if this subroutine has been called once. my %keyhash = (); # if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') { @@ -2036,7 +2053,7 @@ sub submission { <br /><b>$lt{'keyw'}:</b> <a href="javascript:keywords(document.SCORE);" target="_self">$lt{'list'}</a> <a href="#" onmousedown="javascript:getSel(); return false" - CLASS="page">$lt{'past'}</a> + class="page">$lt{'past'}</a> <a href="javascript:kwhighlight();" target="_self">$lt{'high'}</a><br /><br /> KEYWORDS # @@ -2046,7 +2063,7 @@ KEYWORDS my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); $apath=&escape($apath); $apath=~s/\W/\_/gs; - %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); + &init_old_essays($symb,$apath,$adom,$aname); } } @@ -2122,137 +2139,146 @@ KEYWORDS $result.=$sub_result; } $request->print($result."\n"); - + # print student answer/submission # Options are (1) Handgraded submission only # (2) Last submission, includes submission that is not handgraded # (for multi-response type part) # (3) Last submission plus the parts info # (4) The whole record for this student - if ($env{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { - my ($string,$timestamp)= &get_last_submission(\%record); + + my ($string,$timestamp)= &get_last_submission(\%record); - my $lastsubonly; + my $lastsubonly; - if ($$timestamp eq '') { - $lastsubonly.='<div class="LC_grade_submissions_body">'.$$string[0].'</div>'; - } else { - $lastsubonly = - '<div class="LC_grade_submissions_body">' - .'<b>'.&mt('Date Submitted:').'</b> '.$$timestamp."\n"; - - my %seenparts; - my @part_response_id = &flatten_responseType($responseType); - foreach my $part (@part_response_id) { - next if ($env{'form.lastSub'} eq 'hdgrade' + if ($$timestamp eq '') { + $lastsubonly.='<div class="LC_grade_submissions_body">'.$$string[0].'</div>'; + } else { + $lastsubonly = + '<div class="LC_grade_submissions_body">' + .'<b>'.&mt('Date Submitted:').'</b> '.$$timestamp."\n"; + + my %seenparts; + my @part_response_id = &flatten_responseType($responseType); + foreach my $part (@part_response_id) { + next if ($env{'form.lastSub'} eq 'hdgrade' && $$handgrade{$$part[0].'_'.$$part[1]} ne 'yes'); - my ($partid,$respid) = @{ $part }; - my $display_part=&get_display_part($partid,$symb); - if ($env{"form.$uname:$udom:$partid:submitted_by"}) { - if (exists($seenparts{$partid})) { next; } - $seenparts{$partid}=1; - my $submitby='<b>Part:</b> '.$display_part. - ' <b>Collaborative submission by:</b> '. - '<a href="javascript:viewSubmitter(\''. - $env{"form.$uname:$udom:$partid:submitted_by"}. - '\');" target="_self">'. - $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a><br />'; - $request->print($submitby); - next; - } - my $responsetype = $responseType->{$partid}->{$respid}; - if (!exists($record{"resource.$partid.$respid.submission"})) { - $lastsubonly.="\n".'<div class="LC_grade_submission_part">'. - '<b>'.&mt('Part: [_1]',$display_part).'</b>'. - ' <span class="LC_internal_info">'. - '('.&mt('Response ID: [_1]',$respid).')'. - '</span> '. - '<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br /><br /></div>'; - next; - } - foreach my $submission (@$string) { - my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); - if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; } - my ($ressub,$hide,$subval) = split(/:/,$submission,3); - # Similarity check - my $similar=''; - my ($type,$trial,$rndseed); - if ($hide eq 'rand') { - $type = 'randomizetry'; - $trial = $record{"resource.$partid.tries"}; - $rndseed = $record{"resource.$partid.rndseed"}; - } - if($env{'form.checkPlag'}){ - my ($oname,$odom,$ocrsid,$oessay,$osim)= - &most_similar($uname,$udom,$subval,\%old_essays); - if ($osim) { - $osim=int($osim*100.0); - my %old_course_desc = - &Apache::lonnet::coursedescription($ocrsid, - {'one_time' => 1}); - - if ($hide eq 'anon') { - $similar='<hr /><span class="LC_warning">'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'<br />'. - &mt('As the current submission is for an anonymous survey, no other details are available.').'</span><hr />'; - } else { - $similar="<hr /><h3><span class=\"LC_warning\">". - &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])', - $osim, - &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')', + my ($partid,$respid) = @{ $part }; + my $display_part=&get_display_part($partid,$symb); + if ($env{"form.$uname:$udom:$partid:submitted_by"}) { + if (exists($seenparts{$partid})) { next; } + $seenparts{$partid}=1; + $request->print( + '<b>'.&mt('Part: [_1]',$display_part).'</b>'. + ' <b>'.&mt('Collaborative submission by: [_1]', + '<a href="javascript:viewSubmitter(\''. + $env{"form.$uname:$udom:$partid:submitted_by"}. + '\');" target="_self">'. + $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'</a>'). + '<br />'); + next; + } + my $responsetype = $responseType->{$partid}->{$respid}; + if (!exists($record{"resource.$partid.$respid.submission"})) { + $lastsubonly.="\n".'<div class="LC_grade_submission_part">'. + '<b>'.&mt('Part: [_1]',$display_part).'</b>'. + ' <span class="LC_internal_info">'. + '('.&mt('Response ID: [_1]',$respid).')'. + '</span> '. + '<span class="LC_warning">'.&mt('Nothing submitted - no attempts.').'</span><br /><br /></div>'; + next; + } + foreach my $submission (@$string) { + my ($partid,$respid) = ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); + if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; } + my ($ressub,$hide,$subval) = split(/:/,$submission,3); + # Similarity check + my $similar=''; + my ($type,$trial,$rndseed); + if ($hide eq 'rand') { + $type = 'randomizetry'; + $trial = $record{"resource.$partid.tries"}; + $rndseed = $record{"resource.$partid.rndseed"}; + } + if ($env{'form.checkPlag'}) { + my ($oname,$odom,$ocrsid,$oessay,$osim)= + &most_similar($uname,$udom,$symb,$subval); + if ($osim) { + $osim=int($osim*100.0); + my %old_course_desc = + &Apache::lonnet::coursedescription($ocrsid, + {'one_time' => 1}); + + if ($hide eq 'anon') { + $similar='<hr /><span class="LC_warning">'.&mt("Essay was found to be similar to another essay submitted for this assignment.").'<br />'. + &mt('As the current submission is for an anonymous survey, no other details are available.').'</span><hr />'; + } else { + $similar="<hr /><h3><span class=\"LC_warning\">". + &mt('Essay is [_1]% similar to an essay by [_2] in course [_3] (course id [_4]:[_5])', + $osim, + &Apache::loncommon::plainname($oname,$odom).' ('.$oname.':'.$odom.')', $old_course_desc{'description'}, $old_course_desc{'num'}, $old_course_desc{'domain'}). '</span></h3><blockquote><i>'. &keywords_highlight($oessay). '</i></blockquote><hr />'; - } - } - } - my $order=&get_order($partid,$respid,$symb,$uname,$udom, - undef,$type,$trial,$rndseed); - if ($env{'form.lastSub'} eq 'lastonly' || - ($env{'form.lastSub'} eq 'hdgrade' && + } + } + } + my $order=&get_order($partid,$respid,$symb,$uname,$udom, + undef,$type,$trial,$rndseed); + if ($env{'form.lastSub'} eq 'lastonly' || $env{'form.lastSub'} eq 'datesub' || $env{'form.lastSub'} =~ /^(last|all)$/ || ($env{'form.lastSub'} eq 'hdgrade' && $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) { - my $display_part=&get_display_part($partid,$symb); - $lastsubonly.='<div class="LC_grade_submission_part">'. - '<b>'.&mt('Part: [_1]',$display_part).'</b>'. - ' <span class="LC_internal_info">'. - '('.&mt('Response ID: [_1]',$respid).')'. - '</span> '; - my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record); - if (@$files) { - if ($hide eq 'anon') { - $lastsubonly.='<br />'.&mt('[quant,_1,file] uploaded to this anonymous survey',scalar(@{$files})); - } else { - $lastsubonly.='<br /><span class="LC_warning">'.&mt('Like all files provided by users, this file may contain viruses').'</span><br />'; - foreach my $file (@$files) { - &Apache::lonnet::allowuploaded('/adm/grades',$file); - $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0" /> '.$file.'</a>'; - } - } - $lastsubonly.='<br />'; - } + my $display_part=&get_display_part($partid,$symb); + $lastsubonly.='<div class="LC_grade_submission_part">'. + '<b>'.&mt('Part: [_1]',$display_part).'</b>'. + ' <span class="LC_internal_info">'. + '('.&mt('Response ID: [_1]',$respid).')'. + '</span> '; + my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record); + + if (@$files) { if ($hide eq 'anon') { - $lastsubonly.='<b>'.&mt('Anonymous Survey').'</b>'; + $lastsubonly.='<br />'.&mt('[quant,_1,file] uploaded to this anonymous survey',scalar(@{$files})); } else { - $lastsubonly.='<b>'.&mt('Submitted Answer:').' </b>'. - &cleanRecord($subval,$responsetype,$symb,$partid, - $respid,\%record,$order,undef,$uname,$udom,$type,$trial,$rndseed); + $lastsubonly.='<br /><br />'.'<b>'.&mt('Submitted Files:').'</b>' + .'<br /><span class="LC_warning">'; + if(@$files == 1) { + $lastsubonly .= &mt('Like all files provided by users, this file may contain viruses!'); + } else { + $lastsubonly .= &mt('Like all files provided by users, these files may contain viruses!'); + } + $lastsubonly .= '</span>'; + foreach my $file (@$files) { + &Apache::lonnet::allowuploaded('/adm/grades',$file); + $lastsubonly.='<br /><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0" alt="" /> '.$file.'</a>'; + } } - if ($similar) {$lastsubonly.="<br /><br />$similar\n";} - $lastsubonly.='</div>'; - } + $lastsubonly.='<br />'; + } + if ($hide eq 'anon') { + $lastsubonly.='<br /><b>'.&mt('Anonymous Survey').'</b>'; + } else { + $lastsubonly.='<br /><b>'.&mt('Submitted Answer:').' </b>'. + &cleanRecord($subval,$responsetype,$symb,$partid, + $respid,\%record,$order,undef,$uname,$udom,$type,$trial,$rndseed); + } + if ($similar) {$lastsubonly.="<br /><br />$similar\n";} + $lastsubonly.='</div>'; } - } - $lastsubonly.='</div>'."\n"; # End: LC_grade_submissions_body + } } - $request->print($lastsubonly); - } elsif ($env{'form.lastSub'} eq 'datesub') { + $lastsubonly.='</div>'."\n"; # End: LC_grade_submissions_body + } + $request->print($lastsubonly); + if ($env{'form.lastSub'} eq 'datesub') { my ($parts,$handgrade,$responseType) = &response_type($symb,\$res_error); $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); - } elsif ($env{'form.lastSub'} =~ /^(last|all)$/) { - $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, + } + if ($env{'form.lastSub'} =~ /^(last|all)$/) { + $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, $env{'request.course.id'}, $last,'.submission', 'Apache::grades::keywords_highlight')); @@ -2285,10 +2311,10 @@ KEYWORDS '<input type="hidden" name="newmsg'.$counter.'" value="" />'."\n"; $result.=' <a href="javascript:msgCenter(document.SCORE,'.$counter. ',\''.$msgfor.'\');" target="_self">'. - &mt('Compose message to student').(scalar(@$col_fullnames) >= 1 ? 's' : '').'</a><label> ('. + &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'). - '/mailbkgrd.gif" width="14" height="10" name="mailicon'.$counter.'" />'."\n". + ' <img src="'.$request->dir_config('lonIconsURL'). + '/mailbkgrd.gif" width="14" height="10" alt="" name="mailicon'.$counter.'" />'."\n". '<br /> ('. &mt('Message will be sent when you click on Save & Next below.').")\n"; $result.='</div></div>'; @@ -2508,6 +2534,183 @@ sub keywords_highlight { return $string; } +# For Tasks provide a mechanism to display previous version for one specific student + +sub show_previous_task_version { + my ($request,$symb) = @_; + if ($symb eq '') { + $request->print("Unable to handle ambiguous references."); + + return ''; + } + my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'}); + my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'}); + if (!&canview($usec)) { + $request->print('<span class="LC_warning">Unable to view previous version for requested student.('. + $uname.':'.$udom.' in section '.$usec.' in course id '. + $env{'request.course.id'}.')</span>'); + return; + } + my $mode = 'both'; + my $isTask = ($symb =~/\.task$/); + if ($isTask) { + if ($env{'form.previousversion'} =~ /^\d+$/) { + if ($env{'form.fullname'} eq '') { + $env{'form.fullname'} = + &Apache::loncommon::plainname($uname,$udom,'lastname'); + } + my $probtitle=&Apache::lonnet::gettitle($symb); + $request->print("\n\n". + '<div class="LC_grade_show_user">'. + '<h2>'.&nameUserString(undef,$env{'form.fullname'},$uname,$udom). + '</h2>'."\n"); + &Apache::lonxml::clear_problem_counter(); + $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode, + {'previousversion' => $env{'form.previousversion'} })); + $request->print("\n</div>"); + } + } + return; +} + +sub choose_task_version_form { + my ($symb,$uname,$udom,$nomenu) = @_; + my $isTask = ($symb =~/\.task$/); + my ($current,$version,$result,$js,$displayed,$rowtitle); + if ($isTask) { + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'}, + $udom,$uname); + if (($record{'resource.0.version'} eq '') || + ($record{'resource.0.version'} < 2)) { + return ($record{'resource.0.version'}, + $record{'resource.0.version'},$result,$js); + } else { + $current = $record{'resource.0.version'}; + } + if ($env{'form.previousversion'}) { + $displayed = $env{'form.previousversion'}; + $rowtitle = &mt('Choose another version:') + } else { + $displayed = $current; + $rowtitle = &mt('Show earlier version:'); + } + $result = '<div class="LC_left_float">'; + my $list; + my $numversions = 0; + for (my $i=1; $i<=$record{'resource.0.version'}; $i++) { + if ($i == $current) { + if (!$env{'form.previousversion'} || $nomenu) { + next; + } else { + $list .= '<option value="'.$i.'">'.&mt('Current').'</option>'."\n"; + $numversions ++; + } + } elsif (defined($record{'resource.'.$i.'.0.status'})) { + unless ($i == $env{'form.previousversion'}) { + $numversions ++; + } + $list .= '<option value="'.$i.'">'.$i.'</option>'."\n"; + } + } + if ($numversions) { + $symb = &HTML::Entities::encode($symb,'<>"&'); + $result .= + '<form name="getprev" method="post" action=""'. + ' onsubmit="return previousVersion('."'$uname','$udom','$symb','$displayed'".');">'. + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_row(). + '<th align="left">'.$rowtitle.'</th>'. + '<td><select name="version">'. + '<option>'.&mt('Select').'</option>'. + $list. + '</select></td>'. + &Apache::loncommon::end_data_table_row(); + unless ($nomenu) { + $result .= &Apache::loncommon::start_data_table_row(). + '<th align="left">'.&mt('Open in new window').'</th>'. + '<td><span class="LC_nobreak">'. + '<label><input type="radio" name="prevwin" value="1" />'. + &mt('Yes').'</label>'. + '<label><input type="radio" name="prevwin" value="0" checked="checked" />'.&mt('No').'</label>'. + '</span></td>'. + &Apache::loncommon::end_data_table_row(); + } + $result .= + &Apache::loncommon::start_data_table_row(). + '<th align="left"> </th>'. + '<td>'. + '<input type="submit" name="prevsub" value="'.&mt('Display').'" />'. + '</td>'. + &Apache::loncommon::end_data_table_row(). + &Apache::loncommon::end_data_table(). + '</form>'; + $js = &previous_display_javascript($nomenu,$current); + } elsif ($displayed && $nomenu) { + $result .= '<a href="javascript:window.close()">'.&mt('Close window').'</a>'; + } else { + $result .= &mt('No previous versions to show for this student'); + } + $result .= '</div>'; + } + return ($current,$displayed,$result,$js); +} + +sub previous_display_javascript { + my ($nomenu,$current) = @_; + my $js = <<"JSONE"; +<script type="text/javascript"> +// <![CDATA[ +function previousVersion(uname,udom,symb) { + var current = '$current'; + var version = document.getprev.version.options[document.getprev.version.selectedIndex].value; + var prevstr = new RegExp("^\\\\d+\$"); + if (!prevstr.test(version)) { + return false; + } + var url = ''; + if (version == current) { + url = '/adm/grades?student='+uname+'&userdom='+udom+'&symb='+symb+'&command=submission'; + } else { + url = '/adm/grades?student='+uname+'&userdom='+udom+'&symb='+symb+'&command=versionsub&previousversion='+version; + } +JSONE + if ($nomenu) { + $js .= <<"JSTWO"; + document.location.href = url; +JSTWO + } else { + $js .= <<"JSTHREE"; + var newwin = 0; + for (var i=0; i<document.getprev.prevwin.length; i++) { + if (document.getprev.prevwin[i].checked == true) { + newwin = document.getprev.prevwin[i].value; + } + } + if (newwin == 1) { + var options = 'height=600,width=800,resizable=yes,scrollbars=yes,location=no,menubar=no,toolbar=no'; + url = url+'&inhibitmenu=yes'; + if (typeof(previousWin) == 'undefined' || previousWin.closed) { + previousWin = window.open(url,'',options,1); + } else { + previousWin.location.href = url; + } + previousWin.focus(); + return false; + } else { + document.location.href = url; + return false; + } +JSTHREE + } + $js .= <<"ENDJS"; + return false; +} +// ]]> +</script> +ENDJS + +} + #--- Called from submission routine sub processHandGrade { my ($request,$symb) = @_; @@ -2909,7 +3112,7 @@ sub handback_files { &Apache::lonnet::dirlist($portfolio_root.$portfolio_path, $domain,$stuname,$getpropath); my $version = &get_next_version($answer_name,$answer_ext,$dir_list); - # fix file name + # fix filename my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, $newflg.'_'.$part_resp.'_returndoc'.$counter, @@ -2928,7 +3131,7 @@ sub handback_files { $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name; $file_msg.= '<span class="LC_filename"><a href="/uploaded/'."$domain/$stuname/".$save_file_name.'">'.$save_file_name."</a></span> <br />"; } - $request->print('<br />'.&mt('[_1] will be the uploaded file name [_2]','<span class="LC_info">'.$fname.'</span>','<span class="LC_filename">'.$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter}.'</span>')); + $request->print('<br />'.&mt('[_1] will be the uploaded filename [_2]','<span class="LC_info">'.$fname.'</span>','<span class="LC_filename">'.$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter}.'</span>')); } } } @@ -3392,9 +3595,10 @@ sub viewgrades { $partid.'" size="4" '.'onchange="javascript:writePoint(\''. $partid.'\','.$weight{$partid}.',\'textval\')" /> /'. $weight{$partid}.' '.&mt('(problem weight)').'</td>'."\n"; - $line.= '<td><b>'.&mt('Grade Status').':</b><select name="SELVAL_'.$partid.'"'. - 'onchange="javascript:writeRadText(\''.$partid.'\','. - $weight{$partid}.')"> '. + $line.= '<td><b>'.&mt('Grade Status').':</b>'. + '<select name="SELVAL_'.$partid.'" '. + 'onchange="javascript:writeRadText(\''.$partid.'\','. + $weight{$partid}.')"> '. '<option selected="selected"> </option>'. '<option value="excused">'.&mt('excused').'</option>'. '<option value="reset status">'.&mt('reset status').'</option>'. @@ -3443,8 +3647,8 @@ sub viewgrades { my $display_part=&get_display_part($partid,$symb); if ($display =~ /^Partial Credit Factor/) { $result.='<th>'. - &mt('Score Part: [_1]<br /> (weight = [_2])', - $display_part,$weight{$partid}).'</th>'."\n"; + &mt('Score Part: [_1][_2](weight = [_3])', + $display_part,'<br />',$weight{$partid}).'</th>'."\n"; next; } else { @@ -3939,11 +4143,12 @@ sub csvupload_fields { sub csvuploadmap_footer { my ($request,$i,$keyfields) =@_; + my $buttontext = &mt('Assign Grades'); $request->print(<<ENDPICK); </table> <input type="hidden" name="nfields" value="$i" /> <input type="hidden" name="keyfields" value="$keyfields" /> -<input type="button" onclick="javascript:verify(this.form)" value="Assign Grades" /><br /> +<input type="button" onclick="javascript:verify(this.form)" value="$buttontext" /><br /> </form> ENDPICK } @@ -4064,7 +4269,7 @@ ENDPICK } # FIXME do a check for any duplicated user ids... # FIXME do a check for any invalid user ids?... - $request->print('<input type="submit" value="Assign Grades" /><br /> + $request->print('<input type="submit" value="'.&mt('Assign Grades').'" /><br /> <hr /></form>'."\n"); return ''; } @@ -4252,48 +4457,68 @@ LISTJAVASCRIPT my ($curpage) =&Apache::lonnet::decode_symb($symb); # my ($curpage,$mapId) =&Apache::lonnet::decode_symb($symb); # my $type=($curpage =~ /\.(page|sequence)/); - my $select = '<select name="selectpage">'."\n"; + + # Collection of hidden fields my $ctr=0; foreach (@$titles) { - my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); - $select.='<option value="'.$ctr.'" '. - ($$symbx{$_} =~ /$curpage$/ ? 'selected="selected"' : ''). - '>'.$showtitle.'</option>'."\n"; - $ctr++; + my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); + $result.='<input type="hidden" name="page'.$ctr.'" value="'.$$symbx{$_}.'" />'."\n"; + $result.='<input type="hidden" name="title'.$ctr.'" value="'.$showtitle.'" />'."\n"; + $ctr++; } - $select.= '</select>'; - $result.=' <b>'.&mt('Problems from').':</b> '.$select."<br />\n"; + $result.='<input type="hidden" name="page" />'."\n". + '<input type="hidden" name="title" />'."\n"; + + $result.=&build_section_inputs(); + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + $result.='<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". + '<input type="hidden" name="command" value="displayPage" />'."\n". + '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."\n"; + # Show grading options + $result.=&Apache::lonhtmlcommon::start_pick_box(); + my $select = '<select name="selectpage">'."\n"; $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); - $result.='<input type="hidden" name="page'.$ctr.'" value="'.$$symbx{$_}.'" />'."\n"; - $result.='<input type="hidden" name="title'.$ctr.'" value="'.$showtitle.'" />'."\n"; + $select.='<option value="'.$ctr.'"'. + ($$symbx{$_} =~ /$curpage$/ ? ' selected="selected"' : ''). + '>'.$showtitle.'</option>'."\n"; $ctr++; } - $result.='<input type="hidden" name="page" />'."\n". - '<input type="hidden" name="title" />'."\n"; + $select.= '</select>'; - my $options = - '<label><input type="radio" name="vProb" value="no" checked="checked" /> '.&mt('no').' </label>'."\n". - '<label><input type="radio" name="vProb" value="yes" /> '.&mt('yes').' </label>'."<br />\n"; - $result.=' <b>'.&mt('View Problem Text').': </b>'.$options; - - $options = - '<label><input type="radio" name="lastSub" value="none" /> '.&mt('none').' </label>'."\n". - '<label><input type="radio" name="lastSub" value="datesub" checked="checked" /> '.&mt('by dates and submissions').'</label>'."\n". - '<label><input type="radio" name="lastSub" value="all" /> '.&mt('all details').' </label>'."\n"; - $result.=' <b>'.&mt('Submissions').': </b>'.$options; + $result.= + &Apache::lonhtmlcommon::row_title(&mt('Problems from')) + .$select + .&Apache::lonhtmlcommon::row_closure(); + + $result.= + &Apache::lonhtmlcommon::row_title(&mt('View Problem Text')) + .'<label><input type="radio" name="vProb" value="no"' + .' checked="checked" /> '.&mt('no').' </label>'."\n" + .'<label><input type="radio" name="vProb" value="yes" />' + .&mt('yes').'</label>'."\n" + .&Apache::lonhtmlcommon::row_closure(); + + $result.= + &Apache::lonhtmlcommon::row_title(&mt('View Submissions')) + .'<label><input type="radio" name="lastSub" value="none" /> ' + .&mt('none').' </label>'."\n" + .'<label><input type="radio" name="lastSub" value="datesub"' + .' checked="checked" /> '.&mt('all submissions').'</label>'."\n" + .'<label><input type="radio" name="lastSub" value="all" /> ' + .&mt('all submissions with details').' </label>' + .&Apache::lonhtmlcommon::row_closure(); - $result.=&build_section_inputs(); - my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); - $result.='<input type="hidden" name="Status" value="'.$stu_status.'" />'."\n". - '<input type="hidden" name="command" value="displayPage" />'."\n". - '<input type="hidden" name="symb" value="'.&Apache::lonenc::check_encrypt($symb).'" />'."<br />\n"; + $result.= + &Apache::lonhtmlcommon::row_title(&mt('Use CODE')) + .'<input type="text" name="CODE" value="" />' + .&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box(); - $result.=' <b>'.&mt('Use CODE').': </b> <input type="text" name="CODE" value="" /> <br />'."\n"; - - $result.=' <input type="button" '. + # Show list of students to select for grading + $result.='<br /><input type="button" '. 'onclick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" /><br />'."\n"; $request->print($result); @@ -4438,7 +4663,7 @@ sub displayPage { '</span>'."\n". &Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(). - '<th align="center"> Prob. </th>'. + '<th>'.&mt('Prob.').'</th>'. '<th> '.($env{'form.vProb'} eq 'no' ? &mt('Title') : &mt('Problem Text')).'/'.&mt('Grade').'</th>'. &Apache::loncommon::end_data_table_header_row(); @@ -4458,8 +4683,8 @@ sub displayPage { &Apache::loncommon::start_data_table_row(). '<td align="center" valign="top" >'.$prob. (scalar(@{$parts}) == 1 ? '' - : '<br />('.&mt('[_1]parts)', - scalar(@{$parts}).' ') + : '<br />('.&mt('[_1]parts', + scalar(@{$parts}).' ').')' ). '</td>'; $studentTable.='<td valign="top">'; @@ -4540,6 +4765,7 @@ sub displaySubByDates { &Apache::loncommon::start_data_table_header_row(). '<th>'.&mt('Date/Time').'</th>'. ($isCODE?'<th>'.&mt('CODE').'</th>':''). + ($isTask?'<th>'.&mt('Version').'</th>':''). '<th>'.&mt('Submission').'</th>'. '<th>'.&mt('Status').'</th>'. &Apache::loncommon::end_data_table_header_row(); @@ -4560,7 +4786,9 @@ sub displaySubByDates { if (exists($$record{$version.':resource.0.version'})) { $interaction = $$record{$version.':resource.0.version'}; } - + if ($isTask && $env{'form.previousversion'}) { + next unless ($interaction == $env{'form.previousversion'}); + } my $where = ($isTask ? "$version:resource.$interaction" : "$version:resource"); $studentTable.=&Apache::loncommon::start_data_table_row(). @@ -4568,6 +4796,9 @@ sub displaySubByDates { if ($isCODE) { $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>'; } + if ($isTask) { + $studentTable.='<td>'.$interaction.'</td>'; + } my @versionKeys = split(/\:/,$$record{$version.':keys'}); my @displaySub = (); foreach my $partid (@{$parts}) { @@ -4587,7 +4818,7 @@ sub displaySubByDates { my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); - $displaySub[0].='<span class="LC_nobreak"'; + $displaySub[0].='<span class="LC_nobreak">'; $displaySub[0].='<b>'.&mt('Part: [_1]',$display_part).'</b>' .' <span class="LC_internal_info">' .'('.&mt('Response ID: [_1]',$responseId).')' @@ -4856,7 +5087,7 @@ like. Next each scanline is checked for any errors of either 'missing bubbles' (it's an error because it may have been mis-scanned because too light bubbling), 'double bubble' (each bubble line should -have no more that one letter picked), invalid or duplicated CODE, +have no more than one letter picked), invalid or duplicated CODE, invalid student/employee ID If the CODE option is used that determines the randomization of the @@ -4944,6 +5175,11 @@ my %subdivided_bubble_lines; # no. my %responsetype_per_response; # responsetype for each response +my %masterseq_id_responsenum; # src_id (e.g., 12.3_0.11 etc.) for each + # numbered response. Needed when randomorder + # or randompick are in use. Key is ID, value + # is response number. + # Save and restore the bubble lines array to the form env. @@ -4957,12 +5193,17 @@ sub save_bubble_lines { $env{"form.scantron.responsetype.$line"} = $responsetype_per_response{$line}; } + foreach my $resid (keys(%masterseq_id_responsenum)) { + my $line = $masterseq_id_responsenum{$resid}; + $env{"form.scantron.residpart.$line"} = $resid; + } } sub restore_bubble_lines { my $line = 0; %bubble_lines_per_response = (); + %masterseq_id_responsenum = (); while ($env{"form.scantron.bubblelines.$line"}) { my $value = $env{"form.scantron.bubblelines.$line"}; $bubble_lines_per_response{$line} = $value; @@ -4972,28 +5213,12 @@ sub restore_bubble_lines { $env{"form.scantron.sub_bubblelines.$line"}; $responsetype_per_response{$line} = $env{"form.scantron.responsetype.$line"}; + my $id = $env{"form.scantron.residpart.$line"}; + $masterseq_id_responsenum{$id} = $line; $line++; } } -# Given the parsed scanline, get the response for -# 'answer' number n: - -sub get_response_bubbles { - my ($parsed_line, $response) = @_; - - my $bubble_line = $first_bubble_line{$response-1} +1; - my $bubble_lines= $bubble_lines_per_response{$response-1}; - - my $selected = ""; - - for (my $bline = 0; $bline < $bubble_lines; $bline++) { - $selected .= $$parsed_line{"scantron.$bubble_line.answer"}.":"; - $bubble_line++; - } - return $selected; -} - =pod =item scantron_filenames @@ -5321,7 +5546,7 @@ sub scantron_selectphase { &Apache::lonpickcode::code_list($r,2); - $r->print('<br /><form method="post" name="checkscantron">'. + $r->print('<br /><form method="post" name="checkscantron" action="">'. $default_form_data."\n". &Apache::loncommon::start_data_table('LC_scantron_action')."\n". &Apache::loncommon::start_data_table_header_row()."\n". @@ -5412,6 +5637,7 @@ sub scantron_selectphase { LastNameLength - number of columns that the last name spans BubblesPerRow - number of bubbles available in each row used to bubble an answer. (If not specified, 10 assumed). + =cut sub get_scantron_config { @@ -5653,6 +5879,27 @@ sub digits_to_letters { (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. + randomorder - True if randomorder in use + randompick - True if randompick in use + sequence - Exam folder URL + master_seq - Ref to array containing symbs in exam folder + symb_to_resource - Ref to hash of symbs for resources in exam folder + (corresponding values are resource objects) + partids_by_symb - Ref to hash of symb -> array ref of partIDs + orderedforcode - Ref to hash of arrays. keys are CODEs and values + are refs to an array of resource objects, ordered + according to order used for CODE, when randomorder + and or randompick are in use. + respnumlookup - Ref to hash mapping question numbers in bubble lines + for current line to question number used for same question + in "Master Sequence" (as seen by Course Coordinator). + startline - Ref to hash where key is question number (0 is first) + and value is number of first bubble line for current + student or code-based randompick and/or randomorder. + totalref - Ref of scalar used to score total number of bubble + lines needed for responses in a scan line (used when + randompick in use. + Returns: Hash containing the result of parsing the scanline @@ -5697,12 +5944,12 @@ sub digits_to_letters { =cut sub scantron_parse_scanline { - my ($line,$whichline,$scantron_config,$scan_data,$just_header)=@_; + my ($line,$whichline,$scantron_config,$scan_data,$just_header,$idmap, + $randomorder,$randompick,$sequence,$master_seq,$symb_to_resource, + $partids_by_symb,$orderedforcode,$respnumlookup,$startline,$totalref)=@_; my %record; - my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'}; - my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos); # Answers - my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # earlier stuff + my $data=substr($line,0,$$scantron_config{'Qstart'}-1); # stuff before answers if (!($$scantron_config{'CODElocation'} eq 0 || $$scantron_config{'CODElocation'} eq 'none')) { if ($$scantron_config{'CODElocation'} < 0 || @@ -5738,10 +5985,29 @@ sub scantron_parse_scanline { my $questnum=0; my $ansnum =1; # Multiple 'answer lines'/question. + my $lastpos = $env{'form.scantron_maxbubble'}*$$scantron_config{'Qlength'}; + if ($randompick || $randomorder) { + my $total = &get_respnum_lookups($sequence,$scan_data,$idmap,$line,\%record, + $master_seq,$symb_to_resource, + $partids_by_symb,$orderedforcode, + $respnumlookup,$startline); + if ($total) { + $lastpos = $total*$$scantron_config{'Qlength'}; + } + if (ref($totalref)) { + $$totalref = $total; + } + } + my $questions=substr($line,$$scantron_config{'Qstart'}-1,$lastpos); # Answers chomp($questions); # Get rid of any trailing \n. $questions =~ s/\r$//; # Get rid of trailing \r too (MAC or Win uploads). while (length($questions)) { - my $answers_needed = $bubble_lines_per_response{$questnum}; + my $answers_needed; + if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { + $answers_needed = $bubble_lines_per_response{$respnumlookup->{$questnum}}; + } else { + $answers_needed = $bubble_lines_per_response{$questnum}; + } my $answer_length = ($$scantron_config{'Qlength'} * $answers_needed) || 1; $questnum++; @@ -5750,11 +6016,16 @@ sub scantron_parse_scanline { $questions = substr($questions,$answer_length); if (length($currentquest) < $answer_length) { next; } - if ($subdivided_bubble_lines{$questnum-1} =~ /,/) { + my $subdivided; + if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { + $subdivided = $subdivided_bubble_lines{$respnumlookup->{$questnum-1}}; + } else { + $subdivided = $subdivided_bubble_lines{$questnum-1}; + } + if ($subdivided =~ /,/) { my $subquestnum = 1; my $subquestions = $currentquest; - my @subanswers_needed = - split(/,/,$subdivided_bubble_lines{$questnum-1}); + my @subanswers_needed = split(/,/,$subdivided); foreach my $subans (@subanswers_needed) { my $subans_length = ($$scantron_config{'Qlength'} * $subans) || 1; @@ -5765,10 +6036,13 @@ sub scantron_parse_scanline { ($$scantron_config{'Qon'} eq 'number')) { $ansnum = &scantron_validator_lettnum($ansnum, $questnum,$quest_id,$subans,$currsubquest,$whichline, - \@alphabet,\%record,$scantron_config,$scan_data); + \@alphabet,\%record,$scantron_config,$scan_data, + $randomorder,$randompick,$respnumlookup); } else { $ansnum = &scantron_validator_positional($ansnum, - $questnum,$quest_id,$subans,$currsubquest,$whichline, \@alphabet,\%record,$scantron_config,$scan_data); + $questnum,$quest_id,$subans,$currsubquest,$whichline, + \@alphabet,\%record,$scantron_config,$scan_data, + $randomorder,$randompick,$respnumlookup); } $subquestnum ++; } @@ -5777,11 +6051,13 @@ sub scantron_parse_scanline { ($$scantron_config{'Qon'} eq 'number')) { $ansnum = &scantron_validator_lettnum($ansnum,$questnum, $quest_id,$answers_needed,$currentquest,$whichline, - \@alphabet,\%record,$scantron_config,$scan_data); + \@alphabet,\%record,$scantron_config,$scan_data, + $randomorder,$randompick,$respnumlookup); } else { $ansnum = &scantron_validator_positional($ansnum,$questnum, $quest_id,$answers_needed,$currentquest,$whichline, - \@alphabet,\%record,$scantron_config,$scan_data); + \@alphabet,\%record,$scantron_config,$scan_data, + $randomorder,$randompick,$respnumlookup); } } } @@ -5789,9 +6065,66 @@ sub scantron_parse_scanline { return \%record; } +sub get_master_seq { + my ($resources,$master_seq,$symb_to_resource) = @_; + return unless ((ref($resources) eq 'ARRAY') && (ref($master_seq) eq 'ARRAY') && + (ref($symb_to_resource) eq 'HASH')); + my $resource_error; + foreach my $resource (@{$resources}) { + my $ressymb; + if (ref($resource)) { + $ressymb = $resource->symb(); + push(@{$master_seq},$ressymb); + $symb_to_resource->{$ressymb} = $resource; + } else { + $resource_error = 1; + last; + } + } + return $resource_error; +} + +sub get_respnum_lookups { + my ($sequence,$scan_data,$idmap,$line,$record,$master_seq,$symb_to_resource, + $partids_by_symb,$orderedforcode,$respnumlookup,$startline) = @_; + return unless ((ref($record) eq 'HASH') && (ref($master_seq) eq 'ARRAY') && + (ref($symb_to_resource) eq 'HASH') && (ref($partids_by_symb) eq 'HASH') && + (ref($orderedforcode) eq 'HASH') && (ref($respnumlookup) eq 'HASH') && + (ref($startline) eq 'HASH')); + my ($user,$scancode); + if ((exists($record->{'scantron.CODE'})) && + (&Apache::lonnet::validCODE($record->{'scantron.CODE'}))) { + $scancode = $record->{'scantron.CODE'}; + } else { + $user = &scantron_find_student($record,$scan_data,$idmap,$line); + } + my @mapresources = + &users_order($user,$scancode,$sequence,$master_seq,$symb_to_resource, + $orderedforcode); + my $total = 0; + my $count = 0; + foreach my $resource (@mapresources) { + my $id = $resource->id(); + my $symb = $resource->symb(); + if (ref($partids_by_symb->{$symb}) eq 'ARRAY') { + foreach my $partid (@{$partids_by_symb->{$symb}}) { + my $respnum = $masterseq_id_responsenum{$id.'_'.$partid}; + if ($respnum ne '') { + $respnumlookup->{$count} = $respnum; + $startline->{$count} = $total; + $total += $bubble_lines_per_response{$respnum}; + $count ++; + } + } + } + } + return $total; +} + sub scantron_validator_lettnum { my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline, - $alphabet,$record,$scantron_config,$scan_data) = @_; + $alphabet,$record,$scantron_config,$scan_data,$randomorder, + $randompick,$respnumlookup) = @_; # Qon 'letter' implies for each slot in currquest we have: # ? or * for doubles, a letter in A-Z for a bubble, and @@ -5810,19 +6143,23 @@ sub scantron_validator_lettnum { $matchon = '\d'; } my $occurrences = 0; - if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || - ($responsetype_per_response{$questnum-1} eq 'formularesponse') || - ($responsetype_per_response{$questnum-1} eq 'stringresponse') || - ($responsetype_per_response{$questnum-1} eq 'imageresponse') || - ($responsetype_per_response{$questnum-1} eq 'reactionresponse') || - ($responsetype_per_response{$questnum-1} eq 'organicresponse')) { + my $responsenum = $questnum-1; + if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { + $responsenum = $respnumlookup->{$questnum-1} + } + if (($responsetype_per_response{$responsenum} eq 'essayresponse') || + ($responsetype_per_response{$responsenum} eq 'formularesponse') || + ($responsetype_per_response{$responsenum} eq 'stringresponse') || + ($responsetype_per_response{$responsenum} eq 'imageresponse') || + ($responsetype_per_response{$responsenum} eq 'reactionresponse') || + ($responsetype_per_response{$responsenum} eq 'organicresponse')) { my @singlelines = split('',$currquest); foreach my $entry (@singlelines) { $occurrences = &occurence_count($entry,$matchon); if ($occurrences > 1) { last; } - } + } } else { $occurrences = &occurence_count($currquest,$matchon); } @@ -5870,7 +6207,8 @@ sub scantron_validator_lettnum { sub scantron_validator_positional { my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest, - $whichline,$alphabet,$record,$scantron_config,$scan_data) = @_; + $whichline,$alphabet,$record,$scantron_config,$scan_data, + $randomorder,$randompick,$respnumlookup) = @_; # Otherwise there's a positional notation; # each bubble line requires Qlength items, and there are filled in @@ -5912,12 +6250,16 @@ sub scantron_validator_positional { # record all the bubbles filled in as well as the # fact this response consists of multiple bubbles. # - if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || - ($responsetype_per_response{$questnum-1} eq 'formularesponse') || - ($responsetype_per_response{$questnum-1} eq 'stringresponse') || - ($responsetype_per_response{$questnum-1} eq 'imageresponse') || - ($responsetype_per_response{$questnum-1} eq 'reactionresponse') || - ($responsetype_per_response{$questnum-1} eq 'organicresponse')) { + my $responsenum = $questnum-1; + if (($randompick || $randomorder) && (ref($respnumlookup) eq 'HASH')) { + $responsenum = $respnumlookup->{$questnum-1} + } + if (($responsetype_per_response{$responsenum} eq 'essayresponse') || + ($responsetype_per_response{$responsenum} eq 'formularesponse') || + ($responsetype_per_response{$responsenum} eq 'stringresponse') || + ($responsetype_per_response{$responsenum} eq 'imageresponse') || + ($responsetype_per_response{$responsenum} eq 'reactionresponse') || + ($responsetype_per_response{$responsenum} eq 'organicresponse')) { my $doubleerror = 0; while (($currquest >= $$scantron_config{'Qlength'}) && (!$doubleerror)) { @@ -6099,7 +6441,11 @@ sub scantron_process_corrections { } } if ($err) { - $r->print("<span class=\"LC_warning\">Unable to accept last correction, an error occurred :$errmsg:</span>"); + $r->print( + '<p class="LC_error">' + .&mt('Unable to accept last correction, an error occurred: [_1]', + $errmsg) + .'</p>'); } else { &scantron_put_line($scanlines,$scan_data,$which,$line,$skip); &scantron_putfile($scanlines,$scan_data); @@ -6242,7 +6588,7 @@ sub scantron_warning_screen { <tr><td><b>'.&mt('Data File that will be used:').'</b></td><td><tt>'.$env{'form.scantron_selectfile'}.'</tt></td></tr> '.$CODElist.$lastbubblepoints.' </table> -<p> '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).'<br /> +<p> '.&mt("If this information is correct, please click on '[_1]'.",&mt($button_text)).'<br /> '.&mt('If something is incorrect, please return to [_1]Grade/Manage/Review Bubblesheets[_2] to start over.','<a href="/adm/grades?symb='.$symb.'&command=scantron_selectphase" class="LC_info">','</a>').'</p> <br /> @@ -6322,9 +6668,11 @@ SCANTRONFORM '<input type="hidden" name="scantron.sub_bubblelines.'.$line.'" value="'.$env{"form.scantron.sub_bubblelines.$line"}.'" />'."\n"; $chunk .= '<input type="hidden" name="scantron.responsetype.'.$line.'" value="'.$env{"form.scantron.responsetype.$line"}.'" />'."\n"; + $chunk .= + '<input type="hidden" name="scantron.residpart.'.$line.'" value="'.$env{"form.scantron.residpart.$line"}.'" />'."\n"; $result .= $chunk; $line++; - } + } return $result; } @@ -6345,7 +6693,7 @@ sub scantron_validate_file { if (!$symb) {return '';} my $default_form_data=&defaultFormData($symb); - # do the detection of only doing skipped records first befroe we delete + # do the detection of only doing skipped records first before we delete # them when doing the corrections reset if ($env{'form.scantron_options_redo'} ne 'redo_skipped_ready') { &reset_skipping_status(); @@ -6396,6 +6744,7 @@ sub scantron_validate_file { while (!$stop && $currentphase < scalar(@validate_phases)) { $r->print(&mt('Validating '.$validate_phases[$currentphase]).'<br />'); $r->rflush(); + my $which="scantron_validate_".$validate_phases[$currentphase]; { no strict 'refs'; @@ -6804,7 +7153,13 @@ sub scantron_validate_sequence { my @resources= $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); if (@resources) { - $r->print("<p>".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."</p>"); + $r->print( + '<p class="LC_warning">' + .&mt('Some resources in the sequence currently are not set to' + .' bubblesheet exam mode. Grading these resources currently may not' + .' work correctly.') + .'</p>' + ); return (1,$currentphase); } } @@ -6885,7 +7240,8 @@ sub scantron_validate_ID { sub scantron_get_correction { - my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; + my ($r,$i,$scan_record,$scan_config,$line,$error,$arg, + $randomorder,$randompick,$respnumlookup,$startline)=@_; #FIXME in the case of a duplicated ID the previous line, probably need #to show both the current line and the previous one and allow skipping #the previous one or the current one @@ -6935,7 +7291,7 @@ sub scantron_get_correction { $r->print(&Apache::loncommon::selectstudent_link('scantronupload', 'scantron_username','scantron_domain')); $r->print(": <input type='text' name='scantron_username' value='' />"); - $r->print("\n@". + $r->print("\n:\n". &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain')); $r->print('</li>'); @@ -7019,7 +7375,8 @@ ENDSCRIPT # The form field scantron_questions is acutally a list of line numbers. # represented by this form so: - my $line_list = &questions_to_line_list($arg); + my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, + $respnumlookup,$startline); $r->print('<input type="hidden" name="scantron_questions" value="'. $line_list.'" />'); @@ -7027,7 +7384,9 @@ ENDSCRIPT $r->print("<p>".&mt("Please indicate which bubble should be used for grading")."</p>"); foreach my $question (@{$arg}) { my @linenums = &prompt_for_corrections($r,$question,$scan_config, - $scan_record, $error); + $scan_record, $error, + $randomorder,$randompick, + $respnumlookup,$startline); push(@lines_to_correct,@linenums); } $r->print(&verify_bubbles_checked(@lines_to_correct)); @@ -7040,14 +7399,17 @@ ENDSCRIPT # The form field scantron_questions is actually a list of line numbers not # a list of question numbers. Therefore: # - - my $line_list = &questions_to_line_list($arg); + + my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, + $respnumlookup,$startline); $r->print('<input type="hidden" name="scantron_questions" value="'. $line_list.'" />'); foreach my $question (@{$arg}) { my @linenums = &prompt_for_corrections($r,$question,$scan_config, - $scan_record, $error); + $scan_record, $error, + $randomorder,$randompick, + $respnumlookup,$startline); push(@lines_to_correct,@linenums); } $r->print(&verify_bubbles_checked(@lines_to_correct)); @@ -7098,12 +7460,20 @@ used to fill in the scantron_questions f Arguments: questions - Reference to an array of questions. + randomorder - True if randomorder in use. + randompick - True if randompick in use. + respnumlookup - Reference to HASH mapping question numbers in bubble lines + for current line to question number used for same question + in "Master Seqence" (as seen by Course Coordinator). + startline - Reference to hash where key is question number (0 is first) + and key is number of first bubble line for current student + or code-based randompick and/or randomorder. =cut sub questions_to_line_list { - my ($questions) = @_; + my ($questions,$randomorder,$randompick,$respnumlookup,$startline) = @_; my @lines; foreach my $item (@{$questions}) { @@ -7112,8 +7482,16 @@ sub questions_to_line_list { if ($item =~ /^(\d+)\.(\d+)$/) { $question = $1; my $subquestion = $2; - $first = $first_bubble_line{$question-1} + 1; - my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); + my $responsenum = $question-1; + if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { + $responsenum = $respnumlookup->{$question-1}; + if (ref($startline) eq 'HASH') { + $first = $startline->{$question-1} + 1; + } + } else { + $first = $first_bubble_line{$responsenum} + 1; + } + my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); my $subcount = 1; while ($subcount<$subquestion) { $first += $subans[$subcount-1]; @@ -7121,8 +7499,16 @@ sub questions_to_line_list { } $count = $subans[$subquestion-1]; } else { - $first = $first_bubble_line{$question-1} + 1; - $count = $bubble_lines_per_response{$question-1}; + my $responsenum = $question-1; + if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { + $responsenum = $respnumlookup->{$question-1}; + if (ref($startline) eq 'HASH') { + $first = $startline->{$question-1} + 1; + } + } else { + $first = $first_bubble_line{$responsenum} + 1; + } + $count = $bubble_lines_per_response{$responsenum}; } $last = $first+$count-1; push(@lines, ($first..$last)); @@ -7144,6 +7530,15 @@ for multi and missing bubble cases). $scan_config - The scantron file configuration hash. $scan_record - Reference to the hash that has the the parsed scanlines. $error - Type of error + $randomorder - True if randomorder in use. + $randompick - True if randompick in use. + $respnumlookup - Reference to HASH mapping question numbers in bubble lines + for current line to question number used for same question + in "Master Seqence" (as seen by Course Coordinator). + $startline - Reference to hash where key is question number (0 is first) + and value is number of first bubble line for current student + or code-based randompick and/or randomorder. + Implicit inputs: %bubble_lines_per_response - Starting line numbers for each question. @@ -7168,15 +7563,26 @@ for multi and missing bubble cases). =cut sub prompt_for_corrections { - my ($r, $question, $scan_config, $scan_record, $error) = @_; + my ($r, $question, $scan_config, $scan_record, $error, $randomorder, + $randompick, $respnumlookup, $startline) = @_; my ($current_line,$lines); my @linenums; my $questionnum = $question; + my ($first,$responsenum); if ($question =~ /^(\d+)\.(\d+)$/) { $question = $1; - $current_line = $first_bubble_line{$question-1} + 1 ; my $subquestion = $2; - my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); + if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { + $responsenum = $respnumlookup->{$question-1}; + if (ref($startline) eq 'HASH') { + $first = $startline->{$question-1}; + } + } else { + $responsenum = $question-1; + $first = $first_bubble_line{$responsenum} + 1; + } + $current_line = $first + 1 ; + my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); my $subcount = 1; while ($subcount<$subquestion) { $current_line += $subans[$subcount-1]; @@ -7184,25 +7590,43 @@ sub prompt_for_corrections { } $lines = $subans[$subquestion-1]; } else { - $current_line = $first_bubble_line{$question-1} + 1 ; - $lines = $bubble_lines_per_response{$question-1}; + if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { + $responsenum = $respnumlookup->{$question-1}; + if (ref($startline) eq 'HASH') { + $first = $startline->{$question-1}; + } + } else { + $responsenum = $question-1; + $first = $first_bubble_line{$responsenum}; + } + $current_line = $first + 1; + $lines = $bubble_lines_per_response{$responsenum}; } if ($lines > 1) { $r->print(&mt('The group of bubble lines below responds to a single question.').'<br />'); - if (($responsetype_per_response{$question-1} eq 'essayresponse') || - ($responsetype_per_response{$question-1} eq 'formularesponse') || - ($responsetype_per_response{$question-1} eq 'stringresponse') || - ($responsetype_per_response{$question-1} eq 'imageresponse') || - ($responsetype_per_response{$question-1} eq 'reactionresponse') || - ($responsetype_per_response{$question-1} eq 'organicresponse')) { - $r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their bubblesheets.",$lines).'<br /><br />'.&mt('A non-zero score can be assigned to the student during bubblesheet grading by selecting a bubble in at least one line.').'<br />'.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').'<br />'.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").'<br /><br />'); + if (($responsetype_per_response{$responsenum} eq 'essayresponse') || + ($responsetype_per_response{$responsenum} eq 'formularesponse') || + ($responsetype_per_response{$responsenum} eq 'stringresponse') || + ($responsetype_per_response{$responsenum} eq 'imageresponse') || + ($responsetype_per_response{$responsenum} eq 'reactionresponse') || + ($responsetype_per_response{$responsenum} eq 'organicresponse')) { + $r->print( + &mt("Although this particular question type requires handgrading, the instructions for this question in the bubblesheet exam directed students to leave [quant,_1,line] blank on their bubblesheets.",$lines) + .'<br /><br />' + .&mt('A non-zero score can be assigned to the student during bubblesheet grading by selecting a bubble in at least one line.') + .'<br />' + .&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.') + .'<br />' + .&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.") + .'<br /><br />' + ); } else { $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")."<br />"); } } for (my $i =0; $i < $lines; $i++) { my $selected = $$scan_record{"scantron.$current_line.answer"}; - &scantron_bubble_selector($r,$scan_config,$current_line, + &scantron_bubble_selector($r,$scan_config,$current_line, $questionnum,$error,split('', $selected)); push(@linenums,$current_line); $current_line++; @@ -7456,11 +7880,42 @@ sub scantron_validate_doublebubble { #get student info my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); + my (undef,undef,$sequence)= + &Apache::lonnet::decode_symb($env{'form.selectpage'}); #get scantron line setup my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); + + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, + %grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline); + my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); + my $nav_error; + if (ref($map)) { + $randomorder = $map->randomorder(); + $randompick = $map->randompick(); + if ($randomorder || $randompick) { + $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); + if ($nav_error) { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + &graders_resources_pass(\@resources,\%grader_partids_by_symb, + \%grader_randomlists_by_symb,$bubbles_per_row); + } + } else { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble line array. if ($nav_error) { $r->print(&navmap_errormsg()); @@ -7471,11 +7926,15 @@ sub scantron_validate_doublebubble { my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, - $scan_data); + $scan_data,undef,\%idmap,$randomorder, + $randompick,$sequence,\@master_seq, + \%symb_to_resource,\%grader_partids_by_symb, + \%orderedforcode,\%respnumlookup,\%startline); if (!defined($$scan_record{'scantron.doubleerror'})) { next; } &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, 'doublebubble', - $$scan_record{'scantron.doubleerror'}); + $$scan_record{'scantron.doubleerror'}, + $randomorder,$randompick,\%respnumlookup,\%startline); return (1,$currentphase); } return (0,$currentphase+1); @@ -7514,11 +7973,14 @@ sub scantron_get_maxbubble { %first_bubble_line = (); %subdivided_bubble_lines = (); %responsetype_per_response = (); + %masterseq_id_responsenum = (); my $response_number = 0; my $bubble_line = 0; foreach my $resource (@resources) { - my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom,undef,$bubbles_per_row); + my $resid = $resource->id(); + my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname, + $udom,undef,$bubbles_per_row); if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) { foreach my $part_id (@{$parts}) { my $lines; @@ -7567,6 +8029,7 @@ sub scantron_get_maxbubble { $bubble_lines_per_response{$response_number} = $lines; $responsetype_per_response{$response_number} = $analysis->{$part_id.'.type'}; + $masterseq_id_responsenum{$resid.'_'.$part_id} = $response_number; $response_number++; $bubble_line += $lines; @@ -7599,21 +8062,59 @@ sub scantron_validate_missingbubbles { #get student info my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); + my (undef,undef,$sequence)= + &Apache::lonnet::decode_symb($env{'form.selectpage'}); #get scantron line setup my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); + + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, + %grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline); + my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); + my $nav_error; + if (ref($map)) { + $randomorder = $map->randomorder(); + $randompick = $map->randompick(); + if ($randomorder || $randompick) { + $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); + if ($nav_error) { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + &graders_resources_pass(\@resources,\%grader_partids_by_symb, + \%grader_randomlists_by_symb,$bubbles_per_row); + } + } else { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + + my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); if ($nav_error) { + $r->print(&navmap_errormsg()); return(1,$currentphase); } + if (!$max_bubble) { $max_bubble=2**31; } for (my $i=0;$i<=$scanlines->{'count'};$i++) { my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } - my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, - $scan_data); + my $scan_record = + &scantron_parse_scanline($line,$i,\%scantron_config,$scan_data,undef,\%idmap, + $randomorder,$randompick,$sequence,\@master_seq, + \%symb_to_resource,\%grader_partids_by_symb, + \%orderedforcode,\%respnumlookup,\%startline); if (!defined($$scan_record{'scantron.missingerror'})) { next; } my @to_correct; @@ -7624,9 +8125,16 @@ sub scantron_validate_missingbubbles { if ($missing =~ /^(\d+)\.(\d+)$/) { my $question = $1; my $subquestion = $2; - if (!defined($first_bubble_line{$question -1})) { next; } - my $first = $first_bubble_line{$question-1}; - my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); + my ($first,$responsenum); + if ($randomorder || $randompick) { + $responsenum = $respnumlookup{$question-1}; + $first = $startline{$question-1}; + } else { + $responsenum = $question-1; + $first = $first_bubble_line{$responsenum}; + } + if (!defined($first)) { next; } + my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); my $subcount = 1; while ($subcount<$subquestion) { $first += $subans[$subcount-1]; @@ -7635,15 +8143,25 @@ sub scantron_validate_missingbubbles { my $count = $subans[$subquestion-1]; $lastbubble = $first + $count; } else { - if (!defined($first_bubble_line{$missing - 1})) { next; } - $lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1}; + my ($first,$responsenum); + if ($randomorder || $randompick) { + $responsenum = $respnumlookup{$missing-1}; + $first = $startline{$missing-1}; + } else { + $responsenum = $missing-1; + $first = $first_bubble_line{$responsenum}; + } + if (!defined($first)) { next; } + $lastbubble = $first + $bubble_lines_per_response{$responsenum}; } if ($lastbubble > $max_bubble) { next; } push(@to_correct,$missing); } if (@to_correct) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, - $line,'missingbubble',\@to_correct); + $line,'missingbubble',\@to_correct, + $randomorder,$randompick,\%respnumlookup, + \%startline); return (1,$currentphase); } @@ -7697,8 +8215,7 @@ sub scantron_process_students { my $default_form_data=&defaultFormData($symb); my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); - my $bubbles_per_row = - &bubblesheet_bubbles_per_row(\%scantron_config); + my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); my ($scanlines,$scan_data)=&scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); @@ -7706,36 +8223,28 @@ sub scantron_process_students { unless (ref($navmap)) { $r->print(&navmap_errormsg()); return ''; - } - my $map=$navmap->getResourceByUrl($sequence); - my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); - my (%grader_partids_by_symb,%grader_randomlists_by_symb); - &graders_resources_pass(\@resources,\%grader_partids_by_symb, - \%grader_randomlists_by_symb,$bubbles_per_row); - my $resource_error; - foreach my $resource (@resources) { - my $ressymb; - if (ref($resource)) { - $ressymb = $resource->symb(); - } else { - $resource_error = 1; - last; - } - my ($analysis,$parts) = - &scantron_partids_tograde($resource,$env{'request.course.id'}, - $env{'user.name'},$env{'user.domain'},1,$bubbles_per_row); - $grader_partids_by_symb{$ressymb} = $parts; - if (ref($analysis) eq 'HASH') { - if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') { - $grader_randomlists_by_symb{$ressymb} = - $analysis->{'parts_withrandomlist'}; - } - } } - if ($resource_error) { + my $map=$navmap->getResourceByUrl($sequence); + my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, + %grader_randomlists_by_symb); + if (ref($map)) { + $randomorder = $map->randomorder(); + $randompick = $map->randompick(); + } else { $r->print(&navmap_errormsg()); return ''; } + my $nav_error; + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + if ($randomorder || $randompick) { + $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); + if ($nav_error) { + $r->print(&navmap_errormsg()); + return ''; + } + } + &graders_resources_pass(\@resources,\%grader_partids_by_symb, + \%grader_randomlists_by_symb,$bubbles_per_row); my ($uname,$udom); my $result= <<SCANTRONFORM; @@ -7750,17 +8259,13 @@ SCANTRONFORM my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam')); my $count=&get_todo_count($scanlines,$scan_data); - my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet Status', - 'Bubblesheet Progress',$count, - 'inline',undef,'scantronupload'); - &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, - 'Processing first student'); + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count); + &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,'Processing first student'); $r->print('<br />'); my $start=&Time::HiRes::time(); my $i=-1; my $started; - my $nav_error; &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse. if ($nav_error) { $r->print(&navmap_errormsg()); @@ -7779,6 +8284,7 @@ SCANTRONFORM my %lettdig = &letter_to_digits(); my $numletts = scalar(keys(%lettdig)); + my %orderedforcode; while ($i<$scanlines->{'count'}) { ($uname,$udom)=('',''); @@ -7786,12 +8292,18 @@ SCANTRONFORM my $line=&scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } if ($started) { - &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, - 'last student'); + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,'last student'); } $started=1; + my %respnumlookup = (); + my %startline = (); + my $total; my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, - $scan_data); + $scan_data,undef,\%idmap,$randomorder, + $randompick,$sequence,\@master_seq, + \%symb_to_resource,\%grader_partids_by_symb, + \%orderedforcode,\%respnumlookup,\%startline, + \$total); unless ($uname=&scantron_find_student($scan_record,$scan_data, \%idmap,$i)) { &scantron_add_delay(\@delayqueue,$line, @@ -7803,10 +8315,26 @@ SCANTRONFORM 'Student '.$uname.' has multiple sheets',2); next; } + my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION]; + my $user = $uname.':'.$usec; ($uname,$udom)=split(/:/,$uname); + my $scancode; + if ((exists($scan_record->{'scantron.CODE'})) && + (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { + $scancode = $scan_record->{'scantron.CODE'}; + } else { + $scancode = ''; + } + + my @mapresources = @resources; + if ($randomorder || $randompick) { + @mapresources = + &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource, + \%orderedforcode); + } my (%partids_by_symb,$res_error); - foreach my $resource (@resources) { + foreach my $resource (@mapresources) { my $ressymb; if (ref($resource)) { $ressymb = $resource->symb(); @@ -7817,7 +8345,8 @@ SCANTRONFORM if ((exists($grader_randomlists_by_symb{$ressymb})) || (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { my ($analysis,$parts) = - &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom,undef,$bubbles_per_row); + &scantron_partids_tograde($resource,$env{'request.course.id'}, + $uname,$udom,undef,$bubbles_per_row); $partids_by_symb{$ressymb} = $parts; } else { $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb}; @@ -7837,17 +8366,11 @@ SCANTRONFORM &scantron_putfile($scanlines,$scan_data); } - my $scancode; - if ((exists($scan_record->{'scantron.CODE'})) && - (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { - $scancode = $scan_record->{'scantron.CODE'}; - } else { - $scancode = ''; - } - if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, - \@resources,\%partids_by_symb, - $bubbles_per_row) eq 'ssi_error') { + \@mapresources,\%partids_by_symb, + $bubbles_per_row,$randomorder,$randompick, + \%respnumlookup,\%startline) + eq 'ssi_error') { $ssi_error = 0; # So end of handler error message does not trigger. $r->print("</form>"); &ssi_print_error($r); @@ -7855,27 +8378,43 @@ SCANTRONFORM return ''; # Why return ''? Beats me. } + if (($scancode) && ($randomorder || $randompick)) { + my $parmresult = + &Apache::lonparmset::storeparm_by_symb($symb, + '0_examcode',2,$scancode, + 'string_examcode',$uname, + $udom); + } $completedstudents{$uname}={'line'=>$line}; if ($env{'form.verifyrecord'}) { my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; + if ($randompick) { + if ($total) { + $lastpos = $total*$scantron_config{'Qlength'}; + } + } + my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos); chomp($studentdata); $studentdata =~ s/\r$//; my $studentrecord = ''; my $counter = -1; - foreach my $resource (@resources) { + foreach my $resource (@mapresources) { my $ressymb = $resource->symb(); ($counter,my $recording) = &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, $counter,$studentdata,$partids_by_symb{$ressymb}, - \%scantron_config,\%lettdig,$numletts); + \%scantron_config,\%lettdig,$numletts,$randomorder, + $randompick,\%respnumlookup,\%startline); $studentrecord .= $recording; } if ($studentrecord ne $studentdata) { &Apache::lonxml::clear_problem_counter(); if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, - \@resources,\%partids_by_symb, - $bubbles_per_row) eq 'ssi_error') { + \@mapresources,\%partids_by_symb, + $bubbles_per_row,$randomorder,$randompick, + \%respnumlookup,\%startline) + eq 'ssi_error') { $ssi_error = 0; # So end of handler error message does not trigger. $r->print("</form>"); &ssi_print_error($r); @@ -7885,12 +8424,14 @@ SCANTRONFORM } $counter = -1; $studentrecord = ''; - foreach my $resource (@resources) { + foreach my $resource (@mapresources) { my $ressymb = $resource->symb(); ($counter,my $recording) = &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, $counter,$studentdata,$partids_by_symb{$ressymb}, - \%scantron_config,\%lettdig,$numletts); + \%scantron_config,\%lettdig,$numletts, + $randomorder,$randompick,\%respnumlookup, + \%startline); $studentrecord .= $recording; } if ($studentrecord ne $studentdata) { @@ -7946,7 +8487,8 @@ sub graders_resources_pass { my $ressymb = $resource->symb(); my ($analysis,$parts) = &scantron_partids_tograde($resource,$env{'request.course.id'}, - $env{'user.name'},$env{'user.domain'},1,$bubbles_per_row); + $env{'user.name'},$env{'user.domain'}, + 1,$bubbles_per_row); $grader_partids_by_symb->{$ressymb} = $parts; if (ref($analysis) eq 'HASH') { if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') { @@ -7959,9 +8501,67 @@ sub graders_resources_pass { return; } +=pod + +=item users_order + + Returns array of resources in current map, ordered based on either CODE, + if this is a CODEd exam, or based on student's identity if this is a + "NAMEd" exam. + + Should be used when randomorder and/or randompick applied when the + corresponding exam was printed, prior to students completing bubblesheets + for the version of the exam the student received. + +=cut + +sub users_order { + my ($user,$scancode,$mapurl,$master_seq,$symb_to_resource,$orderedforcode) = @_; + my @mapresources; + unless ((ref($master_seq) eq 'ARRAY') && (ref($symb_to_resource) eq 'HASH')) { + return @mapresources; + } + if ($scancode) { + if ((ref($orderedforcode) eq 'HASH') && (ref($orderedforcode->{$scancode}) eq 'ARRAY')) { + @mapresources = @{$orderedforcode->{$scancode}}; + } else { + $env{'form.CODE'} = $scancode; + my $actual_seq = + &Apache::lonprintout::master_seq_to_person_seq($mapurl, + $master_seq, + $user,$scancode,1); + if (ref($actual_seq) eq 'ARRAY') { + @mapresources = map { $symb_to_resource->{$_}; } @{$actual_seq}; + if (ref($orderedforcode) eq 'HASH') { + if (@mapresources > 0) { + $orderedforcode->{$scancode} = \@mapresources; + } + } + } + delete($env{'form.CODE'}); + } + } else { + my $actual_seq = + &Apache::lonprintout::master_seq_to_person_seq($mapurl, + $master_seq, + $user,undef,1); + if (ref($actual_seq) eq 'ARRAY') { + @mapresources = + map { $symb_to_resource->{$_}; } @{$actual_seq}; + } + } + return @mapresources; +} + sub grade_student_bubbles { - my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row) = @_; -# Walk folder as student here to get resources in order student sees. + my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row, + $randomorder,$randompick,$respnumlookup,$startline) = @_; + my $uselookup = 0; + if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH') && + (ref($startline) eq 'HASH')) { + $uselookup = 1; + } + if (ref($resources) eq 'ARRAY') { my $count = 0; foreach my $resource (@{$resources}) { @@ -7983,8 +8583,12 @@ sub grade_student_bubbles { if (ref($parts) eq 'HASH') { if (ref($parts->{$ressymb}) eq 'ARRAY') { foreach my $part (@{$parts->{$ressymb}}) { - $form{'scantron_questnum_start.'.$part} = - 1+$env{'form.scantron.first_bubble_line.'.$count}; + if ($uselookup) { + $form{'scantron_questnum_start.'.$part} = $startline->{$count} + 1; + } else { + $form{'scantron_questnum_start.'.$part} = + 1+$env{'form.scantron.first_bubble_line.'.$count}; + } $count++; } } @@ -8215,7 +8819,7 @@ sub scantron_download_scantron_data { if (! &valid_file($file)) { $r->print(' <p> - '.&mt('The requested file name was invalid.').' + '.&mt('The requested filename was invalid.').' </p> '); return; @@ -8265,10 +8869,20 @@ sub checkscantron_results { return ''; } my $map=$navmap->getResourceByUrl($sequence); + my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, + %grader_randomlists_by_symb,%orderedforcode); + if (ref($map)) { + $randomorder=$map->randomorder(); + $randompick=$map->randompick(); + } my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); - my (%grader_partids_by_symb,%grader_randomlists_by_symb); - &graders_resources_pass(\@resources,\%grader_partids_by_symb, \%grader_randomlists_by_symb); - + my $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); + if ($nav_error) { + $r->print(&navmap_errormsg()); + return ''; + } + &graders_resources_pass(\@resources,\%grader_partids_by_symb, + \%grader_randomlists_by_symb,$bubbles_per_row); my ($uname,$udom); my (%scandata,%lastname,%bylast); $r->print(' @@ -8277,20 +8891,16 @@ sub checkscantron_results { my @delayqueue; my %completedstudents; - my $count=&Apache::grades::get_todo_count($scanlines,$scan_data); - my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet/Submissions Comparison Status', - 'Progress of Bubblesheet Data/Submission Records Comparison',$count, - 'inline',undef,'checkscantron'); - my ($username,$domain,$started); - my $nav_error; + my $count=&get_todo_count($scanlines,$scan_data); + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count); + my ($username,$domain,$started,%ordered); &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse. if ($nav_error) { $r->print(&navmap_errormsg()); return ''; } - &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, - 'Processing first student'); + &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,'Processing first student'); my $start=&Time::HiRes::time(); my $i=-1; @@ -8300,15 +8910,14 @@ sub checkscantron_results { my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i); if ($line=~/^[\s\cz]*$/) { next; } if ($started) { - &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, - 'last student'); + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,'last student'); } $started=1; my $scan_record= &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config, $scan_data); - unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data, - \%idmap,$i)) { + unless ($uname=&scantron_find_student($scan_record,$scan_data, + \%idmap,$i)) { &Apache::grades::scantron_add_delay(\@delayqueue,$line, 'Unable to find a student that matches',1); next; @@ -8321,26 +8930,57 @@ sub checkscantron_results { my $pid = $scan_record->{'scantron.ID'}; $lastname{$pid} = $scan_record->{'scantron.LastName'}; push(@{$bylast{$lastname{$pid}}},$pid); + my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION]; + my $user = $uname.':'.$usec; + ($username,$domain)=split(/:/,$uname); + + my $scancode; + if ((exists($scan_record->{'scantron.CODE'})) && + (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { + $scancode = $scan_record->{'scantron.CODE'}; + } else { + $scancode = ''; + } + + my @mapresources = @resources; my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; + my %respnumlookup=(); + my %startline=(); + if ($randomorder || $randompick) { + @mapresources = + &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource, + \%orderedforcode); + my $total = &get_respnum_lookups($sequence,$scan_data,\%idmap,$line, + $scan_record,\@master_seq,\%symb_to_resource, + \%grader_partids_by_symb,\%orderedforcode, + \%respnumlookup,\%startline); + if ($randompick && $total) { + $lastpos = $total*$scantron_config{'Qlength'}; + } + } $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos); chomp($scandata{$pid}); $scandata{$pid} =~ s/\r$//; - ($username,$domain)=split(/:/,$uname); + my $counter = -1; - foreach my $resource (@resources) { + foreach my $resource (@mapresources) { my $parts; my $ressymb = $resource->symb(); if ((exists($grader_randomlists_by_symb{$ressymb})) || (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { (my $analysis,$parts) = - &scantron_partids_tograde($resource,$env{'request.course.id'},$username,$domain,undef,$bubbles_per_row); + &scantron_partids_tograde($resource,$env{'request.course.id'}, + $username,$domain,undef, + $bubbles_per_row); } else { $parts = $grader_partids_by_symb{$ressymb}; } ($counter,my $recording) = &verify_scantron_grading($resource,$domain,$username,$cid,$counter, $scandata{$pid},$parts, - \%scantron_config,\%lettdig,$numletts); + \%scantron_config,\%lettdig,$numletts, + $randomorder,$randompick, + \%respnumlookup,\%startline); $record{$pid} .= $recording; } } @@ -8387,7 +9027,12 @@ sub checkscantron_results { $env{'form.scantron_maxbubble'}) .'</p>' ); - $r->print('<p>'.&mt('Exact matches for <b>[quant,_1,student]</b>.',$passed).'<br />'.&mt('Discrepancies detected for <b>[quant,_1,student]</b>.',$failed).'</p>'); + $r->print('<p>' + .&mt('Exact matches for [_1][quant,_2,student][_3].','<b>',$passed,'</b>') + .'<br />' + .&mt('Discrepancies detected for [_1][quant,_2,student][_3].','<b>',$failed,'</b>') + .'</p>' + ); if ($passed) { $r->print(&mt('Students with exact correspondence between bubblesheet data and submissions are as follows:').'<br /><br />'); $r->print(&Apache::loncommon::start_data_table()."\n". @@ -8413,7 +9058,8 @@ sub checkscantron_results { sub verify_scantron_grading { my ($resource,$domain,$username,$cid,$counter,$scandata,$partids, - $scantron_config,$lettdig,$numletts) = @_; + $scantron_config,$lettdig,$numletts,$randomorder,$randompick, + $respnumlookup,$startline) = @_; my ($record,%expected,%startpos); return ($counter,$record) if (!ref($resource)); return ($counter,$record) if (!$resource->is_problem()); @@ -8422,15 +9068,21 @@ sub verify_scantron_grading { foreach my $part_id (@{$partids}) { $counter ++; $expected{$part_id} = 0; - if ($env{"form.scantron.sub_bubblelines.$counter"}) { - my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"}); + my $respnum = $counter; + if ($randomorder || $randompick) { + $respnum = $respnumlookup->{$counter}; + $startpos{$part_id} = $startline->{$counter} + 1; + } else { + $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"}; + } + if ($env{"form.scantron.sub_bubblelines.$respnum"}) { + my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$respnum"}); foreach my $item (@sub_lines) { $expected{$part_id} += $item; } } else { - $expected{$part_id} = $env{"form.scantron.bubblelines.$counter"}; + $expected{$part_id} = $env{"form.scantron.bubblelines.$respnum"}; } - $startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"}; } if ($symb) { my %recorded; @@ -8526,7 +9178,7 @@ sub verify_scantron_grading { return ($counter,$record); } -sub letter_to_digits { +sub letter_to_digits { my %lettdig = ( A => 1, B => 2, @@ -8553,7 +9205,7 @@ sub letter_to_digits { sub href_symb_cmd { my ($symb,$cmd)=@_; - return '/adm/grades?symb='.&HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'<>&"').'&command='.$cmd; + return '/adm/grades?symb='.&HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'<>&"').'&command='.$cmd; } sub grading_menu { @@ -8816,6 +9468,21 @@ sub init_perm { } } +sub init_old_essays { + my ($symb,$apath,$adom,$aname) = @_; + if ($symb ne '') { + my %essays = &Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); + if (keys(%essays) > 0) { + $old_essays{$symb} = \%essays; + } + } + return; +} + +sub reset_old_essays { + undef(%old_essays); +} + sub gather_clicker_ids { my %clicker_ids; @@ -8913,7 +9580,8 @@ sub process_clicker { my $pincorrect=&mt("Percentage points for incorrect solution"); my $selectform=&Apache::loncommon::select_form($env{'form.upfiletype'},'upfiletype', {'iclicker' => 'i>clicker', - 'interwrite' => 'interwrite PRS'}); + 'interwrite' => 'interwrite PRS', + 'turning' => 'Turning Technologies'}); $symb = &Apache::lonenc::check_encrypt($symb); $result.= &Apache::lonhtmlcommon::scripttag(<<ENDUPFORM); function sanitycheck() { @@ -9087,6 +9755,9 @@ ENDHEADER if ($env{'form.upfiletype'} eq 'interwrite') { ($errormsg,$number)=&interwrite_eval(\@questiontitles,\%responses); } + if ($env{'form.upfiletype'} eq 'turning') { + ($errormsg,$number)=&turning_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', @@ -9145,7 +9816,7 @@ ENDHEADER &mt('Found [_1] registered and [_2] unregistered clickers.',$student_count,$unknown_count); if (($env{'form.gradingmechanism'} ne 'attendance') && ($env{'form.gradingmechanism'} ne 'given')) { if ($correct_count==0) { - $errormsg.="Found no correct answers answers for grading!"; + $errormsg.="Found no correct answers for grading!"; } elsif ($correct_count>1) { $result.='<br /><span class="LC_warning">'.&mt("Found [_1] entries for grading!",$correct_count).'</span>'; } @@ -9223,6 +9894,32 @@ sub interwrite_eval { return ($errormsg,$number); } +sub turning_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>$number) { $number=$#entries; } + my $id=$entries[0]; + my @idresponses; + $id=~s/^[\#0]+//; + unless ($id) { next; } + for (my $idx=1;$idx<=$#entries;$idx++) { + $entries[$idx]=~s/\,/\;/g; + $entries[$idx]=~s/[^a-zA-Z0-9\.\*\-\+\;]+//g; + push(@idresponses,$entries[$idx]); + } + $$responses{$id}=join(',',@idresponses); + } + for (my $i=1; $i<=$number; $i++) { + $$questiontitles[$i]=&mt('Question [_1]',$i); + } + return ($errormsg,$number); +} + + sub assign_clicker_grades { my ($r,$symb)=@_; if (!$symb) {return '';} @@ -9291,7 +9988,7 @@ sub assign_clicker_grades { if ($user) { if ($users{$user}) { $result.='<br /><span class="LC_warning">'. - &mt("More than one entry found for <tt>[_1]</tt>!",$user). + &mt('More than one entry found for [_1]!','<tt>'.$user.'</tt>'). '</span><br />'; } $users{$user}=1; @@ -9360,13 +10057,17 @@ sub navmap_errormsg { } sub startpage { - my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag) = @_; - unshift(@$crumbs,{href=>&href_symb_cmd($symb,'gradingmenu'),text=>"Grading"}); - $r->print(&Apache::loncommon::start_page('Grading',undef, - {'bread_crumbs' => $crumbs})); - &Apache::lonquickgrades::startGradeScreen($r,($env{'form.symb'}?'probgrading':'grading')); + my ($r,$symb,$crumbs,$onlyfolderflag,$nodisplayflag,$stuvcurrent,$stuvdisp,$nomenu,$js) = @_; + if ($nomenu) { + $r->print(&Apache::loncommon::start_page("Student's Version",$js,{'only_body' => '1'})); + } else { + unshift(@$crumbs,{href=>&href_symb_cmd($symb,'gradingmenu'),text=>"Grading"}); + $r->print(&Apache::loncommon::start_page('Grading',$js, + {'bread_crumbs' => $crumbs})); + &Apache::lonquickgrades::startGradeScreen($r,($env{'form.symb'}?'probgrading':'grading')); + } unless ($nodisplayflag) { - $r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag)); + $r->print(&Apache::lonhtmlcommon::resource_info_box($symb,$onlyfolderflag,$stuvcurrent,$stuvdisp)); } } @@ -9403,6 +10104,7 @@ sub handler { } } elsif (!%perm) { $request->internal_redirect('/adm/quickgrades'); + return OK; } &Apache::loncommon::content_type($request,'text/html'); $request->send_http_header; @@ -9429,8 +10131,29 @@ sub handler { &select_problem($request); } else { if ($command eq 'submission' && $perm{'vgr'}) { - &startpage($request,$symb,[{href=>"", text=>"Student Submissions"}]); + my ($stuvcurrent,$stuvdisp,$versionform,$js); + if (($env{'form.student'} ne '') && ($env{'form.userdom'} ne '')) { + ($stuvcurrent,$stuvdisp,$versionform,$js) = + &choose_task_version_form($symb,$env{'form.student'}, + $env{'form.userdom'}); + } + &startpage($request,$symb,[{href=>"", text=>"Student Submissions"}],undef,undef,$stuvcurrent,$stuvdisp,undef,$js); + if ($versionform) { + $request->print($versionform); + } + $request->print('<br clear="all" />'); ($env{'form.student'} eq '' ? &listStudents($request,$symb) : &submission($request,0,0,$symb)); + } elsif ($command eq 'versionsub' && $perm{'vgr'}) { + my ($stuvcurrent,$stuvdisp,$versionform,$js) = + &choose_task_version_form($symb,$env{'form.student'}, + $env{'form.userdom'}, + $env{'form.inhibitmenu'}); + &startpage($request,$symb,[{href=>"", text=>"Previous Student Version"}],undef,undef,$stuvcurrent,$stuvdisp,$env{'form.inhibitmenu'},$js); + if ($versionform) { + $request->print($versionform); + } + $request->print('<br clear="all" />'); + $request->print(&show_previous_task_version($request,$symb)); } elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) { &startpage($request,$symb,[{href=>&href_symb_cmd($symb,'all_for_one'),text=>'Grade page/folder for one student'}, {href=>'',text=>'Select student'}],1,1); @@ -9568,8 +10291,11 @@ sub handler { if ($ssi_error) { &ssi_print_error($request); } - &Apache::lonquickgrades::endGradeScreen($request); - $request->print(&Apache::loncommon::end_page()); + if ($env{'form.inhibitmenu'}) { + $request->print(&Apache::loncommon::end_page()); + } else { + &Apache::lonquickgrades::endGradeScreen($request); + } &reset_caches(); return OK; } @@ -9640,6 +10366,75 @@ ssi_with_retries() =over +=head1 Routines to display previous version of a Task for a specific student + +Tasks are graded pass/fail. Students who have yet to pass a particular Task +can receive another opportunity. Access to tasks is slot-based. If a slot +requires a proctor to check-in the student, a new version of the Task will +be created when the student is checked in to the new opportunity. + +If a particular student has tried two or more versions of a particular task, +the submission screen provides a user with vgr privileges (e.g., a Course +Coordinator) the ability to display a previous version worked on by the +student. By default, the current version is displayed. If a previous version +has been selected for display, submission data are only shown that pertain +to that particular version, and the interface to submit grades is not shown. + +=over 4 + +=item show_previous_task_version() + +Displays a specified version of a student's Task, as the student sees it. + +Inputs: 2 + request - request object + symb - unique symb for current instance of resource + +Output: None. + +Side Effects: calls &show_problem() to print version of Task, with + version contained in form item: $env{'form.previousversion'} + +=item choose_task_version_form() + +Displays a web form used to select which version of a student's view of a +Task should be displayed. Either launches a pop-up window, or replaces +content in existing pop-up, or replaces page in main window. + +Inputs: 4 + symb - unique symb for current instance of resource + uname - username of student + udom - domain of student + nomenu - 1 if display is in a pop-up window, and hence no menu + breadcrumbs etc., are displayed + +Output: 4 + current - student's current version + displayed - student's version being displayed + result - scalar containing HTML for web form used to switch to + a different version (or a link to close window, if pop-up). + js - javascript for processing selection in versions web form + +Side Effects: None. + +=item previous_display_javascript() + +Inputs: 2 + nomenu - 1 if display is in a pop-up window, and hence no menu + breadcrumbs etc., are displayed. + current - student's current version number. + +Output: 1 + js - javascript for processing selection in versions web form. + +Side Effects: None. + +=back + +=head1 Routines to process bubblesheet data. + +=over 4 + =item scantron_get_correction() : Builds the interface screen to interact with the operator to fix a @@ -9666,6 +10461,17 @@ ssi_with_retries() - missingbubble - array ref of the bubble lines that have missing bubble errors + $randomorder - True if exam folder has randomorder set + $randompick - True if exam folder has randompick set + $respnumlookup - Reference to HASH mapping question numbers in bubble lines + for current line to question number used for same question + in "Master Seqence" (as seen by Course Coordinator). + $startline - Reference to hash where key is question number (0 is first) + and value is number of first bubble line for current student + or code-based randompick and/or randomorder. + + + =item scantron_get_maxbubble() : Arguments: @@ -9686,7 +10492,7 @@ ssi_with_retries() $env{'form.scantron.bubble_lines.n'}, $env{'form.scantron.first_bubble_line.n'} and $env{"form.scantron.sub_bubblelines.n"} - which are the total number of bubble, lines, the number of bubble + which are the total number of bubble lines, the number of bubble lines for response n and number of the first bubble line for response n, and a comma separated list of numbers of bubble lines for sub-questions (for optionresponse, matchresponse, and rankresponse items), for response n. @@ -9745,7 +10551,9 @@ ssi_with_retries() =item navmap_errormsg() : Returns HTML mark-up inside a <div></div> with a link to re-initialize the course. - Should be called whenever the request to instantiate a navmap object fails. + Should be called whenever the request to instantiate a navmap object fails. + +=back =back