--- loncom/interface/courseprefs.pm 2021/06/07 02:19:51 1.92
+++ loncom/interface/courseprefs.pm 2023/04/13 15:21:00 1.119
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set configuration settings for a course
#
-# $Id: courseprefs.pm,v 1.92 2021/06/07 02:19:51 raeburn Exp $
+# $Id: courseprefs.pm,v 1.119 2023/04/13 15:21:00 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -52,12 +52,16 @@ This module is used for configuration of
=item process_changes()
+=item process_linkprot()
+
=item get_sec_str()
=item check_clone()
=item store_changes()
+=item store_linkprot()
+
=item update_env()
=item display_disallowed()
@@ -112,7 +116,7 @@ This module is used for configuration of
=item item_table_row_end()
-=item yes_no_radio()
+=item yesno_radio()
=item select_from_options()
@@ -220,6 +224,8 @@ use Apache::lonparmset;
use Apache::courseclassifier;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);
+use Crypt::CBC;
+use Time::HiRes qw( sleep );
my $registered_cleanup;
my $modified_courses;
@@ -288,7 +294,7 @@ sub handler {
excc => 'Exclude from community catalog',
clon => 'Users allowed to clone community',
rept => 'Replacement titles for standard community roles',
- time => 'Timezone where the community is located',
+ time => 'Time Zone where the community is located',
date => 'Locale used for community calendar',
coco => 'Community Content',
copo => 'Community Policy',
@@ -317,7 +323,7 @@ sub handler {
excc => 'Exclude from course catalog',
clon => 'Users allowed to clone course',
rept => 'Replacement titles for standard course roles',
- time => 'Timezone in which the course takes place',
+ time => 'Time Zone in which the course takes place',
date => 'Locale used for course calendar',
coco => 'Course Content',
copo => 'Course Policy',
@@ -365,10 +371,48 @@ sub handler {
}
my %values=&Apache::lonnet::dump('environment',$cdom,$cnum);
+ my %linkprot=&Apache::lonnet::dump('lti',$cdom,$cnum,undef,undef,undef,1);
+ 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);
+ foreach my $id (keys(%linkprot)) {
+ if (ref($linkprot{$id}) eq 'HASH') {
+ if (ref($ltienc{$id}) eq 'HASH') {
+ $values{'linkprot'}{$id} = { %{$linkprot{$id}}, %{$ltienc{$id}} };
+ } else {
+ $values{'linkprot'}{$id} = $linkprot{$id};
+ }
+ }
+ unless ($phase eq 'process') {
+ if (ref($values{'linkprot'}{$id}) eq 'HASH') {
+ delete($values{'linkprot'}{$id}{'secret'});
+ }
+ }
+ }
+ if ($linkprot{'lock'}) {
+ delete($linkprot{'lock'});
+ }
+ foreach my $id (keys(%ltitools)) {
+ if (ref($ltitools{$id}) eq 'HASH') {
+ if (ref($ltitoolsenc{$id}) eq 'HASH') {
+ $values{'ltitools'}{$id} = { %{$ltitools{$id}}, %{$ltitoolsenc{$id}} };
+ } else {
+ $values{'ltitools'}{$id} = $ltitools{$id};
+ }
+ }
+ unless ($phase eq 'process') {
+ if (ref($values{'ltitools'}{$id}) eq 'HASH') {
+ delete($values{'ltitools'}{$id}{'secret'});
+ }
+ }
+ }
+ if ($ltitools{'lock'}) {
+ delete($ltitools{'lock'});
+ }
my @prefs_order = ('courseinfo','localization','feedback','discussion',
'classlists','appearance','grading','printouts',
- 'menuitems','spreadsheet','bridgetasks','lti','other');
-
+ 'menuitems','ltitools','linkprot','spreadsheet',
+ 'bridgetasks','lti','other');
my %prefs = (
'courseinfo' =>
{ text => $lt{'gens'},
@@ -467,7 +511,8 @@ sub handler {
help => 'Course_Prefs_Display',
ordered => ['default_xml_style','pageseparators',
'disable_receipt_display','texengine',
- 'tthoptions','uselcmath','usejsme'],
+ 'tthoptions','uselcmath','usejsme',
+ 'inline_chem','extresource'],
itemtext => {
default_xml_style => 'Default XML style file',
pageseparators => 'Visibly Separate Items on Pages',
@@ -476,6 +521,8 @@ sub handler {
tthoptions => 'Default set of options to pass to tth/m when converting TeX',
uselcmath => 'Student formula entry uses inline preview, not DragMath pop-up',
usejsme => 'Molecule editor uses JSME (HTML5) in place of JME (Java)',
+ inline_chem => 'Chemical reaction response uses inline preview, not pop-up',
+ extresource => 'Display of external resources',
},
},
'grading' =>
@@ -557,6 +604,22 @@ sub handler {
menucollections => 'Menu collections',
},
},
+ 'linkprot' =>
+ {
+ text => 'Link protection',
+ help => 'Course_Prefs_Linkprotection',
+ header => [{col1 => 'Item',
+ col2 => 'Settings',
+ }],
+ },
+ 'ltitools' =>
+ {
+ text => 'External tools',
+ help => 'Course_Prefs_ExternalTools',
+ header => [{col1 => 'Item',
+ col2 => 'Settings',
+ }],
+ },
'other' =>
{ text => 'Other settings',
help => 'Course_Prefs_Other',
@@ -567,10 +630,14 @@ sub handler {
);
if (($phase eq 'process') && ($parm_permission->{'process'})) {
my @allitems = &get_allitems(%prefs);
- &Apache::lonconfigsettings::make_changes($r,$cdom,$phase,$context,
- \@prefs_order,\%prefs,\%values,
- $cnum,undef,\@allitems,
- 'coursepref',$parm_permission);
+ my $result = &Apache::lonconfigsettings::make_changes($r,$cdom,$phase,$context,
+ \@prefs_order,\%prefs,\%values,
+ $cnum,undef,\@allitems,
+ 'coursepref',$parm_permission);
+ if ((ref($result) eq 'HASH') && (keys(%{$result}))) {
+ $r->rflush();
+ &devalidate_remote_courseprefs($cdom,$cnum,$result);
+ }
} elsif (($phase eq 'display') && ($parm_permission->{'display'})) {
my $noedit;
if (ref($parm_permission) eq 'HASH') {
@@ -581,7 +648,7 @@ sub handler {
my $jscript = &get_jscript($cid,$cdom,$phase,$crstype,\%values,$noedit);
my @allitems = &get_allitems(%prefs);
&Apache::lonconfigsettings::display_settings($r,$cdom,$phase,$context,
- \@prefs_order,\%prefs,\%values,undef,$jscript,\@allitems,$crstype,
+ \@prefs_order,\%prefs,\%values,$cnum,$jscript,\@allitems,$crstype,
'coursepref',$parm_permission);
} else {
&Apache::lonconfigsettings::display_choices($r,$phase,$context,
@@ -634,7 +701,7 @@ sub get_allitems {
}
sub print_config_box {
- my ($r,$cdom,$phase,$action,$item,$settings,$allitems,$crstype,$parm_permission) = @_;
+ my ($r,$cdom,$cnum,$phase,$action,$item,$settings,$allitems,$crstype,$parm_permission) = @_;
my $ordered = $item->{'ordered'};
my $itemtext = $item->{'itemtext'};
my $noedit;
@@ -760,10 +827,18 @@ sub print_config_box {
$output .= &print_spreadsheet($cdom,$settings,$ordered,$itemtext,\$rowtotal,$crstype,$noedit);
} elsif ($action eq 'bridgetasks') {
$output .= &print_bridgetasks($cdom,$settings,$ordered,$itemtext,\$rowtotal,$crstype,$noedit);
+ } elsif ($action eq 'ltitools') {
+ my $currtools = {};
+ if ((ref($settings) eq 'HASH') && (ref($settings->{'ltitools'}))) {
+ $currtools = $settings->{'ltitools'};
+ }
+ $output .= &print_ltitools($cdom,$cnum,$currtools,\$rowtotal,$crstype,$noedit,'course');
} elsif ($action eq 'lti') {
$output .= &print_lti($cdom,$settings,$ordered,$itemtext,\$rowtotal,$crstype,$noedit);
} elsif ($action eq 'menuitems') {
$output .= &print_menuitems('bottom',$cdom,$settings,$itemtext,\$rowtotal,$crstype,$noedit);
+ } elsif ($action eq 'linkprot') {
+ $output .= &print_linkprotection($cdom,$cnum,$settings,\$rowtotal,$crstype,$noedit,'course');
} elsif ($action eq 'other') {
$output .= &print_other($cdom,$settings,$allitems,\$rowtotal,$crstype,$noedit);
}
@@ -776,8 +851,8 @@ sub print_config_box {
}
sub process_changes {
- my ($cdom,$action,$values,$item,$changes,$allitems,$disallowed,$crstype) = @_;
- my %newvalues;
+ my ($cdom,$cnum,$action,$values,$item,$changes,$allitems,$disallowed,$crstype,$lastactref) = @_;
+ my (%newvalues,$errors);
if (ref($item) eq 'HASH') {
if (ref($changes) eq 'HASH') {
my @ordered;
@@ -794,6 +869,18 @@ sub process_changes {
}
}
}
+ } elsif (($action eq 'linkprot') || ($action eq 'ltitools')) {
+ if (ref($values->{$action}) eq 'HASH') {
+ foreach my $id (keys(%{$values->{$action}})) {
+ if ($id =~ /^\d+$/) {
+ push(@ordered,$id);
+ }
+ }
+ }
+ @ordered = sort { $a <=> $b } @ordered;
+ if (($env{'form.'.$action.'_add'}) && ($env{'form.'.$action.'_maxnum'} =~ /^\d+$/)) {
+ push(@ordered,$env{'form.'.$action.'_maxnum'});
+ }
} elsif (ref($item->{'ordered'}) eq 'ARRAY') {
if ($action eq 'courseinfo') {
my ($can_toggle_cat,$can_categorize) =
@@ -931,6 +1018,16 @@ sub process_changes {
} elsif ($values->{'menucollections'}) {
$changes->{'menucollections'} = '';
}
+ } elsif ($action eq 'linkprot') {
+ if (ref($values) eq 'HASH') {
+ $errors = &process_linkprot($cdom,$cnum,$values->{$action},$changes,'course',$lastactref);
+ }
+ } elsif ($action eq 'ltitools') {
+ if (ref($values) eq 'HASH') {
+ my $switchserver = &check_switchserver($cdom,$cnum,'course','/adm/courseprefs');
+ $errors = &process_ltitools('',$cdom,$cnum,$values->{$action},$changes,'course',$lastactref,
+ 'ok','','ok');
+ }
} else {
foreach my $entry (@ordered) {
if ($entry eq 'cloners') {
@@ -971,7 +1068,7 @@ sub process_changes {
my $clonedom = $env{'form.cloners_newdom'};
if (&check_clone($clonedom,$disallowed) eq 'ok') {
my $newdom = '*:'.$env{'form.cloners_newdom'};
- if (@clonedoms) {
+ if (@clonedoms) {
if (!grep(/^\Q$newdom\E$/,@clonedoms)) {
$newvalues{$entry} .= ','.$newdom;
}
@@ -1060,7 +1157,9 @@ sub process_changes {
$autocoowner = $domconf{'autoenroll'}{'co-owners'};
}
}
- unless ($autocoowner) {
+ if ($autocoowner) {
+ $newvalues{'co-owners'} = $values->{'internal.co-owners'};
+ } else {
my @keepcoowners = &Apache::loncommon::get_env_multiple('form.coowners');
my @pendingcoowners = &Apache::loncommon::get_env_multiple('form.pendingcoowners');
my @invitecoowners = &Apache::loncommon::get_env_multiple('form.invitecoowners');
@@ -1105,6 +1204,8 @@ sub process_changes {
if ($pendingcoowners ne '') {
@newpending = @pendingcoown;
}
+ } else {
+ @newcoown = @currcoown;
}
$newvalues{'pendingco-owners'} = join(',',sort(@newpending));
$newvalues{'co-owners'} = join(',',sort(@newcoown));
@@ -1404,10 +1505,54 @@ sub process_changes {
$newvalues{$entry} = '';
}
}
+ } elsif ($entry eq 'extresource') {
+ if ($env{'form.'.$entry} =~ /^iframe|tab|window$/) {
+ $newvalues{$entry} = $env{'form.'.$entry};
+ if ($env{'form.'.$entry} ne 'iframe') {
+ if ($env{'form.extwintabreuse'}) {
+ $newvalues{$entry} .= ':1';
+ } else {
+ $newvalues{$entry} .= ':0';
+ }
+ if ($env{'form.'.$entry} eq 'window') {
+ foreach my $dim ('width','height') {
+ $env{'form.extreswin'.$dim} =~ s/^\s+|\s+$//g;
+ if ($env{'form.extreswin'.$dim} =~ /^\d+$/) {
+ $newvalues{$entry} .= ':'.$env{'form.extreswin'.$dim};
+ } else {
+ $newvalues{$entry} .= ':';
+ }
+ }
+ }
+ }
+ }
+ unless (($newvalues{$entry} eq 'iframe') && ($values->{$entry} eq '')) {
+ if ($newvalues{$entry} ne $values->{$entry}) {
+ $changes->{$entry} = $newvalues{$entry};
+ }
+ }
+ } elsif ($entry eq 'timezone') {
+ if ($env{'form.'.$entry}) {
+ $newvalues{$entry} = $env{'form.'.$entry};
+ if ($newvalues{$entry} ne $values->{$entry}) {
+ $changes->{$entry} = $newvalues{$entry};
+ }
+ if ($env{'form.tzover'}) {
+ $newvalues{'tzover'} = $env{'form.tzover'};
+ if ($newvalues{'tzover'} ne $values->{'tzover'}) {
+ $changes->{'tzover'} = $newvalues{'tzover'};
+ }
+ } elsif ($values->{'tzover'}) {
+ $changes->{'tzover'} = '';
+ }
+ } elsif ($values->{$entry}) {
+ $changes->{$entry} = '';
+ }
} else {
$newvalues{$entry} = $env{'form.'.$entry};
}
- unless (($entry eq 'co-owners') || ($entry eq 'discussion_post_fonts')) {
+ unless (($entry eq 'co-owners') || ($entry eq 'discussion_post_fonts') ||
+ ($entry eq 'extresource') || ($entry eq 'timezone')) {
if ($newvalues{$entry} ne $values->{$entry}) {
$changes->{$entry} = $newvalues{$entry};
}
@@ -1417,7 +1562,937 @@ sub process_changes {
}
}
}
- return;
+ return $errors;
+}
+
+sub process_linkprot {
+ my ($cdom,$cnum,$values,$changes,$context,$lastactref) = @_;
+ my ($dest,$ltiauth,$privnum,$cipher,$errors,%linkprot);
+ if (ref($values) eq 'HASH') {
+ foreach my $id (keys(%{$values})) {
+ if ($id =~ /^\d+$/) {
+ unless (ref($values->{$id}) eq 'HASH') {
+ $linkprot{$id} = '';
+ }
+ }
+ }
+ }
+ ($cipher,$privnum) = &get_credentials($cdom,$cnum,'lti',$context);
+ if ($context eq 'domain') {
+ $dest = '/adm/domainprefs';
+ $ltiauth = 1;
+ } else {
+ $dest = '/adm/courseprefs';
+ if (exists($env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'})) {
+ $ltiauth = $env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'};
+ } else {
+ my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
+ $ltiauth = $domdefs{'crsltiauth'};
+ }
+ }
+ my $switchserver = &check_switchserver($cdom,$cnum,$context,$dest);
+ my (@items,%deletions,%itemids,%haschanges);
+ if ($env{'form.linkprot_add'}) {
+ my $name = $env{'form.linkprot_name_add'};
+ $name =~ s/(`)/'/g;
+ my ($newid,$error) = &get_linkprot_id($cdom,$cnum,$name,$context);
+ if ($newid) {
+ $itemids{'add'} = $newid;
+ push(@items,'add');
+ $haschanges{$newid} = 1;
+ } else {
+ $errors .= ''.
+ &mt('Failed to acquire unique ID for link protection').
+ '';
+ }
+ }
+ if (ref($values) eq 'HASH') {
+ my @todelete = &Apache::loncommon::get_env_multiple('form.linkprot_del');
+ my $maxnum = $env{'form.linkprot_maxnum'};
+ for (my $i=0; $i<$maxnum; $i++) {
+ my $itemid = $env{'form.linkprot_id_'.$i};
+ $itemid =~ s/\D+//g;
+ if ($itemid) {
+ if (ref($values->{$itemid}) eq 'HASH') {
+ push(@items,$i);
+ $itemids{$i} = $itemid;
+ if ((@todelete > 0) && (grep(/^$i$/,@todelete))) {
+ $deletions{$itemid} = $values->{$itemid}->{'name'};
+ }
+ }
+ }
+ }
+ }
+ foreach my $idx (@items) {
+ my $itemid = $itemids{$idx};
+ next unless ($itemid);
+ if (exists($deletions{$itemid})) {
+ $linkprot{$itemid} = $deletions{$itemid};
+ $haschanges{$itemid} = 1;
+ next;
+ }
+ my %current;
+ if (ref($values) eq 'HASH') {
+ if (ref($values->{$itemid}) eq 'HASH') {
+ foreach my $key (keys(%{$values->{$itemid}})) {
+ $current{$key} = $values->{$itemid}->{$key};
+ }
+ }
+ }
+ foreach my $inner ('name','lifetime','version') {
+ my $formitem = 'form.linkprot_'.$inner.'_'.$idx;
+ $env{$formitem} =~ s/(`)/'/g;
+ if ($inner eq 'lifetime') {
+ $env{$formitem} =~ s/[^\d.]//g;
+ }
+ unless ($idx eq 'add') {
+ if ($current{$inner} ne $env{$formitem}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ if ($env{$formitem} ne '') {
+ $linkprot{$itemid}{$inner} = $env{$formitem};
+ }
+ }
+ my $urlitem = 'form.linkprot_returnurl_'.$idx;
+ my $urlparamname = 'form.linkprot_urlparam_'.$idx;
+ if ($env{$urlitem} == 1) {
+ $env{$urlparamname} =~ s/(`)/'/g;
+ } elsif (exists($env{$urlparamname})) {
+ $env{$urlparamname} = '';
+ }
+ unless ($idx eq 'add') {
+ if ((!$current{'returnurl'} && ($env{$urlparamname} ne '')) ||
+ ($current{'returnurl'} && ($env{$urlparamname} eq ''))) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ if ($env{$urlparamname} ne '') {
+ $linkprot{$itemid}{'returnurl'} = $env{$urlparamname};
+ }
+ if ($ltiauth) {
+ my $reqitem = 'form.linkprot_requser_'.$idx;
+ $env{$reqitem} =~ s/(`)/'/g;
+ unless ($idx eq 'add') {
+ if ((!$current{'requser'} && $env{$reqitem}) ||
+ ($current{'requser'} && !$env{$reqitem})) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ if ($env{$reqitem} == 1) {
+ $linkprot{$itemid}{'requser'} = $env{$reqitem};
+ foreach my $inner ('mapuser','notstudent') {
+ my $formitem = 'form.linkprot_'.$inner.'_'.$idx;
+ $env{$formitem} =~ s/(`)/'/g;
+ if ($inner eq 'mapuser') {
+ if ($env{$formitem} eq 'other') {
+ my $mapuser = $env{'form.linkprot_customuser_'.$idx};
+ $mapuser =~ s/(`)/'/g;
+ $mapuser =~ s/^\s+|\s+$//g;
+ if ($mapuser ne '') {
+ $linkprot{$itemid}{$inner} = $mapuser;
+ } else {
+ delete($linkprot{$itemid}{'requser'});
+ last;
+ }
+ } elsif ($env{$formitem} eq 'sourcedid') {
+ $linkprot{$itemid}{$inner} = 'lis_person_sourcedid';
+ } elsif ($env{$formitem} eq 'email') {
+ $linkprot{$itemid}{$inner} = 'lis_person_contact_email_primary';
+ }
+ } else {
+ $linkprot{$itemid}{$inner} = $env{$formitem};
+ }
+ unless ($idx eq 'add') {
+ if ($current{$inner} ne $linkprot{$itemid}{$inner}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ }
+ }
+ unless ($switchserver) {
+ my $keyitem = 'form.linkprot_key_'.$idx;
+ $env{$keyitem} =~ s/(`)/'/g;
+ unless ($idx eq 'add') {
+ if ($current{'key'} ne $env{$keyitem}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ if ($env{$keyitem} ne '') {
+ $linkprot{$itemid}{'key'} = $env{$keyitem};
+ }
+ my $secretitem = 'form.linkprot_secret_'.$idx;
+ $env{$secretitem} =~ s/(`)/'/g;
+ if ($current{'usable'}) {
+ if ($env{'form.linkprot_changesecret_'.$idx}) {
+ if ($env{$secretitem} ne '') {
+ if ($privnum && $cipher) {
+ $linkprot{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem});
+ $linkprot{$itemid}{'cipher'} = $privnum;
+ } else {
+ $linkprot{$itemid}{'secret'} = $env{$secretitem};
+ }
+ $haschanges{$itemid} = 1;
+ }
+ } else {
+ $linkprot{$itemid}{'secret'} = $current{'secret'};
+ $linkprot{$itemid}{'cipher'} = $current{'cipher'};
+ }
+ } elsif ($env{$secretitem} ne '') {
+ if ($privnum && $cipher) {
+ $linkprot{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem});
+ $linkprot{$itemid}{'cipher'} = $privnum;
+ } else {
+ $linkprot{$itemid}{'secret'} = $env{$secretitem};
+ }
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ if (keys(%haschanges)) {
+ foreach my $entry (keys(%haschanges)) {
+ $changes->{$entry} = $linkprot{$entry};
+ }
+ if (ref($lastactref) eq 'HASH') {
+ $lastactref->{'courselti'} = 1;
+ }
+ }
+ return $errors;
+}
+
+sub get_linkprot_id {
+ my ($cdom,$cnum,$name,$context) = @_;
+ # get lock on lti db in course or linkprot db in domain
+ my $lockhash = {
+ lock => $env{'user.name'}.
+ ':'.$env{'user.domain'},
+ };
+ my $tries = 0;
+ my $gotlock;
+ if ($context eq 'domain') {
+ $gotlock = &Apache::lonnet::newput_dom('linkprot',$lockhash,$cdom);
+ } else {
+ $gotlock = &Apache::lonnet::newput('lti',$lockhash,$cdom,$cnum);
+ }
+ my ($id,$error);
+ while (($gotlock ne 'ok') && ($tries<10)) {
+ $tries ++;
+ sleep (0.1);
+ if ($context eq 'domain') {
+ $gotlock = &Apache::lonnet::newput_dom('linkprot',$lockhash,$cdom);
+ } else {
+ $gotlock = &Apache::lonnet::newput('lti',$lockhash,$cdom,$cnum);
+ }
+ }
+ if ($gotlock eq 'ok') {
+ my %currids;
+ if ($context eq 'domain') {
+ %currids = &Apache::lonnet::dump_dom('linkprot',$cdom);
+ } else {
+ %currids = &Apache::lonnet::dump('lti',$cdom,$cnum,undef,undef,undef,1);
+ }
+ if ($currids{'lock'}) {
+ delete($currids{'lock'});
+ if (keys(%currids)) {
+ my @curr = sort { $a <=> $b } keys(%currids);
+ if ($curr[-1] =~ /^\d+$/) {
+ $id = 1 + $curr[-1];
+ } else {
+ $id = 1;
+ }
+ } else {
+ $id = 1;
+ }
+ if ($id) {
+ if ($context eq 'domain') {
+ unless (&Apache::lonnet::newput_dom('linkprot',{ $id => $name },$cdom) eq 'ok') {
+ $error = 'nostore';
+ }
+ } else {
+ unless (&Apache::lonnet::newput('lti',{ $id => $name },$cdom,$cnum) eq 'ok') {
+ $error = 'nostore';
+ }
+ }
+ } else {
+ $error = 'nonumber';
+ }
+ }
+ my $dellockoutcome;
+ if ($context eq 'domain') {
+ $dellockoutcome = &Apache::lonnet::del_dom('linkprot',['lock'],$cdom);
+ } else {
+ $dellockoutcome = &Apache::lonnet::del('lti',['lock'],$cdom,$cnum);
+ }
+ } else {
+ $error = 'nolock';
+ }
+ return ($id,$error);
+}
+
+sub get_credentials {
+ my ($cdom,$cnum,$type,$context) = @_;
+ my ($cipher,$privnum,$home);
+ my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
+ my @ids=&Apache::lonnet::current_machine_ids();
+ if ($context eq 'domain') {
+ $home = &Apache::lonnet::domain($cdom,'primary');
+ } else {
+ $home = &Apache::lonnet::homeserver($cnum,$cdom);
+ }
+ my ($hostskey,$domkey,$crskey);
+ if ($type eq 'ltitools') {
+ $hostskey = 'toolprivhosts';
+ $domkey = 'toolenc_dom';
+ $crskey = 'toolenc_crs';
+ } else {
+ $hostskey = 'ltiprivhosts';
+ $domkey = 'linkprotenc_dom';
+ $crskey = 'linkprotenc_crs';
+ }
+ if ((($context eq 'domain') && ($domdefs{$domkey})) ||
+ (($context eq 'course') && ($domdefs{$crskey}))) {
+ unless (($home eq 'no_host') || ($home eq '')) {
+ if (grep(/^\Q$home\E$/,@ids)) {
+ if (ref($domdefs{$hostskey}) eq 'ARRAY') {
+ if (grep(/^\Q$home\E$/,@{$domdefs{$hostskey}})) {
+ my %privhash = &Apache::lonnet::restore_dom($type,'private',$cdom,$home,1);
+ my $privkey = $privhash{'key'};
+ $privnum = $privhash{'version'};
+ if (($privnum) && ($privkey ne '')) {
+ $cipher = Crypt::CBC->new({'key' => $privkey,
+ 'cipher' => 'DES'});
+ }
+ }
+ }
+ }
+ }
+ }
+ return ($cipher,$privnum);
+}
+
+sub process_ltitools {
+ my ($r,$cdom,$cnum,$values,$changes,$context,$lastactref,$configuserok,$lonhost,
+ $author_ok,$confname) = @_;
+ my (%currconfig,$newid,@allpos,%changes,%ltitools,$errors);
+
+ my (%posslti,%possfield);
+ my @courseroles = ('cc','in','ta','ep','st');
+ my @ltiroles = qw(Instructor ContentDeveloper TeachingAssistant Learner);
+ map { $posslti{$_} = 1; } @ltiroles;
+ my @allfields = ('fullname','firstname','lastname','email','user','roles');
+ map { $possfield{$_} = 1; } @allfields;
+
+ my ($dest,$privnum,$cipher,$errors,%ltitools);
+
+ ($cipher,$privnum) = &get_credentials($cdom,$cnum,'ltitools',$context);
+ if ($context eq 'domain') {
+ $dest = '/adm/domainprefs';
+ } else {
+ $dest = '/adm/courseprefs';
+ }
+ my $switchserver = &check_switchserver($cdom,$cnum,$context,$dest);
+
+ my (@allpos,@items,%deletions,%itemids,%haschanges);
+ if ($env{'form.ltitools_add'}) {
+ my $title = $env{'form.ltitools_add_title'};
+ $title =~ s/(`)/'/g;
+ my ($newid,$error) = &get_ltitools_id($context,$cdom,$cnum,$title);
+ if ($newid) {
+ my $position = $env{'form.ltitools_add_pos'};
+ $position =~ s/\D+//g;
+ if ($position ne '') {
+ $allpos[$position] = $newid;
+ }
+ $haschanges{$newid} = 1;
+ foreach my $item ('title','url','lifetime') {
+ $env{'form.ltitools_add_'.$item} =~ s/(`)/'/g;
+ if ($item eq 'lifetime') {
+ $env{'form.ltitools_add_'.$item} =~ s/[^\d.]//g;
+ }
+ if ($env{'form.ltitools_add_'.$item}) {
+ $ltitools{$newid}{$item} = $env{'form.ltitools_add_'.$item};
+ }
+ }
+ if ($env{'form.ltitools_add_version'} eq 'LTI-1p0') {
+ $ltitools{$newid}{'version'} = $env{'form.ltitools_add_version'};
+ }
+ if ($env{'form.ltitools_add_msgtype'} eq 'basic-lti-launch-request') {
+ $ltitools{$newid}{'msgtype'} = $env{'form.ltitools_add_msgtype'};
+ }
+ if ($env{'form.ltitools_add_sigmethod'} eq 'HMAC-SHA256') {
+ $ltitools{$newid}{'sigmethod'} = $env{'form.ltitools_add_sigmethod'};
+ } else {
+ $ltitools{$newid}{'sigmethod'} = 'HMAC-SHA1';
+ }
+ foreach my $item ('width','height','linktext','explanation') {
+ $env{'form.ltitools_add_'.$item} =~ s/^\s+//;
+ $env{'form.ltitools_add_'.$item} =~ s/\s+$//;
+ if (($item eq 'width') || ($item eq 'height')) {
+ if ($env{'form.ltitools_add_'.$item} =~ /^\d+$/) {
+ $ltitools{$newid}{'display'}{$item} = $env{'form.ltitools_add_'.$item};
+ }
+ } else {
+ if ($env{'form.ltitools_add_'.$item} ne '') {
+ $ltitools{$newid}{'display'}{$item} = $env{'form.ltitools_add_'.$item};
+ }
+ }
+ }
+ if ($env{'form.ltitools_add_target'} eq 'window') {
+ $ltitools{$newid}{'display'}{'target'} = $env{'form.ltitools_add_target'};
+ } elsif ($env{'form.ltitools_add_target'} eq 'tab') {
+ $ltitools{$newid}{'display'}{'target'} = $env{'form.ltitools_add_target'};
+ } else {
+ $ltitools{$newid}{'display'}{'target'} = 'iframe';
+ }
+ foreach my $item ('passback','roster') {
+ if ($env{'form.ltitools_'.$item.'_add'}) {
+ $ltitools{$newid}{$item} = 1;
+ if ($env{'form.ltitools_'.$item.'valid_add'} ne '') {
+ my $lifetime = $env{'form.ltitools_'.$item.'valid_add'};
+ $lifetime =~ s/^\s+|\s+$//g;
+ if ($lifetime =~ /^\d+\.?\d*$/) {
+ $ltitools{$newid}{$item.'valid'} = $lifetime;
+ }
+ }
+ }
+ }
+ if ($env{'form.ltitools_add_image.filename'} ne '') {
+ my ($imageurl,$error) =
+ &process_ltitools_image($r,$context,$cdom,$cnum,$confname,'ltitools_add_image',
+ $newid,$configuserok,$lonhost,$author_ok);
+ if ($imageurl) {
+ $ltitools{$newid}{'image'} = $imageurl;
+ }
+ if ($error) {
+ &Apache::lonnet::logthis($error);
+ $errors .= '
'.$error.'';
+ }
+ }
+ my @fields = &Apache::loncommon::get_env_multiple('form.ltitools_add_fields');
+ foreach my $field (@fields) {
+ if ($possfield{$field}) {
+ if ($field eq 'roles') {
+ foreach my $role (@courseroles) {
+ my $choice = $env{'form.ltitools_add_roles_'.$role};
+ if (($choice ne '') && ($posslti{$choice})) {
+ $ltitools{$newid}{'roles'}{$role} = $choice;
+ if ($role eq 'cc') {
+ $ltitools{$newid}{'roles'}{'co'} = $choice;
+ }
+ }
+ }
+ } else {
+ $ltitools{$newid}{'fields'}{$field} = 1;
+ }
+ }
+ }
+ if (ref($ltitools{$newid}{'fields'}) eq 'HASH') {
+ if ($ltitools{$newid}{'fields'}{'user'}) {
+ if ($env{'form.ltitools_add_userincdom'}) {
+ $ltitools{$newid}{'incdom'} = 1;
+ }
+ }
+ }
+ my @courseconfig = &Apache::loncommon::get_env_multiple('form.ltitools_add_courseconfig');
+ foreach my $item (@courseconfig) {
+ $ltitools{$newid}{'crsconf'}{$item} = 1;
+ }
+ if ($env{'form.ltitools_add_custom'}) {
+ my $name = $env{'form.ltitools_add_custom_name'};
+ my $value = $env{'form.ltitools_add_custom_value'};
+ $value =~ s/(`)/'/g;
+ $name =~ s/(`)/'/g;
+ $ltitools{$newid}{'custom'}{$name} = $value;
+ }
+ unless ($switchserver) {
+ my $keyitem = 'form.ltitools_add_key';
+ $env{$keyitem} =~ s/(`)/'/g;
+ if ($env{$keyitem} ne '') {
+ $ltitools{$newid}{'key'} = $env{$keyitem};
+ }
+ my $secretitem = 'form.ltitools_secret_add';
+ $env{$secretitem} =~ s/(`)/'/g;
+ if ($env{$secretitem} ne '') {
+ if ($privnum && $cipher) {
+ $ltitools{$newid}{'secret'} = $cipher->encrypt_hex($env{$secretitem});
+ $ltitools{$newid}{'cipher'} = $privnum;
+ } else {
+ $ltitools{$newid}{'secret'} = $env{$secretitem};
+ }
+ }
+ }
+ } else {
+ $errors .= ''.
+ &mt('Failed to acquire unique ID for new external tool').
+ '';
+ }
+ }
+ if (ref($values) eq 'HASH') {
+ my %deletions;
+ my @todelete = &Apache::loncommon::get_env_multiple('form.ltitools_del');
+ if (@todelete) {
+ map { $deletions{$_} = 1; } @todelete;
+ }
+ my %customadds;
+ my @newcustom = &Apache::loncommon::get_env_multiple('form.ltitools_customadd');
+ if (@newcustom) {
+ map { $customadds{$_} = 1; } @newcustom;
+ }
+ my %imgdeletions;
+ my @todeleteimages = &Apache::loncommon::get_env_multiple('form.ltitools_image_del');
+ if (@todeleteimages) {
+ map { $imgdeletions{$_} = 1; } @todeleteimages;
+ }
+ my $maxnum = $env{'form.ltitools_maxnum'};
+ for (my $i=0; $i<=$maxnum; $i++) {
+ my $itemid = $env{'form.ltitools_id_'.$i};
+ $itemid =~ s/\D+//g;
+ if (ref($values->{$itemid}) eq 'HASH') {
+ if ($deletions{$itemid}) {
+ if ($values->{$itemid}{'image'}) {
+ #FIXME need to obsolete item in RES space
+ }
+ $haschanges{$itemid} = $values->{$itemid}{'title'};
+ next;
+ } else {
+ my $newpos = $env{'form.ltitools_'.$itemid};
+ $newpos =~ s/\D+//g;
+ foreach my $item ('title','url','lifetime') {
+ $ltitools{$itemid}{$item} = $env{'form.ltitools_'.$item.'_'.$i};
+ if ($values->{$itemid}{$item} ne $ltitools{$itemid}{$item}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ if ($env{'form.ltitools_version_'.$i} eq 'LTI-1p0') {
+ $ltitools{$itemid}{'version'} = $env{'form.ltitools_version_'.$i};
+ }
+ if ($env{'form.ltitools_msgtype_'.$i} eq 'basic-lti-launch-request') {
+ $ltitools{$itemid}{'msgtype'} = $env{'form.ltitools_msgtype_'.$i};
+ }
+ if ($env{'form.ltitools_sigmethod_'.$i} eq 'HMAC-SHA256') {
+ $ltitools{$itemid}{'sigmethod'} = $env{'form.ltitools_sigmethod_'.$i};
+ } else {
+ $ltitools{$itemid}{'sigmethod'} = 'HMAC-SHA1';
+ }
+ if ($values->{$itemid}{'sigmethod'} eq '') {
+ if ($ltitools{$itemid}{'sigmethod'} ne 'HMAC-SHA1') {
+ $haschanges{$itemid} = 1;
+ }
+ } elsif ($values->{$itemid}{'sigmethod'} ne $ltitools{$itemid}{'sigmethod'}) {
+ $haschanges{$itemid} = 1;
+ }
+ foreach my $size ('width','height') {
+ $env{'form.ltitools_'.$size.'_'.$i} =~ s/^\s+//;
+ $env{'form.ltitools_'.$size.'_'.$i} =~ s/\s+$//;
+ if ($env{'form.ltitools_'.$size.'_'.$i} =~ /^\d+$/) {
+ $ltitools{$itemid}{'display'}{$size} = $env{'form.ltitools_'.$size.'_'.$i};
+ if (ref($values->{$itemid}{'display'}) eq 'HASH') {
+ if ($values->{$itemid}{'display'}{$size} ne $ltitools{$itemid}{'display'}{$size}) {
+ $haschanges{$itemid} = 1;
+ }
+ } else {
+ $haschanges{$itemid} = 1;
+ }
+ } elsif (ref($values->{$itemid}{'display'}) eq 'HASH') {
+ if ($values->{$itemid}{'display'}{$size} ne '') {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ foreach my $item ('linktext','explanation') {
+ $env{'form.ltitools_'.$item.'_'.$i} =~ s/^\s+//;
+ $env{'form.ltitools_'.$item.'_'.$i} =~ s/\s+$//;
+ if ($env{'form.ltitools_'.$item.'_'.$i} ne '') {
+ $ltitools{$itemid}{'display'}{$item} = $env{'form.ltitools_'.$item.'_'.$i};
+ if (ref($values->{$itemid}{'display'}) eq 'HASH') {
+ if ($values->{$itemid}{'display'}{$item} ne $ltitools{$itemid}{'display'}{$item}) {
+ $haschanges{$itemid} = 1;
+ }
+ } else {
+ $haschanges{$itemid} = 1;
+ }
+ } elsif (ref($values->{$itemid}{'display'}) eq 'HASH') {
+ if ($values->{$itemid}{'display'}{$item} ne '') {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ if ($env{'form.ltitools_target_'.$i} eq 'window') {
+ $ltitools{$itemid}{'display'}{'target'} = $env{'form.ltitools_target_'.$i};
+ } elsif ($env{'form.ltitools_target_'.$i} eq 'tab') {
+ $ltitools{$itemid}{'display'}{'target'} = $env{'form.ltitools_target_'.$i};
+ } else {
+ $ltitools{$itemid}{'display'}{'target'} = 'iframe';
+ }
+ if (ref($values->{$itemid}{'display'}) eq 'HASH') {
+ if ($values->{$itemid}{'display'}{'target'} ne $ltitools{$itemid}{'display'}{'target'}) {
+ $haschanges{$itemid} = 1;
+ }
+ } else {
+ $haschanges{$itemid} = 1;
+ }
+ foreach my $extra ('passback','roster') {
+ if ($env{'form.ltitools_'.$extra.'_'.$i}) {
+ $ltitools{$itemid}{$extra} = 1;
+ if ($env{'form.ltitools_'.$extra.'valid_'.$i} ne '') {
+ my $lifetime = $env{'form.ltitools_'.$extra.'valid_'.$i};
+ $lifetime =~ s/^\s+|\s+$//g;
+ if ($lifetime =~ /^\d+\.?\d*$/) {
+ $ltitools{$itemid}{$extra.'valid'} = $lifetime;
+ }
+ }
+ }
+ if ($values->{$itemid}{$extra} ne $ltitools{$itemid}{$extra}) {
+ $haschanges{$itemid} = 1;
+ }
+ if ($values->{$itemid}{$extra.'valid'} ne $ltitools{$itemid}{$extra.'valid'}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ my @courseconfig = &Apache::loncommon::get_env_multiple('form.ltitools_courseconfig_'.$i);
+ foreach my $item ('label','title','target','linktext','explanation','append') {
+ if (grep(/^\Q$item\E$/,@courseconfig)) {
+ $ltitools{$itemid}{'crsconf'}{$item} = 1;
+ if (ref($values->{$itemid}{'crsconf'}) eq 'HASH') {
+ if ($values->{$itemid}{'crsconf'}{$item} ne $ltitools{$itemid}{'crsconf'}{$item}) {
+ $haschanges{$itemid} = 1;
+ }
+ } else {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ my @fields = &Apache::loncommon::get_env_multiple('form.ltitools_fields_'.$i);
+ foreach my $field (@fields) {
+ if ($possfield{$field}) {
+ if ($field eq 'roles') {
+ foreach my $role (@courseroles) {
+ my $choice = $env{'form.ltitools_roles_'.$role.'_'.$i};
+ if (($choice ne '') && ($posslti{$choice})) {
+ $ltitools{$itemid}{'roles'}{$role} = $choice;
+ if ($role eq 'cc') {
+ $ltitools{$itemid}{'roles'}{'co'} = $choice;
+ }
+ }
+ if (ref($values->{$itemid}{'roles'}) eq 'HASH') {
+ if ($values->{$itemid}{'roles'}{$role} ne $ltitools{$itemid}{'roles'}{$role}) {
+ $haschanges{$itemid} = 1;
+ }
+ } elsif ($ltitools{$itemid}{'roles'}{$role}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ } else {
+ $ltitools{$itemid}{'fields'}{$field} = 1;
+ if (ref($values->{$itemid}{'fields'}) eq 'HASH') {
+ if ($values->{$itemid}{'fields'}{$field} ne $ltitools{$itemid}{'fields'}{$field}) {
+ $haschanges{$itemid} = 1;
+ }
+ } else {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ }
+ if (ref($ltitools{$itemid}{'fields'}) eq 'HASH') {
+ if ($ltitools{$itemid}{'fields'}{'user'}) {
+ if ($env{'form.ltitools_userincdom_'.$i}) {
+ $ltitools{$itemid}{'incdom'} = 1;
+ }
+ if ($values->{$itemid}{'incdom'} ne $ltitools{$itemid}{'incdom'}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ $allpos[$newpos] = $itemid;
+ }
+ if ($imgdeletions{$itemid}) {
+ $haschanges{$itemid} = 1;
+ if ($context eq 'course') {
+ my $currimgurl = $values->{$itemid}{'image'};
+ if ($currimgurl =~ m{^(\Q/uploaded/$cdom/$cnum/toollogo/$itemid\E)/([^/]+)$}) {
+ my ($path,$imagefile) = ($1,$2);
+ if ($imagefile =~ /^tn\-(.+)$/) {
+ my $origimg = $1;
+ &Apache::lonnet::removeuploadedurl("$path/$origimg");
+ }
+ &Apache::lonnet::removeuploadedurl($currimgurl);
+ }
+ }
+ #FIXME need to obsolete item in RES space
+ } elsif ($env{'form.ltitools_image_'.$i.'.filename'}) {
+ my $currimgurl = $values->{$itemid}{'image'};
+ my ($imgurl,$error) = &process_ltitools_image($r,$context,$cdom,$cnum,$confname,'ltitools_image_'.$i,
+ $itemid,$configuserok,$lonhost,$author_ok,$currimgurl);
+ if ($imgurl) {
+ $ltitools{$itemid}{'image'} = $imgurl;
+ $haschanges{$itemid} = 1;
+ }
+ if ($error) {
+ &Apache::lonnet::logthis($error);
+ $errors .= ''.$error.'';
+ }
+ } elsif ($values->{$itemid}{'image'}) {
+ $ltitools{$itemid}{'image'} = $values->{$itemid}{'image'};
+ }
+ if ($customadds{$i}) {
+ my $name = $env{'form.ltitools_custom_name_'.$i};
+ $name =~ s/(`)/'/g;
+ $name =~ s/^\s+//;
+ $name =~ s/\s+$//;
+ my $value = $env{'form.ltitools_custom_value_'.$i};
+ $value =~ s/(`)/'/g;
+ $value =~ s/^\s+//;
+ $value =~ s/\s+$//;
+ if ($name ne '') {
+ $ltitools{$itemid}{'custom'}{$name} = $value;
+ $haschanges{$itemid} = 1;
+ }
+ }
+ my %customdels;
+ my @customdeletions = &Apache::loncommon::get_env_multiple('form.ltitools_customdel_'.$i);
+ if (@customdeletions) {
+ $haschanges{$itemid} = 1;
+ }
+ map { $customdels{$_} = 1; } @customdeletions;
+ if (ref($values->{$itemid}{'custom'}) eq 'HASH') {
+ foreach my $key (keys(%{$values->{$itemid}{'custom'}})) {
+ unless ($customdels{$key}) {
+ if ($env{'form.ltitools_customval_'.$key.'_'.$i} ne '') {
+ $ltitools{$itemid}{'custom'}{$key} = $env{'form.ltitools_customval_'.$key.'_'.$i};
+ }
+ if ($values->{$itemid}{'custom'}{$key} ne $env{'form.ltitools_customval_'.$key.'_'.$i}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ }
+ unless ($switchserver) {
+ my $keyitem = 'form.ltitools_key_'.$i;
+ $env{$keyitem} =~ s/(`)/'/g;
+ if ($values->{$itemid}{'key'} ne $env{$keyitem}) {
+ $haschanges{$itemid} = 1;
+ }
+ if ($env{$keyitem} ne '') {
+ $ltitools{$itemid}{'key'} = $env{$keyitem};
+ }
+ my $secretitem = 'form.ltitools_secret_'.$i;
+ $env{$secretitem} =~ s/(`)/'/g;
+ if ($values->{$itemid}{'usable'}) {
+ if ($env{'form.ltitools_changesecret_'.$i}) {
+ if ($env{$secretitem} ne '') {
+ if ($privnum && $cipher) {
+ $ltitools{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem});
+ $ltitools{$itemid}{'cipher'} = $privnum;
+ } else {
+ $ltitools{$itemid}{'secret'} = $env{$secretitem};
+ }
+ $haschanges{$itemid} = 1;
+ }
+ } else {
+ $ltitools{$itemid}{'secret'} = $values->{$itemid}{'secret'};
+ $ltitools{$itemid}{'cipher'} = $values->{$itemid}{'cipher'};
+ }
+ } elsif ($env{$secretitem} ne '') {
+ if ($privnum && $cipher) {
+ $ltitools{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem});
+ $ltitools{$itemid}{'cipher'} = $privnum;
+ } else {
+ $ltitools{$itemid}{'secret'} = $env{$secretitem};
+ }
+ $haschanges{$itemid} = 1;
+ }
+ }
+ unless ($haschanges{$itemid}) {
+ foreach my $key (keys(%{$values->{$itemid}})) {
+ if (ref($values->{$itemid}{$key}) eq 'HASH') {
+ if (ref($ltitools{$itemid}{$key}) eq 'HASH') {
+ foreach my $innerkey (keys(%{$values->{$itemid}{$key}})) {
+ unless (exists($ltitools{$itemid}{$key}{$innerkey})) {
+ $haschanges{$itemid} = 1;
+ last;
+ }
+ }
+ } elsif (keys(%{$values->{$itemid}{$key}}) > 0) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ last if ($haschanges{$itemid});
+ }
+ }
+ }
+ }
+ }
+ if (@allpos > 0) {
+ my $idx = 0;
+ foreach my $itemid (@allpos) {
+ if ($itemid ne '') {
+ $ltitools{$itemid}{'order'} = $idx;
+ if (ref($values) eq 'HASH') {
+ if (ref($values->{$itemid}) eq 'HASH') {
+ if ($values->{$itemid}{'order'} ne $idx) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ $idx ++;
+ }
+ }
+ }
+ if (keys(%haschanges)) {
+ foreach my $entry (keys(%haschanges)) {
+ $changes->{$entry} = $ltitools{$entry};
+ }
+ if (ref($lastactref) eq 'HASH') {
+ $lastactref->{'courseltitools'} = 1;
+ }
+ }
+ return $errors;
+}
+
+sub get_ltitools_id {
+ my ($context,$cdom,$cnum,$title) = @_;
+ my ($lockhash,$tries,$gotlock,$id,$error);
+
+ # get lock on ltitools db
+ $lockhash = {
+ lock => $env{'user.name'}.
+ ':'.$env{'user.domain'},
+ };
+ $tries = 0;
+ if ($context eq 'domain') {
+ $gotlock = &Apache::lonnet::newput_dom('ltitools',$lockhash,$cdom);
+ } else {
+ $gotlock = &Apache::lonnet::newput('ltitools',$lockhash,$cdom,$cnum);
+ }
+ while (($gotlock ne 'ok') && ($tries<10)) {
+ $tries ++;
+ sleep (0.1);
+ if ($context eq 'domain') {
+ $gotlock = &Apache::lonnet::newput_dom('ltitools',$lockhash,$cdom);
+ } else {
+ $gotlock = &Apache::lonnet::newput('ltitools',$lockhash,$cdom,$cnum);
+ }
+ }
+ if ($gotlock eq 'ok') {
+ my %currids;
+ if ($context eq 'domain') {
+ %currids = &Apache::lonnet::dump_dom('ltitools',$cdom);
+ } else {
+ %currids = &Apache::lonnet::dump('ltitools',$cdom,$cnum);
+ }
+ if ($currids{'lock'}) {
+ delete($currids{'lock'});
+ if (keys(%currids)) {
+ my @curr = sort { $a <=> $b } keys(%currids);
+ if ($curr[-1] =~ /^\d+$/) {
+ $id = 1 + $curr[-1];
+ }
+ } else {
+ $id = 1;
+ }
+ if ($id) {
+ if ($context eq 'domain') {
+ unless (&Apache::lonnet::newput_dom('ltitools',{ $id => $title },$cdom) eq 'ok') {
+ $error = 'nostore';
+ }
+ } else {
+ unless (&Apache::lonnet::newput('ltitools',{ $id => $title },$cdom,$cnum) eq 'ok') {
+ $error = 'nostore';
+ }
+ }
+ } else {
+ $error = 'nonumber';
+ }
+ }
+ my $dellockoutcome;
+ if ($context eq 'domain') {
+ $dellockoutcome = &Apache::lonnet::del_dom('ltitools',['lock'],$cdom);
+ } else {
+ $dellockoutcome = &Apache::lonnet::del('ltitools',['lock'],$cdom,$cnum);
+ }
+ } else {
+ $error = 'nolock';
+ }
+ return ($id,$error);
+}
+
+sub process_ltitools_image {
+ my ($r,$context,$dom,$cnum,$confname,$caller,$itemid,$configuserok,$switch,$author_ok,$currimg) = @_;
+ my $filename = $env{'form.'.$caller.'.filename'};
+ my ($error,$url);
+ my ($width,$height) = (21,21);
+ if ($configuserok eq 'ok') {
+ if ($switch) {
+ $error = &mt('Upload of Tool Provider (LTI) icon is not permitted to this server: [_1]',
+ $switch);
+ } elsif ($author_ok eq 'ok') {
+ my ($result,$imageurl,$madethumb);
+ if ($context eq 'domain') {
+ ($result,$imageurl,$madethumb) =
+ &Apache::lonconfigsettings::publishlogo($r,'upload',$caller,$dom,$confname,
+ "ltitools/$itemid/icon",$width,$height);
+ } else {
+ ($result,$imageurl,$madethumb) = &processlogo($dom,$cnum,$caller,$currimg,$itemid,$width,$height);
+ }
+ if ($result eq 'ok') {
+ if ($madethumb) {
+ my ($path,$imagefile) = ($imageurl =~ m{^(.+)/([^/]+)$});
+ my $imagethumb = "$path/tn-".$imagefile;
+ $url = $imagethumb;
+ } else {
+ $url = $imageurl;
+ }
+ } else {
+ if ($context eq 'domain') {
+ $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$filename,$result);
+ } else {
+ $error = &mt("Upload of [_1] failed because an error occurred. Error was: [_2].",$filename,$result);
+ }
+ }
+ } else {
+ $error = &mt("Upload of [_1] failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3]. Error was: [_4].",$filename,$confname,$dom,$author_ok);
+ }
+ } else {
+ $error = &mt("Upload of [_1] failed because a Domain Configuration user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$filename,$confname,$dom,$configuserok);
+ }
+ return ($url,$error);
+}
+
+sub processlogo {
+ my ($dom,$cnum,$caller,$currimg,$itemid,$width,$height) = @_;
+ my ($result,$imageurl,$madethumb);
+ if ($env{"form.$caller.filename"} ne '') {
+ unless ($caller eq 'ltitools_add_image') {
+ if ($currimg =~ m{^(\Q/uploaded/$dom/$cnum/toollogo/$itemid\E)/([^/]+)$}) {
+ my ($path,$imagefile) = ($1,$2);
+ if ($imagefile =~ /^tn\-(.+)$/) {
+ my $origimg = $1;
+ &Apache::lonnet::removeuploadedurl("$path/$origimg");
+ }
+ &Apache::lonnet::removeuploadedurl($currimg);
+ }
+ }
+ $imageurl = &Apache::lonnet::userfileupload($caller,'toollogo',"toollogo/$itemid",
+ '','','',$cnum,$dom,$width,$height);
+ if ($imageurl =~ m{^(\Q/uploaded/$dom/$cnum/toollogo/$itemid\E)/([^/]+)$}) {
+ my ($path,$imagefile) = ($1,$2);
+ $result = 'ok';
+ my $thumburl = "$path/tn-".$imagefile;
+ my ($rtncode,$info);
+ my $res = &Apache::lonnet::getuploaded('HEAD',$thumburl,$dom,$cnum,\$info,\$rtncode);
+ if ($res eq 'ok') {
+ $madethumb = 1;
+ }
+ } elsif ($imageurl eq '/adm/notfound.html') {
+ undef($imageurl);
+ $result = 'store failed';
+ } elsif ($imageurl =~ /^error: (.+)$/) {
+ $result = $1;
+ }
+ }
+ return ($result,$imageurl,$madethumb);
}
sub get_sec_str {
@@ -1462,8 +2537,15 @@ sub check_clone {
sub store_changes {
my ($cdom,$cnum,$prefs_order,$actions,$prefs,$values,$changes,$crstype) = @_;
my ($chome,$output);
- my (%storehash,@delkeys,@need_env_update,@oldcloner);
+ my (%storehash,@delkeys,@need_env_update,@oldcloner,%oldlinkprot,%oldltitools);
if ((ref($values) eq 'HASH') && (ref($changes) eq 'HASH')) {
+ if (ref($values->{'linkprot'}) eq 'HASH') {
+ %oldlinkprot = %{$values->{'linkprot'}};
+ }
+ delete($values->{'linkprot'});
+ if (ref($values->{'ltitools'}) eq 'HASH') {
+ %oldltitools = %{$values->{'ltitools'}};
+ }
%storehash = %{$values};
} else {
if ($crstype eq 'Community') {
@@ -1473,6 +2555,22 @@ sub store_changes {
}
return $output;
}
+ my ($numchanges,$skipstore);
+ if (ref($changes) eq 'HASH') {
+ $numchanges = scalar(keys(%{$changes}));
+ if (($numchanges == 1) && (exists($changes->{'linkprot'}))) {
+ $skipstore = 1;
+ } elsif (($numchanges == 1) && (exists($changes->{'ltitools'}))) {
+ $skipstore = 1;
+ } elsif (!$numchanges) {
+ if ($crstype eq 'Community') {
+ $output = &mt('No changes made to community settings.');
+ } else {
+ $output = &mt('No changes made to course settings.');
+ }
+ return $output;
+ }
+ }
my %yesno = (
hidefromcat => '1',
problem_stream_switch => '1',
@@ -1498,6 +2596,10 @@ sub store_changes {
"'$storehash{$key}'")).'';
}
}
+ } elsif ($item eq 'linkprot') {
+ $output .= &store_linkprot($cdom,$cnum,'course',$changes->{$item},\%oldlinkprot);
+ } elsif ($item eq 'ltitools') {
+ $output .= &store_ltitools($cdom,$cnum,'course',$changes->{$item},\%oldltitools);
} else {
if (ref($prefs->{$item}->{'ordered'}) eq 'ARRAY') {
my @settings = @{$prefs->{$item}->{'ordered'}};
@@ -1529,12 +2631,52 @@ sub store_changes {
if ($msg ne '') {
$output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt($displayname)).'';
}
+ } elsif ($key eq 'timezone') {
+ next unless ((exists($changes->{$item}{$key})) || (exists($changes->{$item}{'tzover'})));
+ my ($displayname,$text);
+ $text = $prefs->{$item}->{'itemtext'}{$key};
+ my $displayval;
+ if (exists($changes->{$item}{$key})) {
+ $displayname = &mt($text);
+ $storehash{$key} = $changes->{$item}{$key};
+ if ($changes->{$item}{$key} ne '') {
+ $displayval = ''.$changes->{$item}{$key}.'';
+ } else {
+ push(@delkeys,$key);
+ if (exists($values->{'tzover'})) {
+ push(@delkeys,'tzover');
+ }
+ $output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt('Deleted setting for [_1]',
+ ''.$displayname.'')).'';
+ }
+ }
+ unless (grep(/^\Q$key\E$/,@delkeys)) {
+ if (exists($changes->{$item}{'tzover'})) {
+ $storehash{'tzover'} = $changes->{$item}{'tzover'};
+ my $tzovertext;
+ if ($changes->{$item}{'tzover'} ne '') {
+ $tzovertext = &mt('Course Time Zone overrides individual user preference');
+ } else {
+ push(@delkeys,'tzover');
+ $tzovertext = &mt('Course Time Zone does not override individual user preference');
+ }
+ if ($displayval eq '') {
+ $output .= ''.&Apache::lonhtmlcommon::confirm_success($tzovertext).'';
+ } else {
+ $displayval .= '
'.(' 'x5).$tzovertext;
+ }
+ }
+ if ($displayval ne '') {
+ $output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt('[_1] set to [_2]',
+ ''.$displayname.'',$displayval)).'';
+ }
+ }
} else {
next if (!exists($changes->{$item}{$key}));
my ($displayname,$text);
$text = $prefs->{$item}->{'itemtext'}{$key};
my $displayval;
- unless (($key eq 'co-owners') || ($key eq 'discussion_post_fonts')) {
+ unless (($key eq 'co-owners') || ($key eq 'discussion_post_fonts') || ($key eq 'extresource')) {
$displayval = $changes->{$item}{$key};
}
if ($item eq 'feedback') {
@@ -1652,12 +2794,44 @@ sub store_changes {
$displayval = &Apache::lonlocal::locallocaltime($displayval);
} elsif ($key eq 'categories') {
$displayval = $env{'form.categories_display'};
- } elsif (($key eq 'canuse_pdfforms') || ($key eq 'usejsme') || ($key eq 'uselcmath')) {
+ } elsif (($key eq 'canuse_pdfforms') || ($key eq 'usejsme') ||
+ ($key eq 'uselcmath') || ($key eq 'inline_chem')) {
if ($changes->{$item}{$key} eq '1') {
$displayval = &mt('Yes');
} elsif ($changes->{$item}{$key} eq '0') {
$displayval = &mt('No');
}
+ } elsif ($key eq 'extresource') {
+ if ($changes->{$item}{$key} eq 'iframe') {
+ $displayval = &mt('In iframe');
+ } else {
+ my ($selected,$reuse,$width,$height) = split(/:/,$changes->{$item}{$key});
+ if ($selected eq 'tab') {
+ if ($reuse) {
+ $displayval = &mt('[_1]In tab[_2],[_3] and tab re-used for different external resources in course',
+ "'","'",'
');
+ } else {
+ $displayval = &mt('[_1]In tab[_2],[_3] with new tab for each external resource in course',
+ "'","'",'
');
+ }
+ } elsif ($selected eq 'window') {
+ if ($reuse) {
+ $displayval = &mt('[_1]In pop-up window[_2],[_3] and window re-used for different external resources in course',
+ "'","'",'
');
+ } else {
+ $displayval = &mt('[_1]In pop-up window[_2],[_3] with new window for each external resource in course',
+ "'","'",'
');
+ }
+ if (($width ne '') || ($height ne '')) {
+ if ($width ne '') {
+ $displayval .= '
'.&mt('Window width: [_1]px',$width);
+ }
+ if ($height ne '') {
+ $displayval .= '
'.&mt('Window height: [_1]px',$height);
+ }
+ }
+ }
+ }
}
if ($key eq 'co-owners') {
if (ref($changes->{$item}{$key}) eq 'HASH') {
@@ -1729,9 +2903,11 @@ sub store_changes {
$output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt('Numbered menu collections:')).'
'.
$displayval.'';
} else {
+ unless (($key eq 'extresource') && ($changes->{$item}{$key} ne 'iframe')) {
+ $displayval = "'$displayval'";
+ }
$output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt('[_1] set to [_2]',
- ''.$displayname.'',
- "'$displayval'"));
+ ''.$displayname.'',$displayval));
if ($key eq 'url') {
my $bkuptime=time;
$output .= (' 'x2).&mt('(Previous URL backed up)').': '.
@@ -1785,6 +2961,9 @@ sub store_changes {
}
}
}
+ if ($skipstore) {
+ return $output;
+ }
if (&Apache::lonnet::put('environment',\%storehash,$cdom,$cnum) eq 'ok') {
if (ref($changes) eq 'HASH') {
if (ref($changes->{'courseinfo'}) eq 'HASH') {
@@ -1827,6 +3006,372 @@ sub store_changes {
return $output;
}
+sub store_linkprot {
+ my ($cdom,$cnum,$context,$changes,$oldlinkprot) = @_;
+ my ($ltiauth,$home,$lti_save_error,$output,$error,%ltienc,@deletions);
+ if ($context eq 'domain') {
+ $ltiauth = 1;
+ $home = &Apache::lonnet::domain($cdom,'primary');
+ } else {
+ $home = &Apache::lonnet::homeserver($cnum,$cdom);
+ if (exists($env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'})) {
+ $ltiauth = $env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'};
+ } else {
+ my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
+ $ltiauth = $domdefs{'crsltiauth'};
+ }
+ }
+ if (ref($changes) eq 'HASH') {
+ foreach my $id (sort { $a <=> $b } keys(%{$changes})) {
+ if (ref($changes->{$id}) eq 'HASH') {
+ if (exists($changes->{$id}->{'key'})) {
+ $ltienc{$id}{'key'} = $changes->{$id}->{'key'};
+ delete($changes->{$id}->{'key'});
+ }
+ if (exists($changes->{$id}->{'secret'})) {
+ $ltienc{$id}{'secret'} = $changes->{$id}->{'secret'};
+ delete($changes->{$id}->{'secret'});
+ } elsif (ref($oldlinkprot->{$id}) eq 'HASH') {
+ if (exists($oldlinkprot->{$id}{'usable'})) {
+ $changes->{$id}->{'usable'} = 1;
+ }
+ if (exists($oldlinkprot->{$id}{'cipher'})) {
+ $changes->{$id}->{'cipher'} = $oldlinkprot->{$id}{'cipher'};
+ }
+ }
+ }
+ }
+ }
+ my @ids=&Apache::lonnet::current_machine_ids();
+ if (keys(%ltienc) > 0) {
+ if ($context eq 'domain') {
+ foreach my $id (keys(%ltienc)) {
+ if (exists($ltienc{$id}{'secret'})) {
+ $changes->{$id}->{'usable'} = 1;
+ }
+ }
+ } else {
+ unless (($home eq 'no_host') || ($home eq '')) {
+ my $allowed;
+ foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
+ if ($allowed) {
+ if (&Apache::lonnet::put('nohist_ltienc',\%ltienc,$cdom,$cnum,1) eq 'ok') {
+ foreach my $id (keys(%ltienc)) {
+ if (exists($ltienc{$id}{'secret'})) {
+ $changes->{$id}->{'usable'} = 1;
+ }
+ }
+ } else {
+ $lti_save_error = 1;
+ }
+ }
+ }
+ }
+ }
+ unless ($lti_save_error) {
+ if ($context eq 'course') {
+ if (&Apache::lonnet::put('lti',$changes,$cdom,$cnum,1) eq 'ok') {
+ my $hashid=$cdom.'_'.$cnum;
+ &Apache::lonnet::devalidate_cache_new('courselti',$hashid);
+ unless (($home eq 'no_host') || ($home eq '')) {
+ if (grep(/^\Q$home\E$/,@ids)) {
+ &Apache::lonnet::devalidate_cache_new('courseltienc',$hashid);
+ }
+ }
+ } else {
+ $lti_save_error = 1;
+ }
+ }
+ unless ($lti_save_error) {
+ foreach my $id (sort { $a <=> $b } %{$changes}) {
+ if (ref($changes->{$id}) eq 'HASH') {
+ my %values = %{$changes->{$id}};
+ my %desc = &linkprot_names();
+ my $display;
+ foreach my $title ('name','lifetime','version','key','secret','returnurl') {
+ if (($title eq 'key') || ($title eq 'secret')) {
+ if (ref($ltienc{$id}) eq 'HASH') {
+ if (exists($ltienc{$id}{$title})) {
+ if ($title eq 'secret') {
+ my $length = length($ltienc{$id}{$title});
+ $display .= $desc{$title}.': ['.&mt('not shown').'], ';
+ } else {
+ $display .= $desc{$title}.': '.$ltienc{$id}{$title}.', ';
+ }
+ }
+ }
+ } elsif ($title eq 'version') {
+ if ($values{$title} eq 'LTI-1p0') {
+ $display .= $desc{$title}.': 1.1, ';
+ }
+ } elsif ($title eq 'returnurl') {
+ if ($values{$title}) {
+ $display .= &mt('Return URL parameter').': '.$values{$title}.', ';
+ }
+ } else {
+ $display .= $desc{$title}.': '.$values{$title}.', ';
+ }
+ }
+ if ($ltiauth) {
+ if (($values{'requser'}) && ($values{'mapuser'} ne '')) {
+ if ($values{'mapuser'} eq 'lis_person_contact_email_primary') {
+ $display .= &mt('Source of username: Email address [_1]',
+ '(lis_person_contact_email_primary)').', ';
+ } elsif ($values{'mapuser'} eq 'lis_person_sourcedid') {
+ $display .= &mt('Source of username: User ID [_1]',
+ '(lis_person_sourcedid)').', ';
+ } else {
+ $display .= &mt('Source of username: [_1]',$values{'mapuser'}).', ';
+ }
+ if ($values{'notstudent'} eq 'auth') {
+ $display .= &mt('Display LON-CAPA login page if no match').', ';
+ } elsif ($values{'notstudent'} eq 'reject') {
+ $display .= &mt('Discontinue launch if no match').', ';
+ }
+ }
+ }
+ $display =~ s/, $//;
+ $output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt('[_1] set to [_2]',''.$id.'',
+ "'$display'")).'';
+ } elsif (ref($oldlinkprot->{$id}) eq 'HASH') {
+ my $oldname = $oldlinkprot->{$id}{'name'};
+ $output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt('Deleted setting for [_1]',''."$id ($oldname)".'')).'';
+ }
+ }
+ } else {
+ $lti_save_error = 1;
+ }
+ }
+ unless ($lti_save_error) {
+ foreach my $id (sort { $a <=> $b } keys(%{$changes})) {
+ unless (ref($changes->{$id}) eq 'HASH') {
+ push(@deletions,$id);
+ }
+ }
+ if (@deletions) {
+ if ($context eq 'course') {
+ &Apache::lonnet::del('nohist_ltienc',\@deletions,$cdom,$cnum);
+ }
+ }
+ }
+ if ($lti_save_error) {
+ $output .= ''.
+ ''.
+ &mt('An error occurred when saving changes to link protection settings, which remain unchanged.').
+ ''.
+ '';
+ }
+ return $output;
+}
+
+sub store_ltitools {
+ my ($cdom,$cnum,$context,$changes,$oldltitools) = @_;
+ my ($home,$ltitools_save_error,$output,$error,%toolsenc,@deletions);
+ my %lt = <itools_names();
+ my @courseroles = ('cc','in','ta','ep','st');
+ my @allfields = ('fullname','firstname','lastname','email','user','roles');
+ if ($context eq 'domain') {
+ $home = &Apache::lonnet::domain($cdom,'primary');
+ } else {
+ $home = &Apache::lonnet::homeserver($cnum,$cdom);
+ }
+ if (ref($changes) eq 'HASH') {
+ foreach my $id (sort { $a <=> $b } keys(%{$changes})) {
+ if (ref($changes->{$id}) eq 'HASH') {
+ if (exists($changes->{$id}->{'key'})) {
+ $toolsenc{$id}{'key'} = $changes->{$id}->{'key'};
+ delete($changes->{$id}->{'key'});
+ }
+ if (exists($changes->{$id}->{'secret'})) {
+ $toolsenc{$id}{'secret'} = $changes->{$id}->{'secret'};
+ delete($changes->{$id}->{'secret'});
+ } elsif (ref($oldltitools->{$id}) eq 'HASH') {
+ if (exists($oldltitools->{$id}{'usable'})) {
+ $changes->{$id}->{'usable'} = 1;
+ }
+ if (exists($oldltitools->{$id}{'cipher'})) {
+ $changes->{$id}->{'cipher'} = $oldltitools->{$id}{'cipher'};
+ }
+ }
+ }
+ }
+ }
+ my @ids=&Apache::lonnet::current_machine_ids();
+ if (keys(%toolsenc) > 0) {
+ unless (($home eq 'no_host') || ($home eq '')) {
+ my $allowed;
+ foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
+ if ($allowed) {
+ if (($context eq 'domain') ||
+ (($context eq 'course') &&
+ (&Apache::lonnet::put('nohist_toolsenc',\%toolsenc,$cdom,$cnum,1) eq 'ok'))) {
+ foreach my $id (keys(%toolsenc)) {
+ if (exists($toolsenc{$id}{'secret'})) {
+ $changes->{$id}->{'usable'} = 1;
+ }
+ }
+ } else {
+ $ltitools_save_error = 1;
+ }
+ }
+ }
+ }
+ unless ($ltitools_save_error) {
+ if ($context eq 'course') {
+ if (&Apache::lonnet::put('ltitools',$changes,$cdom,$cnum,1) eq 'ok') {
+ my $hashid=$cdom.'_'.$cnum;
+ &Apache::lonnet::devalidate_cache_new('courseltitools',$hashid);
+ unless (($home eq 'no_host') || ($home eq '')) {
+ if (grep(/^\Q$home\E$/,@ids)) {
+ &Apache::lonnet::devalidate_cache_new('courseltitoolsenc',$hashid);
+ }
+ }
+ } else {
+ $ltitools_save_error = 1;
+ }
+ }
+ unless ($ltitools_save_error) {
+ my %bynum;
+ foreach my $itemid (sort(keys(%{$changes}))) {
+ my $position = $changes->{$itemid}{'order'};
+ $bynum{$position} = $itemid;
+ }
+ foreach my $pos (sort { $a <=> $b } keys(%bynum)) {
+ my $itemid = $bynum{$pos};
+ if (ref($changes->{$itemid}) ne 'HASH') {
+ $output .= ''.&mt('Deleted: [_1]',$changes->{$itemid}).'';
+ } else {
+ $output .= ''.$changes->{$itemid}{'title'}.'';
+ if ($changes->{$itemid}{'image'}) {
+ $output .= ' '.
+ '';
+ }
+ $output .= '';
+ my $position = $pos + 1;
+ $output .= '- '.&mt('Order: [_1]',$position).'
';
+ foreach my $item ('version','msgtype','sigmethod','url','lifetime') {
+ if ($changes->{$itemid}{$item} ne '') {
+ $output .= '- '.$lt{$item}.': '.$changes->{$itemid}{$item}.'
';
+ }
+ }
+ if (ref($toolsenc{$itemid}) eq 'HASH') {
+ foreach my $item ('key','secret') {
+ if (exists($toolsenc{$itemid}{$item})) {
+ if ($item eq 'secret') {
+ $output .= '- '.$lt{$item}.': ['.&mt('not shown').']
';
+ } else {
+ $output .= '- '.$lt{$item}.': '.$toolsenc{$itemid}{$item}.'
';
+ }
+ }
+ }
+ }
+ $output .= '- '.&mt('Configurable in course:');
+ my @possconfig = ('label','title','target','linktext','explanation','append');
+ my $numconfig = 0;
+ if (ref($changes->{$itemid}{'crsconf'}) eq 'HASH') {
+ foreach my $item (@possconfig) {
+ if ($changes->{$itemid}{'crsconf'}{$item}) {
+ $numconfig ++;
+ $output .= ' "'.$lt{'crs'.$item}.'"';
+ }
+ }
+ }
+ if (!$numconfig) {
+ $output .= ' '.&mt('None');
+ }
+ $output .= '
';
+ foreach my $item ('passback','roster') {
+ $output .= '- '.$lt{$item}.' ';
+ if ($changes->{$itemid}{$item}) {
+ $output .= &mt('Yes');
+ if ($changes->{$itemid}{$item.'valid'}) {
+ if ($item eq 'passback') {
+ $output .= ' '.&mt('valid for at least [quant,_1,day] after launch',
+ $changes->{$itemid}{$item.'valid'});
+ } else {
+ $output .= ' '.&mt('valid for at least [quant,_1,second] after launch',
+ $changes->{$itemid}{$item.'valid'});
+ }
+ }
+ } else {
+ $output .= &mt('No');
+ }
+ $output .= '
';
+ }
+ if (ref($changes->{$itemid}{'display'}) eq 'HASH') {
+ my $displaylist;
+ if ($changes->{$itemid}{'display'}{'target'}) {
+ $displaylist = &mt('Display target').': '.
+ $changes->{$itemid}{'display'}{'target'}.',';
+ }
+ foreach my $size ('width','height') {
+ if ($changes->{$itemid}{'display'}{$size}) {
+ $displaylist .= (' 'x2).$lt{$size}.': '.
+ $changes->{$itemid}{'display'}{$size}.',';
+ }
+ }
+ if ($displaylist) {
+ $displaylist =~ s/,$//;
+ $output .= '- '.$displaylist.'
';
+ }
+ foreach my $item ('linktext','explanation') {
+ if ($changes->{$itemid}{'display'}{$item}) {
+ $output .= '- '.$lt{$item}.': '.$changes->{$itemid}{'display'}{$item}.'
';
+ }
+ }
+ }
+ if (ref($changes->{$itemid}{'fields'}) eq 'HASH') {
+ my $fieldlist;
+ foreach my $field (@allfields) {
+ if ($changes->{$itemid}{'fields'}{$field}) {
+ $fieldlist .= (' 'x2).$lt{$field}.',';
+ }
+ }
+ if ($fieldlist) {
+ $fieldlist =~ s/,$//;
+ if ($changes->{$itemid}{'fields'}{'user'}) {
+ if ($changes->{$itemid}{'incdom'}) {
+ $fieldlist .= ' ('.&mt('username:domain').')';
+ } else {
+ $fieldlist .= ' ('.&mt('username').')';
+ }
+ }
+ $output .= '- '.&mt('Data sent').':'.$fieldlist.'
';
+ }
+ }
+ if (ref($changes->{$itemid}{'roles'}) eq 'HASH') {
+ my $rolemaps;
+ foreach my $role (@courseroles) {
+ if ($changes->{$itemid}{'roles'}{$role}) {
+ $rolemaps .= (' 'x2).&Apache::lonnet::plaintext($role,'Course').'='.
+ $changes->{$itemid}{'roles'}{$role}.',';
+ }
+ }
+ if ($rolemaps) {
+ $rolemaps =~ s/,$//;
+ $output .= '- '.&mt('Role mapping:').$rolemaps.'
';
+ }
+ }
+ if (ref($changes->{$itemid}{'custom'}) eq 'HASH') {
+ my $customlist;
+ if (keys(%{$changes->{$itemid}{'custom'}})) {
+ foreach my $key (sort(keys(%{$changes->{$itemid}{'custom'}}))) {
+ $customlist .= $key.':'.$changes->{$itemid}{'custom'}{$key}.(' 'x2);
+ }
+ }
+ if ($customlist) {
+ $output .= '- '.&mt('Custom items').': '.$customlist.'
';
+ }
+ }
+ $output .= '
';
+ }
+ }
+ }
+ }
+ return $output;
+}
+
sub update_env {
my ($cnum,$cdom,$chome,$need_env_update,$storehash) = @_;
my $count = 0;
@@ -1959,10 +3504,15 @@ sub get_course {
sub get_jscript {
my ($cid,$cdom,$phase,$crstype,$settings,$noedit) = @_;
my ($can_toggle_cat,$can_categorize) = &can_modify_catsettings($cdom,$crstype);
- my ($jscript,$categorize_js,$loncaparev_js,$instcode_js);
+ my ($jscript,$categorize_js,$loncaparev_js,$instcode_js,$extresource_js,$localization_js);
my $stubrowse_js = &Apache::loncommon::studentbrowser_javascript();
my $browse_js = &Apache::loncommon::browser_and_searcher_javascript('parmset');
my $cloners_js = &cloners_javascript($phase);
+ my $currltitools;
+ if (ref($settings) eq 'HASH') {
+ $currltitools = $settings->{'ltitools'};
+ }
+ my $ltitools_js = &Apache::lonconfigsettings::ltitools_javascript($currltitools);
my @code_order;
if ($crstype ne 'Community') {
if (ref($settings) eq 'HASH') {
@@ -2166,12 +3716,55 @@ function toggleAddmenucoll() {
}
ENDSCRIPT
}
+ $extresource_js = <<"ENDSCRIPT";
+function toggleExtRes() {
+ if (document.getElementById('LC_extresource')) {
+ var extressel = document.getElementById('LC_extresource').value;
+ if (document.getElementById('LC_extresreusediv')) {
+ var extresreuse = document.getElementById('LC_extresreusediv');
+ if (document.getElementById('LC_extressize')) {
+ var extressize = document.getElementById('LC_extressize');
+ var setvis;
+ if ((extressel == 'tab') || (extressel == 'window')) {
+ extresreuse.style.display = 'inline-block';
+ setvis = 1;
+ if (extressel == 'window') {
+ extressize.style.display = 'inline-block';
+ } else {
+ extressize.style.display = 'none';
+ }
+ }
+ if (!setvis) {
+ extresreuse.style.display = 'none';
+ extressize.style.display = 'none';
+ }
+ }
+ }
+ }
+}
+ENDSCRIPT
+ $localization_js = <<"ENDSCRIPT";
+function toggleTimeZone() {
+ if (document.getElementById('LC_set_timezone')) {
+ var timezonesel = document.getElementById('LC_set_timezone').value;
+ if (document.getElementById('LC_tzoverdiv')) {
+ var tzoverdiv = document.getElementById('LC_tzoverdiv');
+ if (timezonesel == '') {
+ tzoverdiv.style.display = 'none';
+ } else {
+ tzoverdiv.style.display = 'block';
+ }
+ }
+ }
+}
+ENDSCRIPT
$jscript = ''."\n".$stubrowse_js."\n";
+ $cloners_js."\n".$instcode_js."\n".$localization_js."\n".
+ $syllabus_js."\n".$menuitems_js."\n".$extresource_js."\n".
+ &linkprot_javascript()."\n".'//]]>'."\n".
+ ''."\n".$stubrowse_js."\n".$ltitools_js."\n";
return $jscript;
}
@@ -2256,6 +3849,36 @@ function getIndexByName(item) {
ENDSCRIPT
}
+sub linkprot_javascript {
+ return <<"ENDSCRIPT";
+function toggleLinkProtExtra(form,item,extra,valon,styleon,num) {
+ if (document.getElementById('linkprot_'+extra+'_'+num)) {
+ var extraid = document.getElementById('linkprot_'+extra+'_'+num);
+ var itemname = form.elements['linkprot_'+item+'_'+num];
+ if (itemname) {
+ if (itemname.length > 0) {
+ var setvis;
+ for (var i=0; i'.
&mt('Requirements for specific folders or resources').
'';
@@ -3601,7 +5221,7 @@ sub coowner_invitations {
@pendingcoown = split(',',$pendingcoowners);
}
if (ref($currcoownref) eq 'ARRAY') {
- @currcoown == @{$currcoownref};
+ @currcoown = @{$currcoownref};
}
my $disabled;
if ($noedit) {
@@ -3665,7 +5285,7 @@ sub manage_coownership {
@pendingcoown = split(',',$pendingcoowners);
}
if (ref($currcoownref) eq 'ARRAY') {
- @currcoown == @{$currcoownref};
+ @currcoown = @{$currcoownref};
}
my $disabled;
if ($noedit) {
@@ -3751,9 +5371,23 @@ sub print_localization {
if ($item eq 'timezone') {
my $includeempty = 1;
my $timezone = &Apache::lonlocal::gettimezone();
+ my $onchange;
+ unless ($noedit) {
+ $onchange = ' onchange="javascript:toggleTimeZone();"';
+ }
+ my $id = ' id="LC_set_timezone"';
$datatable .=
- &Apache::loncommon::select_timezone($item,$timezone,undef,
- $includeempty,$disabled);
+ &Apache::loncommon::select_timezone($item,$timezone,$onchange,
+ $includeempty,$id,$disabled);
+ my $tzsty = 'none';
+ if ($timezone ne '') {
+ $tzsty = 'block';
+ }
+ $datatable .= ''.
+ ''.
+ &mt('Override individual user preference?').
+ &yesno_radio('tzover',$settings,undef,1,'',$noedit).
+ '
';
} elsif ($item eq 'datelocale') {
my $includeempty = 1;
my $locale_obj = &Apache::lonlocal::getdatelocale();
@@ -3873,8 +5507,8 @@ sub print_feedback {
}
if ($position eq 'top') {
my $includeempty = 0;
- $datatable .= ''.
- &user_table($cdom,$item,\@sections,
+ $datatable .= ' | '.
+ &user_table($cdom,$item,\@sections,
$settings->{$item},\%lt,$noedit);
} else {
$datatable .= &Apache::lonhtmlcommon::textbox($item.'.text',
@@ -4097,8 +5731,8 @@ sub print_discussion {
''.&role_checkboxes($cdom,$cnum,$item,$settings,undef,undef,$noedit).
' ';
} elsif ($item eq 'plc.users.denied') {
- $datatable .= ' | '.
- &user_table($cdom,$item,undef,
+ $datatable .= ' | '.
+ &user_table($cdom,$item,undef,
$settings->{$item},\%lt,$noedit);
} elsif ($item eq 'pch.roles.denied') {
$datatable .= ' | '.
@@ -4468,6 +6102,20 @@ sub print_appearance {
text => ''.&mt($itemtext->{'usejsme'}).'',
input => 'radio',
},
+ 'inline_chem' => {
+ text => ''.&mt($itemtext->{'inline_chem'}).'',
+ input => 'radio',
+ },
+ 'extresource' => {
+ text => ''.&mt($itemtext->{'extresource'}).'',
+ input => 'selectbox',
+ options => {
+ iframe => 'In iframe',
+ tab => 'In new tab',
+ window => 'In pop-up window',
+ },
+ order => ['iframe','tab','window'],
+ },
);
return &make_item_rows($cdom,\%items,$ordered,$settings,$rowtotal,$crstype,'appearance',$noedit);
}
@@ -4659,6 +6307,523 @@ sub print_bridgetasks {
return &make_item_rows($cdom,\%items,$ordered,$settings,$rowtotal,$crstype,'bridgetasks',$noedit);
}
+sub print_ltitools {
+ my ($cdom,$cnum,$settings,$rowtotal,$crstype,$noedit,$context) = @_;
+ my ($datatable,$disabled,$css_class,$dest);
+ my %lt = <itools_names();
+ my $itemcount = 1;
+ my $maxnum = 0;
+ my %ordered;
+ if (ref($settings) eq 'HASH') {
+ foreach my $item (keys(%{$settings})) {
+ if (ref($settings->{$item}) eq 'HASH') {
+ my $num = $settings->{$item}{'order'};
+ $ordered{$num} = $item;
+ }
+ }
+ }
+
+ if ($context eq 'domain') {
+ $dest = '/adm/domainprefs';
+ } else {
+ $dest = '/adm/courseprefs';
+ }
+ my ($switchserver,$switchmessage);
+ $switchserver = &check_switchserver($cdom,$cnum,$context,$dest);
+ if ($switchserver) {
+ if ($context eq 'domain') {
+ $switchmessage = &mt("submit from domain's primary library server: [_1].",$switchserver);
+ } elsif ($crstype eq 'Community') {
+ $switchmessage = &mt("submit from community's home server: [_1].",$switchserver);
+ } else {
+ $switchmessage = &mt("submit from course's home server: [_1].",$switchserver);
+ }
+ }
+ my $maxnum = scalar(keys(%ordered));
+ my @courseroles = ('cc','in','ta','ep','st');
+ my @ltiroles = qw(Instructor ContentDeveloper TeachingAssistant Learner);
+ my @fields = ('fullname','firstname','lastname','email','roles','user');
+ if (keys(%ordered)) {
+ my @items = sort { $a <=> $b } keys(%ordered);
+ for (my $i=0; $i<@items; $i++) {
+ $css_class = $itemcount%2?' class="LC_odd_row"':'';
+ my $item = $ordered{$items[$i]};
+ my ($title,$key,$url,$usable,$lifetime,$imgsrc,%sigsel);
+ if (ref($settings->{$item}) eq 'HASH') {
+ $title = $settings->{$item}->{'title'};
+ $url = $settings->{$item}->{'url'};
+ $key = $settings->{$item}->{'key'};
+ $usable = $settings->{$item}->{'usable'};
+ $lifetime = $settings->{$item}->{'lifetime'};
+ my $image = $settings->{$item}->{'image'};
+ if ($image ne '') {
+ $imgsrc = '';
+ }
+ if ($settings->{$item}->{'sigmethod'} eq 'HMAC-256') {
+ $sigsel{'HMAC-256'} = ' selected="selected"';
+ } else {
+ $sigsel{'HMAC-SHA1'} = ' selected="selected"';
+ }
+ }
+ my $chgstr = ' onchange="javascript:reorderLTITools(this.form,'."'ltitools_".$item."'".');"';
+ $datatable .= ' | '
+ .''.(' 'x2).
+ ' | '.
+ ''.
+ ''.
+ '';
+ my (%checkedfields,%rolemaps,$userincdom);
+ if (ref($settings->{$item}) eq 'HASH') {
+ if (ref($settings->{$item}->{'fields'}) eq 'HASH') {
+ %checkedfields = %{$settings->{$item}->{'fields'}};
+ }
+ $userincdom = $settings->{$item}->{'incdom'};
+ if (ref($settings->{$item}->{'roles'}) eq 'HASH') {
+ %rolemaps = %{$settings->{$item}->{'roles'}};
+ $checkedfields{'roles'} = 1;
+ }
+ }
+ $datatable .= ''.
+ '';
+ my %courseconfig;
+ if (ref($settings->{$item}) eq 'HASH') {
+ if (ref($settings->{$item}->{'crsconf'}) eq 'HASH') {
+ %courseconfig = %{$settings->{$item}->{'crsconf'}};
+ }
+ }
+ $datatable .= ''.
+ ' |
'."\n";
+ $itemcount ++;
+ }
+ }
+ $css_class = $itemcount%2?' class="LC_odd_row"':'';
+ my $chgstr = ' onchange="javascript:reorderLTITools(this.form,'."'ltitools_add_pos'".');"';
+ $datatable .= ''."\n".
+ ''."\n".
+ ' '."\n".
+ ''.&mt('Add').' | '."\n".
+ ''.
+ ''.
+ ''.
+ '';
+ $datatable .= ''.
+ ''.
+ ''."\n".
+ ' | '."\n".
+ '
'."\n";
+ $itemcount ++;
+ return $datatable;
+}
+
+sub ltitools_names {
+ my %lt = &Apache::lonlocal::texthash(
+ 'title' => 'Title',
+ 'version' => 'Version',
+ 'msgtype' => 'Message Type',
+ 'sigmethod' => 'Signature Method',
+ 'url' => 'URL',
+ 'key' => 'Key',
+ 'lifetime' => 'Nonce lifetime (s)',
+ 'secret' => 'Secret',
+ 'icon' => 'Icon',
+ 'user' => 'User',
+ 'fullname' => 'Full Name',
+ 'firstname' => 'First Name',
+ 'lastname' => 'Last Name',
+ 'email' => 'E-mail',
+ 'roles' => 'Role',
+ 'window' => 'Window',
+ 'tab' => 'Tab',
+ 'iframe' => 'iFrame',
+ 'height' => 'Height',
+ 'width' => 'Width',
+ 'linktext' => 'Default Link Text',
+ 'explanation' => 'Default Explanation',
+ 'passback' => 'Tool can return grades:',
+ 'roster' => 'Tool can retrieve roster:',
+ 'crstarget' => 'Display target',
+ 'crslabel' => 'Course label',
+ 'crstitle' => 'Course title',
+ 'crslinktext' => 'Link Text',
+ 'crsexplanation' => 'Explanation',
+ 'crsappend' => 'Provider URL',
+ );
+ return %lt;
+}
+
sub print_lti {
my ($cdom,$settings,$ordered,$itemtext,$rowtotal,$crstype,$noedit) = @_;
unless ((ref($settings) eq 'HASH') && (ref($ordered) eq 'ARRAY') && (ref($itemtext) eq 'HASH')) {
@@ -4861,7 +7026,7 @@ sub print_menuitems {
my %checked;
my $on = ' checked="checked"';
foreach my $key (keys(%{$menu{$num}})) {
- if (($key eq 'top') || ($key eq 'inline') || ($key eq 'main')) {
+ if (($key eq 'top') || ($key eq 'inline') || ($key eq 'foot') || ($key eq 'main')) {
if ($menu{$num}{$key} eq 'y') {
$checked{$key} = $on;
}
@@ -4878,7 +7043,13 @@ sub print_menuitems {
foreach my $category (@order) {
if ((ref($categories{$category}) eq 'ARRAY') && (@{$categories{$category}} > 0)) {
$datatable .= '