--- loncom/homework/grades.pm 2024/12/13 05:04:49 1.805 +++ 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.805 2024/12/13 05:04:49 raeburn Exp $ +# $Id: grades.pm,v 1.811 2025/06/28 14:35:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -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 { @@ -1263,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; @@ -1312,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; @@ -1332,13 +1337,13 @@ sub do_passback { 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; @@ -1365,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"}; @@ -1386,7 +1391,7 @@ 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) = @@ -1408,24 +1413,23 @@ sub do_passback { 'id' => $id, '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,'',$pb{'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"; } @@ -1457,7 +1461,7 @@ sub do_passback { 'pbtype' => $pb{'type'}, 'pbscope' => $pbscope, 'pbmap' => $pbmap, - 'pbsymb' => $pbsymb, + 'pbsymb' => $launchsymb, 'format' => $scoretype, 'scope' => $scope, 'clientip' => $pb{'clientip'}, @@ -1579,29 +1583,25 @@ 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); + 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 ($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); - } - } + 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); } } } @@ -1683,7 +1683,7 @@ sub passbacks_for_symb { } if (ref($passback{$symb}) eq 'HASH') { foreach my $launcher (keys(%{$passback{$symb}})) { - $needpb{$launcher} = 1; + $needpb{$launcher} = $symb; } } } @@ -1700,7 +1700,7 @@ sub passbacks_for_symb { } if (ref($passback{$mapsymb}) eq 'HASH') { foreach my $launcher (keys(%{$passback{$mapsymb}})) { - $needpb{$launcher} = 1; + $needpb{$launcher} = $mapsymb; } } } @@ -1717,7 +1717,7 @@ sub passbacks_for_symb { foreach my $launcher (keys(%{$passback{$key}})) { my ($linkuri,$linkprotector,$scope) = split("\0",$launcher); next unless ($scope eq 'rec'); - $needpb{$launcher} = 1; + $needpb{$launcher} = $key; } } } @@ -1782,7 +1782,7 @@ sub process_passbacks { if ($pb{'lti_in_use'}->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) { $pb{'scoretype'} = $1; } - $pb{'symb'} = &Apache::loncommon::symb_from_tinyurl($pb{'linkuri'},$cnum,$cdom); + $pb{'symb'} = $needpb->{$launcher}; if ($pb{'symb'} =~ /\.(page|sequence)$/) { $pb{'map'} = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pb{'symb'}))[2]); } else { @@ -1854,7 +1854,7 @@ sub process_passbacks { $possible = $possible_by_symb{$pb{'symb'}}; } elsif (($pb{'pbscope'} eq 'map') || ($pb{'pbscope'} eq 'nonrec')) { ($total,$possible) = - &Apache::lonhomework::get_lti_score($uname,$udom,$pb{'map'},$pb{'pbscope'}, + &Apache::lonhomework::get_lti_score($uname,$udom,$usec,$pb{'map'},$pb{'pbscope'}, \%total_by_symb,\%possible_by_symb); } if (!$possible) { @@ -1887,7 +1887,7 @@ sub process_passbacks { } $value=~s/\&$//; &Apache::lonnet::courselog(&escape($pb{'linkuri'}).':'.$uname.':'.$udom.':EXPORT:'.$value); - &Apache::lonnet::cstore({'score' => $score},$launcher,$namespace,$udom,$uname,'',$pb{'ip'},1); + &Apache::lonnet::store_userdata({'score' => $score},$launcher,$namespace,$udom,$uname,$pb{'ip'}); } else { $no_passback = 1; } @@ -2957,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'}, @@ -4469,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,$needpb,$skip_passback,$pbsave) = @_; + 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'}); @@ -4477,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,$sendupdate) = ('','',0,0); + my ($pts,$wgt,$totchg,$sendupdate,$poss_pb) = ('','',0,0,0); my %aggregate = (); my $aggregateflag = 0; if ($env{'form.HIDE'.$newflg}) { @@ -4485,13 +4487,19 @@ 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 ($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 '') { + 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}; @@ -4602,12 +4610,9 @@ sub saveHandGrade { &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, $cdom,$cnum); } - if (($sendupdate || $totchg) && (!$submitter)) { - if ((ref($needpb) eq 'HASH') && - (keys(%{$needpb}))) { - &process_passbacks('handgrade',[$symb],$cdom,$cnum,$domain,$stuname,$usec,\%weights, - \%awardeds,\%excuseds,$needpb,$skip_passback,$pbsave); - } + 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); } @@ -5421,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})) { @@ -5437,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.='