--- loncom/homework/grades.pm 2024/12/09 02:29:37 1.797
+++ loncom/homework/grades.pm 2024/12/09 21:39:48 1.799
@@ -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.799 2024/12/09 21:39:48 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;
@@ -1061,6 +1061,11 @@ sub verifyreceipt {
return $string;
}
+#-------------------------------------------------------------------
+
+#------------------------------------------- Grade Passback Routines
+#
+
sub initialpassback {
my ($request,$symb) = @_;
my $cdom = $env{"course.$env{'request.course.id'}.domain"};
@@ -1323,11 +1328,7 @@ 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().
@@ -1389,8 +1390,8 @@ sub do_passback {
}
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,14 +1399,14 @@ 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='';
@@ -1414,7 +1415,7 @@ sub do_passback {
}
$value=~s/\&$//;
&Apache::lonnet::courselog(&escape($linkuri).':'.$uname.':'.$udom.':EXPORT:'.$value);
- &Apache::lonnet::cstore({'score' => $score},$chosen,$namespace,$udom,$uname,'',$ip,1);
+ &Apache::lonnet::cstore({'score' => $score},$chosen,$namespace,$udom,$uname,'',$pb{'ip'},1);
$ctr++;
if ($ctr%2 ==1) {
$outcome .= &Apache::loncommon::start_data_table_row();
@@ -1450,14 +1451,14 @@ sub do_passback {
'uhome' => $uhome,
'pbid' => $id,
'pburl' => $url,
- 'pbtype' => $type,
+ 'pbtype' => $pb{'type'},
'pbscope' => $pbscope,
'pbmap' => $pbmap,
'pbsymb' => $pbsymb,
'format' => $scoretype,
'scope' => $scope,
- 'clientip' => $clientip,
- 'linkprot' => $linkprotector,
+ 'clientip' => $pb{'clientip'},
+ 'linkprot' => $linkprotector.':'.$linkuri,
'total' => $total,
'possible' => $possible,
'score' => $score,
@@ -1594,7 +1595,7 @@ sub get_passback_launcher {
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 ($launchsymb,$appname,$setter);
}
}
}
@@ -1666,6 +1667,272 @@ 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} = 1;
+ }
+ }
+ }
+ 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} = 1;
+ }
+ }
+ }
+ 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} = 1;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return %needpb;
+}
+
+sub process_passbacks {
+ my ($context,$symbs,$cdom,$cnum,$udom,$uname,$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'} = &Apache::loncommon::symb_from_tinyurl($pb{'linkuri'},$cnum,$cdom);
+ 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,
+ '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::lonhomework::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,$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::cstore({'score' => $score},$launcher,$namespace,$udom,$uname,'',$pb{'ip'},1);
+ } 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
@@ -3914,11 +4181,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;
@@ -3973,11 +4242,13 @@ sub processHandGrade {
foreach my $collaborator (@collaborators) {
my ($errorflag,$pts,$wgt) =
&saveHandGrade($request,$symb,$collaborator,$udom,$ctr,
- $env{'form.unamedom'.$ctr},$part,\%queueable);
+ $env{'form.unamedom'.$ctr},$part,\%queueable,\%needpb,\%skip_passback,%pbsave);
if ($errorflag eq 'not_allowed') {
$request->print("".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom")."");
next;
- } elsif ($message ne '') {
+ } else {
+ $pbcollab{$collaborator}{$part} = [$pts,$wgt];
+ if ($message ne '') {
my ($baseurl,$showsymb) =
&get_feedurl_and_symb($symb,$collaborator,
$udom);
@@ -3993,6 +4264,9 @@ sub processHandGrade {
}
$ctr++;
}
+ if ((keys(%pbcollab)) && (keys(%needpb))) {
+ # FIXME passback scores for collaborators
+ }
}
my %keyhash = ();
@@ -4146,7 +4420,7 @@ 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'});
@@ -4157,23 +4431,36 @@ sub saveHandGrade {
my ($pts,$wgt,$totchg) = ('','',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
if ($submitter && $new_part ne $part) { next; }
my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part};
+ if ($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 = 1;
}
} elsif ($dropMenu eq 'reset status'
&& exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts
@@ -4197,6 +4484,9 @@ sub saveHandGrade {
&decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus);
$aggregateflag = 1;
}
+ $sendupdate = 1;
+ $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 +4497,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 = 1;
}
if ($record{'resource.'.$new_part.'.awarded'} ne $partial) {
$newrecord{'resource.'.$new_part.'.awarded'} = $partial;
@@ -4264,6 +4557,13 @@ sub saveHandGrade {
&Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
$cdom,$cnum);
}
+ if (($sendupdate) && (!$submitter)) {
+ if ((ref($needpb) eq 'HASH') &&
+ (keys(%{$needpb}))) {
+ &process_passbacks('handgrade',[$symb],$cdom,$cnum,$domain,$stuname,\%weights,
+ \%awardeds,\%excuseds,$needpb,$skip_passback,$pbsave);
+ }
+ }
return ('',$pts,$wgt,$totchg);
}
@@ -5151,6 +5451,10 @@ sub editgrades {
);
my ($classlist,undef,$fullname) = &getclasslist($env{'form.section'},'0');
+ 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 (@partid);
my %weight = ();
my %columns = ();
@@ -5201,7 +5505,7 @@ sub editgrades {
&Apache::loncommon::end_data_table_header_row();
my @noupdate;
my ($updateCtr,$noupdateCtr) = (1,1);
- my ($got_types,%queueable);
+ my ($got_types,%queueable,%pbsave,%skip_passback);
for ($i=0; $i<$env{'form.total'}; $i++) {
my $user = $env{'form.ctr'.$i};
my ($uname,$udom)=split(/:/,$user);
@@ -5220,6 +5524,7 @@ sub editgrades {
my %aggregate = ();
my $aggregateflag = 0;
$user=~s/:/_/; # colon doen't work in javascript for names
+ my (%weights,%awardeds,%excuseds);
foreach (@partid) {
my $old_aw = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};
my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
@@ -5228,6 +5533,7 @@ sub editgrades {
my $awarded = $env{'form.GD_'.$user.'_'.$_.'_awarded'};
my $pcr = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);
my $partial = $awarded eq '' ? '' : $pcr;
+ $awardeds{$symb}{$_} = $partial;
my $score;
if ($partial eq '') {
$score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
@@ -5268,6 +5574,11 @@ sub editgrades {
my $partid=$_;
+ if ($score eq 'excused') {
+ $excuseds{$symb}{$partid} = 1;
+ } else {
+ $excuseds{$symb}{$partid} = '';
+ }
foreach my $stores (@parts) {
my ($part,$type) = &split_part_type($stores);
if ($part !~ m/^\Q$partid\E/) { next;}
@@ -5285,9 +5596,6 @@ sub editgrades {
}
$line.="\n";
- my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
- my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
-
if ($updateflag) {
$count++;
&Apache::lonnet::cstore(\%newrecord,$symb,$env{'request.course.id'},
@@ -5339,6 +5647,11 @@ sub editgrades {
'| '.$updateCtr.' | '.$line.
&Apache::loncommon::end_data_table_row();
$updateCtr++;
+ if (keys(%needpb)) {
+ $weights{$symb} = \%weight;
+ &process_passbacks('editgrades',[$symb],$cdom,$cnum,$udom,$uname,\%weights,
+ \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave);
+ }
} else {
push(@noupdate,
' '.$noupdateCtr.' | '.$line);
@@ -5704,11 +6017,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 +6118,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 +6145,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 +6177,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'},
+ &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,\%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 +6798,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 +6807,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 +6825,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 +6849,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 +6862,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 +6890,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 +6934,9 @@ sub updateGradeByPage {
&Apache::loncommon::end_data_table_row();
$prob++;
+ if ($changeflag) {
+ push(@updates,$symbx);
+ }
}
$curRes = $iterator->next();
}
@@ -6557,6 +6950,76 @@ sub updateGradeByPage {
$hideflag).'
');
$request->print($hidemsg.$grademsg.$studentTable);
+ if (@updates) {
+ undef(@Apache::lonhomework::ltipassback);
+ 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);
+ 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;
+ }
+ $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;
+ }
+ }
+ } elsif (grep(/^\Q$possible$\E$/,@updates)) {
+ foreach my $launcher (keys(%{$passback{$possible}})) {
+ $possrespb{$launcher} = 1;
+ }
+ $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') {
+ $needpb{$key} = 1;
+ }
+ }
+ my @symbs = keys(%uniqsymbs);
+ &process_passbacks('updatebypage',\@symbs,$cdom,$cnum,$udom,$uname,\%weights,
+ \%awardeds,\%excuseds,\%needpb,\%skip_passback,\%pbsave,\%pbids);
+ if (@Apache::lonhomework::ltipassback) {
+ unless ($registered_cleanup) {
+ my $handlers = $request->get_handlers('PerlCleanupHandler');
+ $request->set_handlers('PerlCleanupHandler' =>
+ [\&Apache::lonhomework::do_ltipassback,@{$handlers}]);
+ }
+ }
+ }
+ }
return '';
}
@@ -12185,6 +12648,7 @@ 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
}
}
}
|