--- loncom/homework/grades.pm 2024/12/09 02:29:37 1.797 +++ loncom/homework/grades.pm 2025/06/28 14:35:00 1.811 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.797 2024/12/09 02:29:37 raeburn Exp $ +# $Id: grades.pm,v 1.811 2025/06/28 14:35:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -67,7 +67,7 @@ my $ssi_retries = 5; my $ssi_error; my $ssi_error_resource; my $ssi_error_message; - +my $registered_cleanup; sub ssi_with_retries { my ($resource, $retries, %form) = @_; @@ -776,7 +776,7 @@ sub getclasslist { if (($udom ne '') && ($uname ne '')) { my %pbinfo = &Apache::lonnet::get('nohist_'.$cdom.'_'.$cnum.'_linkprot_pb',[$filterbypbid],$udom,$uname); if (ref($pbinfo{$filterbypbid}) eq 'ARRAY') { - $passback{$student} = $pbinfo{$filterbypbid} + $passback{$student} = $pbinfo{$filterbypbid}; } else { delete($classlist->{$student}); next; @@ -881,14 +881,20 @@ sub jscriptNform { -# Given the score (as a number [0-1] and the weight) what is the final -# point value? This function will round to the nearest tenth, third, -# or quarter if one of those is within the tolerance of .00001. +# Given the score (as a number [0-1], the weight, and a posible +# reduction for submission between duedate and overduedate) +# what is the final point value? This function will round to +# the nearest tenth, third, or quarter if one of those is +# within the tolerance of .00001. sub compute_points { - my ($score, $weight) = @_; + my ($score, $weight, $latefrac) = @_; my $tolerance = .00001; my $points = $score * $weight; + if (($latefrac ne '') && + ($latefrac < 1) && ($latefrac >= 0)) { + $points = $points * $latefrac; + } # Check for nearness to 1/x. my $check_for_nearness = sub { @@ -1061,6 +1067,11 @@ sub verifyreceipt { return $string; } +#------------------------------------------------------------------- + +#------------------------------------------- Grade Passback Routines +# + sub initialpassback { my ($request,$symb) = @_; my $cdom = $env{"course.$env{'request.course.id'}.domain"}; @@ -1258,18 +1269,18 @@ sub do_passback { my $cdom = $env{"course.$env{'request.course.id'}.domain"}; my $cnum = $env{"course.$env{'request.course.id'}.num"}; my $crstype = &Apache::loncommon::course_type(); - my ($launcher,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen); + my ($launchsymb,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen); if ($env{'form.passback'} ne '') { $chosen = &unescape($env{'form.passback'}); ($linkuri,$linkprotector,$scope) = split("\0",$chosen); - ($launcher,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen); + ($launchsymb,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen); } - if ($launcher ne '') { - $request->print(&launcher_info_box($launcher,$appname,$setter,$linkuri,$scope)); + if ($launchsymb ne '') { + $request->print(&launcher_info_box($launchsymb,$appname,$setter,$linkuri,$scope)); } my $error; if ($perm{'mgr'}) { - if ($launcher ne '') { + if ($launchsymb ne '') { my @poss_students = &Apache::loncommon::get_env_multiple('form.stuinfo'); if (@poss_students) { my %possibles; @@ -1307,12 +1318,11 @@ sub do_passback { if ($lti_in_use->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) { $scoretype = $1; } - my $pbsymb = &Apache::loncommon::symb_from_tinyurl($linkuri,$cnum,$cdom); my $pbmap; - if ($pbsymb =~ /\.(page|sequence)$/) { - $pbmap = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pbsymb))[2]); + if ($launchsymb =~ /\.(page|sequence)$/) { + $pbmap = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($launchsymb))[2]); } else { - $pbmap = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pbsymb))[0]); + $pbmap = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($launchsymb))[0]); } $pbmap = &Apache::lonnet::clutter($pbmap); my $pbscope; @@ -1323,21 +1333,17 @@ sub do_passback { } elsif ($scope eq 'rec') { $pbscope = 'map'; } - my $sigmethod = 'HMAC-SHA1'; - my $type = 'linkprot'; - my $clientip = &Apache::lonnet::get_requestor_ip(); - my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; - my $ip = &Apache::lonnet::get_host_ip($lonhost); + my %pb = &common_passback_info(); my $numstudents = scalar(keys(%tosend)); my %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($request,$numstudents); my $outcome = &Apache::loncommon::start_data_table(). - &Apache::loncommon::start_data_table_header_row(); + &Apache::loncommon::start_data_table_header_row(); my $loop = 0; while ($loop < 2) { $outcome .= ''.&mt('No.').''. - ''.&nameUserString('header').' '.&mt('Section/Group').''. - ''.&mt('Score').''; - $loop++; + ''.&nameUserString('header').' '.&mt('Section/Group').''. + ''.&mt('Score').''; + $loop++; } $outcome .= &Apache::loncommon::end_data_table_header_row()."\n"; my $ctr=0; @@ -1364,14 +1370,14 @@ sub do_passback { $possible = 0; my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom); if (ref($navmap)) { - my $res = $navmap->getBySymb($pbsymb); + my $res = $navmap->getBySymb($launchsymb); if (ref($res)) { my $partlist = $res->parts(); if (ref($partlist) eq 'ARRAY') { - my %record = &Apache::lonnet::restore($pbsymb,$env{'request.course.id'},$udom,$uname); + my %record = &Apache::lonnet::restore($launchsymb,$env{'request.course.id'},$udom,$uname); foreach my $part (@{$partlist}) { next if ($record{"resource.$part.solved"} =~/^excused/); - my $weight = &Apache::lonnet::EXT("resource.$part.weight",$pbsymb,$udom,$uname,$usec); + my $weight = &Apache::lonnet::EXT("resource.$part.weight",$launchsymb,$udom,$uname,$usec); $possible += $weight; if (($record{'version'}) && (exists($record{"resource.$part.awarded"}))) { my $awarded = $record{"resource.$part.awarded"}; @@ -1385,12 +1391,12 @@ sub do_passback { } } elsif (($pbscope eq 'map') || ($pbscope eq 'nonrec')) { ($total,$possible) = - &Apache::lonhomework::get_lti_score($uname,$udom,$pbmap,$pbscope); + &Apache::lonhomework::get_lti_score($uname,$udom,$usec,$pbmap,$pbscope); } if (($id ne '') && ($url ne '') && ($possible)) { my ($sent,$score,$code,$result) = - &LONCAPA::ltiutils::send_grade($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id, - $url,$scoretype,$sigmethod,$msgformat,$total,$possible); + &LONCAPA::ltiutils::send_grade($cdom,$cnum,$crsdef,$pb{'type'},$ltinum,$keynum,$id, + $url,$scoretype,$pb{'sigmethod'},$msgformat,$total,$possible); my $no_passback; if ($sent) { if ($code == 200) { @@ -1398,33 +1404,32 @@ sub do_passback { my $namespace = $cdom.'_'.$cnum.'_lp_passback'; my $store = { 'score' => $score, - 'ip' => $ip, - 'host' => $lonhost, + 'ip' => $pb{'ip'}, + 'host' => $pb{'lonhost'}, 'protector' => $linkprotector, 'deeplink' => $linkuri, 'scope' => $scope, 'url' => $url, 'id' => $id, - 'clientip' => $clientip, + 'clientip' => $pb{'clientip'}, 'whodoneit' => $env{'user.name'}.':'.$env{'user.domain'}, - }; + }; my $value=''; foreach my $key (keys(%{$store})) { $value.=&escape($key).'='.&Apache::lonnet::freeze_escape($store->{$key}).'&'; } $value=~s/\&$//; &Apache::lonnet::courselog(&escape($linkuri).':'.$uname.':'.$udom.':EXPORT:'.$value); - &Apache::lonnet::cstore({'score' => $score},$chosen,$namespace,$udom,$uname,'',$ip,1); + &Apache::lonnet::store_userdata({'score' => $score},$chosen,$namespace,$udom,$uname,$pb{'ip'}); $ctr++; if ($ctr%2 ==1) { $outcome .= &Apache::loncommon::start_data_table_row(); } - my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; $outcome .= ''.$ctr.' '. - ''.&nameUserString(undef,$$fullname{$student},$uname,$udom). - ' '.$section.($group ne '' ?'/'.$group:'').''. - ''.$score.''."\n"; + ''.&nameUserString(undef,$$fullname{$student},$uname,$udom). + ' '.$usec.($group ne '' ?'/'.$group:'').''. + ''.$score.''."\n"; if ($ctr%2 ==0) { $outcome .= &Apache::loncommon::end_data_table_row()."\n"; } @@ -1440,27 +1445,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' => $type, - 'pbscope' => $pbscope, - 'pbmap' => $pbmap, - 'pbsymb' => $pbsymb, - 'format' => $scoretype, - 'scope' => $scope, - 'clientip' => $clientip, - 'linkprot' => $linkprotector, - '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' => $launchsymb, + '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); } @@ -1574,31 +1583,27 @@ sub get_passback_launcher { } } } - if ($linkuri =~ m{^\Q/tiny/$cdom/\E(\w+)$}) { - my $key = $1; - my $tinyurl; - my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key); - if (defined($cached)) { - $tinyurl = $result; - } else { - my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); - my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname); - if ($currtiny{$key} ne '') { - $tinyurl = $currtiny{$key}; - &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600); - } - } - if ($tinyurl) { - my ($crsnum,$launchsymb) = split(/\&/,$tinyurl); - if ($crsnum eq $cnum) { - my %passback = &Apache::lonnet::get('nohist_linkprot_passback',[$launchsymb],$cdom,$cnum); - if (ref($passback{$launchsymb}) eq 'HASH') { - if (exists($passback{$launchsymb}{$chosen})) { - return ($launchsymb,$appname,$setter) - } + my $launchsymb = &Apache::loncommon::symb_from_tinyurl($linkuri,$cnum,$cdom); + if ($launchsymb eq '') { + my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum); + foreach my $poss_symb (keys(%passback)) { + if (ref($passback{$poss_symb}) eq 'HASH') { + if (exists($passback{$poss_symb}{$chosen})) { + $launchsymb = $poss_symb; + last; } } } + if ($launchsymb ne '') { + return ($launchsymb,$appname,$setter); + } + } else { + my %passback = &Apache::lonnet::get('nohist_linkprot_passback',[$launchsymb],$cdom,$cnum); + if (ref($passback{$launchsymb}) eq 'HASH') { + if (exists($passback{$launchsymb}{$chosen})) { + return ($launchsymb,$appname,$setter); + } + } } return (); } @@ -1666,6 +1671,273 @@ sub launcher_info_box { &Apache::lonhtmlcommon::end_pick_box().'

