--- loncom/homework/lonhomework.pm 2024/12/09 22:22:57 1.387 +++ loncom/homework/lonhomework.pm 2025/06/28 14:35:00 1.395 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Homework handler # -# $Id: lonhomework.pm,v 1.387 2024/12/09 22:22:57 raeburn Exp $ +# $Id: lonhomework.pm,v 1.395 2025/06/28 14:35:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -600,10 +600,12 @@ sub check_access { return ('SHOW_ANSWER'); } } - foreach my $temp ("opendate","duedate","answerdate") { + foreach my $temp ("opendate","duedate","overduedate","answerdate") { $lastdate = $date; if ($temp eq 'duedate') { $date = &due_date($id,$symb); + } elsif ($temp eq 'overduedate') { + $date = &overdue_date($id,$symb); } else { $date = &Apache::lonnet::EXT("resource.$id.$temp",$symb); } @@ -644,6 +646,9 @@ sub check_access { } elsif ($type eq 'duedate') { $status='CAN_ANSWER'; $datemsg = &mt('is due at [_1]',$date); + } elsif ($type eq 'overduedate') { + $status='CAN_ANSWER'; + $datemsg = &mt('past-due grace period until [_1]',$date); } elsif ($type eq 'answerdate') { $status='CLOSED'; $datemsg = &mt('was due on [_1], and answers will be available on [_2]', @@ -734,6 +739,76 @@ sub due_date { return $date; } +sub overdue_date { + my ($part_id,$symb,$udom,$uname)=@_; + my $date; + my $duedate= &Apache::lonnet::EXT("resource.$part_id.duedate",$symb, + $udom,$uname); + if ($duedate ne '') { + my $grace = &Apache::lonnet::EXT("resource.$part_id.grace",$symb, + $udom,$uname); + if ($grace) { + my $grace_end = (split(/,/,$grace))[-1]; + my ($offset) = split(/:/,$grace_end,2); + if ($offset > 0) { + $date = $offset + $duedate; + } + } + } + return $date; +} + +sub partial_credit_overdue { + my ($part_id,$symb,$udom,$uname)=@_; + my $reduction; + my $duedate = &Apache::lonnet::EXT("resource.$part_id.duedate",$symb, + $udom,$uname); + if ($duedate) { + my $grace = &Apache::lonnet::EXT("resource.$part_id.grace",$symb, + $udom,$uname); + if ($grace) { + my $lateness = time - $duedate; + if ($lateness > 0) { + my ($start,$end,$startfrac,$endfrac,$usegrad); + $start = 0; + $startfrac = 1.0; + $usegrad = 0; + foreach my $item (split(/,/,$grace)) { + my ($offset,$frac,$grad) = split(/:/,$item); + if ($lateness > $offset) { + $start = $offset; + $startfrac = $frac; + next; + } elsif ($lateness <= $offset) { + $end = $offset; + $endfrac = $frac; + $usegrad = $grad; + last; + } + } + if ($end) { + if (($end == $start) || ($startfrac == $endfrac)) { + $reduction = $endfrac; + } elsif ($end - $start > 0) { + if (($endfrac <= 1.0) && ($endfrac >= 0)) { + $reduction = $endfrac; + if ($usegrad) { + my $decline = $startfrac - $endfrac; + my $fraction = ($lateness - $start)/($end - $start); + if (($fraction <= 1) && ($fraction >= 0)) { + my $value = $startfrac - ($decline*$fraction); + $reduction = sprintf("%.2f", $value); + } + } + } + } + } + } + } + } + return $reduction; +} + sub seconds_to_human_length { my ($length)=@_; @@ -1989,6 +2064,7 @@ sub do_ltipassback { } undef(@Apache::lonhomework::ltipassback); } + return OK; } sub run_passback { @@ -2008,6 +2084,7 @@ sub run_passback { my $uname = $item->{'uname'}; my $udom = $item->{'udom'}; my $uhome = $item->{'uhome'}; + my $usec = $item->{'usec'}; my $keynum = $item->{'lti'}->{'cipher'}; my $crsdef = $item->{'crsdef'}; my $scoretype = $item->{'format'}; @@ -2041,12 +2118,12 @@ sub run_passback { if (($pbscope eq 'map') || ($pbscope eq 'nonrec')) { if ((keys(%total_by_symb)) && (keys(%possible_by_symb))) { ($total,$possible) = - &get_lti_score($uname,$udom,$map,$pbscope,\%total_by_symb,\%possible_by_symb); + &get_lti_score($uname,$udom,$usec,$map,$pbscope,\%total_by_symb,\%possible_by_symb); } else { - ($total,$possible) = &get_lti_score($uname,$udom,$map,$pbscope); + ($total,$possible) = &get_lti_score($uname,$udom,$usec,$map,$pbscope); } } elsif ($pbscope eq 'course') { - ($total,$possible) = &get_lti_score($uname,$udom); + ($total,$possible) = &get_lti_score($uname,$udom,$usec); } $item->{'total'} = $total; $item->{'possible'} = $possible; @@ -2082,7 +2159,7 @@ sub run_passback { } $value=~s/\&$//; &Apache::lonnet::courselog(&escape($linkuri).':'.$uname.':'.$udom.':EXPORT:'.$value); - &Apache::lonnet::cstore({'score' => $score},$skey,$namespace,$udom,$uname,'',$ip,1); + &Apache::lonnet::store_userdata({'score' => $score},$skey,$namespace,$udom,$uname,$ip); } } else { if ($item->{'linkprot'}) { @@ -2111,7 +2188,11 @@ sub run_passback { $no_passback .= " LTI launcher $linkprotector ($appname) for $linkuri (${cdom}_${cnum})"; &Apache::lonnet::logthis($no_passback." for $uname:$udom"); &Apache::lonnet::log($udom,$uname,$uhome,"$no_passback score=$score total=$total poss=$possible"); - &Apache::lonnet::put('linkprot_passback_pending',$item,$cdom,$cnum); + if ($item->{'linkprot'}) { + my $pendingkey = &Time::HiRes::time().':'.$uname.':'.$udom.':'. + "$linkuri\0$linkprotector\0$scope"; + &Apache::lonnet::put('linkprot_passback_pending',{$pendingkey => $item},$cdom,$cnum); + } } } } @@ -2121,19 +2202,21 @@ sub run_passback { } sub get_lti_score { - my ($uname,$udom,$mapurl,$pbscope,$totals,$possibles) = @_; - my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom); + my ($uname,$udom,$usec,$mapurl,$pbscope,$totals,$possibles) = @_; + my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom,$usec); if (ref($navmap)) { my $iterator; if ($mapurl ne '') { my $map = $navmap->getResourceByUrl($mapurl); - my $firstres = $map->map_start(); - my $finishres = $map->map_finish(); - my $recursive = 1; - if ($pbscope eq 'nonrec') { - $recursive = 0; + if (ref($map)) { + my $firstres = $map->map_start(); + my $finishres = $map->map_finish(); + my $recursive = 1; + if ($pbscope eq 'nonrec') { + $recursive = 0; + } + $iterator = $navmap->getIterator($firstres,$finishres,undef,$recursive); } - $iterator = $navmap->getIterator($firstres,$finishres,undef,$recursive); } else { $iterator = $navmap->getIterator(undef,undef,undef,1); }