--- loncom/homework/grades.pm 2006/05/30 12:45:36 1.359 +++ loncom/homework/grades.pm 2007/01/04 14:59:57 1.386 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.359 2006/05/30 12:45:36 www Exp $ +# $Id: grades.pm,v 1.386 2007/01/04 14:59:57 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -36,9 +36,10 @@ 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 Apache::lonenc; use String::Similarity; use lib '/home/httpd/lib/perl'; use LONCAPA; @@ -112,36 +113,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 { @@ -168,25 +167,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; @@ -589,7 +589,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". @@ -1470,7 +1470,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)' : @@ -1493,10 +1494,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++; @@ -1513,14 +1514,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; } sub show_problem { - my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode) = @_; + my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode,$form) = @_; my $rendered; + my %form = ((ref($form) eq 'HASH')? %{$form} : ()); &Apache::lonxml::remember_problem_counter(); if ($mode eq 'both' or $mode eq 'text') { $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, - $env{'request.course.id'}); + $env{'request.course.id'}, + undef,\%form); } 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') { &Apache::lonxml::restore_problem_counter(); - $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, - $env{'request.course.id'}); + $companswer= + &Apache::loncommon::get_student_answers($symb,$uname,$udom, + $env{'request.course.id'}, + %form); } if ($removeform) { $companswer=~s|||g; @@ -1637,7 +1646,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 @@ -1749,7 +1759,7 @@ KEYWORDS # Load the other essays for similarity check # my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); - my ($adom,$aname,$apath)=($essayurl=~/^(\w+)\/(\w+)\/(.*)$/); + my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); $apath=&escape($apath); $apath=~s/\W/\_/gs; %oldessays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); @@ -1855,8 +1865,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; } @@ -1880,7 +1891,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=''; @@ -1900,7 +1911,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. @@ -1990,8 +2001,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,9 +2117,19 @@ sub processHandGrade { } my $includemsg = $env{'form.includemsg'.$ctr}; my ($subject,$message,$msgstatus) = ('','',''); + my $restitle = &Apache::lonnet::gettitle($symb); + my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', + $symb,$udom,$uname); + my ($feedurl,$baseurl,$showsymb,$messagetail); + $feedurl = &Apache::lonnet::clutter($url); + if ($encrypturl =~ /^yes$/i) { + $baseurl = &Apache::lonenc::encrypted($feedurl,1); + $showsymb = &Apache::lonenc::encrypted($symb,1); + } if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/); unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); } + $subject.=' ['.$restitle.']'; my (@msgnum) = split(/,/,$includemsg); foreach (@msgnum) { $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); @@ -2114,14 +2137,16 @@ sub processHandGrade { $message =&Apache::lonfeedback::clear_out_html($message); if ($env{'form.withgrades'.$ctr}) { $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt; - $message.=" for $env{'form.probTitle'}"; - } - $msgstatus = &Apache::lonmsg::user_normal_msg($uname,$udom, - $subject.' ['. - &Apache::lonnet::declutter($url).']',$message); - $request->print('
'.&mt('Sending message to [_1]@[_2]',$uname,$udom).': '. + $messagetail = " for $env{'form.probTitle'}"; + } + $msgstatus = + &Apache::lonmsg::user_normal_msg($uname,$udom,$subject, + $message.$messagetail, + undef,$baseurl,undef, + undef,undef,$showsymb, + $restitle); + $request->print('
'.&mt('Sending message to [_1]:[_2]',$uname,$udom).': '. $msgstatus); } if ($env{'form.collaborator'.$ctr}) { @@ -2133,11 +2158,27 @@ 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); + $encrypturl= + &Apache::lonnet::EXT('resource.0.encrypturl', + $symb,$udom,$collaborator); + if ($encrypturl =~ /^yes$/i) { + $baseurl = &Apache::lonenc::encrypted($feedurl,1); + $showsymb = &Apache::lonenc::encrypted($symb,1); + } else { + $baseurl = $feedurl; + $showsymb = $symb; + } + if ($env{'form.withgrades'.$ctr}) { + $messagetail = " for $env{'form.probTitle'}"; + + } + $msgstatus = + &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); } } } @@ -2329,7 +2370,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 @@ -2389,7 +2430,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_/ || @@ -2404,22 +2444,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, @@ -2428,15 +2464,37 @@ 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 = &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 @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) = @@ -2446,9 +2504,6 @@ sub handback_files { 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; - $version++; # fix file name my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, @@ -2458,19 +2513,43 @@ sub handback_files { $request->print(' An errror occured ('.$result. ') while trying to upload '.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'
'); } else { - 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 is named:
".$save_file_name."
"; - $message .= " and can be found in your portfolio space."; - &Apache::lonnet::logthis($message); - my $msgstatus = &Apache::lonmsg::user_normal_msg($stuname,$domain, - $subject.' [File Returned]',$message); + # 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(" ".$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]; + my $feedurl = &Apache::lonnet::declutter($url); + my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', + $symb,$domain,$stuname); + my ($baseurl,$showsymb); + if ($encrypturl =~ /^yes$/i) { + $baseurl = &Apache::lonenc::encrypted($feedurl,1); + $showsymb = &Apache::lonenc::encrypted($symb,1); + } else { + $baseurl = $feedurl; + $showsymb = $symb; + } + my $restitle = &Apache::lonnet::gettitle($symb); + my $msgstatus = + &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject. + ' (File Returned) ['.$restitle.']',$message,undef, + $baseurl,undef,undef,undef,$showsymb,$restitle); } } return; @@ -2562,7 +2641,7 @@ sub version_portfiles { 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 =~ /^(.*?)([^\/]*)$/); @@ -2574,7 +2653,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']); } } @@ -2856,16 +2935,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; @@ -3424,9 +3505,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; @@ -3738,6 +3822,9 @@ LISTJAVASCRIPT ''."\n". ''."
\n"; + $result.=' '.&mt('Use CODE:').' '. + '
'."\n"; + $result.=' 
'."\n"; @@ -3768,8 +3855,8 @@ LISTJAVASCRIPT $studentTable.=($ptr%2 == 0 ? '
  ' if ($ptr%2 == 0); - $studentTable.='
