# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
# $Id: domainprefs.pm,v 1.49 2008/05/08 22:13:32 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#
###############################################################
##############################################################
package Apache::domainprefs;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonhtmlcommon();
use Apache::lonlocal;
use Apache::lonmsg();
use LONCAPA;
use LONCAPA::Enrollment;
use File::Copy;
use Locale::Language;
sub handler {
my $r=shift;
if ($r->header_only) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK;
}
my $dom = $env{'request.role.domain'};
my $domdesc = &Apache::lonnet::domain($dom,'description');
if (&Apache::lonnet::allowed('mau',$dom)) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
} else {
$env{'user.error.msg'}=
"/adm/domainprefs:mau:0:0:Cannot modify domain settings";
return HTTP_NOT_ACCEPTABLE;
}
&Apache::lonhtmlcommon::clear_breadcrumbs();
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['phase']);
my $phase = 'pickactions';
if ( exists($env{'form.phase'}) ) {
$phase = $env{'form.phase'};
}
my %domconfig =
&Apache::lonnet::get_dom('configuration',['login','rolecolors',
'quotas','autoenroll','autoupdate','directorysrch',
'usercreation','usermodification','contacts','defaults',
'scantron','coursecategories'],$dom);
my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll',
'autoupdate','directorysrch','contacts',
'usercreation','usermodification','scantron',
'coursecategories');
my %prefs = (
'rolecolors' =>
{ text => 'Default color schemes',
help => 'Default_Color_Schemes',
header => [{col1 => 'Student Settings',
col2 => '',},
{col1 => 'Coordinator Settings',
col2 => '',},
{col1 => 'Author Settings',
col2 => '',},
{col1 => 'Administrator Settings',
col2 => '',}],
},
'login' =>
{ text => 'Log-in page options',
help => 'Domain_Log-in_Page',
header => [{col1 => 'Item',
col2 => '',}],
},
'defaults' =>
{ text => 'Default authentication/language',
help => '',
header => [{col1 => 'Setting',
col2 => 'Value'}],
},
'quotas' =>
{ text => 'Default quotas for user portfolios',
help => 'Default_User_Quota',
header => [{col1 => 'User type',
col2 => 'Default quota'}],
},
'autoenroll' =>
{ text => 'Auto-enrollment settings',
help => 'Domain_Auto_Enrollment',
header => [{col1 => 'Configuration setting',
col2 => 'Value(s)'}],
},
'autoupdate' =>
{ text => 'Auto-update settings',
help => 'Domain_Auto_Update',
header => [{col1 => 'Setting',
col2 => 'Value',},
{col1 => 'User population',
col2 => 'Updataeable user data'}],
},
'directorysrch' =>
{ text => 'Institutional directory searches',
help => 'Domain_Directory_Search',
header => [{col1 => 'Setting',
col2 => 'Value',}],
},
'contacts' =>
{ text => 'Contact Information',
help => 'Domain_Contact_Information',
header => [{col1 => 'Setting',
col2 => 'Value',}],
},
'usercreation' =>
{ text => 'User creation',
help => 'Domain_User_Creation',
header => [{col1 => 'Format rule type',
col2 => 'Format rules in force'},
{col1 => 'User account creation',
col2 => 'Usernames which may be created',},
{col1 => 'Context',
col2 => 'Assignable authentication types'}],
},
'usermodification' =>
{ text => 'User modification',
help => 'Domain_User_Modification',
header => [{col1 => 'Target user has role',
col2 => 'User information updateable in author context'},
{col1 => 'Target user has role',
col2 => 'User information updateable in course context'}],
},
'scantron' =>
{ text => 'Scantron format file',
help => 'Domain_Scantron_Formats',
header => [ {col1 => 'Item',
col2 => '',
}],
},
'coursecategories' =>
{ text => 'Cataloging of courses',
help => 'Domain_Course_Catalog',
header => [ {col1 => 'Categories',
col2 => '',
}],
}
);
my @roles = ('student','coordinator','author','admin');
my @actions = &Apache::loncommon::get_env_multiple('form.actions');
&Apache::lonhtmlcommon::add_breadcrumb
({href=>"javascript:changePage(document.$phase,'pickactions')",
text=>"Pick functionality"});
my $confname = $dom.'-domainconfig';
if ($phase eq 'process') {
&Apache::lonhtmlcommon::add_breadcrumb
({href=>"javascript:changePage(document.$phase,'display')",
text=>"Domain Configuration"},
{href=>"javascript:changePage(document.$phase,'$phase')",
text=>"Updated"});
&print_header($r,$phase);
foreach my $item (@prefs_order) {
if (grep(/^\Q$item\E$/,@actions)) {
$r->print('
');
&print_footer($r,$phase,'display','Back to configuration display',
\@actions);
$r->print('
');
} elsif ($phase eq 'display') {
&Apache::lonhtmlcommon::add_breadcrumb
({href=>"javascript:changePage(document.$phase,'display')",
text=>"Domain Configuration"});
&print_header($r,$phase);
if (@actions > 0) {
my $rowsum = 0;
my (%output,%rowtotal,@items);
my $halfway = @actions/2;
foreach my $item (@prefs_order) {
if (grep(/^\Q$item\E$/,@actions)) {
push(@items,$item);
($output{$item},$rowtotal{$item}) =
&print_config_box($r,$dom,$confname,$phase,
$item,$prefs{$item},
$domconfig{$item});
$rowsum += $rowtotal{$item};
}
}
my $colend;
my $halfway = $rowsum/2;
my $aggregate = 0;
my $sumleft = 0;
my $sumright = 0;
my $crossover;
for (my $i=0; $i<@items; $i++) {
$aggregate += $rowtotal{$items[$i]};
if ($aggregate > $halfway) {
$crossover = $i;
last;
}
}
for (my $i=0; $i<$crossover; $i++) {
$sumleft += $rowtotal{$items[$i]};
}
for (my $i=$crossover+1; $i<@items; $i++) {
$sumright += $rowtotal{$items[$i]};
}
if ((@items > 1) && ($env{'form.numcols'} == 2)) {
my $sumdiff = $sumright - $sumleft;
if ($sumdiff > 0) {
$colend = $crossover + 1;
} else {
$colend = $crossover;
}
} else {
$colend = @items;
}
$r->print('
');
for (my $i=0; $i<$colend; $i++) {
$r->print($output{$items[$i]});
}
$r->print('
');
if ($colend < @items) {
for (my $i=$colend; $i<@items; $i++) {
$r->print($output{$items[$i]});
}
}
$r->print('
');
$r->print(&print_footer($r,$phase,'process','Save',\@actions));
} else {
$r->print(''.
''."\n".
''.&mt('No settings chosen').
'');
}
$r->print('');
$r->print(&Apache::loncommon::end_page());
} else {
if ($phase eq '') {
$phase = 'pickactions';
}
my %helphash;
&print_header($r,$phase);
if (keys(%domconfig) == 0) {
my $primarylibserv = &Apache::lonnet::domain($dom,'primary');
my @ids=&Apache::lonnet::current_machine_ids();
if (!grep(/^\Q$primarylibserv\E$/,@ids)) {
my %designhash = &Apache::loncommon::get_domainconf($dom);
my @loginimages = ('img','logo','domlogo','login');
my $custom_img_count = 0;
foreach my $img (@loginimages) {
if ($designhash{$dom.'.login.'.$img} ne '') {
$custom_img_count ++;
}
}
foreach my $role (@roles) {
if ($designhash{$dom.'.'.$role.'.img'} ne '') {
$custom_img_count ++;
}
}
if ($custom_img_count > 0) {
my $switch_server = &check_switchserver($dom,$confname);
$r->print(
&mt('Domain configuration settings have yet to be saved for this domain via the web-based domain preferences interface.').' '.
&mt("While this remains so, you must switch to the domain's primary library server in order to update settings.").'
'.
&mt("Thereafter, (with a Domain Coordinator role selected in the domain) you will be able to update settings when logged in to any server in the LON-CAPA network.").' '.
&mt("However, you will still need to switch to the domain's primary library server to upload new images or logos.").'
');
if ($switch_server) {
$r->print($switch_server.' '.&mt('to primary library server for domain: [_1]',$dom));
}
return OK;
}
}
}
$r->print('
'.&mt('Functionality to display/modify').'
');
$r->print(''."\n".'
'.
'
');
my ($numitems,$midpoint,$seconddiv,$count);
$numitems = @prefs_order;
$midpoint = int($numitems/2);
if ($numitems%2) {
$midpoint ++;
}
$count = 0;
foreach my $item (@prefs_order) {
$r->print('');
$count ++;
if ((!$seconddiv) && ($count >= $midpoint)) {
$r->print('
';
return $datatable;
}
sub build_category_rows {
my ($itemcount,$cats,$depth,$parent,$path,$idx) = @_;
my ($text,$name,$item,$chgstr);
if (ref($cats) eq 'ARRAY') {
my $maxdepth = scalar(@{$cats});
if (ref($cats->[$depth]) eq 'HASH') {
if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
my $numchildren = @{$cats->[$depth]{$parent}};
my $css_class = $itemcount%2?' class="LC_odd_row"':'';
$text .= '
';
}
my $defcheck = ' ';
if (ref($settings->{'cansearch'}) eq 'ARRAY') {
if (grep(/^default$/,@{$settings->{'cansearch'}})) {
$defcheck = ' checked="checked" ';
}
}
$output .= '
'.
'
';
return $output;
}
sub sorted_searchtitles {
my %searchtitles = &Apache::lonlocal::texthash(
'uname' => 'username',
'lastname' => 'last name',
'lastfirst' => 'last name, first name',
);
my @titleorder = ('uname','lastname','lastfirst');
return (\%searchtitles,\@titleorder);
}
sub sorted_searchtypes {
my %srchtypes_desc = (
exact => 'is exact match',
contains => 'contains ..',
begins => 'begins with ..',
);
my @srchtypeorder = ('exact','begins','contains');
return (\%srchtypes_desc,\@srchtypeorder);
}
sub usertype_update_row {
my ($settings,$usertypes,$fieldtitles,$fields,$types,$rownums) = @_;
my $datatable;
my $numinrow = 4;
foreach my $type (@{$types}) {
if (defined($usertypes->{$type})) {
$$rownums ++;
my $css_class = $$rownums%2?' class="LC_odd_row"':'';
$datatable .= '
'.$usertypes->{$type}.
'
';
for (my $i=0; $i<@{$fields}; $i++) {
my $rem = $i%($numinrow);
if ($rem == 0) {
if ($i > 0) {
$datatable .= '';
}
$datatable .= '
';
}
my $check = ' ';
if (ref($settings) eq 'HASH') {
if (ref($settings->{'fields'}) eq 'HASH') {
if (ref($settings->{'fields'}{$type}) eq 'ARRAY') {
if (grep(/^\Q$fields->[$i]\E$/,@{$settings->{'fields'}{$type}})) {
$check = ' checked="checked" ';
}
}
}
}
if ($i == @{$fields}-1) {
my $colsleft = $numinrow - $rem;
if ($colsleft > 1) {
$datatable .= '
';
} else {
$datatable .= '
';
}
} else {
$datatable .= '
';
}
$datatable .= '
';
}
$datatable .= '
';
}
}
return $datatable;
}
sub modify_login {
my ($r,$dom,$confname,%domconfig) = @_;
my ($resulttext,$errors,$colchgtext,%changes,%colchanges);
my %title = ( coursecatalog => 'Display course catalog',
adminmail => 'Display administrator E-mail address',
newuser => 'Link for visitors to create a user account',
loginheader => 'Log-in box header');
my @offon = ('off','on');
my %loginhash;
($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'],
\%domconfig,\%loginhash);
my @toggles = ('coursecatalog','adminmail','newuser');
foreach my $item (@toggles) {
$loginhash{login}{$item} = $env{'form.'.$item};
}
$loginhash{login}{loginheader} = $env{'form.loginheader'};
if (ref($colchanges{'login'}) eq 'HASH') {
$colchgtext = &display_colorchgs($dom,\%colchanges,['login'],
\%loginhash);
}
my $putresult = &Apache::lonnet::put_dom('configuration',\%loginhash,
$dom);
if ($putresult eq 'ok') {
my @toggles = ('coursecatalog','adminmail','newuser');
my %defaultchecked = (
'coursecatalog' => 'on',
'adminmail' => 'off',
'newuser' => 'off',
);
foreach my $item (@toggles) {
if ($defaultchecked{$item} eq 'on') {
if (($domconfig{'login'}{$item} eq '0') &&
($env{'form.'.$item} eq '1')) {
$changes{$item} = 1;
} elsif (($domconfig{'login'}{$item} eq '' ||
$domconfig{'login'}{$item} eq '1') &&
($env{'form.'.$item} eq '0')) {
$changes{$item} = 1;
}
} elsif ($defaultchecked{$item} eq 'off') {
if (($domconfig{'login'}{$item} eq '1') &&
($env{'form.'.$item} eq '0')) {
$changes{$item} = 1;
} elsif (($domconfig{'login'}{$item} eq '' ||
$domconfig{'login'}{$item} eq '0') &&
($env{'form.'.$item} eq '1')) {
$changes{$item} = 1;
}
}
}
if (($domconfig{'login'}{'loginheader'} eq 'text') &&
($env{'form.loginheader'} eq 'image')) {
$changes{'loginheader'} = 1;
} elsif (($domconfig{'login'}{'loginheader'} eq '' ||
$domconfig{'login'}{'loginheader'} eq 'image') &&
($env{'form.loginheader'} eq 'text')) {
$changes{'loginheader'} = 1;
}
if (keys(%changes) > 0 || $colchgtext) {
&Apache::loncommon::devalidate_domconfig_cache($dom);
$resulttext = &mt('Changes made:').'
';
foreach my $item (sort(keys(%changes))) {
if ($item eq 'loginheader') {
$resulttext .= '
'.&mt("$title{$item} set to $env{'form.loginheader'}").'
';
} else {
$resulttext .= '
'.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'
';
}
}
$resulttext .= $colchgtext.'
';
} else {
$resulttext = &mt('No changes made to log-in page settings');
}
} else {
$resulttext = ''.
&mt('An error occurred: [_1]',$putresult).'';
}
if ($errors) {
$resulttext .= ' '.&mt('The following errors occurred: ').'
'.
$errors.'
';
}
return $resulttext;
}
sub color_font_choices {
my %choices =
&Apache::lonlocal::texthash (
img => "Header",
bgs => "Background colors",
links => "Link colors",
font => "Font color",
pgbg => "Page",
tabbg => "Header",
sidebg => "Border",
link => "Link",
alink => "Active link",
vlink => "Visited link",
);
return %choices;
}
sub modify_rolecolors {
my ($r,$dom,$confname,$roles,%domconfig) = @_;
my ($resulttext,%rolehash);
$rolehash{'rolecolors'} = {};
my ($errors,%changes) = &modify_colors($r,$dom,$confname,$roles,
$domconfig{'rolecolors'},$rolehash{'rolecolors'});
my $putresult = &Apache::lonnet::put_dom('configuration',\%rolehash,
$dom);
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
&Apache::loncommon::devalidate_domconfig_cache($dom);
$resulttext = &display_colorchgs($dom,\%changes,$roles,
$rolehash{'rolecolors'});
} else {
$resulttext = &mt('No changes made to default color schemes');
}
} else {
$resulttext = ''.
&mt('An error occurred: [_1]',$putresult).'';
}
if ($errors) {
$resulttext .= &mt('The following errors occurred: ').'
'.
$errors.'
';
}
return $resulttext;
}
sub modify_colors {
my ($r,$dom,$confname,$roles,$domconfig,$confhash) = @_;
my (%changes,%choices);
my @bgs = ('pgbg','mainbg','sidebg');
my @links = ('link','alink','vlink');
my @logintext;
my @images;
my $servadm = $r->dir_config('lonAdmEMail');
my $errors;
foreach my $role (@{$roles}) {
if ($role eq 'login') {
%choices = &login_choices();
@logintext = ('textcol','bgcol');
} else {
%choices = &color_font_choices();
}
if ($role eq 'login') {
@images = ('img','logo','domlogo','login');
} else {
@images = ('img');
}
$confhash->{$role}{'font'} = $env{'form.'.$role.'_font'};
foreach my $item (@bgs,@links,@logintext) {
$confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item};
}
my ($configuserok,$author_ok,$switchserver) =
&config_check($dom,$confname,$servadm);
my ($width,$height) = &thumb_dimensions();
if (ref($domconfig->{$role}) ne 'HASH') {
$domconfig->{$role} = {};
}
foreach my $img (@images) {
if ( ! $env{'form.'.$role.'_'.$img.'.filename'}
&& !defined($domconfig->{$role}{$img})
&& !$env{'form.'.$role.'_del_'.$img}
&& $env{'form.'.$role.'_import_'.$img}) {
# import the old configured image from the .tab setting
# if they haven't provided a new one
$domconfig->{$role}{$img} =
$env{'form.'.$role.'_import_'.$img};
}
if ($env{'form.'.$role.'_'.$img.'.filename'} ne '') {
my $error;
if ($configuserok eq 'ok') {
if ($switchserver) {
$error = &mt("Upload of [_1] image for $role page(s) is not permitted to this server: [_2]",$choices{$img},$switchserver);
} else {
if ($author_ok eq 'ok') {
my ($result,$logourl) =
&publishlogo($r,'upload',$role.'_'.$img,
$dom,$confname,$img,$width,$height);
if ($result eq 'ok') {
$confhash->{$role}{$img} = $logourl;
$changes{$role}{'images'}{$img} = 1;
} else {
$error = &mt("Upload of [_1] image for $role page(s) failed because an error occurred publishing the file in RES space. Error was: [_2].",$choices{img},$result);
}
} else {
$error = &mt("Upload of [_1] image for $role page(s) failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3]. Error was: [_4].",$choices{$img},$confname,$dom,$author_ok);
}
}
} else {
$error = &mt("Upload of [_1] image for $role page(s) failed because a Domain Configuration user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$choices{$img},$confname,$dom,$configuserok);
}
if ($error) {
&Apache::lonnet::logthis($error);
$errors .= '
'.$error.'
';
}
} elsif ($domconfig->{$role}{$img} ne '') {
if ($domconfig->{$role}{$img} !~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) {
my $error;
if ($configuserok eq 'ok') {
# is confname an author?
if ($switchserver eq '') {
if ($author_ok eq 'ok') {
my ($result,$logourl) =
&publishlogo($r,'copy',$domconfig->{$role}{$img},
$dom,$confname,$img,$width,$height);
if ($result eq 'ok') {
$confhash->{$role}{$img} = $logourl;
$changes{$role}{'images'}{$img} = 1;
}
}
}
}
}
}
}
if (ref($domconfig) eq 'HASH') {
if (ref($domconfig->{$role}) eq 'HASH') {
foreach my $img (@images) {
if ($domconfig->{$role}{$img} ne '') {
if ($env{'form.'.$role.'_del_'.$img}) {
$confhash->{$role}{$img} = '';
$changes{$role}{'images'}{$img} = 1;
} else {
if ($confhash->{$role}{$img} eq '') {
$confhash->{$role}{$img} = $domconfig->{$role}{$img};
}
}
} else {
if ($env{'form.'.$role.'_del_'.$img}) {
$confhash->{$role}{$img} = '';
$changes{$role}{'images'}{$img} = 1;
}
}
}
if ($domconfig->{$role}{'font'} ne '') {
if ($confhash->{$role}{'font'} ne $domconfig->{$role}{'font'}) {
$changes{$role}{'font'} = 1;
}
} else {
if ($confhash->{$role}{'font'}) {
$changes{$role}{'font'} = 1;
}
}
foreach my $item (@bgs) {
if ($domconfig->{$role}{$item} ne '') {
if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
$changes{$role}{'bgs'}{$item} = 1;
}
} else {
if ($confhash->{$role}{$item}) {
$changes{$role}{'bgs'}{$item} = 1;
}
}
}
foreach my $item (@links) {
if ($domconfig->{$role}{$item} ne '') {
if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
$changes{$role}{'links'}{$item} = 1;
}
} else {
if ($confhash->{$role}{$item}) {
$changes{$role}{'links'}{$item} = 1;
}
}
}
foreach my $item (@logintext) {
if ($domconfig->{$role}{$item} ne '') {
if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
$changes{$role}{'logintext'}{$item} = 1;
}
} else {
if ($confhash->{$role}{$item}) {
$changes{$role}{'logintext'}{$item} = 1;
}
}
}
} else {
&default_change_checker($role,\@images,\@links,\@bgs,
\@logintext,$confhash,\%changes);
}
} else {
&default_change_checker($role,\@images,\@links,\@bgs,
\@logintext,$confhash,\%changes);
}
}
return ($errors,%changes);
}
sub config_check {
my ($dom,$confname,$servadm) = @_;
my ($configuserok,$author_ok,$switchserver,%currroles);
my $uhome = &Apache::lonnet::homeserver($confname,$dom,1);
($configuserok,%currroles) = &check_configuser($uhome,$dom,
$confname,$servadm);
if ($configuserok eq 'ok') {
$switchserver = &check_switchserver($dom,$confname);
if ($switchserver eq '') {
$author_ok = &check_authorstatus($dom,$confname,%currroles);
}
}
return ($configuserok,$author_ok,$switchserver);
}
sub default_change_checker {
my ($role,$images,$links,$bgs,$logintext,$confhash,$changes) = @_;
foreach my $item (@{$links}) {
if ($confhash->{$role}{$item}) {
$changes->{$role}{'links'}{$item} = 1;
}
}
foreach my $item (@{$bgs}) {
if ($confhash->{$role}{$item}) {
$changes->{$role}{'bgs'}{$item} = 1;
}
}
foreach my $item (@{$logintext}) {
if ($confhash->{$role}{$item}) {
$changes->{$role}{'logintext'}{$item} = 1;
}
}
foreach my $img (@{$images}) {
if ($env{'form.'.$role.'_del_'.$img}) {
$confhash->{$role}{$img} = '';
$changes->{$role}{'images'}{$img} = 1;
}
}
if ($confhash->{$role}{'font'}) {
$changes->{$role}{'font'} = 1;
}
}
sub display_colorchgs {
my ($dom,$changes,$roles,$confhash) = @_;
my (%choices,$resulttext);
if (!grep(/^login$/,@{$roles})) {
$resulttext = &mt('Changes made:').' ';
}
foreach my $role (@{$roles}) {
if ($role eq 'login') {
%choices = &login_choices();
} else {
%choices = &color_font_choices();
}
if (ref($changes->{$role}) eq 'HASH') {
if ($role ne 'login') {
$resulttext .= '
'.&mt($role).'
';
}
foreach my $key (sort(keys(%{$changes->{$role}}))) {
if ($role ne 'login') {
$resulttext .= '
';
}
if (ref($changes->{$role}{$key}) eq 'HASH') {
if ($role ne 'login') {
$resulttext .= '
'.&mt($choices{$key}).':
';
}
foreach my $item (sort(keys(%{$changes->{$role}{$key}}))) {
if ($confhash->{$role}{$item} eq '') {
$resulttext .= '
'.&mt("$choices{$item} set to default").'
';
} else {
my $newitem = $confhash->{$role}{$item};
if ($key eq 'images') {
$newitem = '';
}
$resulttext .= '
';
} else {
$resulttext = &mt('No changes made to autoupdates');
}
} else {
$resulttext = ''.
&mt('An error occurred: [_1]',$putresult).'';
}
return $resulttext;
}
sub modify_directorysrch {
my ($dom,%domconfig) = @_;
my ($resulttext,%changes);
my %currdirsrch;
if (ref($domconfig{'directorysrch'}) eq 'HASH') {
foreach my $key (keys(%{$domconfig{'directorysrch'}})) {
$currdirsrch{$key} = $domconfig{'directorysrch'}{$key};
}
}
my %title = ( available => 'Directory search available',
localonly => 'Other domains can search',
searchby => 'Search types',
searchtypes => 'Search latitude');
my @offon = ('off','on');
my @otherdoms = ('Yes','No');
my @searchtypes = &Apache::loncommon::get_env_multiple('form.searchtypes');
my @cansearch = &Apache::loncommon::get_env_multiple('form.cansearch');
my @searchby = &Apache::loncommon::get_env_multiple('form.searchby');
my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
if (keys(%{$usertypes}) == 0) {
@cansearch = ('default');
} else {
if (ref($currdirsrch{'cansearch'}) eq 'ARRAY') {
foreach my $type (@{$currdirsrch{'cansearch'}}) {
if (!grep(/^\Q$type\E$/,@cansearch)) {
push(@{$changes{'cansearch'}},$type);
}
}
foreach my $type (@cansearch) {
if (!grep(/^\Q$type\E$/,@{$currdirsrch{'cansearch'}})) {
push(@{$changes{'cansearch'}},$type);
}
}
} else {
push(@{$changes{'cansearch'}},@cansearch);
}
}
if (ref($currdirsrch{'searchby'}) eq 'ARRAY') {
foreach my $by (@{$currdirsrch{'searchby'}}) {
if (!grep(/^\Q$by\E$/,@searchby)) {
push(@{$changes{'searchby'}},$by);
}
}
foreach my $by (@searchby) {
if (!grep(/^\Q$by\E$/,@{$currdirsrch{'searchby'}})) {
push(@{$changes{'searchby'}},$by);
}
}
} else {
push(@{$changes{'searchby'}},@searchby);
}
if (ref($currdirsrch{'searchtypes'}) eq 'ARRAY') {
foreach my $type (@{$currdirsrch{'searchtypes'}}) {
if (!grep(/^\Q$type\E$/,@searchtypes)) {
push(@{$changes{'searchtypes'}},$type);
}
}
foreach my $type (@searchtypes) {
if (!grep(/^\Q$type\E$/,@{$currdirsrch{'searchtypes'}})) {
push(@{$changes{'searchtypes'}},$type);
}
}
} else {
if (exists($currdirsrch{'searchtypes'})) {
foreach my $type (@searchtypes) {
if ($type ne $currdirsrch{'searchtypes'}) {
push(@{$changes{'searchtypes'}},$type);
}
}
if (!grep(/^\Q$currdirsrch{'searchtypes'}\E/,@searchtypes)) {
push(@{$changes{'searchtypes'}},$currdirsrch{'searchtypes'});
}
} else {
push(@{$changes{'searchtypes'}},@searchtypes);
}
}
my %dirsrch_hash = (
directorysrch => { available => $env{'form.dirsrch_available'},
cansearch => \@cansearch,
localonly => $env{'form.dirsrch_localonly'},
searchby => \@searchby,
searchtypes => \@searchtypes,
}
);
my $putresult = &Apache::lonnet::put_dom('configuration',\%dirsrch_hash,
$dom);
if ($putresult eq 'ok') {
if (exists($currdirsrch{'available'})) {
if ($currdirsrch{'available'} ne $env{'form.dirsrch_available'}) {
$changes{'available'} = 1;
}
} else {
if ($env{'form.dirsrch_available'} eq '1') {
$changes{'available'} = 1;
}
}
if (exists($currdirsrch{'localonly'})) {
if ($currdirsrch{'localonly'} ne $env{'form.dirsrch_localonly'}) {
$changes{'localonly'} = 1;
}
} else {
if ($env{'form.dirsrch_localonly'} eq '1') {
$changes{'localonly'} = 1;
}
}
if (keys(%changes) > 0) {
$resulttext = &mt('Changes made:').'
';
if ($changes{'available'}) {
$resulttext .= '
'.&mt("$title{'available'} set to: $offon[$env{'form.dirsrch_available'}]").'
';
}
if ($changes{'localonly'}) {
$resulttext .= '
'.&mt("$title{'localonly'} set to: $otherdoms[$env{'form.dirsrch_localonly'}]").'
';
}
if (ref($changes{'cansearch'}) eq 'ARRAY') {
my $chgtext;
if (ref($usertypes) eq 'HASH') {
if (keys(%{$usertypes}) > 0) {
foreach my $type (@{$types}) {
if (grep(/^\Q$type\E$/,@cansearch)) {
$chgtext .= $usertypes->{$type}.'; ';
}
}
if (grep(/^default$/,@cansearch)) {
$chgtext .= $othertitle;
} else {
$chgtext =~ s/\; $//;
}
$resulttext .= '
'.&mt("Users from domain '[_1]' permitted to search the institutional directory set to: [_2]",$dom,$chgtext).'
';
}
}
}
if (ref($changes{'searchby'}) eq 'ARRAY') {
my ($searchtitles,$titleorder) = &sorted_searchtitles();
my $chgtext;
foreach my $type (@{$titleorder}) {
if (grep(/^\Q$type\E$/,@searchby)) {
if (defined($searchtitles->{$type})) {
$chgtext .= $searchtitles->{$type}.'; ';
}
}
}
$chgtext =~ s/\; $//;
$resulttext .= '
'.&mt("$title{'searchby'} set to: [_1]",$chgtext).'
';
}
if (ref($changes{'searchtypes'}) eq 'ARRAY') {
my ($srchtypes_desc,$srchtypeorder) = &sorted_searchtypes();
my $chgtext;
foreach my $type (@{$srchtypeorder}) {
if (grep(/^\Q$type\E$/,@searchtypes)) {
if (defined($srchtypes_desc->{$type})) {
$chgtext .= $srchtypes_desc->{$type}.'; ';
}
}
}
$chgtext =~ s/\; $//;
$resulttext .= '
'.&mt("$title{'searchtypes'} set to: \"[_1]\"",$chgtext).'
';
}
$resulttext .= '
';
} else {
$resulttext = &mt('No changes made to institution directory search settings');
}
} else {
$resulttext = ''.
&mt('An error occurred: [_1]',$putresult).'';
}
return $resulttext;
}
sub modify_contacts {
my ($dom,%domconfig) = @_;
my ($resulttext,%currsetting,%newsetting,%changes,%contacts_hash);
if (ref($domconfig{'contacts'}) eq 'HASH') {
foreach my $key (keys(%{$domconfig{'contacts'}})) {
$currsetting{$key} = $domconfig{'contacts'}{$key};
}
}
my (%others,%to);
my @contacts = ('supportemail','adminemail');
my @mailings = ('errormail','packagesmail','helpdeskmail');
foreach my $type (@mailings) {
@{$newsetting{$type}} =
&Apache::loncommon::get_env_multiple('form.'.$type);
foreach my $item (@contacts) {
if (grep(/^\Q$item\E$/,@{$newsetting{$type}})) {
$contacts_hash{contacts}{$type}{$item} = 1;
} else {
$contacts_hash{contacts}{$type}{$item} = 0;
}
}
$others{$type} = $env{'form.'.$type.'_others'};
$contacts_hash{contacts}{$type}{'others'} = $others{$type};
}
foreach my $item (@contacts) {
$to{$item} = $env{'form.'.$item};
$contacts_hash{'contacts'}{$item} = $to{$item};
}
if (keys(%currsetting) > 0) {
foreach my $item (@contacts) {
if ($to{$item} ne $currsetting{$item}) {
$changes{$item} = 1;
}
}
foreach my $type (@mailings) {
foreach my $item (@contacts) {
if (ref($currsetting{$type}) eq 'HASH') {
if ($currsetting{$type}{$item} ne $contacts_hash{contacts}{$type}{$item}) {
push(@{$changes{$type}},$item);
}
} else {
push(@{$changes{$type}},@{$newsetting{$type}});
}
}
if ($others{$type} ne $currsetting{$type}{'others'}) {
push(@{$changes{$type}},'others');
}
}
} else {
my %default;
$default{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'};
$default{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'};
$default{'errormail'} = 'adminemail';
$default{'packagesmail'} = 'adminemail';
$default{'helpdeskmail'} = 'supportemail';
foreach my $item (@contacts) {
if ($to{$item} ne $default{$item}) {
$changes{$item} = 1;
}
}
foreach my $type (@mailings) {
if ((@{$newsetting{$type}} != 1) || ($newsetting{$type}[0] ne $default{$type})) {
push(@{$changes{$type}},@{$newsetting{$type}});
}
if ($others{$type} ne '') {
push(@{$changes{$type}},'others');
}
}
}
my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash,
$dom);
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
my ($titles,$short_titles) = &contact_titles();
$resulttext = &mt('Changes made:').'
';
foreach my $item (@contacts) {
if ($changes{$item}) {
$resulttext .= '
'.$titles->{$item}.
&mt(' set to: ').
''.
$to{$item}.'
';
}
}
foreach my $type (@mailings) {
if (ref($changes{$type}) eq 'ARRAY') {
$resulttext .= '
'.$titles->{$type}.': ';
my @text;
foreach my $item (@{$newsetting{$type}}) {
push(@text,$short_titles->{$item});
}
if ($others{$type} ne '') {
push(@text,$others{$type});
}
$resulttext .= ''.
join(', ',@text).'
';
}
}
$resulttext .= '
';
} else {
$resulttext = &mt('No changes made to contact information');
}
} else {
$resulttext = ''.
&mt('An error occurred: [_1].',$putresult).'';
}
return $resulttext;
}
sub modify_usercreation {
my ($dom,%domconfig) = @_;
my ($resulttext,%curr_usercreation,%changes,%authallowed,%cancreate);
my $warningmsg;
if (ref($domconfig{'usercreation'}) eq 'HASH') {
foreach my $key (keys(%{$domconfig{'usercreation'}})) {
$curr_usercreation{$key} = $domconfig{'usercreation'}{$key};
}
}
my @username_rule = &Apache::loncommon::get_env_multiple('form.username_rule');
my @id_rule = &Apache::loncommon::get_env_multiple('form.id_rule');
my @email_rule = &Apache::loncommon::get_env_multiple('form.email_rule');
my @contexts = ('author','course','selfcreate');
foreach my $item(@contexts) {
$cancreate{$item} = $env{'form.can_createuser_'.$item};
if ($item eq 'selfcreate') {
my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
if (!((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth'))) {
if (($cancreate{$item} eq 'any') || ($cancreate{$item} eq 'login')) {
$warningmsg = &mt('Although account creation has been set to be available for institutional logins, currently default authentication in this domain has not been set to support this.').' '.&mt('You need to set the default authentication type to Kerberos 4 or 5 (with a Kerberos domain specified), or to Local authentication, if the localauth module has been customized in your domain to authenticate institutional logins.');
}
}
}
}
if (ref($curr_usercreation{'cancreate'}) eq 'HASH') {
foreach my $item (@contexts) {
if ($curr_usercreation{'cancreate'}{$item} ne $cancreate{$item}) {
push(@{$changes{'cancreate'}},$item);
}
}
} elsif (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') {
foreach my $item (@contexts) {
if (!grep(/^\Q$item\E$/,@{$curr_usercreation{'cancreate'}})) {
if ($cancreate{$item} ne 'any') {
push(@{$changes{'cancreate'}},$item);
}
} else {
if ($cancreate{$item} ne 'none') {
push(@{$changes{'cancreate'}},$item);
}
}
}
} else {
foreach my $item (@contexts) {
push(@{$changes{'cancreate'}},$item);
}
}
if (ref($curr_usercreation{'username_rule'}) eq 'ARRAY') {
foreach my $type (@{$curr_usercreation{'username_rule'}}) {
if (!grep(/^\Q$type\E$/,@username_rule)) {
push(@{$changes{'username_rule'}},$type);
}
}
foreach my $type (@username_rule) {
if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'username_rule'}})) {
push(@{$changes{'username_rule'}},$type);
}
}
} else {
push(@{$changes{'username_rule'}},@username_rule);
}
if (ref($curr_usercreation{'id_rule'}) eq 'ARRAY') {
foreach my $type (@{$curr_usercreation{'id_rule'}}) {
if (!grep(/^\Q$type\E$/,@id_rule)) {
push(@{$changes{'id_rule'}},$type);
}
}
foreach my $type (@id_rule) {
if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'id_rule'}})) {
push(@{$changes{'id_rule'}},$type);
}
}
} else {
push(@{$changes{'id_rule'}},@id_rule);
}
if (ref($curr_usercreation{'email_rule'}) eq 'ARRAY') {
foreach my $type (@{$curr_usercreation{'email_rule'}}) {
if (!grep(/^\Q$type\E$/,@email_rule)) {
push(@{$changes{'email_rule'}},$type);
}
}
foreach my $type (@email_rule) {
if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'email_rule'}})) {
push(@{$changes{'email_rule'}},$type);
}
}
} else {
push(@{$changes{'email_rule'}},@email_rule);
}
my @authen_contexts = ('author','course','domain');
my @authtypes = ('int','krb4','krb5','loc');
my %authhash;
foreach my $item (@authen_contexts) {
my @authallowed = &Apache::loncommon::get_env_multiple('form.'.$item.'_auth');
foreach my $auth (@authtypes) {
if (grep(/^\Q$auth\E$/,@authallowed)) {
$authhash{$item}{$auth} = 1;
} else {
$authhash{$item}{$auth} = 0;
}
}
}
if (ref($curr_usercreation{'authtypes'}) eq 'HASH') {
foreach my $item (@authen_contexts) {
if (ref($curr_usercreation{'authtypes'}{$item}) eq 'HASH') {
foreach my $auth (@authtypes) {
if ($authhash{$item}{$auth} ne $curr_usercreation{'authtypes'}{$item}{$auth}) {
push(@{$changes{'authtypes'}},$item);
last;
}
}
}
}
} else {
foreach my $item (@authen_contexts) {
push(@{$changes{'authtypes'}},$item);
}
}
my %usercreation_hash = (
usercreation => {
cancreate => \%cancreate,
username_rule => \@username_rule,
id_rule => \@id_rule,
email_rule => \@email_rule,
authtypes => \%authhash,
}
);
my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash,
$dom);
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
$resulttext = &mt('Changes made:').'
';
if (ref($changes{'cancreate'}) eq 'ARRAY') {
my %lt = &usercreation_types();
foreach my $type (@{$changes{'cancreate'}}) {
my $chgtext = $lt{$type}.', ';
if ($type eq 'selfcreate') {
if ($cancreate{$type} eq 'none') {
$chgtext .= &mt('creation of a new user account is not permitted.');
} elsif ($cancreate{$type} eq 'any') {
$chgtext .= &mt('creation of a new account is permitted for users authenticated by institutional log-in and SSO, and also for e-mail addresses used as usernames.');
} elsif ($cancreate{$type} eq 'login') {
$chgtext .= &mt('creation of a new account is only permitted for users authenticated by institutional log-in.');
} elsif ($cancreate{$type} eq 'sso') {
$chgtext .= &mt('creation of a new account is only permitted for users authenticated by institutional single sign on.');
} elsif ($cancreate{$type} eq 'email') {
$chgtext .= &mt('creation of a new account is only permitted for users who provide a valid e-mail address for use as the username.');
}
} else {
if ($cancreate{$type} eq 'none') {
$chgtext .= &mt('creation of new users is not permitted, except by a Domain Coordinator.');
} elsif ($cancreate{$type} eq 'any') {
$chgtext .= &mt('creation of new users is permitted for both institutional and non-institutional usernames.');
} elsif ($cancreate{$type} eq 'official') {
$chgtext .= &mt('creation of new users is only permitted for institutional usernames.');
} elsif ($cancreate{$type} eq 'unofficial') {
$chgtext .= &mt('creation of new users is only permitted for non-institutional usernames.');
}
}
$resulttext .= '
'.$chgtext.'
';
}
}
if (ref($changes{'username_rule'}) eq 'ARRAY') {
my ($rules,$ruleorder) =
&Apache::lonnet::inst_userrules($dom,'username');
my $chgtext = '
';
foreach my $type (@username_rule) {
if (ref($rules->{$type}) eq 'HASH') {
$chgtext .= '
'.$rules->{$type}{'name'}.'
';
}
}
$chgtext .= '
';
if (@username_rule > 0) {
$resulttext .= '
'.&mt('Usernames with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'
';
} else {
$resulttext .= '
'.&mt('There are now no username formats restricted to verified users in the institutional directory.').'
';
}
}
if (ref($changes{'id_rule'}) eq 'ARRAY') {
my ($idrules,$idruleorder) =
&Apache::lonnet::inst_userrules($dom,'id');
my $chgtext = '
';
foreach my $type (@id_rule) {
if (ref($idrules->{$type}) eq 'HASH') {
$chgtext .= '
'.$idrules->{$type}{'name'}.'
';
}
}
$chgtext .= '
';
if (@id_rule > 0) {
$resulttext .= '
'.&mt('IDs with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'
';
} else {
$resulttext .= '
'.&mt('There are now no ID formats restricted to verified users in the institutional directory.').'
';
}
}
if (ref($changes{'email_rule'}) eq 'ARRAY') {
my ($emailrules,$emailruleorder) =
&Apache::lonnet::inst_userrules($dom,'email');
my $chgtext = '
';
foreach my $type (@email_rule) {
if (ref($emailrules->{$type}) eq 'HASH') {
$chgtext .= '
'.$emailrules->{$type}{'name'}.'
';
}
}
$chgtext .= '
';
if (@email_rule > 0) {
$resulttext .= '
'.&mt('Accounts may not be created by users self-enrolling with e-mail addresses of the following types: ').$chgtext.'
';
} else {
$resulttext .= '
'.&mt('There are now no restrictions on e-mail addresses which may be used as a username when self-enrolling.').'
';
}
}
my %authname = &authtype_names();
my %context_title = &context_names();
if (ref($changes{'authtypes'}) eq 'ARRAY') {
my $chgtext = '
';
foreach my $type (@{$changes{'authtypes'}}) {
my @allowed;
$chgtext .= '
'.$context_title{$type}.' - '.&mt('assignable authentication types: ');
foreach my $auth (@authtypes) {
if ($authhash{$type}{$auth}) {
push(@allowed,$authname{$auth});
}
}
if (@allowed > 0) {
$chgtext .= join(', ',@allowed).'
'.&mt('Authentication types available for assignment to new users').' '.$chgtext;
$resulttext .= '
';
}
$resulttext .= '
';
} else {
$resulttext = &mt('No changes made to user creation settings');
}
} else {
$resulttext = ''.
&mt('An error occurred: [_1]',$putresult).'';
}
if ($warningmsg ne '') {
$resulttext .= ' '.$warningmsg.' ';
}
return $resulttext;
}
sub modify_usermodification {
my ($dom,%domconfig) = @_;
my ($resulttext,%curr_usermodification,%changes);
if (ref($domconfig{'usermodification'}) eq 'HASH') {
foreach my $key (keys(%{$domconfig{'usermodification'}})) {
$curr_usermodification{$key} = $domconfig{'usermodification'}{$key};
}
}
my @contexts = ('author','course');
my %context_title = (
author => 'In author context',
course => 'In course context',
);
my @fields = ('lastname','firstname','middlename','generation',
'permanentemail','id');
my %roles = (
author => ['ca','aa'],
course => ['st','ep','ta','in','cr'],
);
my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
my %modifyhash;
foreach my $context (@contexts) {
foreach my $role (@{$roles{$context}}) {
my @modifiable = &Apache::loncommon::get_env_multiple('form.canmodify_'.$role);
foreach my $item (@fields) {
if (grep(/^\Q$item\E$/,@modifiable)) {
$modifyhash{$context}{$role}{$item} = 1;
} else {
$modifyhash{$context}{$role}{$item} = 0;
}
}
}
if (ref($curr_usermodification{$context}) eq 'HASH') {
foreach my $role (@{$roles{$context}}) {
if (ref($curr_usermodification{$context}{$role}) eq 'HASH') {
foreach my $field (@fields) {
if ($modifyhash{$context}{$role}{$field} ne
$curr_usermodification{$context}{$role}{$field}) {
push(@{$changes{$context}},$role);
last;
}
}
}
}
} else {
foreach my $context (@contexts) {
foreach my $role (@{$roles{$context}}) {
push(@{$changes{$context}},$role);
}
}
}
}
my %usermodification_hash = (
usermodification => \%modifyhash,
);
my $putresult = &Apache::lonnet::put_dom('configuration',
\%usermodification_hash,$dom);
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
$resulttext = &mt('Changes made: ').'
';
foreach my $context (@contexts) {
if (ref($changes{$context}) eq 'ARRAY') {
$resulttext .= '
'.$context_title{$context}.':
';
if (ref($changes{$context}) eq 'ARRAY') {
foreach my $role (@{$changes{$context}}) {
my $rolename;
if ($role eq 'cr') {
$rolename = &mt('Custom');
} else {
$rolename = &Apache::lonnet::plaintext($role);
}
my @modifiable;
$resulttext .= '
'.&mt('Target user with [_1] role',$rolename).' - '.&mt('modifiable fields: ');
foreach my $field (@fields) {
if ($modifyhash{$context}{$role}{$field}) {
push(@modifiable,$fieldtitles{$field});
}
}
if (@modifiable > 0) {
$resulttext .= join(', ',@modifiable);
} else {
$resulttext .= &mt('none');
}
$resulttext .= '
';
}
$resulttext .= '
';
}
}
}
$resulttext .= '
';
} else {
$resulttext = &mt('No changes made to user modification settings');
}
} else {
$resulttext = ''.
&mt('An error occurred: [_1]',$putresult).'';
}
return $resulttext;
}
sub modify_defaults {
my ($dom,$r) = @_;
my ($resulttext,$mailmsgtxt,%newvalues,%changes,@errors);
my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
my @items = ('auth_def','auth_arg_def','lang_def');
my @authtypes = ('internal','krb4','krb5','localauth');
foreach my $item (@items) {
$newvalues{$item} = $env{'form.'.$item};
if ($item eq 'auth_def') {
if ($newvalues{$item} ne '') {
if (!grep(/^\Q$newvalues{$item}\E$/,@authtypes)) {
push(@errors,$item);
}
}
} elsif ($item eq 'lang_def') {
if ($newvalues{$item} ne '') {
if ($newvalues{$item} =~ /^(\w+)/) {
my $langcode = $1;
if (code2language($langcode) eq '') {
push(@errors,$item);
}
} else {
push(@errors,$item);
}
}
}
if (grep(/^\Q$item\E$/,@errors)) {
$newvalues{$item} = $domdefaults{$item};
} elsif ($domdefaults{$item} ne $newvalues{$item}) {
$changes{$item} = 1;
}
}
my %defaults_hash = (
defaults => { auth_def => $newvalues{'auth_def'},
auth_arg_def => $newvalues{'auth_arg_def'},
lang_def => $newvalues{'lang_def'},
}
);
my $title = &defaults_titles();
my $putresult = &Apache::lonnet::put_dom('configuration',\%defaults_hash,
$dom);
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
$resulttext = &mt('Changes made:').'
';
my $version = $r->dir_config('lonVersion');
my $mailmsgtext = "Changes made to domain settings in a LON-CAPA installation - domain: $dom (running version: $version) - dns_domain.tab needs to be updated with the following changes, to support legacy 2.4, 2.5 and 2.6 versions of LON-CAPA.\n\n";
foreach my $item (sort(keys(%changes))) {
my $value = $env{'form.'.$item};
if ($value eq '') {
$value = &mt('none');
} elsif ($item eq 'auth_def') {
my %authnames = &authtype_names();
my %shortauth = (
internal => 'int',
krb4 => 'krb4',
krb5 => 'krb5',
localauth => 'loc',
);
$value = $authnames{$shortauth{$value}};
}
$resulttext .= '
'.&mt('[_1] set to "[_2]"',$title->{$item},$value).'
';
$mailmsgtext .= "$title->{$item} set to $value\n";
}
$resulttext .= '
';
$mailmsgtext .= "\n";
my $cachetime = 24*60*60;
&Apache::lonnet::do_cache_new('domdefaults',$dom,
$defaults_hash{'defaults'},$cachetime);
my $sysmail = $r->dir_config('lonSysEMail');
&Apache::lonmsg::sendemail($sysmail,"LON-CAPA Domain Settings Change - $dom",$mailmsgtext);
} else {
$resulttext = &mt('No changes made to default authentication/language settings');
}
} else {
$resulttext = ''.
&mt('An error occurred: [_1]',$putresult).'';
}
if (@errors > 0) {
$resulttext .= ' '.&mt('The following were left unchanged because the values entered were invalid:');
foreach my $item (@errors) {
$resulttext .= ' "'.$title->{$item}.'",';
}
$resulttext =~ s/,$//;
}
return $resulttext;
}
sub modify_scantron {
my ($r,$dom,$confname,%domconfig) = @_;
my ($resulttext,%confhash,%changes,$errors);
my $custom = 'custom.tab';
my $default = 'default.tab';
my $servadm = $r->dir_config('lonAdmEMail');
my ($configuserok,$author_ok,$switchserver) =
&config_check($dom,$confname,$servadm);
if ($env{'form.scantronformat.filename'} ne '') {
my $error;
if ($configuserok eq 'ok') {
if ($switchserver) {
$error = &mt("Upload of scantron format file is not permitted to this server: [_1]",$switchserver);
} else {
if ($author_ok eq 'ok') {
my ($result,$scantronurl) =
&publishlogo($r,'upload','scantronformat',$dom,
$confname,'scantron','','',$custom);
if ($result eq 'ok') {
$confhash{'scantron'}{'scantronformat'} = $scantronurl;
$changes{'scantronformat'} = 1;
} else {
$error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$custom,$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].",$custom,$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].",$custom,$confname,$dom,$configuserok);
}
if ($error) {
&Apache::lonnet::logthis($error);
$errors .= '
'.$error.'
';
}
}
if (ref($domconfig{'scantron'}) eq 'HASH') {
if ($domconfig{'scantron'}{'scantronformat'} ne '') {
if ($env{'form.scantronformat_del'}) {
$confhash{'scantron'}{'scantronformat'} = '';
$changes{'scantronformat'} = 1;
}
}
}
if (keys(%confhash) > 0) {
my $putresult = &Apache::lonnet::put_dom('configuration',\%confhash,
$dom);
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
if (ref($confhash{'scantron'}) eq 'HASH') {
$resulttext = &mt('Changes made:').'
';
if ($confhash{'scantron'}{'scantronformat'} eq '') {
$resulttext .= '
'.&mt('[_1] scantron format file removed; [_2] file will be used for courses in this domain.',$custom,$default).'
';
} else {
$resulttext .= '
'.&mt('Custom scantron format file ([_1]) uploaded for use with courses in this domain.',$custom).'
';
}
$resulttext .= '
';
} else {
$resulttext = &mt('Changes made to scantron format file.');
}
$resulttext .= '';
&Apache::loncommon::devalidate_domconfig_cache($dom);
} else {
$resulttext = &mt('No changes made to scantron format file');
}
} else {
$resulttext = ''.
&mt('An error occurred: [_1]',$putresult).'';
}
} else {
$resulttext = &mt('No changes made to scantron format file');
}
if ($errors) {
$resulttext .= &mt('The following errors occurred: ').'
'.
$errors.'
';
}
return $resulttext;
}
sub modify_coursecategories {
my ($dom,%domconfig) = @_;
my ($resulttext,%deletions,%reorderings,%needreordering,%adds,$errors);
my @deletecategory = &Apache::loncommon::get_env_multiple('form.deletecategory');
if (($domconfig{'coursecategories'}{'instcode::0'} ne '') && ($env{'form.instcode'} == 0)) {
push (@deletecategory,'instcode::0');
}
my (@predelcats,@predeltrails,%predelallitems);
if (ref($domconfig{'coursecategories'}) eq 'HASH') {
if (@deletecategory > 0) {
#FIXME Need to remove category from all courses using a deleted category
&extract_categories($domconfig{'coursecategories'},\@predelcats,\@predeltrails,\%predelallitems);
foreach my $item (@deletecategory) {
if ($domconfig{'coursecategories'}{$item} ne '') {
delete($domconfig{'coursecategories'}{$item});
$deletions{$item} = 1;
&recurse_cat_deletes($item,$domconfig{'coursecategories'},
\%deletions);
}
}
}
foreach my $item (keys(%{$domconfig{'coursecategories'}})) {
my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
if ($domconfig{'coursecategories'}{$item} ne $env{'form.'.$item}) {
$reorderings{$item} = 1;
$domconfig{'coursecategories'}{$item} = $env{'form.'.$item};
}
if ($env{'form.addcategory_name_'.$item} ne '') {
my $newcat = $env{'form.addcategory_name_'.$item};
my $newdepth = $depth+1;
my $newitem = &escape($newcat).':'.&escape($cat).':'.$newdepth;
$domconfig{'coursecategories'}{$newitem} = $env{'form.addcategory_pos_'.$item};
$adds{$newitem} = 1;
}
if ($env{'form.subcat_'.$item} ne '') {
my $newcat = $env{'form.subcat_'.$item};
my $newdepth = $depth+1;
my $newitem = &escape($newcat).':'.&escape($cat).':'.$newdepth;
$domconfig{'coursecategories'}{$newitem} = 0;
$adds{$newitem} = 1;
}
}
}
if ($env{'form.instcode'} eq '1') {
if (ref($domconfig{'coursecategories'}) eq 'HASH') {
my $newitem = 'instcode::0';
if ($domconfig{'coursecategories'}{$newitem} eq '') {
$domconfig{'coursecategories'}{$newitem} = $env{'form.instcode_pos'};
$adds{$newitem} = 1;
}
} else {
my $newitem = 'instcode::0';
$domconfig{'coursecategories'}{$newitem} = $env{'form.instcode_pos'};
$adds{$newitem} = 1;
}
}
if ($env{'form.addcategory_name'} ne '') {
my $newitem = &escape($env{'form.addcategory_name'}).'::0';
$domconfig{'coursecategories'}{$newitem} = $env{'form.addcategory_pos'};
$adds{$newitem} = 1;
}
if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
my %sort_by_deltrail;
if (keys(%deletions) > 0) {
foreach my $key (keys(%deletions)) {
if ($predelallitems{$key} ne '') {
$sort_by_deltrail{$predelallitems{$key}} = $predeltrails[$predelallitems{$key}];
}
}
}
my (@chkcats,@chktrails,%chkallitems);
&extract_categories($domconfig{'coursecategories'},\@chkcats,\@chktrails,\%chkallitems);
if (ref($chkcats[0]) eq 'ARRAY') {
my $depth = 0;
my $chg = 0;
for (my $i=0; $i<@{$chkcats[0]}; $i++) {
my $name = $chkcats[0][$i];
my $item;
if ($name eq '') {
$chg ++;
} else {
$item = &escape($name).'::0';
if ($chg) {
$domconfig{'coursecategories'}{$item} -= $chg;
}
$depth ++;
&recurse_check(\@chkcats,$domconfig{'coursecategories'},$depth,$name);
$depth --;
}
}
}
my $putresult = &Apache::lonnet::put_dom('configuration',\%domconfig,$dom);
my (@cats,@trails,%allitems);
&extract_categories($domconfig{'coursecategories'},\@cats,\@trails,\%allitems);
if ($putresult eq 'ok') {
$resulttext = &mt('Changes made:').'
'; } $resulttext .= '
';
}
} else {
if ($confhash->{$role}{$key} eq '') {
$resulttext .= '