'."\n"; } +sub passbacks_for_symb { + my ($cdom,$cnum,$symb) = @_; + my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum); + my %needpb; + if (keys(%passback)) { + my $checkpb = 1; + if (exists($passback{$symb})) { + if (keys(%passback) == 1) { + undef($checkpb); + } + if (ref($passback{$symb}) eq 'HASH') { + foreach my $launcher (keys(%{$passback{$symb}})) { + $needpb{$launcher} = $symb; + } + } + } + if ($checkpb) { + my ($map,$id,$url) = &Apache::lonnet::decode_symb($symb); + my $navmap = Apache::lonnavmaps::navmap->new(); + if (ref($navmap)) { + my $mapres = $navmap->getResourceByUrl($map); + if (ref($mapres)) { + my $mapsymb = $mapres->symb(); + if (exists($passback{$mapsymb})) { + if (keys(%passback) == 1) { + undef($checkpb); + } + if (ref($passback{$mapsymb}) eq 'HASH') { + foreach my $launcher (keys(%{$passback{$mapsymb}})) { + $needpb{$launcher} = $mapsymb; + } + } + } + my %posspb; + if ($checkpb) { + my @recurseup = $navmap->recurseup_maps($map,1); + if (@recurseup) { + map { $posspb{$_} = 1; } @recurseup; + } + } + foreach my $key (keys(%passback)) { + if (exists($posspb{$key})) { + if (ref($passback{$key}) eq 'HASH') { + foreach my $launcher (keys(%{$passback{$key}})) { + my ($linkuri,$linkprotector,$scope) = split("\0",$launcher); + next unless ($scope eq 'rec'); + $needpb{$launcher} = $key; + } + } + } + } + } + } + } + } + return %needpb; +} + +sub process_passbacks { + 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); + if ((ref($symbs) eq 'ARRAY') && (ref($weights) eq 'HASH') && (ref($awardeds) eq 'HASH') && + (ref($excuseds) eq 'HASH')) { + %weight = %{$weights}; + %awarded = %{$awardeds}; + %excused = %{$excuseds}; + } + my $uhome = &Apache::lonnet::homeserver($uname,$udom); + my @launchers = keys(%{$needpb}); + my %pbinfo; + if (ref($pbids) eq 'HASH') { + %pbinfo = %{$pbids}; + } else { + %pbinfo = &Apache::lonnet::get('nohist_'.$cdom.'_'.$cnum.'_linkprot_pb',\@launchers,$udom,$uname); + } + my %pbc = &common_passback_info(); + foreach my $launcher (@launchers) { + if (ref($pbinfo{$launcher}) eq 'ARRAY') { + my $pbid = $pbinfo{$launcher}[0]; + my $pburl = $pbinfo{$launcher}[1]; + my (%total_by_symb,%possible_by_symb); + if (($pbid ne '') && ($pburl ne '')) { + next if ($skip_passback->{$launcher}); + my %pb = %pbc; + if ((exists($pbsave->{$launcher})) && + (ref($pbsave->{$launcher}) eq 'HASH')) { + foreach my $item ('lti_in_use','crsdef','ltinum','keynum','scoretype','msgformat', + 'symb','map','pbscope','linkuri','linkprotector','scope') { + $pb{$item} = $pbsave->{$launcher}{$item}; + } + } else { + my $ltitype; + ($pb{'linkuri'},$pb{'linkprotector'},$pb{'scope'}) = split("\0",$launcher); + ($pb{'ltinum'},$ltitype) = ($pb{'linkprotector'} =~ /^(\d+)(c|d)$/); + if ($ltitype eq 'c') { + my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider'); + $pb{'lti_in_use'} = $crslti{$pb{'ltinum'}}; + $pb{'crsdef'} = 1; + } else { + my %domlti = &Apache::lonnet::get_domain_lti($cdom,'linkprot'); + $pb{'lti_in_use'} = $domlti{$pb{'ltinum'}}; + } + if (ref($pb{'lti_in_use'}) eq 'HASH') { + $pb{'msgformat'} = $pb{'lti_in_use'}->{'passbackformat'}; + $pb{'keynum'} = $pb{'lti_in_use'}->{'cipher'}; + $pb{'scoretype'} = 'decimal'; + if ($pb{'lti_in_use'}->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) { + $pb{'scoretype'} = $1; + } + $pb{'symb'} = $needpb->{$launcher}; + if ($pb{'symb'} =~ /\.(page|sequence)$/) { + $pb{'map'} = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pb{'symb'}))[2]); + } else { + $pb{'map'} = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pb{'symb'}))[0]); + } + $pb{'map'} = &Apache::lonnet::clutter($pb{'map'}); + if ($pb{'scope'} eq 'res') { + $pb{'pbscope'} = 'resource'; + } elsif ($pb{'scope'} eq 'map') { + $pb{'pbscope'} = 'nonrec'; + } elsif ($pb{'scope'} eq 'rec') { + $pb{'pbscope'} = 'map'; + } + foreach my $item ('lti_in_use','crsdef','ltinum','keynum','scoretype','msgformat', + 'symb','map','pbscope','linkuri','linkprotector','scope') { + $pbsave->{$launcher}{$item} = $pb{$item}; + } + } else { + $skip_passback->{$launcher} = 1; + } + } + if (ref($symbs) eq 'ARRAY') { + foreach my $symb (@{$symbs}) { + if ((ref($weight{$symb}) eq 'HASH') && (ref($awarded{$symb}) eq 'HASH') && + (ref($excused{$symb}) eq 'HASH')) { + foreach my $part (keys(%{$weight{$symb}})) { + if ($excused{$symb}{$part}) { + next; + } + my $partweight = $weight{$symb}{$part} eq '' ? 1 : + $weight{$symb}{$part}; + if ($awarded{$symb}{$part}) { + $total_by_symb{$symb} += $partweight * $awarded{$symb}{$part}; + } + $possible_by_symb{$symb} += $partweight; + } + } + } + } + if ($context eq 'updatebypage') { + my $ltigrade = { + 'ltinum' => $pb{'ltinum'}, + 'lti' => $pb{'lti_in_use'}, + 'crsdef' => $pb{'crsdef'}, + 'cid' => $cdom.'_'.$cnum, + 'uname' => $uname, + 'udom' => $udom, + 'uhome' => $uhome, + 'usec' => $usec, + 'pbid' => $pbid, + 'pburl' => $pburl, + 'pbtype' => $pb{'type'}, + 'pbscope' => $pb{'pbscope'}, + 'pbmap' => $pb{'map'}, + 'pbsymb' => $pb{'symb'}, + 'format' => $pb{'scoretype'}, + 'scope' => $pb{'scope'}, + 'clientip' => $pb{'clientip'}, + 'linkprot' => $pb{'linkprotector'}.':'.$pb{'linkuri'}, + 'total_s' => \%total_by_symb, + 'possible_s' => \%possible_by_symb, + }; + push(@Apache::grades::ltipassback,$ltigrade); + next; + } + my ($total,$possible); + if ($pb{'pbscope'} eq 'resource') { + $total = $total_by_symb{$pb{'symb'}}; + $possible = $possible_by_symb{$pb{'symb'}}; + } elsif (($pb{'pbscope'} eq 'map') || ($pb{'pbscope'} eq 'nonrec')) { + ($total,$possible) = + &Apache::lonhomework::get_lti_score($uname,$udom,$usec,$pb{'map'},$pb{'pbscope'}, + \%total_by_symb,\%possible_by_symb); + } + if (!$possible) { + $total = 0; + $possible = 1; + } + my ($sent,$score,$code,$result) = + &LONCAPA::ltiutils::send_grade($cdom,$cnum,$pb{'crsdef'},$pb{'type'},$pb{'ltinum'}, + $pb{'keynum'},$pbid,$pburl,$pb{'scoretype'},$pb{'sigmethod'}, + $pb{'msgformat'},$total,$possible); + my $no_passback; + if ($sent) { + if ($code == 200) { + my $namespace = $cdom.'_'.$cnum.'_lp_passback'; + my $store = { + 'score' => $score, + 'ip' => $pb{'ip'}, + 'host' => $pb{'lonhost'}, + 'protector' => $pb{'linkprotector'}, + 'deeplink' => $pb{'linkuri'}, + 'scope' => $pb{'scope'}, + 'url' => $pburl, + 'id' => $pbid, + 'clientip' => $pb{'clientip'}, + 'whodoneit' => $env{'user.name'}.':'.$env{'user.domain'}, + }; + my $value=''; + foreach my $key (keys(%{$store})) { + $value.=&escape($key).'='.&Apache::lonnet::freeze_escape($store->{$key}).'&'; + } + $value=~s/\&$//; + &Apache::lonnet::courselog(&escape($pb{'linkuri'}).':'.$uname.':'.$udom.':EXPORT:'.$value); + &Apache::lonnet::store_userdata({'score' => $score},$launcher,$namespace,$udom,$uname,$pb{'ip'}); + } else { + $no_passback = 1; + } + } else { + $no_passback = 1; + } + if ($no_passback) { + &Apache::lonnet::log($udom,$uname,$uhome,$no_passback." score: $score; total: $total; possible: $possible"); + my $ltigrade = { + 'ltinum' => $pb{'ltinum'}, + 'lti' => $pb{'lti_in_use'}, + 'crsdef' => $pb{'crsdef'}, + 'cid' => $cdom.'_'.$cnum, + 'uname' => $uname, + 'udom' => $udom, + 'uhome' => $uhome, + 'pbid' => $pbid, + 'pburl' => $pburl, + 'pbtype' => $pb{'type'}, + 'pbscope' => $pb{'pbscope'}, + 'pbmap' => $pb{'map'}, + 'pbsymb' => $pb{'symb'}, + 'format' => $pb{'scoretype'}, + 'scope' => $pb{'scope'}, + 'clientip' => $pb{'clientip'}, + 'linkprot' => $pb{'linkprotector'}.':'.$pb{'linkuri'}, + 'total' => $total, + 'possible' => $possible, + 'score' => $score, + }; + &Apache::lonnet::put('linkprot_passback_pending',$ltigrade,$cdom,$cnum); + } + } + } + } + } + return; +} + +sub common_passback_info { + my %pbc = ( + sigmethod => 'HMAC-SHA1', + type => 'linkprot', + clientip => &Apache::lonnet::get_requestor_ip(), + lonhost => $Apache::lonnet::perlvar{'lonHostID'}, + ip => &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}), + ); + return %pbc; +} + #--- This is called by a number of programs. #--- Called from the Grading Menu - View/Grade an individual student #--- Also called directly when one clicks on the subm button @@ -2685,7 +2957,8 @@ sub gradeBox { : ''.&mt('problem weight assigned by computer').''; $wgt = ($wgt > 0 ? $wgt : '1'); my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ? - '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt)); + '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt, + $$record{'resource.'.$partid.'.latefrac'})); my $data_WGT=''."\n"; my $display_part= &get_display_part($partid,$symb); my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, @@ -3914,11 +4187,13 @@ sub processHandGrade { } if ($button eq 'Save & Next') { + my %needpb = &passbacks_for_symb($cdom,$cnum,$symb); + my (%skip_passback,%pbsave,%pbcollab); my $ctr = 0; while ($ctr < $ngrade) { my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr}); my ($errorflag,$pts,$wgt,$numhidden) = - &saveHandGrade($request,$symb,$uname,$udom,$ctr,undef,undef,\%queueable); + &saveHandGrade($request,$symb,$uname,$udom,$ctr,undef,undef,\%queueable,\%needpb,\%skip_passback,\%pbsave); if ($errorflag eq 'no_score') { $ctr++; next; @@ -3971,28 +4246,77 @@ 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); if ($errorflag eq 'not_allowed') { $request->print("".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom").""); next; - } elsif ($message ne '') { - my ($baseurl,$showsymb) = - &get_feedurl_and_symb($symb,$collaborator, - $udom); - if ($env{'form.withgrades'.$ctr}) { - $messagetail = " for $restitle"; + } else { + 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"; + } + $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))) { + 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); + } + } + } + } + } + } + } } my %keyhash = (); @@ -4146,7 +4470,8 @@ sub processHandGrade { #---- Save the score and award for each student, if changed sub saveHandGrade { - my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part,$queueable) = @_; + my ($request,$symb,$stuname,$domain,$newflg,$submitter, + $part,$queueable,$needpb,$skip_passback,$pbsave) = @_; my @version_parts; my $usec = &Apache::lonnet::getsection($domain,$stuname, $env{'request.course.id'}); @@ -4154,7 +4479,7 @@ 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,$poss_pb) = ('','',0,0,0); my %aggregate = (); my $aggregateflag = 0; if ($env{'form.HIDE'.$newflg}) { @@ -4162,18 +4487,33 @@ sub saveHandGrade { my $numchgs = &makehidden($version,$parts,\%record,$symb,$domain,$stuname,1); $totchg += $numchgs; } + if ((ref($needpb) eq 'HASH') && (keys(%{$needpb}))) { + $poss_pb = 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 ($poss_pb) { + $weights{$symb}{$new_part} = + &Apache::lonnet::EXT('resource.'.$new_part.'.weight',$symb,$domain,$stuname); + } elsif ($env{'form.WGT'.$newflg.'_'.$new_part} eq '') { + $weights{$symb}{$new_part} = 1; + } else { + $weights{$symb}{$new_part} = $env{'form.WGT'.$newflg.'_'.$new_part}; + } if ($dropMenu eq 'excused') { + $excuseds{$symb}{$new_part} = 1; + $awardeds{$symb}{$new_part} = ''; if ($record{'resource.'.$new_part.'.solved'} ne 'excused') { $newrecord{'resource.'.$new_part.'.solved'} = 'excused'; if (exists($record{'resource.'.$new_part.'.awarded'})) { $newrecord{'resource.'.$new_part.'.awarded'} = ''; } $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; + $sendupdate ++; } } elsif ($dropMenu eq 'reset status' && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts @@ -4197,6 +4537,9 @@ sub saveHandGrade { &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); $aggregateflag = 1; } + $sendupdate ++; + $excuseds{$symb}{$new_part} = ''; + $awardeds{$symb}{$new_part} = ''; } elsif ($dropMenu eq '') { $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? $env{'form.GD_BOX'.$newflg.'_'.$new_part} : @@ -4207,12 +4550,15 @@ sub saveHandGrade { $wgt = $env{'form.WGT'.$newflg.'_'.$new_part} eq '' ? 1 : $env{'form.WGT'.$newflg.'_'.$new_part}; my $partial= $pts/$wgt; + $awardeds{$symb}{$new_part} = $partial; + $excuseds{$symb}{$new_part} = ''; if ($partial eq $record{'resource.'.$new_part.'.awarded'}) { #do not update score for part if not changed. &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); next; } else { push(@parts_graded,$new_part); + $sendupdate ++; } if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { $newrecord{'resource.'.$new_part.'.awarded'} = $partial; @@ -4264,7 +4610,11 @@ sub saveHandGrade { &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, $cdom,$cnum); } - return ('',$pts,$wgt,$totchg); + if (($sendupdate || $totchg) && (!$submitter) && ($poss_pb)) { + &process_passbacks('handgrade',[$symb],$cdom,$cnum,$domain,$stuname,$usec,\%weights, + \%awardeds,\%excuseds,$needpb,$skip_passback,$pbsave); + } + return ('',$pts,$wgt,$totchg,$sendupdate); } sub makehidden { @@ -5076,6 +5426,7 @@ sub viewstudentgrade { foreach my $apart (@$parts) { my ($part,$type) = &split_part_type($apart); my $score=$record{"resource.$part.$type"}; + my $latefrac=$record{"resource.$part.latefrac"}; $result.=''; my ($aggtries,$totaltries); unless (exists($aggregates{$part})) { @@ -5092,7 +5443,7 @@ sub viewstudentgrade { $aggregates{$part} = 1; } if ($type eq 'awarded') { - my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part}); + my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part},$latefrac); $result.=''."\n"; $result.=' '.$updateCtr.' '.$line. &Apache::loncommon::end_data_table_row(); $updateCtr++; + if (keys(%needpb)) { + $weights{$symb} = \%weight; + &process_passbacks('editgrades',[$symb],$cdom,$cnum,$udom,$uname,$usec,\%weights, + \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave); + } } else { push(@noupdate, ' '.$noupdateCtr.' '.$line); @@ -5704,11 +6068,33 @@ sub csvuploadassign { my @gradedata = &Apache::loncommon::upfile_record_sep(); my %fields=&get_fields(); my $courseid=$env{'request.course.id'}; + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my ($classlist) = &getclasslist('all',0); my @notallowed; my @skipped; my @warnings; my $countdone=0; + my @parts; + my %needpb = &passbacks_for_symb($cdom,$cnum,$symb); + my $passback; + if (keys(%needpb)) { + $passback = 1; + my $navmap = Apache::lonnavmaps::navmap->new(); + if (ref($navmap)) { + my $res = $navmap->getBySymb($symb); + if (ref($res)) { + my $partlist = $res->parts(); + if (ref($partlist) eq 'ARRAY') { + @parts = sort(@{$partlist}); + } + } + } else { + return &navmap_errormsg(); + } + } + my (%skip_passback,%pbsave,%weights,%awardeds,%excuseds); + foreach my $grade (@gradedata) { my %entries=&Apache::loncommon::record_sep($grade); my $domain; @@ -5783,9 +6169,14 @@ sub csvuploadassign { my $part=$1; my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', $symb,$domain,$username); + $weights{$symb}{$part} = $wgt; if ($wgt) { $entries{$fields{$dest}}=~s/\s//g; my $pcr=$entries{$fields{$dest}} / $wgt; + if ($passback) { + $awardeds{$symb}{$part} = $pcr; + $excuseds{$symb}{$part} = ''; + } my $award=($pcr == 0) ? 'incorrect_by_override' : 'correct_by_override'; if ($pcr>1) { @@ -5805,6 +6196,22 @@ sub csvuploadassign { if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } my $store_key=$dest; + if ($passback) { + if ($store_key=~/stores_(.*)_(awarded|solved)/) { + my ($part,$key) = ($1,$2); + unless ((ref($weights{$symb}) eq 'HASH') && (exists($weights{$symb}{$part}))) { + $weights{$symb}{$part} = &Apache::lonnet::EXT('resource.'.$part.'.weight', + $symb,$domain,$username); + } + if ($key eq 'awarded') { + $awardeds{$symb}{$part} = $entries{$fields{$dest}}; + } elsif ($key eq 'solved') { + if ($entries{$fields{$dest}} =~ /^excused/) { + $excuseds{$symb}{$part} = 1; + } + } + } + } $store_key=~s/^stores/resource/; $store_key=~s/_/\./g; $grades{$store_key}=$entries{$fields{$dest}}; @@ -5821,11 +6228,32 @@ sub csvuploadassign { # Successfully stored $request->print('.'); # Remove from grading queue - &Apache::bridgetask::remove_from_queue('gradingqueue',$symb, - $env{'course.'.$env{'request.course.id'}.'.domain'}, - $env{'course.'.$env{'request.course.id'}.'.num'}, - $domain,$username); + &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom,$cnum, + $domain,$username); $countdone++; + if ($passback) { + my @parts_in_upload; + if (ref($weights{$symb}) eq 'HASH') { + @parts_in_upload = sort(keys(%{$weights{$symb}})); + } + my @diffs = &Apache::loncommon::compare_arrays(\@parts_in_upload,\@parts); + if (@diffs > 0) { + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$username); + foreach my $part (@parts) { + next if (grep(/^\Q$part\E$/,@parts_in_upload)); + $weights{$symb}{$part} = &Apache::lonnet::EXT('resource.'.$part.'.weight', + $symb,$domain,$username); + if ($record{"resource.$part.solved"} =~/^excused/) { + $excuseds{$symb}{$part} = 1; + } else { + $excuseds{$symb}{$part} = ''; + } + $awardeds{$symb}{$part} = $record{"resource.$part.awarded"}; + } + } + &process_passbacks('csvupload',[$symb],$cdom,$cnum,$domain,$username,$usec,\%weights, + \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave); + } } else { $request->print("

". &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", @@ -6421,6 +6849,7 @@ sub updateGradeByPage { $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" my ($depth,$question,$prob,$changeflag,$hideflag)= (1,1,1,0,0); + my (@updates,%weights,%excuseds,%awardeds,@symbs_in_map); while ($depth > 0) { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } @@ -6429,6 +6858,7 @@ sub updateGradeByPage { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); + push(@symbs_in_map,$symbx); $studentTable.= &Apache::loncommon::start_data_table_row(). ''.$prob. @@ -6446,6 +6876,9 @@ sub updateGradeByPage { my %record = &Apache::lonnet::restore($symbx,$env{'request.course.id'},$udom,$uname); my ($version,$parts) = split(/:/,$env{'form.HIDE'.$prob},2); my $numchgs = &makehidden($version,$parts,\%record,$symbx,$udom,$uname,1); + if ($numchgs) { + push(@updates,$symbx); + } $hideflag += $numchgs; } foreach my $partid (@{$parts}) { @@ -6467,6 +6900,8 @@ sub updateGradeByPage { } my $wgt = $env{'form.WGT'.$question.'_'.$partid} != 0 ? $env{'form.WGT'.$question.'_'.$partid} : 1; + $weights{$symbx}{$partid} = $wgt; + $excuseds{$symbx}{$partid} = ''; my $partial = $newpts/$wgt; my $score; if ($partial > 0) { @@ -6478,6 +6913,7 @@ sub updateGradeByPage { if ($dropMenu eq 'excused') { $partial = ''; $score = 'excused'; + $excuseds{$symbx}{$partid} = 1; } elsif ($dropMenu eq 'reset status' && $env{'form.solved'.$question.'_'.$partid} ne '') { #update only if previous record exists $newrecord{'resource.'.$partid.'.tries'} = 0; @@ -6505,6 +6941,11 @@ sub updateGradeByPage { (($score eq 'excused') ? 'excused' : $newpts). ' 
'; $question++; + if (($newpts eq '') || ($partial eq '')) { + $awardeds{$symbx}{$partid} = 0; + } else { + $awardeds{$symbx}{$partid} = $partial; + } next if ($dropMenu eq 'reset status' || ($newpts eq $oldpts && $score ne 'excused')); $newrecord{'resource.'.$partid.'.awarded'} = $partial if $partial ne ''; @@ -6544,6 +6985,9 @@ sub updateGradeByPage { &Apache::loncommon::end_data_table_row(); $prob++; + if ($changeflag) { + push(@updates,$symbx); + } } $curRes = $iterator->next(); } @@ -6557,9 +7001,95 @@ sub updateGradeByPage { $hideflag).'
'); $request->print($hidemsg.$grademsg.$studentTable); + if (@updates) { + my (@allsymbs,$mapsymb,@recurseup,%parentmapsymbs,%possmappb,%possrespb); + @allsymbs = @updates; + if (ref($map)) { + $mapsymb = $map->symb(); + push(@allsymbs,$mapsymb); + @recurseup = $navmap->recurseup_maps($map->src,1); + } + if (@recurseup) { + push(@allsymbs,@recurseup); + map { $parentmapsymbs{$_} = 1; } @recurseup; + } + my %passback = &Apache::lonnet::get('nohist_linkprot_passback',\@allsymbs,$cdom,$cnum); + my (%uniqsymbs,$use_symbs_in_map,%launch_to_symb); + if (keys(%passback)) { + foreach my $possible (keys(%passback)) { + if (ref($passback{$possible}) eq 'HASH') { + if ($possible eq $mapsymb) { + foreach my $launcher (keys(%{$passback{$possible}})) { + $possmappb{$launcher} = 1; + $launch_to_symb{$launcher} = $possible; + } + $use_symbs_in_map = 1; + } elsif (exists($parentmapsymbs{$possible})) { + foreach my $launcher (keys(%{$passback{$possible}})) { + my ($linkuri,$linkprotector,$scope) = split(/\0/,$launcher); + if ($scope eq 'rec') { + $possmappb{$launcher} = 1; + $use_symbs_in_map = 1; + $launch_to_symb{$launcher} = $possible; + } + } + } elsif (grep(/^\Q$possible$\E$/,@updates)) { + foreach my $launcher (keys(%{$passback{$possible}})) { + $possrespb{$launcher} = 1; + $launch_to_symb{$launcher} = $possible; + } + $uniqsymbs{$possible} = 1; + } + } + } + } + if ($use_symbs_in_map) { + map { $uniqsymbs{$_} = 1; } @symbs_in_map; + } + my @posslaunchers; + if (keys(%possmappb)) { + push(@posslaunchers,keys(%possmappb)); + } + if (keys(%possrespb)) { + push(@posslaunchers,keys(%possrespb)); + } + if (@posslaunchers) { + my (%pbsave,%skip_passback,%needpb); + my %pbids = &Apache::lonnet::get('nohist_'.$cdom.'_'.$cnum.'_linkprot_pb',\@posslaunchers,$udom,$uname); + foreach my $key (keys(%pbids)) { + if (ref($pbids{$key}) eq 'ARRAY') { + if ($launch_to_symb{$key}) { + $needpb{$key} = $launch_to_symb{$key}; + } + } + } + my @symbs = keys(%uniqsymbs); + &process_passbacks('updatebypage',\@symbs,$cdom,$cnum,$udom,$uname,$usec,\%weights, + \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave,\%pbids); + if (@Apache::grades::ltipassback) { + unless ($registered_cleanup) { + my $handlers = $request->get_handlers('PerlCleanupHandler'); + $request->set_handlers('PerlCleanupHandler' => + [\&Apache::grades::make_passback,@{$handlers}]); + $registered_cleanup=1; + } + } + } + } 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 --------- # #------------------------------------------------------------------- @@ -12076,6 +12606,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 @@ -12185,6 +12719,15 @@ sub assign_clicker_grades { $result.="
Failed to save student $username:$domain. Message when trying to save was ($returncode)"; } else { $storecount++; + 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); + } } } } @@ -12343,6 +12886,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'};