[LON-CAPA-cvs] cvs: loncom /homework lonhomework.pm structuretags.pm /lti ltiutils.pm
raeburn
raeburn at source.lon-capa.org
Tue May 15 00:59:22 EDT 2018
raeburn Tue May 15 04:59:22 2018 EDT
Modified files:
/loncom/homework structuretags.pm lonhomework.pm
/loncom/lti ltiutils.pm
Log:
- Bug 6754 LON-CAPA as LTI Provider
- Pass grades back to the LTI Consumer which launched the LTI session.
- Any problemstatus settings of "No" are ignored.
-------------- next part --------------
Index: loncom/homework/structuretags.pm
diff -u loncom/homework/structuretags.pm:1.559 loncom/homework/structuretags.pm:1.560
--- loncom/homework/structuretags.pm:1.559 Fri Mar 30 23:50:13 2018
+++ loncom/homework/structuretags.pm Tue May 15 04:59:14 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# definition of tags that give a structure to a document
#
-# $Id: structuretags.pm,v 1.559 2018/03/30 23:50:13 raeburn Exp $
+# $Id: structuretags.pm,v 1.560 2018/05/15 04:59:14 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1117,6 +1117,7 @@
delete(@Apache::lonhomework::results{@remove});
my ($symb,$courseid,$domain,$name) =
&Apache::lonnet::whichuser($given_symb);
+ my ($passback,$ltiscope,$ltimap,$ltisymb,$ltiref,$total,$possible);
if ($env{'request.state'} eq 'construct'
|| $symb eq ''
|| $Apache::lonhomework::type eq 'practice') {
@@ -1126,17 +1127,23 @@
$namespace,'',$domain,$name);
&Apache::lonxml::debug('Construct Store return message:'.$result);
} else {
- my ($laststore,$checkedparts, at parts,%postcorrect);
+ my ($laststore,$checkedparts, at parts,%postcorrect,%record);
if (($env{'user.name'} eq $name) && ($env{'user.domain'} eq $domain) &&
(!$Apache::lonhomework::scantronmode) && (!defined($env{'form.grade_symb'})) &&
(!defined($env{'form.grade_courseid'}))) {
+ if ($env{'request.lti.login'}) {
+ my ($map)=&Apache::lonnet::decode_symb($symb);
+ $map = &Apache::lonnet::clutter($map);
+ ($passback,$ltiscope,$ltimap,$ltisymb,$ltiref) =
+ &needs_lti_passback($courseid,$symb,$map);
+ }
if ($Apache::lonhomework::history{'version'}) {
$laststore = $Apache::lonhomework::history{'version'}.'='.
$Apache::lonhomework::history{'timestamp'};
} else {
$laststore = '0=0';
}
- my %record = &Apache::lonnet::restore($symb,$courseid,$domain,$name);
+ %record = &Apache::lonnet::restore($symb,$courseid,$domain,$name);
if ($record{'version'}) {
my ($newversion,$oldversion,$oldtimestamp);
if ($Apache::lonhomework::history{'version'}) {
@@ -1212,8 +1219,70 @@
}
}
}
+ if (($passback) && ($ltiscope eq 'resource') && ($ltisymb eq $symb)) {
+ $total = 0;
+ $possible = 0;
+ 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') {
+ foreach my $part (@{$partlist}) {
+ unless (exists($Apache::lonhomework::results{"resource.$part.solved"})) {
+ next if ($Apache::lonhomework::record{"resource.$part.solved"} =~/^excused/);
+ my $weight = &Apache::lonnet::EXT("resource.$part.weight",$symb);
+ $possible += $weight;
+ if (($record{'version'}) && (exists($record{"resource.$part.awarded"}))) {
+ my $awarded = $record{"resource.$part.awarded"};
+ if ($awarded) {
+ $total += $weight * $awarded;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ foreach my $key (keys(%Apache::lonhomework::results)) {
+ if ($key =~ /^resource\.([^\.]+)\.awarded$/) {
+ my $part = $1;
+ my $weight = &Apache::lonnet::EXT("resource.$part.weight",$symb);
+ $possible += $weight;
+ my $awarded = $Apache::lonhomework::results{$key};
+ if ($awarded) {
+ $total += $weight * $awarded;
+ }
+ }
+ }
+ }
&Apache::lonxml::debug('Store return message:'.$result);
&store_aggregates($symb,$courseid);
+ if ($passback) {
+ my $scoreformat = 'decimal';
+ if (ref($ltiref) eq 'HASH') {
+ if ($ltiref->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) {
+ $scoreformat = $1;
+ }
+ }
+ my $ltigrade = {
+ 'lti' => $ltiref,
+ 'cid' => $courseid,
+ 'uname' => $env{'user.name'},
+ 'udom' => $env{'user.domain'},
+ 'pbid' => $env{'request.lti.passbackid'},
+ 'pburl' => $env{'request.lti.passbackurl'},
+ 'scope' => $ltiscope,
+ 'ltimap' => $ltimap,
+ 'ltisymb' => $ltisymb,
+ 'format' => $scoreformat,
+ };
+ if ($ltiscope eq 'resource') {
+ $ltigrade->{'total'} = $total;
+ $ltigrade->{'possible'} = $possible;
+ }
+ push(@Apache::lonhomework::ltipassback,$ltigrade);
+ }
}
} else {
&Apache::lonxml::debug('Nothing to store');
@@ -1221,6 +1290,40 @@
return $result;
}
+sub needs_lti_passback {
+ my ($courseid,$symb,$map) = @_;
+ if (($env{'request.lti.passbackid'}) && ($env{'request.lti.passbackurl'})) {
+ if ($courseid =~ /^($LONCAPA::match_domain)_($LONCAPA::match_courseid)$/) {
+ my ($cdom,$cnum) = ($1,$2);
+ my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
+ if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
+ if ($lti{$env{'request.lti.login'}}{'passback'}) {
+ my ($ltiscope,$ltiuri,$ltisymb) =
+ &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
+ $cdom,$cnum,1);
+ my ($passback,$ltimap);
+ if ($ltiscope eq 'resource') {
+ if ($ltisymb eq $symb) {
+ $passback = 1;
+ }
+ } elsif ($ltiscope eq 'map') {
+ if ($ltiuri eq $map) {
+ $passback = 1;
+ $ltimap = $map;
+ }
+ } elsif ($ltiscope eq 'course') {
+ if (($env{'request.lti.uri'} eq "/$cdom/$cnum") || ($env{'request.lti.uri'} eq '')) {
+ $passback = 1;
+ }
+ }
+ return ($passback,$ltiscope,$ltimap,$ltisymb,$lti{$env{'request.lti.login'}});
+ }
+ }
+ }
+ }
+ return;
+}
+
=pod
=item check_correctness_changes()
Index: loncom/homework/lonhomework.pm
diff -u loncom/homework/lonhomework.pm:1.370 loncom/homework/lonhomework.pm:1.371
--- loncom/homework/lonhomework.pm:1.370 Wed Jan 31 15:28:28 2018
+++ loncom/homework/lonhomework.pm Tue May 15 04:59:14 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Homework handler
#
-# $Id: lonhomework.pm,v 1.370 2018/01/31 15:28:28 raeburn Exp $
+# $Id: lonhomework.pm,v 1.371 2018/05/15 04:59:14 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -53,13 +53,17 @@
use Apache::Constants qw(:common);
use Apache::loncommon();
use Apache::lonparmset();
+use Apache::lonnavmaps();
use Apache::lonlocal;
+use LONCAPA qw(:DEFAULT :match);
+use LONCAPA::ltiutils();
use Time::HiRes qw( gettimeofday tv_interval );
use HTML::Entities();
use File::Copy();
# FIXME - improve commenting
+my $registered_cleanup;
BEGIN {
&Apache::lonxml::register_insert();
@@ -1671,7 +1675,15 @@
}
# just render the page normally outside of construction space
&Apache::lonxml::debug("not construct");
+ undef(@Apache::lonhomework::ltipassback);
&renderpage($request,$file,undef,undef,$donemsg);
+ if (@Apache::lonhomework::ltipassback) {
+ unless ($registered_cleanup) {
+ my $handlers = $request->get_handlers('PerlCleanupHandler');
+ $request->set_handlers('PerlCleanupHandler' =>
+ [\&do_ltipassback,@{$handlers}]);
+ }
+ }
}
#my $td=&tv_interval($t0);
#&Apache::lonxml::debug("Spent $td seconds processing");
@@ -1859,5 +1871,81 @@
return $return;
}
+sub do_ltipassback {
+ if (@Apache::lonhomework::ltipassback) {
+ 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 $ckey = $item->{'lti'}->{'key'};
+ my $secret = $item->{'lti'}->{'secret'};
+ my $id = $item->{'pbid'};
+ my $url = $item->{'pburl'};
+ my $scope = $item->{'scope'};
+ my $map = $item->{'ltimap'};
+ my $symb = $item->{'ltisymb'};
+ my $uname = $item->{'uname'};
+ my $udom = $item->{'udom'};
+ my $scoretype = $item->{'format'};
+ my ($total,$possible);
+ if ($scope eq 'resource') {
+ $total = $item->{'total'};
+ $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 (($ckey ne '') && ($secret ne '') && ($id ne '') && ($url ne '') && ($possible)) {
+ &LONCAPA::ltiutils::send_grade($id,$url,$ckey,$secret,$scoretype,$total,$possible);
+ }
+ }
+ }
+ }
+ undef(@Apache::lonhomework::ltipassback);
+ }
+}
+
+sub get_lti_score {
+ my ($uname,$udom,$mapurl) = @_;
+ my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom);
+ 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);
+ } else {
+ $iterator = $navmap->getIterator(undef,undef,undef,1);
+ }
+ if (ref($iterator)) {
+ my $depth = 1;
+ my $total = 0;
+ my $possible = 0;
+ $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);
+ }
+ }
+ $curRes = $iterator->next();
+ }
+ if ($total > $possible) {
+ $total = $possible;
+ }
+ return ($total,$possible);
+ }
+ }
+ return;
+}
+
1;
__END__
Index: loncom/lti/ltiutils.pm
diff -u loncom/lti/ltiutils.pm:1.9 loncom/lti/ltiutils.pm:1.10
--- loncom/lti/ltiutils.pm:1.9 Tue May 15 04:33:17 2018
+++ loncom/lti/ltiutils.pm Tue May 15 04:59:22 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA LTI interactions
#
-# $Id: ltiutils.pm,v 1.9 2018/05/15 04:33:17 raeburn Exp $
+# $Id: ltiutils.pm,v 1.10 2018/05/15 04:59:22 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -34,6 +34,7 @@
use UUID::Tiny ':std';
use Apache::lonnet;
use Apache::loncommon;
+use Math::Round();
use LONCAPA qw(:DEFAULT :match);
#
@@ -474,9 +475,9 @@
#
sub lti_provider_scope {
- my ($tail,$cdom,$cnum) = @_;
- my ($scope,$realuri);
- if ($tail =~ m{^/uploaded/$cdom/$cnum/(?:default|supplemental)(?:|_\d+)\.(?:sequence|page)(|___\d+___.+)$}) {
+ my ($tail,$cdom,$cnum,$getunenc) = @_;
+ my ($scope,$realuri,$passkey,$unencsymb);
+ if ($tail =~ m{^/?uploaded/$cdom/$cnum/(?:default|supplemental)(?:|_\d+)\.(?:sequence|page)(|___\d+___.+)$}) {
my $rest = $1;
if ($rest eq '') {
$scope = 'map';
@@ -489,9 +490,13 @@
} else {
$scope = 'resource';
$realuri .= '?symb='.$tail;
+ $passkey = $tail;
+ if ($getunenc) {
+ $unencsymb = $tail;
+ }
}
}
- } elsif ($tail =~ m{^/res/$match_domain/$match_username/.+\.(?:sequence|page)(|___\d+___.+)$}) {
+ } elsif ($tail =~ m{^/?res/$match_domain/$match_username/.+\.(?:sequence|page)(|___\d+___.+)$}) {
my $rest = $1;
if ($rest eq '') {
$scope = 'map';
@@ -504,6 +509,10 @@
} else {
$scope = 'resource';
$realuri .= '?symb='.$tail;
+ $passkey = $tail;
+ if ($getunenc) {
+ $unencsymb = $tail;
+ }
}
}
} elsif ($tail =~ m{^/tiny/$cdom/(\w+)$}) {
@@ -528,6 +537,7 @@
} else {
$scope = 'resource';
}
+ $passkey = $symb;
if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
(!$env{'request.role.adv'})) {
$realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url));
@@ -540,12 +550,63 @@
$realuri .= '?symb='.$symb;
}
}
+ if ($getunenc) {
+ $unencsymb = $symb;
+ }
}
- } elsif ($tail =~ m{^/$cdom/$cnum$}) {
+ } elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) {
$scope = 'course';
$realuri = '/adm/navmaps';
+ $passkey = $tail;
+ }
+ if ($scope eq 'map') {
+ $passkey = $realuri;
+ }
+ if (wantarray) {
+ return ($scope,$realuri,$unencsymb);
+ } else {
+ return $passkey;
+ }
+}
+
+sub send_grade {
+ my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_;
+ my $score;
+ if ($possible > 0) {
+ if ($scoretype eq 'ratio') {
+ $score = Math::Round::round($total).'/'.Math::Round::round($possible);
+ } elsif ($scoretype eq 'percentage') {
+ $score = (100.0*$total)/$possible;
+ $score = Math::Round::round($score);
+ } else {
+ $score = $total/$possible;
+ $score = sprintf("%.2f",$score);
+ }
+ }
+ my $date = &Apache::loncommon::utc_string(time);
+ my %ltiparams = (
+ lti_version => 'LTI-1p0',
+ lti_message_type => 'basic-lis-updateresult',
+ sourcedid => $id,
+ result_resultscore_textstring => $score,
+ result_resultscore_language => 'en-US',
+ result_resultvaluesourcedid => $scoretype,
+ result_statusofresult => 'final',
+ result_date => $date,
+ );
+ my $hashref = &sign_params($url,$ckey,$secret,\%ltiparams);
+ if (ref($hashref) eq 'HASH') {
+ my $request=new HTTP::Request('POST',$url);
+ $request->content(join('&',map {
+ my $name = escape($_);
+ "$name=" . ( ref($hashref->{$_}) eq 'ARRAY'
+ ? join("&$name=", map {escape($_) } @{$hashref->{$_}})
+ : &escape($hashref->{$_}) );
+ } keys(%{$hashref})));
+ my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
+ my $message=$response->status_line;
+#FIXME Handle case where pass back of score to LTI Consumer failed.
}
- return ($scope,$realuri);
}
1;
More information about the LON-CAPA-cvs
mailing list