--- loncom/homework/grades.pm 2006/05/29 23:45:14 1.356 +++ loncom/homework/grades.pm 2006/09/14 21:47:22 1.375 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.356 2006/05/29 23:45:14 banghart Exp $ +# $Id: grades.pm,v 1.375 2006/09/14 21:47:22 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=(); @@ -120,7 +123,7 @@ sub response_type { foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { if (/^\w+response_.*/ || /^Task_/) { my ($responsetype,$part) = split(/_/,$_,2); - my ($partid,$respid) = split(/_/,$part); + my ($partid,$respid) = split(/_/,$part,2); if ($responsetype eq 'Task') { $respid='0'; } if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { next; @@ -141,6 +144,18 @@ sub response_type { return (\@partlist,\%handgrade,\%responseType); } +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 { my ($partID,$symb)=@_; my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); @@ -165,25 +180,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; @@ -1535,10 +1551,11 @@ sub handback_box { my ($symb,$uname,$udom,$counter,$partid,$record) = @_; my ($partlist,$handgrade,$responseType) = &response_type($symb); my (@respids); - foreach my $part_resp (sort(keys(%$handgrade))) { - my ($part,$resp) = split(/_/,$part_resp); + my @part_response_id = &flatten_responseType($responseType); + foreach my $part_response_id (@part_response_id) { + my ($part,$resp) = @{ $part_response_id }; if ($part eq $partid) { - push @respids,$resp; + push(@respids,$resp); } } my $result; @@ -1548,15 +1565,18 @@ sub handback_box { next if (!@$files); my $file_counter = 1; foreach my $file (@$files) { - 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.='
'; - $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 +1593,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') { @@ -1747,7 +1767,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 +1872,9 @@ KEYWORDS $lastsubonly.=''.$$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 +1898,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=''; @@ -1987,8 +2008,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 +2127,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 +2140,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 +2154,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 +2350,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 +2410,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,8 +2424,13 @@ 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); @@ -2427,15 +2455,17 @@ sub saveHandGrade { 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) = @@ -2445,9 +2475,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, @@ -2457,19 +2484,31 @@ 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]; + $url = &Apache::lonnet::declutter($url); + my $msgstatus = &Apache::lonmsg::user_normal_msg($stuname,$domain, + $subject.' (File Returned) ['.$url.']',$message); + } } return; @@ -2555,14 +2594,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 =~ /^(.*?)([^\/]*)$/); @@ -2574,7 +2612,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 +2894,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 +3464,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; @@ -4228,7 +4271,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); @@ -4587,7 +4630,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 +4645,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 +4657,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); @@ -4784,15 +4835,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= 'List of CODES to validate against:'. - $CODElist.''; + $env{'form.scantron_CODElist'}.''; } return (< @@ -5102,7 +5153,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); } } @@ -5256,11 +5307,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
");