[LON-CAPA-cvs] cvs: loncom /interface courseprefs.pm domainprefs.pm /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Sat Feb 24 18:41:44 EST 2024
raeburn Sat Feb 24 23:41:44 2024 EDT
Modified files:
/loncom/interface domainprefs.pm courseprefs.pm
/loncom/lonnet/perl lonnet.pm
Log:
- Bug 6907
- In-course definition of applications which can use LTI-mediated deep
linking to launch a LON-CAPA session.
- Domain Coordinator can list recommendations for specific launcher
application(s), to be shown in Course Settings > Link Protection panel.
-------------- next part --------------
Index: loncom/interface/domainprefs.pm
diff -u loncom/interface/domainprefs.pm:1.433 loncom/interface/domainprefs.pm:1.434
--- loncom/interface/domainprefs.pm:1.433 Tue Jan 2 02:34:06 2024
+++ loncom/interface/domainprefs.pm Sat Feb 24 23:41:44 2024
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
-# $Id: domainprefs.pm,v 1.433 2024/01/02 02:34:06 raeburn Exp $
+# $Id: domainprefs.pm,v 1.434 2024/02/24 23:41:44 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -669,6 +669,8 @@
col2 => 'Settings'},
{col1 => 'Rules for shared secrets',
col2 => 'Settings'},
+ {col1 => 'Link Protectors in Courses',
+ col2 => 'Values'},
{col1 => 'Link Protectors',
col2 => 'Settings'},
{col1 => 'Consumers',
@@ -1037,6 +1039,19 @@
$output .= $item->{'print'}->('shared',$dom,$settings,\$rowtotal);
} elsif ($action eq 'passwords') {
$output .= $item->{'print'}->('middle',$dom,$confname,$settings,\$rowtotal);
+ } elsif ($action eq 'lti') {
+ $output .= $item->{'print'}->('upper',$dom,$settings,\$rowtotal).'
+ </table>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <table class="LC_nested">
+ <tr class="LC_info_row">
+ <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[2]->{'col1'}).'</td>
+ <td class="LC_right_item">'.&mt($item->{'header'}->[2]->{'col2'}).'</td>
+ </tr>'."\n".
+ $item->{'print'}->('middle',$dom,$settings,\$rowtotal);
} else {
$output .= $item->{'print'}->('middle',$dom,$settings,\$rowtotal);
}
@@ -1069,6 +1084,10 @@
<td class="LC_right_item"'.$colspan.'>'.&mt($item->{'header'}->[8]->{'col2'}).'</td></tr>'.
$item->{'print'}->('bottom',$dom,$settings,\$rowtotal);
} else {
+ my $hdridx = 2;
+ if ($action eq 'lti') {
+ $hdridx = 3;
+ }
$output .= '
</table>
</td>
@@ -1077,8 +1096,8 @@
<td>
<table class="LC_nested">
<tr class="LC_info_row">
- <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[2]->{'col1'}).'</td>
- <td class="LC_right_item">'.&mt($item->{'header'}->[2]->{'col2'}).'</td>
+ <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[$hdridx]->{'col1'}).'</td>
+ <td class="LC_right_item">'.&mt($item->{'header'}->[$hdridx]->{'col2'}).'</td>
</tr>'."\n";
if ($action eq 'coursecategories') {
$output .= &print_coursecategories('bottom',$dom,$item,$settings,\$rowtotal);
@@ -1089,6 +1108,7 @@
} else {
$output .= $item->{'print'}->('lower',$dom,$settings,\$rowtotal);
}
+ $hdridx ++;
$output .= '
</tr>
</table>
@@ -1098,8 +1118,8 @@
<td>
<table class="LC_nested">
<tr class="LC_info_row">
- <td class="LC_left_item'.$leftnobr.'"'.$colspan.'>'.&mt($item->{'header'}->[3]->{'col1'}).'</td>
- <td class="LC_right_item"'.$colspan.'>'.&mt($item->{'header'}->[3]->{'col2'}).'</td></tr>'."\n";
+ <td class="LC_left_item'.$leftnobr.'"'.$colspan.'>'.&mt($item->{'header'}->[$hdridx]->{'col1'}).'</td>
+ <td class="LC_right_item"'.$colspan.'>'.&mt($item->{'header'}->[$hdridx]->{'col2'}).'</td></tr>'."\n";
if ($action eq 'passwords') {
$output .= $item->{'print'}->('bottom',$dom,$confname,$settings,\$rowtotal);
} else {
@@ -6176,7 +6196,7 @@
my ($position,$dom,$settings,$rowtotal) = @_;
my $itemcount = 1;
my ($datatable,$css_class);
- my (%rules,%encrypt,%privkeys,%linkprot);
+ my (%rules,%encrypt,%privkeys,%linkprot,%suggestions);
if (ref($settings) eq 'HASH') {
if ($position eq 'top') {
if (exists($settings->{'encrypt'})) {
@@ -6199,12 +6219,18 @@
}
}
}
- } elsif ($position eq 'middle') {
+ } elsif ($position eq 'upper') {
if (exists($settings->{'rules'})) {
if (ref($settings->{'rules'}) eq 'HASH') {
%rules = %{$settings->{'rules'}};
}
}
+ } elsif ($position eq 'middle') {
+ if (exists($settings->{'suggested'})) {
+ if (ref($settings->{'suggested'}) eq 'HASH') {
+ %suggestions = %{$settings->{'suggested'}};
+ }
+ }
} elsif ($position eq 'lower') {
if (exists($settings->{'linkprot'})) {
if (ref($settings->{'linkprot'}) eq 'HASH') {
@@ -6215,7 +6241,7 @@
}
}
} else {
- foreach my $key ('encrypt','private','rules','linkprot') {
+ foreach my $key ('encrypt','private','rules','linkprot','suggestions') {
if (exists($settings->{$key})) {
delete($settings->{$key});
}
@@ -6224,11 +6250,14 @@
}
if ($position eq 'top') {
$datatable = &secrets_form($dom,'ltisec',\%encrypt,\%privkeys,$rowtotal);
- } elsif ($position eq 'middle') {
+ } elsif ($position eq 'upper') {
$datatable = &password_rules('ltisecrets',\$itemcount,\%rules);
$$rowtotal += $itemcount;
+ } elsif ($position eq 'middle') {
+ $datatable = &linkprot_suggestions(\%suggestions,\$itemcount);
+ $$rowtotal += $itemcount;
} elsif ($position eq 'lower') {
- $datatable .= &Apache::courseprefs::print_linkprotection($dom,'',$settings,$rowtotal,'','','domain');
+ $datatable .= &Apache::courseprefs::print_linkprotection($dom,'',$settings,$rowtotal,'','','domain');
} else {
my ($switchserver,$switchmessage);
$switchserver = &check_switchserver($dom);
@@ -6815,6 +6844,58 @@
);
}
+sub linkprot_suggestions {
+ my ($suggested,$itemcount) = @_;
+ my $count = 0;
+ my $next = 1;
+ my %lt = &Apache::lonlocal::texthash(
+ 'name' => 'Suggested Launcher',
+ 'info' => 'Recommendations',
+ );
+ my ($datatable,$css_class,$dest);
+ if (ref($suggested) eq 'HASH') {
+ my @current = sort { $a <=> $b } keys(%{$suggested});
+ $next += $current[-1];
+ for (my $i=0; $i<@current; $i++) {
+ my $num = $current[$i];
+ my %values;
+ if (ref($suggested->{$num}) eq 'HASH') {
+ %values = %{$suggested->{$num}};
+ } else {
+ next;
+ }
+ $css_class = $$itemcount%2?' class="LC_odd_row"':'';
+ $datatable .=
+ '<tr '.$css_class.'><td><span class="LC_nobreak">'."\n".
+ '<label><input type="checkbox" name="linkprot_suggested_del" value="'.$i.'" />'."\n".
+ &mt('Delete?').'</label></span></td><td>'."\n".
+ '<div class="LC_floatleft"><fieldset><legend>'.$lt{'name'}.'</legend>'."\n".
+ '<input type="text" size="15" name="linkprot_suggested_name_'.$i.'" value="'.$values{'name'}.'" autocomplete="off" />'."\n".
+ '</fieldset></div>'.
+ '<div class="LC_floatleft"><fieldset><legend>'.$lt{'info'}.'</legend>'."\n".
+ '<textarea cols="55" rows="5" name="linkprot_suggested_info_'.$i.'">'.$values{'info'}.'</textarea>'.
+ '</fieldset></div>'.
+ '<div style="padding:0;clear:both;margin:0;border:0"></div>'."\n".
+ '<input type="hidden" name="linkprot_suggested_id_'.$i.'" value="'.$num.'" /></td></tr>'."\n";
+ $$itemcount ++;
+ }
+ }
+ $css_class = $$itemcount%2?' class="LC_odd_row"':'';
+ $datatable .= '<tr '.$css_class.'><td><span class="LC_nobreak">'."\n".
+ '<input type="hidden" name="linkprot_suggested_maxnum" value="'.$next.'" />'."\n".
+ '<input type="checkbox" name="linkprot_suggested_add" value="1" />'.&mt('Add').'</span></td>'."\n".
+ '<td>'."\n".
+ '<div class="LC_floatleft"><fieldset><legend>'.$lt{'name'}.'</legend>'."\n".
+ '<input type="text" size="15" name="linkprot_suggested_name_add" value="" autocomplete="off" />'."\n".
+ '</fieldset></div>'.
+ '<div class="LC_floatleft"><fieldset><legend>'.$lt{'info'}.'</legend>'."\n".
+ '<textarea cols="55" rows="5" name="linkprot_suggested_info_add"></textarea>'.
+ '</fieldset></div>'.
+ '<div style="padding:0;clear:both;margin:0;border:0"></div>'."\n".
+ '</td></tr>'."\n";
+ return $datatable;
+}
+
sub print_coursedefaults {
my ($position,$dom,$settings,$rowtotal) = @_;
my ($css_class,$datatable,%checkedon,%checkedoff,%defaultchecked, at toggles);
@@ -15016,7 +15097,6 @@
off => &mt('Encryption of stored external tool secrets defined in domain disabled'),
},
);
-
}
my @types= ('crs','dom');
if ($context eq 'lti') {
@@ -15112,6 +15192,28 @@
}
} elsif ($item eq 'linkprot') {
next;
+ } elsif ($item eq 'suggested') {
+ if ((ref($secchanges->{'suggested'}) eq 'HASH') &&
+ (ref($newsec->{'suggested'}) eq 'HASH')) {
+ my $suggestions;
+ foreach my $id (sort { $a <=> $b } keys(%{$secchanges->{'suggested'}})) {
+ if (ref($newsec->{'suggested'}->{$id}) eq 'HASH') {
+ my $name = $newsec->{'suggested'}->{$id}->{'name'};
+ my $info = $newsec->{'suggested'}->{$id}->{'info'};
+ $suggestions .= '<li>'.&mt('Launcher: [_1]',$name).'<br />'.
+ &mt('Recommend: [_1]','<pre>'.$info.'</pre>').
+ '</li>';
+ } else {
+ $suggestions .= '<li>'.&mt('Recommendations deleted for Launcher: [_1]',
+ $newsec->{'suggested'}->{$id}).'</li>';
+ }
+ }
+ if ($suggestions) {
+ $output .= '<li>'.&mt('Hints in Courses for Link Protector Configuration').
+ '<ul>'.$suggestions.'</ul>'.
+ '</li>';
+ }
+ }
}
}
if ($needs_update) {
@@ -15716,7 +15818,7 @@
}
}
if (ref($currltisec{'linkprot'}) eq 'HASH') {
- foreach my $id (%{$currltisec{'linkprot'}}) {
+ foreach my $id (keys(%{$currltisec{'linkprot'}})) {
next if ($id !~ /^\d+$/);
unless (exists($linkprotchg{$id})) {
if (ref($currltisec{'linkprot'}{$id}) eq 'HASH') {
@@ -15738,17 +15840,75 @@
if ($proterror) {
$errors .= '<li>'.$proterror.'</li>';
}
+
+ my (%delsuggested,%suggids, at suggested);;
+ if (ref($currltisec{'suggested'}) eq 'HASH') {
+ my $maxnum = $env{'form.linkprot_suggested_maxnum'};
+ my @todelete = &Apache::loncommon::get_env_multiple('form.linkprot_suggested_del');
+ for (my $i=0; $i<$maxnum; $i++) {
+ my $itemid = $env{'form.linkprot_suggested_id_'.$i};
+ $itemid =~ s/\D+//g;
+ if ($itemid) {
+ if (ref($currltisec{'suggested'}->{$itemid}) eq 'HASH') {
+ push(@suggested,$i);
+ $suggids{$i} = $itemid;
+ if ((@todelete > 0) && (grep(/^$i$/, at todelete))) {
+ if (ref($currltisec{'suggested'}{$itemid}) eq 'HASH') {
+ $delsuggested{$itemid} = $currltisec{'suggested'}{$itemid}{'name'};
+ }
+ } else {
+ if ($env{'form.linkprot_suggested_name_'.$i} eq '') {
+ $delsuggested{$itemid} = $currltisec{'suggested'}{$itemid}{'name'};
+ } else {
+ $env{'form.linkprot_suggested_name_'.$i} =~ s/(`)/'/g;
+ $env{'form.linkprot_suggested_info_'.$i} =~ s/(`)/'/g;
+ $newltisec{'suggested'}{$itemid}{'name'} = $env{'form.linkprot_suggested_name_'.$i};
+ $newltisec{'suggested'}{$itemid}{'info'} = $env{'form.linkprot_suggested_info_'.$i};
+ if (($currltisec{'suggested'}{$itemid}{'name'} ne $newltisec{'suggested'}{$itemid}{'name'}) ||
+ ($currltisec{'suggested'}{$itemid}{'info'} ne $newltisec{'suggested'}{$itemid}{'info'})) {
+ $secchanges{'suggested'}{$itemid} = 1;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ foreach my $key (keys(%delsuggested)) {
+ $newltisec{'suggested'}{$key} = $delsuggested{$key};
+ $secchanges{'suggested'}{$key} = 1;
+ }
+ if (($env{'form.linkprot_suggested_add'}) &&
+ ($env{'form.linkprot_suggested_name_add'} ne '')) {
+ $env{'form.linkprot_suggested_name_add'} =~ s/(`)/'/g;
+ $env{'form.linkprot_suggested_info_add'} =~ s/(`)/'/g;
+ my ($newsuggid,$errormsg) = &get_lti_id($dom,$env{'form.linkprot_suggested_name_add'},'suggested');
+ if ($newsuggid) {
+ $newltisec{'suggested'}{$newsuggid}{'name'} = $env{'form.linkprot_suggested_name_add'};
+ $newltisec{'suggested'}{$newsuggid}{'info'} = $env{'form.linkprot_suggested_info_add'};
+ $secchanges{'suggested'}{$newsuggid} = 1;
+ } else {
+ my $error = &mt('Failed to acquire unique ID for new Link Protectors in Courses Suggestion');
+ if ($errormsg) {
+ $error .= ' ('.$errormsg.')';
+ }
+ $errors .= '<li><span class="LC_error">'.$error.'</span></li>';
+ }
+ }
my (@items,%deletions,%itemids);
if ($env{'form.lti_add'}) {
my $consumer = $env{'form.lti_consumer_add'};
$consumer =~ s/(`)/'/g;
- ($newid,my $error) = &get_lti_id($dom,$consumer);
+ ($newid,my $errormsg) = &get_lti_id($dom,$consumer,'lti');
if ($newid) {
$itemids{'add'} = $newid;
push(@items,'add');
$changes{$newid} = 1;
} else {
my $error = &mt('Failed to acquire unique ID for new LTI configuration');
+ if ($errormsg) {
+ $error .= ' ('.$errormsg.')';
+ }
$errors .= '<li><span class="LC_error">'.$error.'</span></li>';
}
}
@@ -16342,7 +16502,8 @@
}
$resulttext .= '</ul>';
if (ref($lastactref) eq 'HASH') {
- if (($secchanges{'encrypt'}) || ($secchanges{'private'})) {
+ if (($secchanges{'encrypt'}) || ($secchanges{'private'}) || (exists($secchanges{'suggested'}))) {
+ &Apache::lonnet::get_domain_defaults($dom,1);
$lastactref->{'domdefaults'} = 1;
}
}
@@ -16381,23 +16542,26 @@
}
sub get_lti_id {
- my ($domain,$consumer) = @_;
- # get lock on lti db
+ my ($domain,$consumer,$dbname) = @_;
+ unless (($dbname eq 'lti') || ($dbname eq 'suggested')) {
+ return ('','invalid db');
+ }
+ # get lock on db
my $lockhash = {
lock => $env{'user.name'}.
':'.$env{'user.domain'},
};
my $tries = 0;
- my $gotlock = &Apache::lonnet::newput_dom('lti',$lockhash,$domain);
+ my $gotlock = &Apache::lonnet::newput_dom($dbname,$lockhash,$domain);
my ($id,$error);
while (($gotlock ne 'ok') && ($tries<10)) {
$tries ++;
sleep (0.1);
- $gotlock = &Apache::lonnet::newput_dom('lti',$lockhash,$domain);
+ $gotlock = &Apache::lonnet::newput_dom($dbname,$lockhash,$domain);
}
if ($gotlock eq 'ok') {
- my %currids = &Apache::lonnet::dump_dom('lti',$domain);
+ my %currids = &Apache::lonnet::dump_dom($dbname,$domain);
if ($currids{'lock'}) {
delete($currids{'lock'});
if (keys(%currids)) {
@@ -16409,14 +16573,14 @@
$id = 1;
}
if ($id) {
- unless (&Apache::lonnet::newput_dom('lti',{ $id => $consumer },$domain) eq 'ok') {
+ unless (&Apache::lonnet::newput_dom($dbname,{ $id => $consumer },$domain) eq 'ok') {
$error = 'nostore';
}
} else {
$error = 'nonumber';
}
}
- my $dellockoutcome = &Apache::lonnet::del_dom('lti',['lock'],$domain);
+ my $dellockoutcome = &Apache::lonnet::del_dom($dbname,['lock'],$domain);
} else {
$error = 'nolock';
}
Index: loncom/interface/courseprefs.pm
diff -u loncom/interface/courseprefs.pm:1.130 loncom/interface/courseprefs.pm:1.131
--- loncom/interface/courseprefs.pm:1.130 Sat Feb 24 20:46:24 2024
+++ loncom/interface/courseprefs.pm Sat Feb 24 23:41:44 2024
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set configuration settings for a course
#
-# $Id: courseprefs.pm,v 1.130 2024/02/24 20:46:24 raeburn Exp $
+# $Id: courseprefs.pm,v 1.131 2024/02/24 23:41:44 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -372,6 +372,12 @@
my %values=&Apache::lonnet::dump('environment',$cdom,$cnum);
my %linkprot=&Apache::lonnet::dump('lti',$cdom,$cnum,undef,undef,undef,1);
+ my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
+ unless ($phase eq 'process') {
+ if (ref($domdefs{'linkprotsuggested'}) eq 'HASH') {
+ $values{'suggested'} = $domdefs{'linkprotsuggested'};
+ }
+ }
my %ltienc = &Apache::lonnet::dump('nohist_ltienc',$cdom,$cnum,undef,undef,undef,1);
my %ltitools = &Apache::lonnet::dump('ltitools',$cdom,$cnum,undef,undef,undef,1);
my %ltitoolsenc = &Apache::lonnet::dump('nohist_toolsenc',$cdom,$cnum,undef,undef,undef,1);
@@ -793,9 +799,38 @@
<tr>
<td>
<table class="LC_nested">';
+ if ($action eq 'linkprot') {
+ if ((ref($settings) eq 'HASH') && (ref($settings->{'suggested'}) eq 'HASH')) {
+ my $hints;
+ my $hintcount = 0;
+ foreach my $key (sort { $a <=> $b } keys(%{$settings->{'suggested'}})) {
+ if ((ref($settings->{'suggested'}->{$key}) eq 'HASH')) {
+ if (($settings->{'suggested'}->{$key}-{'name'} ne '') &&
+ ($settings->{'suggested'}->{$key}-{'info'} ne '')) {
+ my $css_class = $hintcount%2?' class="LC_odd_row"':' class="LC_even_row"';
+ $hints .= '<tr '.$css_class.'><td class="LC_left_item">'.
+ $settings->{'suggested'}->{$key}->{'name'}.'</td>'.
+ '<td class="LC_right_item"><pre>'.
+ $settings->{'suggested'}->{$key}->{'info'}.
+ '</pre></td></tr>';
+ $hintcount ++;
+ }
+ }
+ }
+ if ($hintcount) {
+ $output .= '<tr class="LC_info_row">'.
+ '<td colspan="2" class="LC_left_item">'.&mt('Recommendation(s) for specific launcher application(s)').'</td>'.
+ '</tr>'."\n".
+ '<tr class="LC_info_row">'.
+ '<td class="LC_left_item"><span class="LC_nobreak">'.&mt('Launcher Application').'</span></td>'.
+ '<td class="LC_right_item">'.&mt('Recommendation(s)').'</td></tr>'."\n".
+ $hints;
+ }
+ }
+ }
if (exists $item->{'header'}->[0]->{'col1'} ||
exists $item->{'header'}->[0]->{'col2'}) {
- $output .= '
+ $output .= '
<tr class="LC_info_row">
<td class="LC_left_item" valign="top">'.&mt($item->{'header'}->[0]->{'col1'}).'</td>';
if (($action eq 'courseinfo') || ($action eq 'localization') ||
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1522 loncom/lonnet/perl/lonnet.pm:1.1523
--- loncom/lonnet/perl/lonnet.pm:1.1522 Thu Dec 28 18:14:09 2023
+++ loncom/lonnet/perl/lonnet.pm Sat Feb 24 23:41:44 2024
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1522 2023/12/28 18:14:09 raeburn Exp $
+# $Id: lonnet.pm,v 1.1523 2024/02/24 23:41:44 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2975,6 +2975,17 @@
$domdefaults{'ltiprivhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
}
}
+ if (ref($domconfig{'ltisec'}{'suggested'}) eq 'HASH') {
+ my %suggestions = %{$domconfig{'ltisec'}{'suggested'}};
+ foreach my $item (keys(%{$domconfig{'ltisec'}{'suggested'}})) {
+ unless (ref($domconfig{'ltisec'}{'suggested'}{$item}) eq 'HASH') {
+ delete($suggestions{$item});
+ }
+ }
+ if (keys(%suggestions)) {
+ $domdefaults{'linkprotsuggested'} = \%suggestions;
+ }
+ }
}
if (ref($domconfig{'toolsec'}) eq 'HASH') {
if (ref($domconfig{'toolsec'}{'encrypt'}) eq 'HASH') {
More information about the LON-CAPA-cvs
mailing list