--- loncom/homework/grades.pm 2017/12/21 23:05:04 1.746 +++ loncom/homework/grades.pm 2018/05/04 15:15:05 1.750 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.746 2017/12/21 23:05:04 raeburn Exp $ +# $Id: grades.pm,v 1.750 2018/05/04 15:15:05 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -502,7 +502,7 @@ COMMONJSFUNCTIONS #--- Dumps the class list with usernames,list of sections, #--- section, ids and fullnames for each user. sub getclasslist { - my ($getsec,$filterlist,$getgroup) = @_; + my ($getsec,$filterbyaccstatus,$getgroup,$symb,$submitonly,$filterbysubmstatus) = @_; my @getsec; my @getgroup; my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); @@ -530,6 +530,13 @@ sub getclasslist { # my %sections; my %fullnames; + my ($cdom,$cnum,$partlist); + if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) { + $cdom = $env{"course.$env{'request.course.id'}.domain"}; + $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $res_error; + ($partlist,my $handgrade,my $responseType) = &response_type($symb,\$res_error); + } foreach my $student (keys(%$classlist)) { my $end = $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; @@ -546,7 +553,7 @@ sub getclasslist { my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; # filter students according to status selected - if ($filterlist && (!($stu_status =~ /Any/))) { + if ($filterbyaccstatus && (!($stu_status =~ /Any/))) { if (!($stu_status =~ $status)) { delete($classlist->{$student}); next; @@ -563,13 +570,58 @@ sub getclasslist { } } if (($grp eq 'none') && !$group) { - $exclude = 0; + $exclude = 0; } } if ($exclude) { delete($classlist->{$student}); + next; } } + if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) { + my $udom = + $classlist->{$student}->[&Apache::loncoursedata::CL_SDOM()]; + my $uname = + $classlist->{$student}->[&Apache::loncoursedata::CL_SNAME()]; + if (($symb ne '') && ($udom ne '') && ($uname ne '')) { + if ($submitonly eq 'queued') { + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + if (!defined($queue_status{'gradingqueue'})) { + delete($classlist->{$student}); + next; + } + } else { + my (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); + my $submitted = 0; + my $graded = 0; + my $incorrect = 0; + foreach (keys(%status)) { + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 1 if ($status{$_} =~ /^ungraded/); + $incorrect = 1 if ($status{$_} =~ /^incorrect/); + + my ($foo,$partid,$foo1) = split(/\./,$_); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $submitted = 0; + } + } + if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')) { + delete($classlist->{$student}); + next; + } elsif (!$graded && ($submitonly eq 'graded')) { + delete($classlist->{$student}); + next; + } elsif (!$incorrect && $submitonly eq 'incorrect') { + delete($classlist->{$student}); + next; + } + } + } + } $section = ($section ne '' ? $section : 'none'); if (&canview($section)) { if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { @@ -584,7 +636,6 @@ sub getclasslist { delete($classlist->{$student}); } } - my %seen = (); my @sections = sort(keys(%sections)); return ($classlist,\@sections,\%fullnames); } @@ -856,7 +907,7 @@ sub verifyreceipt { sub listStudents { my ($request,$symb,$submitonly) = @_; - my $is_tool = ($symb =~ /ext\.tool$/); + my $is_tool = ($symb =~ /ext\.tool$/); my $cdom = $env{"course.$env{'request.course.id'}.domain"}; my $cnum = $env{"course.$env{'request.course.id'}.num"}; my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; @@ -1952,7 +2003,6 @@ sub show_problem { sub files_exist { my ($r, $symb) = @_; my @students = &Apache::loncommon::get_env_multiple('form.stuinfo'); - foreach my $student (@students) { my ($uname,$udom,$fullname) = split(/:/,$student); my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'}, @@ -1975,7 +2025,6 @@ sub download_all_link { $r->print(&mt('There are currently no submitted documents.')); return; } - my $all_students = join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo')); @@ -1995,7 +2044,55 @@ sub submit_download_link { my ($request,$symb) = @_; if (!$symb) { return ''; } #FIXME: Figure out which type of problem this is and provide appropriate download - &download_all_link($request,$symb); + my $res_error; + my ($partlist,$handgrade,$responseType) = &response_type($symb,$res_error); + if (ref($res_error)) { + if ($$res_error) { + $request->print(&mt('An error occurred retrieving response types')); + return; + } + } + my ($numupload,$numessay) = (0,0); + if (ref($responseType) eq 'HASH') { + foreach my $part (sort(keys(%$responseType))) { + foreach my $id (sort(keys(%{ $responseType->{$part} }))) { + my $responsetype = $responseType->{$part}->{$id}; + if ($responsetype eq 'essay') { + my $uploadedfiletypes = + &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes",$symb); + if ($uploadedfiletypes) { + $numupload++; + } else { + $numessay++; + } + } + } + } + } + if (($numupload) || ($numessay)) { + my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; + (undef,undef,my $fullname) = &getclasslist($getsec,1,$getgroup,$symb,$submitonly,1); + if (ref($fullname) eq 'HASH') { + my @students = map { $_.':'.$fullname->{$_} } (keys(%{$fullname})); + if (@students) { + @{$env{'form.stuinfo'}} = @students; + if ($numupload) { + &download_all_link($request,$symb); + } +# FIXME Need to provide a mechanism to download essays, i.e., if $numessay > 0 +# Needs to omit user's identity if resource instance is for an anonymous survey. + } else { + $request->print(&mt('No students match the criteria you selected')); + } + } else { + $request->print(&mt('Could not retrieve student information')); + } + } else { + $request->print(&mt('No essayresponse items found')); + } + return; } sub build_section_inputs { @@ -2635,7 +2732,7 @@ sub get_last_submission { if (!@string) { my $msg; if ($is_tool) { - $msg = &mt('Nothing passed back - no attempts.'); + $msg = &mt('No grade passed back.'); } else { $msg = &mt('Nothing submitted - no attempts.'); } @@ -4090,6 +4187,7 @@ sub editgrades { $ctr++; } my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); + my $totcolspan = 0; foreach my $partid (@partid) { $header .= ''.&mt('Old Score').''. ''.&mt('New Score').''; @@ -4106,6 +4204,7 @@ sub editgrades { ''.&mt('New').' '.$display.''; $columns{$partid}+=2; } + $totcolspan += $columns{$partid}; } foreach my $partid (@partid) { my $display_part=&get_display_part($partid,$symb); @@ -4121,18 +4220,18 @@ sub editgrades { my @noupdate; my ($updateCtr,$noupdateCtr) = (1,1); for ($i=0; $i<$env{'form.total'}; $i++) { - my $line; my $user = $env{'form.ctr'.$i}; my ($uname,$udom)=split(/:/,$user); my %newrecord; my $updateflag = 0; - $line .= ''.&nameUserString(undef,$$fullname{$user},$uname,$udom).''; my $usec=$classlist->{"$uname:$udom"}[5]; - if (!&canmodify($usec)) { - my $numcols=scalar(@partid)*4+2; + my $canmodify = &canmodify($usec); + my $line = ''. + &nameUserString(undef,$$fullname{$user},$uname,$udom).''; + if (!$canmodify) { push(@noupdate, - $line."". - &mt('Not allowed to modify student').""); + $line."". + &mt('Not allowed to modify student').""); next; } my %aggregate = (); @@ -4249,8 +4348,7 @@ sub editgrades { } } if (@noupdate) { -# my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3; - my $numcols=scalar(@partid)*4+2; + my $numcols=$totcolspan+2; $result .= &Apache::loncommon::start_data_table_row('LC_empty_row'). ''. &mt('No Changes Occurred For the Students Below'). @@ -5032,7 +5130,9 @@ sub displayPage { ''; $studentTable.=''; my %form = ('CODE' => $env{'form.CODE'},); - unless ($is_tool) { + if ($is_tool) { + $studentTable.=' '.$title.'
'; + } else { if ($env{'form.vProb'} eq 'yes' ) { $studentTable.=&show_problem($request,$symbx,$uname,$udom,1, undef,'both',\%form); @@ -5110,13 +5210,14 @@ sub displaySubByDates { my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_; my $isCODE=0; my $isTask = ($symb =~/\.task$/); + my $is_tool = ($symb =~/\.tool$/); if (exists($record->{'resource.CODE'})) { $isCODE=1; } my $studentTable=&Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(). ''.&mt('Date/Time').''. ($isCODE?''.&mt('CODE').'':''). ($isTask?''.&mt('Version').'':''). - ''.&mt('Submission').''. + ''.($is_tool?&mt('Grade'):&mt('Submission')).''. ''.&mt('Status').''. &Apache::loncommon::end_data_table_header_row(); my ($version); @@ -5124,7 +5225,11 @@ sub displaySubByDates { my %orders; $mark{'correct_by_student'} = $checkIcon; if (!exists($$record{'1:timestamp'})) { - return '
 '.&mt('Nothing submitted - no attempts.').'
