--- loncom/homework/lonhomework.pm 2023/11/17 17:02:21 1.380 +++ loncom/homework/lonhomework.pm 2024/12/10 04:55:03 1.388 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Homework handler # -# $Id: lonhomework.pm,v 1.380 2023/11/17 17:02:21 raeburn Exp $ +# $Id: lonhomework.pm,v 1.388 2024/12/10 04:55:03 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -949,7 +949,7 @@ STATE sub analyze_header { my ($request) = @_; - my $js = &Apache::structuretags::setmode_javascript(); + my $js = &Apache::lonxml::setmode_javascript(); # Breadcrumbs my $text = 'Authoring Space'; @@ -1198,7 +1198,7 @@ sub editxmlmode { my $js = &Apache::edit::js_change_detection(). &Apache::loncommon::resize_textarea_js(). - &Apache::structuretags::setmode_javascript(). + &Apache::lonxml::setmode_javascript(). &Apache::lonhtmlcommon::dragmath_js("EditMathPopup"); # Breadcrumbs @@ -1692,6 +1692,10 @@ sub handler { $env{'request.uri'}=$request->uri; &setuppermissions(); +# -------------------------------------- Flag and buffer for registered cleanup + $registered_cleanup=0; + undef(@Apache::lonhomework::ltipassback); + my $file=&Apache::lonnet::filelocation("",$request->uri); #check if we know where we are @@ -1780,13 +1784,13 @@ sub handler { } # just render the page normally outside of construction space &Apache::lonxml::debug("not construct"); - undef(@Apache::lonhomework::ltipassback); &renderpage($request,$file,undef,undef,$donemsg,$viewasuser,$symb); if (@Apache::lonhomework::ltipassback) { unless ($registered_cleanup) { my $handlers = $request->get_handlers('PerlCleanupHandler'); $request->set_handlers('PerlCleanupHandler' => [\&do_ltipassback,@{$handlers}]); + $registered_cleanup=1; } } } @@ -1978,53 +1982,159 @@ sub convert_for_js { sub do_ltipassback { if (@Apache::lonhomework::ltipassback) { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my $ip = &Apache::lonnet::get_host_ip($lonhost); foreach my $item (@Apache::lonhomework::ltipassback) { - if (ref($item) eq 'HASH') { - if ((ref($item->{'lti'}) eq 'HASH') && ($item->{'cid'} =~ /^($match_domain)_($match_courseid)$/)) { - my ($cdom,$cnum) = ($1,$2); - my $msgformat = $item->{'lti'}->{'passbackformat'}; - my $sigmethod = 'HMAC-SHA1'; - my $ltinum = $item->{'ltinum'}; - my $id = $item->{'pbid'}; - my $url = $item->{'pburl'}; - my $type = $item->{'pbtype'}; - my $scope = $item->{'scope'}; - my $map = $item->{'ltimap'}; - my $symb = $item->{'ltisymb'}; - my $uname = $item->{'uname'}; - my $udom = $item->{'udom'}; - my $keynum = $item->{'lti'}->{'cipher'}; - my $crsdef = $item->{'crsdef'}; - my $scoretype = $item->{'format'}; - my ($total,$possible); - if ($scope eq 'resource') { + &Apache::lonhomework::run_passback($item,$lonhost,$ip); + } + undef(@Apache::lonhomework::ltipassback); + } +} + +sub run_passback { + my ($item,$lonhost,$ip) = @_; + if (ref($item) eq 'HASH') { + if ((ref($item->{'lti'}) eq 'HASH') && ($item->{'cid'} =~ /^($match_domain)_($match_courseid)$/)) { + my ($cdom,$cnum) = ($1,$2); + my $msgformat = $item->{'lti'}->{'passbackformat'}; + my $sigmethod = 'HMAC-SHA1'; + my $ltinum = $item->{'ltinum'}; + my $id = $item->{'pbid'}; + my $url = $item->{'pburl'}; + my $type = $item->{'pbtype'}; + my $pbscope = $item->{'pbscope'}; + my $map = $item->{'pbmap'}; + my $symb = $item->{'pbsymb'}; + 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'}; + my $scope = $item->{'scope'}; + my $clientip = $item->{'clientip'}; + my ($total,$possible,%total_by_symb,%possible_by_symb); + if ((exists($item->{'total_s'})) && (ref($item->{'total_s'}) eq 'HASH')) { + %total_by_symb = %{$item->{'total_s'}}; + if ($pbscope eq 'resource') { + if (exists($total_by_symb{$symb})) { + $total = $total_by_symb{$symb}; + } else { $total = $item->{'total'}; + } + } + } elsif ($pbscope eq 'resource') { + $total = $item->{'total'}; + } + if ((exists($item->{'possible_s'})) && (ref($item->{'possible_s'}) eq 'HASH')) { + %possible_by_symb = %{$item->{'possible_s'}}; + if ($pbscope eq 'resource') { + if (exists($possible_by_symb{$symb})) { + $possible = $possible_by_symb{$symb}; + } else { $possible = $item->{'possible'}; - } elsif ($scope eq 'map') { - ($total,$possible) = &get_lti_score($uname,$udom,$map); - } elsif ($scope eq 'course') { - ($total,$possible) = &get_lti_score($uname,$udom); } - if (($id ne '') && ($url ne '') && ($possible)) { - &LONCAPA::ltiutils::send_grade($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,$url,$scoretype,$sigmethod,$msgformat,$total,$possible); + } + } elsif ($pbscope eq 'resource') { + $possible = $item->{'possible'}; + } + if (($pbscope eq 'map') || ($pbscope eq 'nonrec')) { + if ((keys(%total_by_symb)) && (keys(%possible_by_symb))) { + ($total,$possible) = + &get_lti_score($uname,$udom,$usec,$map,$pbscope,\%total_by_symb,\%possible_by_symb); + } else { + ($total,$possible) = &get_lti_score($uname,$udom,$usec,$map,$pbscope); + } + } elsif ($pbscope eq 'course') { + ($total,$possible) = &get_lti_score($uname,$udom,$usec); + } + $item->{'total'} = $total; + $item->{'possible'} = $possible; + 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); + $item->{'score'} = $score; + my ($linkprotector,$linkuri,$no_passback,$appname); + if ($item->{'linkprot'}) { + ($linkprotector,$linkuri) = split(/:/,$item->{'linkprot'}); + } + if ($sent) { + if ($code == 200) { + if ($item->{'linkprot'}) { + my $skey = join("\0",($linkuri,$linkprotector,$scope)); + my $namespace = $cdom.'_'.$cnum.'_lp_passback'; + my $store = { + 'score' => $score, + 'ip' => $ip, + 'host' => $Apache::lonnet::perlvar{'lonHostID'}, + 'protector' => $linkprotector, + 'deeplink' => $linkuri, + 'scope' => $scope, + 'url' => $url, + 'id' => $id, + 'clientip' => $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},$skey,$namespace,$udom,$uname,'',$ip,1); + } + } else { + if ($item->{'linkprot'}) { + $no_passback = "Passback response was $code ($result)."; + } + } + } else { + if ($item->{'linkprot'}) { + $no_passback = 'No passback of scores.'; + } + } + if ($no_passback) { + if ($item->{'linkprot'}) { + my ($ltinum,$ltitype) = ($linkprotector =~ /^(\d+)(c|d)$/); + if ($ltitype eq 'c') { + my %lti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider'); + if (ref($lti{$ltinum}) eq 'HASH') { + $appname = $lti{$ltinum}{'name'}; + } + } elsif ($ltitype eq 'd') { + my %lti = &Apache::lonnet::get_domain_lti($cdom,'linkprot'); + if (ref($lti{$ltinum}) eq 'HASH') { + $appname = $lti{$ltinum}{'name'}; + } + } + $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); } } } } - undef(@Apache::lonhomework::ltipassback); } + return; } sub get_lti_score { - my ($uname,$udom,$mapurl) = @_; - 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(); - $iterator = $navmap->getIterator($firstres,$finishres,undef,1); + my $recursive = 1; + if ($pbscope eq 'nonrec') { + $recursive = 0; + } + $iterator = $navmap->getIterator($firstres,$finishres,undef,$recursive); } else { $iterator = $navmap->getIterator(undef,undef,undef,1); } @@ -2032,17 +2142,31 @@ sub get_lti_score { my $depth = 1; my $total = 0; my $possible = 0; + my (%totals_by_symb,%possibles_by_symb); + if (ref($totals) eq 'HASH') { + %totals_by_symb = %{$totals}; + } + if (ref($possibles) eq 'HASH') { + %possibles_by_symb = %{$possibles}; + } $iterator->next(); # ignore first BEGIN_MAP my $curRes = $iterator->next(); while ( $depth > 0 ) { if ($curRes == $iterator->BEGIN_MAP()) {$depth++;} if ($curRes == $iterator->END_MAP()) { $depth--; } if (ref($curRes) && $curRes->is_gradable() && !$curRes->randomout) { - my $parts = $curRes->parts(); - foreach my $part (@{$parts}) { - next if ($curRes->solved($part) eq 'excused'); - $total += $curRes->weight($part) * $curRes->awarded($part); - $possible += $curRes->weight($part); + my $currsymb = $curRes->symb(); + if (($currsymb) && (exists($totals_by_symb{$currsymb})) && + (exists($possibles_by_symb{$currsymb}))) { + $total += $totals_by_symb{$currsymb}; + $possible += $possibles_by_symb{$currsymb}; + } else { + my $parts = $curRes->parts(); + foreach my $part (@{$parts}) { + next if ($curRes->solved($part) eq 'excused'); + $total += $curRes->weight($part) * $curRes->awarded($part); + $possible += $curRes->weight($part); + } } } $curRes = $iterator->next();