'."\n"; + $studentTable.='  ' if ($ptr%2 == 0); + $studentTable.=''."\n"; $studentTable.=''."\n"; @@ -3792,9 +3879,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++; } } @@ -3830,6 +3918,11 @@ sub displayPage { my $result='

 '.$env{'form.title'}.'

'; $result.='

 Student: '.&nameUserString(undef,$$fullname{$env{'form.student'}},$uname,$udom). '

'."\n"; + if (&Apache::lonnet::validCODE($env{'form.CODE'})) { + $result.='

 CODE: '.$env{'form.CODE'}.'

'."\n"; + } else { + delete($env{'form.CODE'}); + } &sub_page_js($request); $request->print($result); @@ -3854,7 +3947,12 @@ sub displayPage { ''."\n". ''."\n"; - my $checkIcon = ''."\n"; + } + my $checkIcon = ''.&mt('Check Mark').
+	''; $studentTable.=' Note: Problems graded correct by the computer are marked with a '.$checkIcon. @@ -3872,18 +3970,19 @@ sub displayPage { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } - if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { + if (ref($curRes) && $curRes->is_problem()) { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); $studentTable.=''.$prob. (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=''; + my %form = ('CODE' => $env{'form.CODE'},); if ($env{'form.vProb'} eq 'yes' ) { $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, - undef,'both'); + undef,'both',\%form); } else { - my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'}); + my $companswer = &Apache::loncommon::get_student_answers($symbx,$uname,$udom,$env{'request.course.id'},%form); $companswer =~ s|||g; $companswer =~ s|||g; # while ($companswer =~ /()/s) { #'. + 'onClick="javascript:checkSubmitPage(this.form,'.$question.');" />'. ''."\n"; $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); @@ -4096,7 +4195,7 @@ sub updateGradeByPage { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } - if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) { + if (ref($curRes) && $curRes->is_problem()) { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); @@ -4151,9 +4250,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 ''; @@ -4163,9 +4261,24 @@ sub updateGradeByPage { $changeflag++; } if (scalar(keys(%newrecord)) > 0) { + my %record = + &Apache::lonnet::restore($symbx,$env{'request.course.id'}, + $udom,$uname); + + if (&Apache::lonnet::validCODE($env{'form.CODE'})) { + $newrecord{'resource.CODE'} = $env{'form.CODE'}; + } elsif (&Apache::lonnet::validCODE($record{'resource.CODE'})) { + $newrecord{'resource.CODE'} = ''; + } &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'}, $udom,$uname); + %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'}, @@ -4279,14 +4392,14 @@ sub scantron_CODElist { } sub scantron_CODEunique { - my $result=' + my $result=' - - + + - '; + '; return $result; } @@ -4405,6 +4518,7 @@ SCANTRONFORM
+ $default_form_data @@ -4587,7 +4701,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 @@ -4601,7 +4716,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 @@ -4612,8 +4728,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); @@ -4743,21 +4865,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; } @@ -4769,6 +4899,7 @@ sub remember_current_skipped { $to_remember{$i}=1; } } + &scan_data($scan_data,'remember_skipping',join(':',%to_remember)); &scantron_putfile(undef,$scan_data); } @@ -4784,15 +4915,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 (< @@ -4874,7 +5005,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'; } @@ -5044,8 +5174,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]; } @@ -5065,12 +5195,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)=@_; @@ -5557,6 +5696,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) { @@ -5567,8 +5710,9 @@ SCANTRONFORM 'grade_domain' =>$udom, 'grade_courseid'=>$env{'request.course.id'}, 'grade_symb' =>$resource->symb()); - if (exists($scan_record->{'scantron.CODE'}) && - $scan_record->{'scantron.CODE'}) { + if (exists($scan_record->{'scantron.CODE'}) + && + &Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) { $form{'CODE'}=$scan_record->{'scantron.CODE'}; } else { $form{'CODE'}='';
List of CODES to validate against:'. - $CODElist.'