--- loncom/homework/grades.pm 2006/05/17 22:08:17 1.353 +++ loncom/homework/grades.pm 2006/10/23 22:32:09 1.381 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.353 2006/05/17 22:08:17 albertel Exp $ +# $Id: grades.pm,v 1.381 2006/10/23 22:32:09 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -36,10 +36,13 @@ use Apache::lonhtmlcommon; use Apache::lonnavmaps; use Apache::lonhomework; use Apache::loncoursedata; -use Apache::lonmsg qw(:user_normal_msg); +use Apache::lonmsg(); use Apache::Constants qw(:common); use Apache::lonlocal; use String::Similarity; +use lib '/home/httpd/lib/perl'; +use LONCAPA; + use POSIX qw(floor); my %oldessays=(); @@ -109,36 +112,34 @@ sub nameUserString { #--- Indicate if a response type is coded handgraded or not. --- sub response_type { my ($symb) = shift; - my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); - my $allkeys = &Apache::lonnet::metadata($url,'keys'); - my %vPart; - foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { - $vPart{$partid}=1; - } - my %seen = (); - my (@partlist,%handgrade,%responseType); - foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_.*/ || /^Task_/) { - my ($responsetype,$part) = split(/_/,$_,2); - my ($partid,$respid) = split(/_/,$part); - if ($responsetype eq 'Task') { $respid='0'; } - if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { - next; - } - if (%vPart && !exists($vPart{$partid})) { - next; - } - $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! - my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); - $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); - if (!exists($responseType{$partid})) { $responseType{$partid}={}; } - $responseType{$partid}->{$respid}=$responsetype; - next if ($seen{$partid} > 0); - $seen{$partid}++; - push @partlist,$partid; - } - } - return (\@partlist,\%handgrade,\%responseType); + + my $navmap = Apache::lonnavmaps::navmap->new(); + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my (%response_types,%handgrade); + foreach my $part (@{ $partlist }) { + my @types = $res->responseType($part); + my @ids = $res->responseIds($part); + for (my $i=0; $i < scalar(@ids); $i++) { + $response_types{$part}{$ids[$i]} = $types[$i]; + $handgrade{$part.'_'.$ids[$i]} = + &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. + '.handgrade',$symb); + } + } + return ($partlist,\%handgrade,\%response_types); +} + +sub flatten_responseType { + my ($responseType) = @_; + my @part_response_id = + map { + my $part = $_; + map { + [$part,$_] + } sort(keys(%{ $responseType->{$part} })); + } sort(keys(%$responseType)); + return @part_response_id; } sub get_display_part { @@ -165,25 +166,26 @@ sub showResourceInfo { my %resptype = (); my $hdgrade='no'; my %partsseen; - for my $part_resID (sort keys(%$handgrade)) { - my $handgrade=$$handgrade{$part_resID}; - my ($partID,$resID) = split(/_/,$part_resID); - my $responsetype = $responseType->{$partID}->{$resID}; - $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.=''; - if ($checkboxes) { - if (exists($partsseen{$partID})) { - $result.=" "; - } else { - $result.=""; + foreach my $partID (sort keys(%$responseType)) { + foreach my $resID (sort keys(%{ $responseType->{$partID} })) { + my $handgrade=$$handgrade{$partID.'_'.$resID}; + my $responsetype = $responseType->{$partID}->{$resID}; + $hdgrade = $handgrade if ($handgrade eq 'yes'); + $result.=''; + if ($checkboxes) { + if (exists($partsseen{$partID})) { + $result.=" "; + } else { + $result.=""; + } + $partsseen{$partID}=1; } - $partsseen{$partID}=1; - } - my $display_part=&get_display_part($partID,$symb); - $result.='Part: '.$display_part.' '. - $resID.''. - 'Type: '.$responsetype.''; + my $display_part=&get_display_part($partID,$symb); + $result.='Part: '.$display_part.' '. + $resID.''. + 'Type: '.$responsetype.''; # 'Handgrade: '.$handgrade.''; + } } $result.=''."\n"; return $result,$responseType,$hdgrade,$partlist,$handgrade; @@ -586,7 +588,7 @@ sub verifyreceipt { my $receipt = &Apache::lonnet::recprefix($courseid).'-'. $env{'form.receipt'}; $receipt =~ s/[^\-\d]//g; - my $symb = &Apache::lonnet::symbread(); + my ($symb) = &get_symb($request); my $title.='

