[LON-CAPA-cvs] cvs: loncom /homework grades.pm
raeburn
raeburn at source.lon-capa.org
Sat Aug 16 19:19:25 EDT 2025
raeburn Sat Aug 16 23:19:25 2025 EDT
Modified files:
/loncom/homework grades.pm
Log:
- Bug 6623.
- Pass-back of grades to launcher CMS for assignments accessed via LTI
mediated deep-linking includes partial credit due to late submission.
- If essayresponse item or dropbox submission included collaborators,
partial credit due to late submission in effect for submitter applies
to collaborators scores also.
-------------- next part --------------
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.815 loncom/homework/grades.pm:1.816
--- loncom/homework/grades.pm:1.815 Sat Aug 16 22:34:08 2025
+++ loncom/homework/grades.pm Sat Aug 16 23:19:25 2025
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.815 2025/08/16 22:34:08 raeburn Exp $
+# $Id: grades.pm,v 1.816 2025/08/16 23:19:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2990,7 +2990,8 @@
my $wgtmsg = ($wgt > 0) ? &mt('(problem weight)')
: '<span class="LC_info">'.&mt('problem weight assigned by computer').'</span>';
$wgt = ($wgt > 0 ? $wgt : '1');
- my $latefrac = $$record{'resource.'.$partid.'.latefrac'};
+ my $latefrac = $record->{'resource.'.$partid.'.latefrac'};
+ my $endgrace = $record->{'resource.'.$partid.'.endgrace'};
my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
'' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));
my $data_WGT='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
@@ -3027,7 +3028,10 @@
($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : '').
' </td>'."\n";
if ($has_late) {
- $line.='<td>'.$latefrac.'</td>';
+ $line.='<td>'.$latefrac.
+ '<input type="hidden" name="latefrac'.$counter.'_'.$partid.'" value="'.$latefrac.'" />'."\n".
+ '<input type="hidden" name="endgrace'.$counter.'_'.$partid.'" value="'.$endgrace.'" />'."\n".
+ '</td>';
$colspan ++;
}
$line.='<td><select name="GD_SEL'.$counter.'_'.$partid.'" '.
@@ -4291,7 +4295,7 @@
@collaborators = map { &unescape($_); } @collaborators;
foreach my $collaborator (@collaborators) {
my ($collabuname,$collabudom) = split(/:/,$collaborator);
- my ($errorflag,$pts,$wgt,$numchg,$numupdate) =
+ my ($errorflag,$pts,$wgt,$numchg,$numupdate,$cblatefrac) =
&saveHandGrade($request,$symb,$collabuname,$collabudom,$ctr,
$env{'form.unamedom'.$ctr},$part,\%queueable);
if ($errorflag eq 'not_allowed') {
@@ -4299,7 +4303,7 @@
next;
} else {
if ($numchg || $numupdate) {
- $pbcollab{$collaborator}{$part} = [$pts,$wgt];
+ $pbcollab{$collaborator}{$part} = [$pts,$wgt,$cblatefrac];
}
if ($message ne '') {
my ($baseurl,$showsymb) =
@@ -4341,6 +4345,7 @@
if ((exists($pbcollab{$user}{$part})) && (ref($pbcollab{$user}{$part}) eq 'ARRAY')) {
my $pts = $pbcollab{$user}{$part}[0];
my $wt = $pbcollab{$user}{$part}[1];
+ $latefracs{$symb}{$part} = $pbcollab{$user}{$part}[2];
if ($wt) {
$awardeds{$symb}{$part} = $pts/$wt;
$weights{$symb}{$part} = $wt;
@@ -4351,6 +4356,7 @@
} else {
$awardeds{$symb}{$part} = $res->awarded($part);
$weights{$symb}{$part} = $res->weight($part);
+ $latefracs{$symb}{$part} = $res->latefrac($part);
}
}
&process_passbacks('handgrade',[$symb],$cdom,$cnum,$clbudom,$clbuname,$clbusec,\%weights,
@@ -4535,7 +4541,7 @@
if ((ref($needpb) eq 'HASH') && (keys(%{$needpb}))) {
$poss_pb = 1;
}
- my (%weights,%awardeds,%excuseds,%latefracs);
+ my (%weights,%awardeds,%excuseds,%latefracs,$cblatefrac,$cbendgrace);
my @parts = split(/:/,$env{'form.partlist'.$newflg});
foreach my $new_part (@parts) {
#collaborator ($submitter may vary for different parts)
@@ -4549,6 +4555,13 @@
} else {
$weights{$symb}{$new_part} = $env{'form.WGT'.$newflg.'_'.$new_part};
}
+ if ($submitter) {
+ $cblatefrac = $env{'form.latefrac'.$newflg.'_'.$new_part};
+ $cbendgrace = $env{'form.endgrace'.$newflg.'_'.$new_part};
+ $latefracs{$symb}{$new_part} = $env{'form.latefrac'.$newflg.'_'.$new_part};
+ } else {
+ $latefracs{$symb}{$new_part} = $record{'resource.'.$new_part.'.latefrac'};
+ }
if ($dropMenu eq 'excused') {
$excuseds{$symb}{$new_part} = 1;
$awardeds{$symb}{$new_part} = '';
@@ -4585,6 +4598,7 @@
$sendupdate ++;
$excuseds{$symb}{$new_part} = '';
$awardeds{$symb}{$new_part} = '';
+ $latefracs{$symb}{$new_part} = '';
} elsif ($dropMenu eq '') {
$pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ?
$env{'form.GD_BOX'.$newflg.'_'.$new_part} :
@@ -4622,6 +4636,14 @@
($record{'resource.'.$new_part.'.submitted_by'} ne $submitter)) {
$newrecord{'resource.'.$new_part.'.submitted_by'} = $submitter;
}
+ if ($submitter &&
+ ($record{'resource.'.$new_part.'.latefrac'} ne $cblatefrac)) {
+ $newrecord{'resource.'.$new_part.'.latefrac'} = $cblatefrac;
+ }
+ if ($submitter &&
+ ($record{'resource.'.$new_part.'.endgrace'} ne $cbendgrace)) {
+ $newrecord{'resource.'.$new_part.'.endgrace'} = $cbendgrace;
+ }
$newrecord{'resource.'.$new_part.'.regrader'}=
"$env{'user.name'}:$env{'user.domain'}";
}
@@ -4659,7 +4681,7 @@
&process_passbacks('handgrade',[$symb],$cdom,$cnum,$domain,$stuname,$usec,\%weights,
\%awardeds,\%excuseds,\%latefracs,$needpb,$skip_passback,$pbsave);
}
- return ('',$pts,$wgt,$totchg,$sendupdate);
+ return ('',$pts,$wgt,$totchg,$sendupdate,$cblatefrac);
}
sub makehidden {
@@ -5507,7 +5529,8 @@
if ($hasgracecol) {
$result.= '<td align="center">';
if (($latefrac ne '') && ($latefrac < 1) && ($latefrac >= 0)) {
- $result.= $latefrac;
+ $result.= $latefrac.'<input type="hidden" name="'.
+ 'GD_'.$student.'_'.$part.'_latefrac" value="'.$latefrac.'" />';
}
$result.= '</td>'."\n";
}
@@ -5654,6 +5677,7 @@
} elsif ($partial == 0) {
$score = 'incorrect_by_override';
}
+ my $latefrac = $env{'form.GD_'.$user.'_'.$_.'_latefrac'};
my $dropMenu = $env{'form.GD_'.$user.'_'.$_.'_solved'};
$score = 'excused' if (($dropMenu eq 'excused') && ($score ne 'excused'));
@@ -5665,6 +5689,10 @@
$newrecord{'resource.'.$_.'.solved'} = '';
$newrecord{'resource.'.$_.'.award'} = '';
$newrecord{'resource.'.$_.'.awarded'} = '';
+ if ($latefrac) {
+ $newrecord{'resource.'.$_.'.latefrac'} = '';
+ $newrecord{'resource.'.$_.'.endgrace'} = '';
+ }
$updateflag = 1;
if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) {
my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'};
@@ -5691,6 +5719,7 @@
} else {
$excuseds{$symb}{$partid} = '';
}
+ $latefracs{$symb}{$partid} = $latefrac;
foreach my $stores (@parts) {
my ($part,$type) = &split_part_type($stores);
if ($part !~ m/^\Q$partid\E/) { next;}
@@ -6139,6 +6168,7 @@
my $countdone=0;
my @parts;
my %needpb = &passbacks_for_symb($cdom,$cnum,$symb);
+ my %symbpartgrace;
my $passback;
if (keys(%needpb)) {
$passback = 1;
@@ -6154,6 +6184,7 @@
} else {
return &navmap_errormsg();
}
+ %symbpartgrace = &Apache::lonnet::dump('nohist_grace',$cdom,$cnum,"^$symb\0");
}
my (%skip_passback,%pbsave,%weights,%awardeds,%excuseds,%latefracs);
@@ -6302,6 +6333,7 @@
if (@diffs > 0) {
my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$username);
foreach my $part (@parts) {
+ $latefracs{$symb}{$part} = $record{"resource.$part.latefrac"};
next if (grep(/^\Q$part\E$/, at parts_in_upload));
$weights{$symb}{$part} = &Apache::lonnet::EXT('resource.'.$part.'.weight',
$symb,$domain,$username);
@@ -6312,6 +6344,11 @@
}
$awardeds{$symb}{$part} = $record{"resource.$part.awarded"};
}
+ } elsif (keys(%symbpartgrace)) {
+ my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$username);
+ foreach my $part (@parts) {
+ $latefracs{$symb}{$part} = $record{"resource.$part.latefrac"};
+ }
}
&process_passbacks('csvupload',[$symb],$cdom,$cnum,$domain,$username,$usec,\%weights,
\%awardeds,\%excuseds,\%latefracs,\%needpb,\%skip_passback,\%pbsave);
@@ -6967,6 +7004,10 @@
$env{'form.WGT'.$question.'_'.$partid} : 1;
$weights{$symbx}{$partid} = $wgt;
$excuseds{$symbx}{$partid} = '';
+ $latefracs{$symbx}{$partid} = '';
+ if ($env{'form.latefrac'.$question.'_'.$partid} ne '') {
+ $latefracs{$symbx}{$partid} = $env{'form.latefrac'.$question.'_'.$partid};
+ }
my $partial = $newpts/$wgt;
my $score;
if ($partial > 0) {
@@ -6986,6 +7027,11 @@
$newrecord{'resource.'.$partid.'.award'} = '';
$newrecord{'resource.'.$partid.'.awarded'} = 0;
$newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}";
+ if ($env{'form.latefrac'.$question.'_'.$partid} ne '') {
+ $newrecord{'resource.'.$partid.'.latefrac'} = '';
+ $newrecord{'resource.'.$partid.'.endgrace'} = '';
+ $latefracs{$symbx}{$partid} = '';
+ }
$changeflag++;
$newpts = '';
More information about the LON-CAPA-cvs
mailing list