'; + if ($is_tool) { + return '
 '.&mt('No grade passed back.').'
'; + } else { + return '
 '.&mt('Nothing submitted - no attempts.').'
'; + } } my $interaction; @@ -5157,56 +5262,64 @@ sub displaySubByDates { if (($type eq 'anonsurvey') || ($type eq 'anonsurveycred')) { $hidden = 1; } - my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys) - : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys)); - + my @matchKey; + if ($isTask) { + @matchKey = sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys); + } elsif ($is_tool) { + @matchKey = sort(grep /^resource\.\Q$partid\E\.awarded$/,@versionKeys); + } else { + @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys); + } # next if ($$record{"$version:resource.$partid.solved"} eq ''); my $display_part=&get_display_part($partid,$symb); foreach my $matchKey (@matchKey) { if (exists($$record{$version.':'.$matchKey}) && $$record{$version.':'.$matchKey} ne '') { - - my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) - : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); - $displaySub[0].=''; - $displaySub[0].=''.&mt('Part: [_1]',$display_part).'' - .' ' - .'('.&mt('Response ID: [_1]',$responseId).')' - .'' - .' '; - if ($hidden) { - $displaySub[0].= &mt('Anonymous Survey').''; + if ($is_tool) { + $displaySub[0].=$$record{"$version:resource.$partid.awarded"}; } else { - my ($trial,$rndseed,$newvariation); - if ($type eq 'randomizetry') { - $trial = $$record{"$where.$partid.tries"}; - $rndseed = $$record{"$where.$partid.rndseed"}; - } - if ($$record{"$where.$partid.tries"} eq '') { - $displaySub[0].=&mt('Trial not counted'); - } else { - $displaySub[0].=&mt('Trial: [_1]', - $$record{"$where.$partid.tries"}); - if (($rndseed ne '') && ($lastrndseed{$partid} ne '')) { - if (($rndseed ne $lastrndseed{$partid}) && - (($type eq 'randomizetry') || ($lasttype{$partid} eq 'randomizetry'))) { - $newvariation = ' ('.&mt('New variation this try').')'; - } + my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/) + : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/)); + $displaySub[0].=''; + $displaySub[0].=''.&mt('Part: [_1]',$display_part).'' + .' ' + .'('.&mt('Response ID: [_1]',$responseId).')' + .'' + .' '; + if ($hidden) { + $displaySub[0].= &mt('Anonymous Survey').''; + } else { + my ($trial,$rndseed,$newvariation); + if ($type eq 'randomizetry') { + $trial = $$record{"$where.$partid.tries"}; + $rndseed = $$record{"$where.$partid.rndseed"}; } - $lastrndseed{$partid} = $rndseed; - $lasttype{$partid} = $type; - } - my $responseType=($isTask ? 'Task' + if ($$record{"$where.$partid.tries"} eq '') { + $displaySub[0].=&mt('Trial not counted'); + } else { + $displaySub[0].=&mt('Trial: [_1]', + $$record{"$where.$partid.tries"}); + if (($rndseed ne '') && ($lastrndseed{$partid} ne '')) { + if (($rndseed ne $lastrndseed{$partid}) && + (($type eq 'randomizetry') || ($lasttype{$partid} eq 'randomizetry'))) { + $newvariation = ' ('.&mt('New variation this try').')'; + } + } + $lastrndseed{$partid} = $rndseed; + $lasttype{$partid} = $type; + } + my $responseType=($isTask ? 'Task' : $responseType->{$partid}->{$responseId}); - if (!exists($orders{$partid})) { $orders{$partid}={}; } - if ((!exists($orders{$partid}->{$responseId})) || ($trial)) { - $orders{$partid}->{$responseId}= - &get_order($partid,$responseId,$symb,$uname,$udom, - $no_increment,$type,$trial,$rndseed); - } - $displaySub[0].=''.$newvariation.''; # /nobreak - $displaySub[0].='  '. - &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).'
'; + if (!exists($orders{$partid})) { $orders{$partid}={}; } + if ((!exists($orders{$partid}->{$responseId})) || ($trial)) { + $orders{$partid}->{$responseId}= + &get_order($partid,$responseId,$symb,$uname,$udom, + $no_increment,$type,$trial,$rndseed); + } + $displaySub[0].=''.$newvariation.''; # /nobreak + $displaySub[0].='  '. + &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom,$type,$trial,$rndseed).'
'; + } } } } @@ -5221,14 +5334,22 @@ sub displaySubByDates { lc($$record{"$where.$partid.award"}).' '. $mark{$$record{"$where.$partid.solved"}}. '
'; + } elsif (($is_tool) && (exists($$record{"$version:resource.$partid.solved"}))) { + if ($$record{"$version:resource.$partid.solved"} =~ /^(in|)correct_by_passback$/) { + $displaySub[1].=&mt('Grade passed back by external tool'); + } } if (exists $$record{"$where.$partid.regrader"}) { - $displaySub[2].=$$record{"$where.$partid.regrader"}. - ' ('.&mt('Part').': '.$display_part.')'; + $displaySub[2].=$$record{"$where.$partid.regrader"}; + unless ($is_tool) { + $displaySub[2].=' ('.&mt('Part').': '.$display_part.')'; + } } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) { $displaySub[2].= - $$record{"$version:resource.$partid.regrader"}. - ' ('.&mt('Part').': '.$display_part.')'; + $$record{"$version:resource.$partid.regrader"}; + unless ($is_tool) { + $displaySub[2].=' ('.&mt('Part').': '.$display_part.')'; + } } } # needed because old essay regrader has not parts info @@ -9787,7 +9908,7 @@ sub submit_options_download { ''."\n"; $result.='

- '.&mt('Select Students for Which to Download Submissions').' + '.&mt('Select Students for whom to Download Submissions').'

'.&selectfield(1,$is_tool).' @@ -10727,7 +10848,7 @@ sub handler { } elsif ($command eq 'downloadfileslink' && $perm{'vgr'}) { &startpage($request,$symb, [{href=>&href_symb_cmd($symb,'downloadfilesselect'), text=>'Select which submissions to download'}, - {href=>'', text=>'Download submissions'}]); + {href=>'', text=>'Download submitted files'}]); &submit_download_link($request,$symb); } elsif ($command) { &startpage($request,$symb,[{href=>'', text=>'Access denied'}]);