Verifying Submission Receipt '. $receipt.'

'."\n". @@ -1467,7 +1469,8 @@ sub get_increment { #--- displays the grading box, used in essay type problem and grading by page/sequence sub gradeBox { my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_; - my $checkIcon = ''; my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname); my $wgtmsg = ($wgt > 0 ? '(problem weight)' : @@ -1490,10 +1493,10 @@ sub gradeBox { my $increment = &get_increment(); $result.=''."\n"; # display radio buttons in a nice table 10 across while ($thisweight<=$wgt) { - $result.= '\n"; + ($score eq $thisweight ? 'checked':'').' /> '.$thisweight."\n"; $result.=(($ctr+1)%10 == 0 ? '' : ''); $thisweight += $increment; $ctr++; @@ -1510,14 +1513,14 @@ sub gradeBox { $result.=''."\n"; - $result.="  \n"; + $result.="  \n"; $result.=''."\n". ''."\n". ''.$file_disp.''); - $result.=''."\n"; - $result.='
'; - $file_counter++; + if ($file =~ /\/portfolio\//) { + my ($file_path, $file_disp) = ($file =~ m|(.+/)(.+)$|); + my ($name,$version,$ext) = &file_name_version_ext($file_disp); + $file_disp = "$name.$ext"; + $file = $file_path.$file_disp; + $result.=&mt('Return commented version of [_1] to student.', + ''.$file_disp.''); + $result.=''."\n"; + $result.='
'; + $result.='(File will be uploaded when you click on Save & Next below.)
'; + $file_counter++; + } } } return $result; @@ -1573,7 +1580,7 @@ sub show_problem { if ($removeform) { $rendered=~s|||g; $rendered=~s|||g; - $rendered=~s|name="submit"|name="would_have_been_submit"|g; + $rendered=~s|(]*name\s*=\s*"?)(\w+)("?)|$1would_have_been_$2$3|g; } my $companswer; if ($mode eq 'both' or $mode eq 'answer') { @@ -1634,7 +1641,8 @@ sub submission { if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; } if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; } my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); - my $checkIcon = ''; # header info @@ -1747,7 +1755,7 @@ KEYWORDS # my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); my ($adom,$aname,$apath)=($essayurl=~/^(\w+)\/(\w+)\/(.*)$/); - $apath=&Apache::lonnet::escape($apath); + $apath=&escape($apath); $apath=~s/\W/\_/gs; %oldessays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); } @@ -1852,8 +1860,9 @@ KEYWORDS $lastsubonly.='' : ''); $ptr++; } - $studentTable.='
'.$$string[0]; } else { my %seenparts; - for my $part (sort keys(%$handgrade)) { - my ($partid,$respid) = split(/_/,$part); + my @part_response_id = &flatten_responseType($responseType); + foreach my $part (@part_response_id) { + 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; } @@ -1877,7 +1886,7 @@ KEYWORDS } foreach (@$string) { my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; - if ($part ne ($partid.'_'.$respid)) { next; } + if (join('_',@{$part}) ne ($partid.'_'.$respid)) { next; } my ($ressub,$subval) = split(/:/,$_,2); # Similarity check my $similar=''; @@ -1897,7 +1906,7 @@ KEYWORDS my $order=&get_order($partid,$respid,$symb,$uname,$udom); if ($env{'form.lastSub'} eq 'lastonly' || ($env{'form.lastSub'} eq 'hdgrade' && - $$handgrade{$part} eq 'yes')) { + $$handgrade{$$part[0].'_'.$$part[1]} eq 'yes')) { my $display_part=&get_display_part($partid,$symb); $lastsubonly.='
Part: '. $display_part.' ( ID '.$respid. @@ -1987,8 +1996,10 @@ KEYWORDS my %seen = (); my @partlist; my @gradePartRespid; - for my $part_resp (sort(keys(%$handgrade))) { - my ($partid,$respid) = split(/_/, $part_resp); + my @part_response_id = &flatten_responseType($responseType); + foreach my $part_response_id (@part_response_id) { + my ($partid,$respid) = @{ $part_response_id }; + my $part_resp = join('_',@{ $part_response_id }); next if ($seen{$partid} > 0); $seen{$partid}++; next if ($$handgrade{$part_resp} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/); @@ -2104,6 +2115,7 @@ sub processHandGrade { if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/); unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); } + $subject.=' ['.&Apache::lonnet::declutter($url).']'; my (@msgnum) = split(/,/,$includemsg); foreach (@msgnum) { $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); @@ -2116,8 +2128,8 @@ sub processHandGrade { "?symb=$symb\">$env{'form.probTitle'}"; } $msgstatus = &Apache::lonmsg::user_normal_msg($uname,$udom, - $subject.' ['. - &Apache::lonnet::declutter($url).']',$message); + $subject, + $message); $request->print('
'.&mt('Sending message to [_1]@[_2]',$uname,$udom).': '. $msgstatus); } @@ -2130,11 +2142,11 @@ sub processHandGrade { &saveHandGrade($request,$symb,$collaborator,$udom,$ctr, $env{'form.unamedom'.$ctr},$part); if ($errorflag eq 'not_allowed') { - $request->print("Not allowed to modify grades for $collaborator:$udom"); + $request->print("".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom").""); next; } else { if ($message ne '') { - $msgstatus = &Apache::lonmsg::user_normal_msg($collaborator,$udom,$env{'form.msgsub'},$message); + $msgstatus = &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message); } } } @@ -2326,7 +2338,7 @@ sub saveHandGrade { if (exists($record{'resource.'.$new_part.'.awarded'})) { $newrecord{'resource.'.$new_part.'.awarded'} = ''; } - $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; + $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; } } elsif ($dropMenu eq 'reset status' && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts @@ -2386,7 +2398,6 @@ sub saveHandGrade { } $newrecord{'resource.'.$new_part.'.regrader'}= "$env{'user.name'}:$env{'user.domain'}"; - &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); } # unless problem has been graded, set flag to version the submitted files unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ || @@ -2401,22 +2412,18 @@ sub saveHandGrade { if (%newrecord) { if (@version_parts) { - my @changed_keys = &version_portfiles(\%record, \@parts_graded, $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts); + my @changed_keys = &version_portfiles(\%record, \@parts_graded, + $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts); @newrecord{@changed_keys} = @record{@changed_keys}; + foreach my $new_part (@version_parts) { + &handback_files($request,$symb,$stuname,$domain,$newflg, + $new_part,\%newrecord); + } } &Apache::lonnet::cstore(\%newrecord,$symb, $env{'request.course.id'},$domain,$stuname); - my @ungraded_parts; - foreach my $part (@parts) { - if ( !defined($record{'resource.'.$part.'.awarded'}) - && !defined($newrecord{'resource.'.$part.'.awarded'}) ) { - push(@ungraded_parts, $part); - } - } - if ( !@ungraded_parts ) { - &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom, - $cnum,$domain,$stuname); - } + &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb, + $cdom,$cnum,$domain,$stuname); } if ($aggregateflag) { &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, @@ -2425,42 +2432,80 @@ sub saveHandGrade { return ('',$pts,$wgt); } +sub check_and_remove_from_queue { + my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname) = @_; + my @ungraded_parts; + foreach my $part (@{$parts}) { + if ( $record->{ 'resource.'.$part.'.awarded'} eq '' + && $record->{ 'resource.'.$part.'.solved' } ne 'excused' + && $newrecord->{'resource.'.$part.'.awarded'} eq '' + && $newrecord->{'resource.'.$part.'.solved' } ne 'excused' + ) { + push(@ungraded_parts, $part); + } + } + if ( !@ungraded_parts ) { + &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom, + $cnum,$domain,$stuname); + } +} + sub handback_files { my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; - my $portfolio_root = &Apache::loncommon::propath($domain, - $stuname). - '/userfiles/portfolio'; - my ($partlist,$handgrade,$responseType) = &response_type($symb); - foreach my $part_resp (sort(keys(%$handgrade))) { - my ($part_id, $resp_id) = split(/_/,$part_resp); + my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio'; + my ($partlist,$handgrade,$responseType) = &response_type($symb); + + my @part_response_id = &flatten_responseType($responseType); + foreach my $part_response_id (@part_response_id) { + my ($part_id,$resp_id) = @{ $part_response_id }; + my $part_resp = join('_',@{ $part_response_id }); if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) { # if multiple files are uploaded names will be 'returndoc2','returndoc3' my $file_counter = 1; + my $file_msg; while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) { my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'}; my ($directory,$answer_file) = ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter} =~ /^(.*?)([^\/]*)$/); my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file); - $directory =~ /^.+$stuname\/portfolio(.*)/; - my $portfolio_path = $1; + my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root); my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); - my $new_answer = &version_selected_portfile($domain, $stuname, $portfolio_path, $answer_file, $version); - $$newrecord{"resource.$new_part.$resp_id.handback"} = $new_answer; - # set the filename to match the submitted file name - $env{'form.'.$newflg.'_'.$part_resp.'_returndoc1.filename'} = $env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter}; - my $result=&Apache::lonnet::userfileupload($newflg.'_'.$part_resp.'_returndoc'.$file_counter,'', - 'portfolio',undef,undef,undef,$stuname,$domain); + # fix file name + my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); + my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, + $newflg.'_'.$part_resp.'_returndoc'.$file_counter, + $save_file_name); if ($result !~ m|^/uploaded/|) { $request->print(' An errror occured ('.$result. - ') while trying to upload '.&display_file().'
'); - # $request->print(&done('Back')); + ') while trying to upload '.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'
'); + } else { + # mark the file as read only + my @files = ($save_file_name); + my @what = ($symb,$env{'request.course.id'},'handback'); + &Apache::lonnet::mark_as_readonly($domain,$stuname,\@files,\@what); + if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) { + $$newrecord{"resource.$new_part.$resp_id.handback"}.=','; + } + $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name; + $file_msg.= "\n".'
'.$save_file_name."
"; + } $request->print("
".$fname." will be the uploaded file name"); - $request->print("Will upload document ".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter}); + $request->print(" ".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter}); $file_counter++; } + my $subject = "File Handed Back by Instructor "; + my $message = "A file has been returned that was originally submitted in reponse to:
"; + $message .= "".&Apache::lonnet::gettitle($symb)."
"; + $message .= ' The returned file(s) are named: '. $file_msg; + $message .= " and can be found in your portfolio space."; + my $url = (&Apache::lonnet::decode_symb($symb))[2]; + $url = &Apache::lonnet::declutter($url); + my $msgstatus = &Apache::lonmsg::user_normal_msg($stuname,$domain, + $subject.' (File Returned) ['.$url.']',$message); + } } return; @@ -2546,14 +2591,13 @@ sub version_portfiles { my $version_parts = join('|',@$v_flag); my @returned_keys; my $parts = join('|', @$parts_graded); - my $portfolio_root = &Apache::loncommon::propath($domain, - $stu_name). - '/userfiles/portfolio'; + my $portfolio_root = &propath($domain,$stu_name). + '/userfiles/portfolio'; foreach my $key (keys(%$record)) { my $new_portfiles; if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { my @versioned_portfiles; - my @portfiles = split(/,/,$$record{$key}); + my @portfiles = split(/\s*,\s*/,$$record{$key}); foreach my $file (@portfiles) { &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file); my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); @@ -2565,7 +2609,7 @@ sub version_portfiles { if ($new_answer ne 'problem getting file') { push(@versioned_portfiles, $directory.$new_answer); &Apache::lonnet::mark_as_readonly($domain,$stu_name, - ['/portfolio'.$directory.$new_answer], + [$directory.$new_answer], [$symb,$env{'request.course.id'},'graded']); } } @@ -2847,16 +2891,18 @@ sub viewgrades { '
'; #radio buttons/text box for assigning points for a section or class. #handles different parts of a problem - my ($partlist,$handgrade) = &response_type($symb); + my ($partlist,$handgrade,$responseType) = &response_type($symb); my %weight = (); my $ctsparts = 0; $result.=''; my %seen = (); - for (sort keys(%$handgrade)) { - my ($partid,$respid) = split (/_/,$_,2); + my @part_response_id = &flatten_responseType($responseType); + foreach my $part_response_id (@part_response_id) { + my ($partid,$respid) = @{ $part_response_id }; + my $part_resp = join('_',@{ $part_response_id }); next if $seen{$partid}; $seen{$partid}++; - my $handgrade=$$handgrade{$_}; + my $handgrade=$$handgrade{$part_resp}; my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb); $weight{$partid} = $wgt eq '' ? '1' : $wgt; @@ -3415,9 +3461,10 @@ sub upcsvScores_form { $result.=$table; $result.='
'."\n"; $result.=''."\n"; $result.='
'."\n"; - $result.=' Specify a file containing the class scores for current resource'. + $result.=' '.&mt('Specify a file containing the class scores for current resource'). '.
'."\n"; + my $upload=&mt("Upload Scores"); my $upfile_select=&Apache::loncommon::upfile_select_html(); my $ignore=&mt('Ignore First Line'); $result.=< $upfile_select -
+
ENDUPFORM - $result.='
'."\n"; + $result.=&Apache::loncommon::help_open_topic("Course_Convert_To_CSV", + &mt("How do I create a CSV file from a spreadsheet")) + .'
'."\n"; $result.='


'."\n"; $result.=&show_grading_menu_form($symb); return $result; @@ -3759,8 +3808,8 @@ LISTJAVASCRIPT $studentTable.=($ptr%2 == 0 ? '
  ' if ($ptr%2 == 0); - $studentTable.='
'."\n"; + $studentTable.='  ' if ($ptr%2 == 0); + $studentTable.=''."\n"; $studentTable.=''."\n"; @@ -3783,9 +3832,10 @@ sub getSymbMap { 1,0,1); for my $sequence ($navmap->getById('0.0'), @sequences) { if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { - my $title = $minder.'.'.$sequence->compTitle(); - push @titles, $title; # minder in case two titles are identical - $symbx{$title} = $sequence->symb(); + my $title = $minder.'.'. + &HTML::Entities::encode($sequence->compTitle(),'"\'&'); + push(@titles, $title); # minder in case two titles are identical + $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); $minder++; } } @@ -3845,7 +3895,8 @@ sub displayPage { ''."\n". ''."\n"; - my $checkIcon = ''; $studentTable.=' Note: Problems graded correct by the computer are marked with a '.$checkIcon. @@ -3925,9 +3976,9 @@ sub displayPage { $curRes = $iterator->next(); } - $studentTable.=''."\n". + $studentTable.=''."\n". ''. + 'onClick="javascript:checkSubmitPage(this.form,'.$question.');" />'. ''."\n"; $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); @@ -4033,7 +4084,7 @@ sub displaySubByDates { if ($displaySub[2]) { $studentTable.='Manually graded by '.$displaySub[2]; } - $studentTable.=' '; + $studentTable.=' 3'; } $studentTable.=''; @@ -4142,9 +4193,8 @@ sub updateGradeByPage { $displayPts[1].=' Part: '.$display_part.' = '. (($score eq 'excused') ? 'excused' : $newpts). ' 
'; - $question++; - next if ($dropMenu eq 'reset status' || ($newpts == $oldpts && $score ne 'excused')); + next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused')); $newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne ''; $newrecord{'resource.'.$partid.'.solved'} = $score if $score ne ''; @@ -4156,7 +4206,12 @@ sub updateGradeByPage { if (scalar(keys(%newrecord)) > 0) { &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'}, $udom,$uname); + my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'}, + $udom,$uname); + &check_and_remove_from_queue($parts,\%record,undef,$symbx, + $cdom,$cnum,$udom,$uname); } + if ($aggregateflag) { &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, $env{'course.'.$env{'request.course.id'}.'.domain'}, @@ -4219,7 +4274,7 @@ sub scantron_filenames { my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my $cname=$env{'course.'.$env{'request.course.id'}.'.num'}; my @files=&Apache::lonnet::dirlist('userfiles',$cdom,$cname, - &Apache::loncommon::propath($cdom,$cname)); + &propath($cdom,$cname)); my @possiblenames; foreach my $filename (sort(@files)) { ($filename)=split(/&/,$filename); @@ -4270,14 +4325,14 @@ sub scantron_CODElist { } sub scantron_CODEunique { - my $result=' + my $result=' - - + + - '; + '; return $result; } @@ -4396,6 +4451,7 @@ SCANTRONFORM
+ $default_form_data @@ -4578,7 +4634,8 @@ sub scantron_parse_scanline { substr($questions,0,$$scantron_config{'Qlength'})=''; if (length($currentquest) < $$scantron_config{'Qlength'}) { next; } if ($$scantron_config{'Qon'} eq 'letter') { - if ($currentquest eq '?') { + if ($currentquest eq '?' + || $currentquest eq '*') { push(@{$record{'scantron.doubleerror'}},$questnum); $record{"scantron.$questnum.answer"}=''; } elsif (!$currentquest @@ -4592,7 +4649,8 @@ sub scantron_parse_scanline { $record{"scantron.$questnum.answer"}=$currentquest; } } elsif ($$scantron_config{'Qon'} eq 'number') { - if ($currentquest eq '?') { + if ($currentquest eq '?' + || $currentquest eq '*') { push(@{$record{'scantron.doubleerror'}},$questnum); $record{"scantron.$questnum.answer"}=''; } elsif (!$currentquest @@ -4603,8 +4661,14 @@ sub scantron_parse_scanline { push(@{$record{"scantron.missingerror"}},$questnum); } } else { - $record{"scantron.$questnum.answer"}= - $alphabet[$currentquest-1]; + # wrap zero back to J + if ($currentquest eq '0') { + $record{"scantron.$questnum.answer"}= + $alphabet[9]; + } else { + $record{"scantron.$questnum.answer"}= + $alphabet[$currentquest-1]; + } } } else { my @array=split($$scantron_config{'Qon'},$currentquest,-1); @@ -4734,21 +4798,29 @@ sub reset_skipping_status { &scantron_putfile(undef,$scan_data); } -sub allow_skipping { +sub start_skipping { my ($scan_data,$i)=@_; my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); - delete($remembered{$i}); + if ($env{'form.scantron_options_redo'} =~ /^redo_/) { + $remembered{$i}=2; + } else { + $remembered{$i}=1; + } &scan_data($scan_data,'remember_skipping',join(':',%remembered)); } sub should_be_skipped { - my ($scan_data,$i)=@_; + my ($scanlines,$scan_data,$i)=@_; if ($env{'form.scantron_options_redo'} !~ /^redo_/) { # not redoing old skips + if ($scanlines->{'skipped'}[$i]) { return 1; } return 0; } my %remembered=split(':',&scan_data($scan_data,'remember_skipping')); - if (exists($remembered{$i})) { return 0; } + + if (exists($remembered{$i}) && $remembered{$i} != 2 ) { + return 0; + } return 1; } @@ -4760,6 +4832,7 @@ sub remember_current_skipped { $to_remember{$i}=1; } } + &scan_data($scan_data,'remember_skipping',join(':',%to_remember)); &scantron_putfile(undef,$scan_data); } @@ -4775,15 +4848,15 @@ sub scantron_warning_screen { my ($button_text)=@_; my $title=&Apache::lonnet::gettitle($env{'form.selectpage'}); my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); - my $CODElist="a"; + my $CODElist; if ($scantron_config{'CODElocation'} && $scantron_config{'CODEstart'} && $scantron_config{'CODElength'}) { $CODElist=$env{'form.scantron_CODElist'}; - if ($CODElist eq '') { $CODElist='None'; } + if ($env{'form.scantron_CODElist'} eq '') { $CODElist='None'; } $CODElist= ''; + $env{'form.scantron_CODElist'}.''; } return (< @@ -4865,7 +4938,6 @@ sub scantron_validate_file { } if ($env{'form.scantron_options_redo'} eq 'redo_skipped') { &remember_current_skipped(); - &scantron_remove_file('skipped'); $env{'form.scantron_options_redo'}='redo_skipped_ready'; } @@ -5035,8 +5107,8 @@ sub scantron_putfile { sub scantron_get_line { my ($scanlines,$scan_data,$i)=@_; - if (&should_be_skipped($scan_data,$i)) { return undef; } - if ($scanlines->{'skipped'}[$i]) { return undef; } + if (&should_be_skipped($scanlines,$scan_data,$i)) { return undef; } + #if ($scanlines->{'skipped'}[$i]) { return undef; } if ($scanlines->{'corrected'}[$i]) {return $scanlines->{'corrected'}[$i];} return $scanlines->{'orig'}[$i]; } @@ -5056,12 +5128,21 @@ sub scantron_put_line { my ($scanlines,$scan_data,$i,$newline,$skip)=@_; if ($skip) { $scanlines->{'skipped'}[$i]=$newline; - &allow_skipping($scan_data,$i); + &start_skipping($scan_data,$i); return; } $scanlines->{'corrected'}[$i]=$newline; } +sub scantron_clear_skip { + my ($scanlines,$scan_data,$i)=@_; + if (exists($scanlines->{'skipped'}[$i])) { + undef($scanlines->{'skipped'}[$i]); + return 1; + } + return 0; +} + sub scantron_filter_not_exam { my ($curres)=@_; @@ -5093,7 +5174,7 @@ sub scantron_validate_sequence { my @resources= $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); if (@resources) { - $r->print("

".&mt('Some resource in the sequece currently are not set to exam mode. Grading these resources currently may not work correctly.')."

"); + $r->print("

".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."

"); return (1,$currentphase); } } @@ -5247,11 +5328,11 @@ function change_radio(field) { ENDSCRIPT my $href="/adm/pickcode?". - "form=".&Apache::lonnet::escape("scantronupload"). - "&scantron_format=".&Apache::lonnet::escape($env{'form.scantron_format'}). - "&scantron_CODElist=".&Apache::lonnet::escape($env{'form.scantron_CODElist'}). - "&curCODE=".&Apache::lonnet::escape($$scan_record{'scantron.CODE'}). - "&scantron_selectfile=".&Apache::lonnet::escape($env{'form.scantron_selectfile'}); + "form=".&escape("scantronupload"). + "&scantron_format=".&escape($env{'form.scantron_format'}). + "&scantron_CODElist=".&escape($env{'form.scantron_CODElist'}). + "&curCODE=".&escape($$scan_record{'scantron.CODE'}). + "&scantron_selectfile=".&escape($env{'form.scantron_selectfile'}); if ($env{'form.scantron_CODElist'} =~ /\S/) { $r->print(" Selected CODE is "); $r->print("\n
"); @@ -5548,6 +5629,10 @@ SCANTRONFORM &Apache::lonxml::clear_problem_counter(); &Apache::lonnet::appenv(%$scan_record); + + if (&scantron_clear_skip($scanlines,$scan_data,$i)) { + &scantron_putfile($scanlines,$scan_data); + } my $i=0; foreach my $resource (@resources) {
List of CODES to validate against:'. - $CODElist.'