--- loncom/homework/grades.pm 2024/12/09 21:39:48 1.799 +++ loncom/homework/grades.pm 2024/12/13 05:04:49 1.805 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.799 2024/12/09 21:39:48 raeburn Exp $ +# $Id: grades.pm,v 1.805 2024/12/13 05:04:49 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1441,27 +1441,31 @@ sub do_passback { } if ($no_passback) { &Apache::lonnet::log($udom,$uname,$uhome,$no_passback." score: $score; total: $total; possible: $possible"); + my $key = &Time::HiRes::time().':'.$uname.':'.$udom.':'. + "$linkuri\0$linkprotector\0$scope"; my $ltigrade = { - 'ltinum' => $ltinum, - 'lti' => $lti_in_use, - 'crsdef' => $crsdef, - 'cid' => $cdom.'_'.$cnum, - 'uname' => $uname, - 'udom' => $udom, - 'uhome' => $uhome, - 'pbid' => $id, - 'pburl' => $url, - 'pbtype' => $pb{'type'}, - 'pbscope' => $pbscope, - 'pbmap' => $pbmap, - 'pbsymb' => $pbsymb, - 'format' => $scoretype, - 'scope' => $scope, - 'clientip' => $pb{'clientip'}, - 'linkprot' => $linkprotector.':'.$linkuri, - 'total' => $total, - 'possible' => $possible, - 'score' => $score, + $key => { + 'ltinum' => $ltinum, + 'lti' => $lti_in_use, + 'crsdef' => $crsdef, + 'cid' => $cdom.'_'.$cnum, + 'uname' => $uname, + 'udom' => $udom, + 'uhome' => $uhome, + 'pbid' => $id, + 'pburl' => $url, + 'pbtype' => $pb{'type'}, + 'pbscope' => $pbscope, + 'pbmap' => $pbmap, + 'pbsymb' => $pbsymb, + 'format' => $scoretype, + 'scope' => $scope, + 'clientip' => $pb{'clientip'}, + 'linkprot' => $linkprotector.':'.$linkuri, + 'total' => $total, + 'possible' => $possible, + 'score' => $score, + }, }; &Apache::lonnet::put('linkprot_passback_pending',$ltigrade,$cdom,$cnum); } @@ -1726,7 +1730,7 @@ sub passbacks_for_symb { } sub process_passbacks { - my ($context,$symbs,$cdom,$cnum,$udom,$uname,$weights,$awardeds,$excuseds,$needpb, + my ($context,$symbs,$cdom,$cnum,$udom,$uname,$usec,$weights,$awardeds,$excuseds,$needpb, $skip_passback,$pbsave,$pbids) = @_; if ((ref($needpb) eq 'HASH') && (ref($skip_passback) eq 'HASH') && (ref($pbsave) eq 'HASH')) { my (%weight,%awarded,%excused); @@ -1827,6 +1831,7 @@ sub process_passbacks { 'uname' => $uname, 'udom' => $udom, 'uhome' => $uhome, + 'usec' => $usec, 'pbid' => $pbid, 'pburl' => $pburl, 'pbtype' => $pb{'type'}, @@ -1840,7 +1845,7 @@ sub process_passbacks { 'total_s' => \%total_by_symb, 'possible_s' => \%possible_by_symb, }; - push(@Apache::lonhomework::ltipassback,$ltigrade); + push(@Apache::grades::ltipassback,$ltigrade); next; } my ($total,$possible); @@ -4240,32 +4245,76 @@ sub processHandGrade { foreach my $collabstr (@collabstrs) { my ($part,@collaborators) = split(/:/,$collabstr); foreach my $collaborator (@collaborators) { - my ($errorflag,$pts,$wgt) = + my ($errorflag,$pts,$wgt,$numchg,$numupdate) = &saveHandGrade($request,$symb,$collaborator,$udom,$ctr, - $env{'form.unamedom'.$ctr},$part,\%queueable,\%needpb,\%skip_passback,%pbsave); + $env{'form.unamedom'.$ctr},$part,\%queueable); if ($errorflag eq 'not_allowed') { $request->print("".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom").""); next; } else { - $pbcollab{$collaborator}{$part} = [$pts,$wgt]; + if ($numchg || $numupdate) { + $pbcollab{$collaborator}{$part} = [$pts,$wgt]; + } if ($message ne '') { - my ($baseurl,$showsymb) = - &get_feedurl_and_symb($symb,$collaborator, - $udom); - if ($env{'form.withgrades'.$ctr}) { - $messagetail = " for $restitle"; + my ($baseurl,$showsymb) = + &get_feedurl_and_symb($symb,$collaborator, + $udom); + if ($env{'form.withgrades'.$ctr}) { + $messagetail = " for $restitle"; + } + $msgstatus = + &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); } - $msgstatus = - &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); - } + } } } } $ctr++; } if ((keys(%pbcollab)) && (keys(%needpb))) { - # FIXME passback scores for collaborators + foreach my $user (keys(%pbcollab)) { + my ($clbuname,$clbudom) = split(/:/,$user); + my $clbusec = &Apache::lonnet::getsection($clbudom,$clbuname,$cdom.'_'.$cnum); + if (ref($pbcollab{$user}) eq 'HASH') { + my @clparts = keys(%{$pbcollab{$user}}); + if (@clparts) { + my $navmap = Apache::lonnavmaps::navmap->new($clbuname,$clbudom,$clbusec); + if (ref($navmap)) { + my $res = $navmap->getBySymb($symb); + if (ref($res)) { + my $partlist = $res->parts(); + if (ref($partlist) eq 'ARRAY') { + my (%weights,%awardeds,%excuseds); + foreach my $part (@{$partlist}) { + if ($res->status($part) eq $res->EXCUSED) { + $excuseds{$symb}{$part} = 1; + } else { + $excuseds{$symb}{$part} = ''; + } + if ((exists($pbcollab{$user}{$part})) && (ref($pbcollab{$user}{$part}) eq 'ARRAY')) { + my $pts = $pbcollab{$user}{$part}[0]; + my $wt = $pbcollab{$user}{$part}[1]; + if ($wt) { + $awardeds{$symb}{$part} = $pts/$wt; + $weights{$symb}{$part} = $wt; + } else { + $awardeds{$symb}{$part} = 0; + $weights{$symb}{$part} = 0; + } + } else { + $awardeds{$symb}{$part} = $res->awarded($part); + $weights{$symb}{$part} = $res->weight($part); + } + } + &process_passbacks('handgrade',[$symb],$cdom,$cnum,$clbudom,$clbuname,$clbusec,\%weights, + \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave); + } + } + } + } + } + } } } @@ -4428,22 +4477,18 @@ sub saveHandGrade { my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname); my @parts_graded; my %newrecord = (); - my ($pts,$wgt,$totchg) = ('','',0); + my ($pts,$wgt,$totchg,$sendupdate) = ('','',0,0); my %aggregate = (); my $aggregateflag = 0; - my $sendupdate; if ($env{'form.HIDE'.$newflg}) { my ($version,$parts) = split(/:/,$env{'form.HIDE'.$newflg},2); my $numchgs = &makehidden($version,$parts,\%record,$symb,$domain,$stuname,1); $totchg += $numchgs; - if ($numchgs) { - $sendupdate = 1; - } } my (%weights,%awardeds,%excuseds); my @parts = split(/:/,$env{'form.partlist'.$newflg}); foreach my $new_part (@parts) { - #collaborator ($submi may vary for different parts + #collaborator ($submitter may vary for different parts) if ($submitter && $new_part ne $part) { next; } my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part}; if ($env{'form.WGT'.$newflg.'_'.$new_part} eq '') { @@ -4460,7 +4505,7 @@ sub saveHandGrade { $newrecord{'resource.'.$new_part.'.awarded'} = ''; } $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; - $sendupdate = 1; + $sendupdate ++; } } elsif ($dropMenu eq 'reset status' && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts @@ -4484,7 +4529,7 @@ sub saveHandGrade { &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); $aggregateflag = 1; } - $sendupdate = 1; + $sendupdate ++; $excuseds{$symb}{$new_part} = ''; $awardeds{$symb}{$new_part} = ''; } elsif ($dropMenu eq '') { @@ -4505,7 +4550,7 @@ sub saveHandGrade { next; } else { push(@parts_graded,$new_part); - $sendupdate = 1; + $sendupdate ++; } if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { $newrecord{'resource.'.$new_part.'.awarded'} = $partial; @@ -4557,14 +4602,14 @@ sub saveHandGrade { &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, $cdom,$cnum); } - if (($sendupdate) && (!$submitter)) { + if (($sendupdate || $totchg) && (!$submitter)) { if ((ref($needpb) eq 'HASH') && (keys(%{$needpb}))) { - &process_passbacks('handgrade',[$symb],$cdom,$cnum,$domain,$stuname,\%weights, + &process_passbacks('handgrade',[$symb],$cdom,$cnum,$domain,$stuname,$usec,\%weights, \%awardeds,\%excuseds,$needpb,$skip_passback,$pbsave); } } - return ('',$pts,$wgt,$totchg); + return ('',$pts,$wgt,$totchg,$sendupdate); } sub makehidden { @@ -5649,7 +5694,7 @@ sub editgrades { $updateCtr++; if (keys(%needpb)) { $weights{$symb} = \%weight; - &process_passbacks('editgrades',[$symb],$cdom,$cnum,$udom,$uname,\%weights, + &process_passbacks('editgrades',[$symb],$cdom,$cnum,$udom,$uname,$usec,\%weights, \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave); } } else { @@ -6178,7 +6223,7 @@ sub csvuploadassign { $request->print('.'); # Remove from grading queue &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom,$cnum, - $domain,$username); + $domain,$username); $countdone++; if ($passback) { my @parts_in_upload; @@ -6200,7 +6245,7 @@ sub csvuploadassign { $awardeds{$symb}{$part} = $record{"resource.$part.awarded"}; } } - &process_passbacks('csvupload',[$symb],$cdom,$cnum,$domain,$username,\%weights, + &process_passbacks('csvupload',[$symb],$cdom,$cnum,$domain,$username,$usec,\%weights, \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave); } } else { @@ -6951,7 +6996,6 @@ sub updateGradeByPage { $request->print($hidemsg.$grademsg.$studentTable); if (@updates) { - undef(@Apache::lonhomework::ltipassback); my (@allsymbs,$mapsymb,@recurseup,%parentmapsymbs,%possmappb,%possrespb); @allsymbs = @updates; if (ref($map)) { @@ -7009,13 +7053,14 @@ sub updateGradeByPage { } } my @symbs = keys(%uniqsymbs); - &process_passbacks('updatebypage',\@symbs,$cdom,$cnum,$udom,$uname,\%weights, + &process_passbacks('updatebypage',\@symbs,$cdom,$cnum,$udom,$uname,$usec,\%weights, \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave,\%pbids); - if (@Apache::lonhomework::ltipassback) { + if (@Apache::grades::ltipassback) { unless ($registered_cleanup) { my $handlers = $request->get_handlers('PerlCleanupHandler'); $request->set_handlers('PerlCleanupHandler' => - [\&Apache::lonhomework::do_ltipassback,@{$handlers}]); + [\&Apache::grades::make_passback,@{$handlers}]); + $registered_cleanup=1; } } } @@ -7023,6 +7068,17 @@ sub updateGradeByPage { return ''; } +sub make_passback { + if (@Apache::grades::ltipassback) { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my $ip = &Apache::lonnet::get_host_ip($lonhost); + foreach my $item (@Apache::grades::ltipassback) { + &Apache::lonhomework::run_passback($item,$lonhost,$ip); + } + undef(@Apache::grades::ltipassback); + } +} + #-------- end of section for handling grading by page/sequence --------- # #------------------------------------------------------------------- @@ -12539,6 +12595,10 @@ sub assign_clicker_grades { if ($res_error) { return &navmap_errormsg(); } + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my %needpb = &passbacks_for_symb($cdom,$cnum,$symb); + my (%skip_passback,%pbsave); # FIXME: This should probably look for the first handgradeable part my $part=$$partlist[0]; # Start screen output @@ -12648,7 +12708,15 @@ sub assign_clicker_grades { $result.="
Failed to save student $username:$domain. Message when trying to save was ($returncode)"; } else { $storecount++; - #FIXME Do passback for $user if required + if (keys(%needpb)) { + my (%weights,%awardeds,%excuseds); + my $usec = &Apache::lonnet::getsection($domain,$username,$env{'request.course.id'}); + $weights{$symb}{$part} = &Apache::lonnet::EXT("resource.$part.weight",$symb,$domain,$username,$usec); + $awardeds{$symb}{$part} = $ave; + $excuseds{$symb}{$part} = ''; + &process_passbacks('clickergrade',[$symb],$cdom,$cnum,$domain,$username,$usec,\%weights, + \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave); + } } } } @@ -12807,6 +12875,10 @@ sub handler { &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands)); } +# -------------------------------------- Flag and buffer for registered cleanup + $registered_cleanup=0; + undef(@Apache::grades::ltipassback); + # see what the symb is my $symb=$env{'form.symb'};