[BACK]Return to lonhomework.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/lonhomework.pm between versions 1.384 and 1.393

version 1.384, 2024/11/21 07:26:01 version 1.393, 2025/01/05 22:42:44
Line 1692  sub handler { Line 1692  sub handler {
     $env{'request.uri'}=$request->uri;      $env{'request.uri'}=$request->uri;
     &setuppermissions();      &setuppermissions();
   
   # -------------------------------------- Flag and buffer for registered cleanup
       $registered_cleanup=0;
       undef(@Apache::lonhomework::ltipassback);
   
     my $file=&Apache::lonnet::filelocation("",$request->uri);      my $file=&Apache::lonnet::filelocation("",$request->uri);
   
     #check if we know where we are      #check if we know where we are
Line 1780  sub handler { Line 1784  sub handler {
         }          }
  # just render the page normally outside of construction space   # just render the page normally outside of construction space
  &Apache::lonxml::debug("not construct");   &Apache::lonxml::debug("not construct");
         undef(@Apache::lonhomework::ltipassback);  
  &renderpage($request,$file,undef,undef,$donemsg,$viewasuser,$symb);   &renderpage($request,$file,undef,undef,$donemsg,$viewasuser,$symb);
         if (@Apache::lonhomework::ltipassback) {          if (@Apache::lonhomework::ltipassback) {
             unless ($registered_cleanup) {              unless ($registered_cleanup) {
                 my $handlers = $request->get_handlers('PerlCleanupHandler');                  my $handlers = $request->get_handlers('PerlCleanupHandler');
                 $request->set_handlers('PerlCleanupHandler' =>                  $request->set_handlers('PerlCleanupHandler' =>
                                        [\&do_ltipassback,@{$handlers}]);                                         [\&do_ltipassback,@{$handlers}]);
                   $registered_cleanup=1;
             }              }
         }          }
     }      }
Line 1981  sub do_ltipassback { Line 1985  sub do_ltipassback {
         my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};          my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
         my $ip = &Apache::lonnet::get_host_ip($lonhost);          my $ip = &Apache::lonnet::get_host_ip($lonhost);
         foreach my $item (@Apache::lonhomework::ltipassback) {          foreach my $item (@Apache::lonhomework::ltipassback) {
             if (ref($item) eq 'HASH') {              &Apache::lonhomework::run_passback($item,$lonhost,$ip);
                 if ((ref($item->{'lti'}) eq 'HASH') && ($item->{'cid'} =~ /^($match_domain)_($match_courseid)$/)) {          }
                     my ($cdom,$cnum) = ($1,$2);          undef(@Apache::lonhomework::ltipassback);
                     my $msgformat = $item->{'lti'}->{'passbackformat'};      }
                     my $sigmethod = 'HMAC-SHA1';      return OK;
                     my $ltinum = $item->{'ltinum'};  }
                     my $id = $item->{'pbid'};  
                     my $url = $item->{'pburl'};  sub run_passback {
                     my $type = $item->{'pbtype'};      my ($item,$lonhost,$ip) = @_;
                     my $pbscope = $item->{'pbscope'};      if (ref($item) eq 'HASH') {
                     my $map = $item->{'pbmap'};          if ((ref($item->{'lti'}) eq 'HASH') && ($item->{'cid'} =~ /^($match_domain)_($match_courseid)$/)) {
                     my $symb = $item->{'pbsymb'};              my ($cdom,$cnum) = ($1,$2);
                     my $uname = $item->{'uname'};              my $msgformat = $item->{'lti'}->{'passbackformat'};
                     my $udom = $item->{'udom'};              my $sigmethod = 'HMAC-SHA1';
                     my $uhome = $item->{'uhome'};              my $ltinum = $item->{'ltinum'};
                     my $keynum = $item->{'lti'}->{'cipher'};              my $id = $item->{'pbid'};
                     my $crsdef = $item->{'crsdef'};              my $url = $item->{'pburl'};
                     my $scoretype = $item->{'format'};              my $type = $item->{'pbtype'};
                     my $scope = $item->{'scope'};              my $pbscope = $item->{'pbscope'};
                     my $clientip = $item->{'clientip'};              my $map = $item->{'pbmap'};
                     my ($total,$possible);              my $symb = $item->{'pbsymb'};
                     if ($pbscope eq 'resource') {              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'};                          $total = $item->{'total'};
                         $possible = $item->{'possible'};                      }
                   }
               } 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 {                      } else {
                         if (($pbscope eq 'map') || ($pbscope eq 'nonrec')) {                          $possible = $item->{'possible'};
                             ($total,$possible) = &get_lti_score($uname,$udom,$map,$pbscope);  
                         } elsif ($pbscope eq 'course') {  
                             ($total,$possible) = &get_lti_score($uname,$udom);  
                         }  
                         $item->{'total'} = $total;  
                         $item->{'possible'} = $possible;  
                     }                      }
                     if (($id ne '') && ($url ne '') && ($possible)) {                  }
                         my ($sent,$score,$code,$result) =               } elsif ($pbscope eq 'resource') {
                             &LONCAPA::ltiutils::send_grade($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,                  $possible = $item->{'possible'};
                                                            $url,$scoretype,$sigmethod,$msgformat,$total,$possible);              }
                         $item->{'score'} = $score;              if (($pbscope eq 'map') || ($pbscope eq 'nonrec')) {
                         my ($linkprotector,$linkuri,$no_passback,$appname);                  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'}) {                          if ($item->{'linkprot'}) {
                             ($linkprotector,$linkuri) = split(/:/,$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::store_userdata({'score' => $score},$skey,$namespace,$udom,$uname,$ip);
                         }                          }
                         if ($sent) {                      } else {
                             if ($code == 200) {                          if ($item->{'linkprot'}) {
                                 if ($item->{'linkprot'}) {                             $no_passback = "Passback response was $code ($result).";
                                     my $key = join("\0",($linkuri,$linkprotector,$scope));                          }
                                     my $namespace = $cdom.'_'.$cnum.'_lp_passback';                      }
                                     my $store = {                  } else {
                                                  'score' => $score,                      if ($item->{'linkprot'}) {
                                                  'ip' => $ip,                          $no_passback = 'No passback of scores.';
                                                  'host' => $Apache::lonnet::perlvar{'lonHostID'},                      }
                                                  'protector' => $linkprotector,                  }
                                                  'deeplink' => $linkuri,                  if ($no_passback) {
                                                  'scope' => $scope,                      if ($item->{'linkprot'}) {
                                                  'url' => $url,                          my ($ltinum,$ltitype) = ($linkprotector =~ /^(\d+)(c|d)$/);
                                                  'id' => $id,                          if ($ltitype eq 'c') {
                                                  'clientip' => $clientip,                              my %lti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
                                                  'whodoneit' => $env{'user.name'}.':'.$env{'user.domain'},                              if (ref($lti{$ltinum}) eq 'HASH') {
                                                 };                                  $appname = $lti{$ltinum}{'name'};
                                     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},$key,$namespace,$udom,$uname,'',$ip,1);  
                                 }  
                             } else {  
                                 if ($item->{'linkprot'}) {  
                                     $no_passback = "Passback response was $code ($result).";  
                                 }  
                             }                              }
                         } else {                          } elsif ($ltitype eq 'd') {
                             if ($item->{'linkprot'}) {                              my %lti = &Apache::lonnet::get_domain_lti($cdom,'linkprot');
                                 $no_passback = 'No passback of scores.';                              if (ref($lti{$ltinum}) eq 'HASH') {
                                   $appname = $lti{$ltinum}{'name'};
                             }                              }
                         }                          }
                         if ($no_passback) {                          $no_passback .= " LTI launcher $linkprotector ($appname) for $linkuri (${cdom}_${cnum})";
                             if ($item->{'linkprot'}) {                          &Apache::lonnet::logthis($no_passback." for $uname:$udom");
                                 my ($ltinum,$ltitype) = ($linkprotector =~ /^(\d+)(c|d)$/);                          &Apache::lonnet::log($udom,$uname,$uhome,"$no_passback score=$score total=$total poss=$possible");
                                 if ($ltitype eq 'c') {                          if ($item->{'linkprot'}) {
                                     my %lti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');                              my $pendingkey = &Time::HiRes::time().':'.$uname.':'.$udom.':'.
                                     if (ref($lti{$ltinum}) eq 'HASH') {                                               "$linkuri\0$linkprotector\0$scope";
                                         $appname = $lti{$ltinum}{'name'};                              &Apache::lonnet::put('linkprot_passback_pending',{$pendingkey => $item},$cdom,$cnum);
                                     }  
                                 } 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 {  sub get_lti_score {
     my ($uname,$udom,$mapurl,$pbscope) = @_;      my ($uname,$udom,$usec,$mapurl,$pbscope,$totals,$possibles) = @_;
     my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom);      my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom,$usec);
     if (ref($navmap)) {      if (ref($navmap)) {
         my $iterator;          my $iterator;
         if ($mapurl ne '') {          if ($mapurl ne '') {
Line 2107  sub get_lti_score { Line 2147  sub get_lti_score {
             my $depth = 1;              my $depth = 1;
             my $total = 0;              my $total = 0;
             my $possible = 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              $iterator->next(); # ignore first BEGIN_MAP
             my $curRes = $iterator->next();              my $curRes = $iterator->next();
             while ( $depth > 0 ) {              while ( $depth > 0 ) {
                 if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}                  if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
                 if ($curRes == $iterator->END_MAP()) { $depth--; }                  if ($curRes == $iterator->END_MAP()) { $depth--; }
                 if (ref($curRes) && $curRes->is_gradable() && !$curRes->randomout) {                  if (ref($curRes) && $curRes->is_gradable() && !$curRes->randomout) {
                     my $parts = $curRes->parts();                      my $currsymb = $curRes->symb();
                     foreach my $part (@{$parts}) {                      if (($currsymb) && (exists($totals_by_symb{$currsymb})) &&
                         next if ($curRes->solved($part) eq 'excused');                          (exists($possibles_by_symb{$currsymb}))) {
                         $total += $curRes->weight($part) * $curRes->awarded($part);                          $total += $totals_by_symb{$currsymb};
                         $possible += $curRes->weight($part);                          $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();                  $curRes = $iterator->next();
Removed from v.1.384  
changed lines
  Added in v.1.393

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>