# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
# $Id: domainprefs.pm,v 1.102.2.2 2009/08/23 12:40:50 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/
#
#
###############################################################
##############################################################
=pod
=head1 NAME
Apache::domainprefs.pm
=head1 SYNOPSIS
Handles configuration of a LON-CAPA domain.
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
=head1 OVERVIEW
Each institution using LON-CAPA will typically have a single domain designated
for use by individuals affliated with the institution. Accordingly, each domain
may define a default set of logos and a color scheme which can be used to "brand"
the LON-CAPA instance. In addition, an institution will typically have a language
and timezone which are used for the majority of courses.
LON-CAPA provides a mechanism to display and modify these defaults, as well as a
host of other domain-wide settings which determine the types of functionality
available to users and courses in the domain.
There is also a mechanism to configure cataloging of courses in the domain, and
controls on the operation of automated processes which govern such things as
roster updates, user directory updates and processing of course requests.
The domain coordination manual which is built dynamically on install/update of
LON-CAPA from the relevant help items provides more information about domain
configuration.
Most of the domain settings are stored in the configuration.db GDBM file which is
housed on the primary library server for the domain in /home/httpd/lonUsers/$dom,
where $dom is the domain. The configuration.db stores settings in a number of
frozen hashes of hashes. In a few cases, domain information must be uploaded to
the domain as files (e.g., image files for logos etc., or plain text files for
bubblesheet formats). In this case the domainprefs.pm must be running in a user
session hosted on the primary library server in the domain, as these files are
stored in author space belonging to a special $dom-domainconfig user.
domainprefs.pm in combination with lonconfigsettings.pm will retrieve and display
the current settings, and provides an interface to make modifications.
=head1 SUBROUTINES
=over
=item print_quotas()
Inputs: 4
$dom,$settings,$rowtotal,$action.
$dom is the domain, $settings is a reference to a hash of current settings for
the current context, $rowtotal is a reference to the scalar used to record the
number of rows displayed on the page, and $action is the context (either quotas
or requestcourses).
The print_quotas routine was orginally created to display/store information
about default quota sizes for portfolio spaces for the different types of
institutional affiliation in the domain (e.g., Faculty, Staff, Student etc.),
but is now also used to manage availability of user tools:
i.e., blogs, aboutme page, and portfolios, and the course request tool,
used by course owners to request creation of a course.
Outputs: 1
$datatable - HTML containing form elements which allow settings to be changed.
In the case of course requests, radio buttons are displayed for each institutional
affiliate type (and also default, and _LC_adv) for each of the course types
(official, unofficial and community). In each case the radio buttons allow the
selection of one of four values:
0, approval, validate, autolimit=N (where N is blank, or a positive integer).
which have the following effects:
0
=over
- course requests are not allowed for this course types/affiliation
=back
approval
=over
- course requests must be approved by a Doman Coordinator in the
course's domain
=back
validate
=over
- an institutional validation (e.g., check requestor is instructor
of record) needs to be passed before the course will be created. The required
validation is in localenroll.pm on the primary library server for the course
domain.
=back
autolimit
=over
- course requests will be processed autoatically up to a limit of
N requests for the course type for the particular requestor.
If N is undefined, there is no limit to the number of course requests
which a course owner may submit and have processed automatically.
=back
=item modify_quotas()
=back
=cut
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 Apache::lonconfigsettings;
use LONCAPA qw(:DEFAULT :match);
use LONCAPA::Enrollment;
use LONCAPA::lonauthcgi();
use File::Copy;
use Locale::Language;
use DateTime::TimeZone;
use DateTime::Locale;
sub handler {
my $r=shift;
if ($r->header_only) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK;
}
my $context = 'domain';
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','actions']);
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','serverstatuses',
'requestcourses'],$dom);
my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll',
'autoupdate','directorysrch','contacts',
'usercreation','usermodification','scantron',
'requestcourses','coursecategories','serverstatuses');
my %prefs = (
'rolecolors' =>
{ text => 'Default color schemes',
help => 'Domain_Configuration_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_Configuration_Login_Page',
header => [{col1 => 'Item',
col2 => '',}],
},
'defaults' =>
{ text => 'Default authentication/language/timezone',
help => 'Domain_Configuration_LangTZAuth',
header => [{col1 => 'Setting',
col2 => 'Value'}],
},
'quotas' =>
{ text => 'User blogs, personal information pages and portfolios',
help => 'Domain_Configuration_Quotas',
header => [{col1 => 'User affiliation',
col2 => 'Available tools',
col3 => 'Portfolio quota',}],
},
'autoenroll' =>
{ text => 'Auto-enrollment settings',
help => 'Domain_Configuration_Auto_Enrollment',
header => [{col1 => 'Configuration setting',
col2 => 'Value(s)'}],
},
'autoupdate' =>
{ text => 'Auto-update settings',
help => 'Domain_Configuration_Auto_Updates',
header => [{col1 => 'Setting',
col2 => 'Value',},
{col1 => 'User population',
col2 => 'Updataeable user data'}],
},
'directorysrch' =>
{ text => 'Institutional directory searches',
help => 'Domain_Configuration_InstDirectory_Search',
header => [{col1 => 'Setting',
col2 => 'Value',}],
},
'contacts' =>
{ text => 'Contact Information',
help => 'Domain_Configuration_Contact_Info',
header => [{col1 => 'Setting',
col2 => 'Value',}],
},
'usercreation' =>
{ text => 'User creation',
help => 'Domain_Configuration_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_Configuration_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'},
{col1 => "Status of user",
col2 => 'Information settable when self-creating account (if directory data blank)'}],
},
'scantron' =>
{ text => 'Bubblesheet format file',
help => 'Domain_Configuration_Scantron_Format',
header => [ {col1 => 'Item',
col2 => '',
}],
},
'requestcourses' =>
{text => 'Request creation of courses',
help => 'Domain_Configuration_Request_Courses',
header => [{col1 => 'User affiliation',
col2 => 'Availability/Processing of requests',},
{col1 => 'Setting',
col2 => 'Value'}],
},
'coursecategories' =>
{ text => 'Cataloging of courses',
help => 'Domain_Configuration_Cataloging_Courses',
header => [{col1 => 'Category settings',
col2 => '',},
{col1 => 'Categories',
col2 => '',
}],
},
'serverstatuses' =>
{text => 'Access to server status pages',
help => 'Domain_Configuration_Server_Status',
header => [{col1 => 'Status Page',
col2 => 'Other named users',
col3 => 'Specific IPs',
}],
},
);
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::lonconfigsettings::make_changes($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,\@roles);
} elsif ($phase eq 'display') {
&Apache::lonconfigsettings::display_settings($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname);
} else {
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) {
&Apache::lonconfigsettings::print_header($r,$phase,$context);
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.").'
';
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 .= '
';
} else {
my $higher = $depth-1;
if ($higher == 0) {
$name = &escape($parent).'::'.$higher;
} else {
if (ref($path) eq 'ARRAY') {
$name = &escape($parent).':'.&escape($path->[-2]).':'.$higher;
}
}
my $colspan;
if ($parent ne 'instcode') {
$colspan = $maxdepth - $depth - 1;
$text .= '
'.&mt('Add subcategory:').'
';
}
}
}
}
return $text;
}
sub modifiable_userdata_row {
my ($context,$role,$settings,$numinrow,$rowcount,$usertypes) = @_;
my $rolename;
if ($context eq 'selfcreate') {
if (ref($usertypes) eq 'HASH') {
$rolename = $usertypes->{$role};
} else {
$rolename = $role;
}
} else {
if ($role eq 'cr') {
$rolename = &mt('Custom role');
} else {
$rolename = &Apache::lonnet::plaintext($role);
}
}
my @fields = ('lastname','firstname','middlename','generation',
'permanentemail','id');
my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
my $output;
my $css_class = $rowcount%2?' class="LC_odd_row"':'';
$output = '
'.
'
'.$rolename.'
'.
'
';
my $rem;
my %checks;
if (ref($settings) eq 'HASH') {
if (ref($settings->{$context}) eq 'HASH') {
if (ref($settings->{$context}->{$role}) eq 'HASH') {
foreach my $field (@fields) {
if ($settings->{$context}->{$role}->{$field}) {
$checks{$field} = ' checked="checked" ';
}
}
}
}
}
for (my $i=0; $i<@fields; $i++) {
my $rem = $i%($numinrow);
if ($rem == 0) {
if ($i > 0) {
$output .= '';
}
$output .= '
';
}
my $check = ' ';
if (exists($checks{$fields[$i]})) {
$check = $checks{$fields[$i]}
} else {
if ($role eq 'st') {
if (ref($settings) ne 'HASH') {
$check = ' checked="checked" ';
}
}
}
$output .= '
'.
'
';
$rem = @fields%($numinrow);
}
my $colsleft = $numinrow - $rem;
if ($colsleft > 1 ) {
$output .= '
'.
'
';
} elsif ($colsleft == 1) {
$output .= '
';
}
$output .= '
';
return $output;
}
sub insttypes_row {
my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle,$context) = @_;
my %lt = &Apache::lonlocal::texthash (
cansearch => 'Users allowed to search',
statustocreate => 'Institutional affiliation(s) able to create own account (login/SSO)',
);
my $showdom;
if ($context eq 'cansearch') {
$showdom = ' ('.$dom.')';
}
my $output = '
'.
'
'.$lt{$context}.$showdom.
'
';
my $rem;
if (ref($types) eq 'ARRAY') {
for (my $i=0; $i<@{$types}; $i++) {
if (defined($usertypes->{$types->[$i]})) {
my $rem = $i%($numinrow);
if ($rem == 0) {
if ($i > 0) {
$output .= '';
}
$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',
);
if (ref($domconfig{'login'}) eq 'HASH') {
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",
images => "Images",
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'} = {};
if (ref($domconfig{'rolecolors'}) ne 'HASH') {
if ($domconfig{'rolecolors'} eq '') {
$domconfig{'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;
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');
@bgs = ('pgbg','mainbg','sidebg');
} else {
@images = ('img');
@bgs = ('pgbg','tabbg','sidebg');
}
$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 (($role eq 'login') && (($img eq 'img') || ($img eq 'logo'))) {
if (defined($env{'form.login_showlogo_'.$img})) {
$confhash->{$role}{'showlogo'}{$img} = 1;
} else {
$confhash->{$role}{'showlogo'}{$img} = 0;
}
}
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 (($role eq 'login') && (($img eq 'logo') || ($img eq 'img'))) {
if (ref($domconfig->{'login'}{'showlogo'}) eq 'HASH') {
if ($confhash->{$role}{'showlogo'}{$img} ne
$domconfig->{$role}{'showlogo'}{$img}) {
$changes{$role}{'showlogo'}{$img} = 1;
}
} else {
if ($confhash->{$role}{'showlogo'}{$img} == 0) {
$changes{$role}{'showlogo'}{$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 ($role eq 'login') {
if ($confhash->{$role}{'showlogo'}{$img} == 0) {
$changes->{$role}{'showlogo'}{$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 (($role eq 'login') && ($key eq 'showlogo')) {
if ($confhash->{$role}{$key}{$item}) {
$resulttext .= '
'.&mt("$choices{$item} set to be displayed").'
';
} else {
$resulttext .= '
'.&mt("$choices{$item} set to not be displayed").'
';
} 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','lonstatusmail',
'requestsmail');
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';
$default{'lonstatusmail'} = 'adminemail';
$default{'requestsmail'} = 'adminemail';
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','requestcrs','selfcreate');
foreach my $item(@contexts) {
if ($item eq 'selfcreate') {
@{$cancreate{$item}} = &Apache::loncommon::get_env_multiple('form.can_createuser_'.$item);
my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
if (!((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth'))) {
if (ref($cancreate{$item}) eq 'ARRAY') {
if (grep(/^login$/,@{$cancreate{$item}})) {
$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.');
}
}
}
} else {
$cancreate{$item} = $env{'form.can_createuser_'.$item};
}
}
my ($othertitle,$usertypes,$types) =
&Apache::loncommon::sorted_inst_types($dom);
if (ref($types) eq 'ARRAY') {
if (@{$types} > 0) {
@{$cancreate{'statustocreate'}} =
&Apache::loncommon::get_env_multiple('form.statustocreate');
} else {
@{$cancreate{'statustocreate'}} = ();
}
push(@contexts,'statustocreate');
}
if (ref($curr_usercreation{'cancreate'}) eq 'HASH') {
foreach my $item (@contexts) {
if (($item eq 'selfcreate') || ($item eq 'statustocreate')) {
if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
foreach my $curr (@{$curr_usercreation{'cancreate'}{$item}}) {
if (ref($cancreate{$item}) eq 'ARRAY') {
if (!grep(/^$curr$/,@{$cancreate{$item}})) {
if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
push(@{$changes{'cancreate'}},$item);
}
}
}
}
} else {
if ($curr_usercreation{'cancreate'}{$item} eq '') {
if (@{$cancreate{$item}} > 0) {
if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
push(@{$changes{'cancreate'}},$item);
}
}
} else {
if ($curr_usercreation{'cancreate'}{$item} eq 'any') {
if (@{$cancreate{$item}} < 3) {
if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
push(@{$changes{'cancreate'}},$item);
}
}
} elsif ($curr_usercreation{'cancreate'}{$item} eq 'none') {
if (@{$cancreate{$item}} > 0) {
if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
push(@{$changes{'cancreate'}},$item);
}
}
} elsif (!grep(/^$curr_usercreation{'cancreate'}{$item}$/,@{$cancreate{$item}})) {
if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
push(@{$changes{'cancreate'}},$item);
}
}
}
}
if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
foreach my $type (@{$cancreate{$item}}) {
if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
if (!grep(/^$type$/,@{$curr_usercreation{'cancreate'}{$item}})) {
if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
push(@{$changes{'cancreate'}},$item);
}
}
} elsif (($curr_usercreation{'cancreate'}{$item} ne 'any') &&
($curr_usercreation{'cancreate'}{$item} ne 'none')) {
if ($curr_usercreation{'cancreate'}{$item} ne $type) {
if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
push(@{$changes{'cancreate'}},$item);
}
}
}
}
}
} else {
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);
my %selfcreatetypes = (
sso => 'users authenticated by institutional single sign on',
login => 'users authenticated by institutional log-in',
email => 'users who provide a valid e-mail address for use as the username',
);
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;
unless ($type eq 'statustocreate') {
$chgtext = $lt{$type}.', ';
}
if ($type eq 'selfcreate') {
if (@{$cancreate{$type}} == 0) {
$chgtext .= &mt('creation of a new user account is not permitted.');
} else {
$chgtext .= &mt('creation of a new account is permitted for:').'
';
foreach my $case (@{$cancreate{$type}}) {
$chgtext .= '
'.$selfcreatetypes{$case}.'
';
}
$chgtext .= '
';
if (ref($cancreate{$type}) eq 'ARRAY') {
if (grep(/^(login|sso)$/,@{$cancreate{$type}})) {
if (ref($cancreate{'statustocreate'}) eq 'ARRAY') {
if (@{$cancreate{'statustocreate'}} == 0) {
$chgtext .= ' '.&mt("However, no institutional affiliations (including 'other') are currently permitted to create accounts.").'';
}
}
}
}
}
} elsif ($type eq 'statustocreate') {
if ((ref($cancreate{'selfcreate'}) eq 'ARRAY') &&
(ref($cancreate{'statustocreate'}) eq 'ARRAY')) {
if (@{$cancreate{'selfcreate'}} > 0) {
if (@{$cancreate{'statustocreate'}} == 0) {
$chgtext .= &mt("Institutional affiliations permitted to create accounts set to 'None'.");
if (!grep(/^email$/,@{$cancreate{'selfcreate'}})) {
$chgtext .= ' '.&mt("However, no institutional affiliations (including 'other') are currently permitted to create accounts.").'';
}
} elsif (ref($usertypes) eq 'HASH') {
if (grep(/^(login|sso)$/,@{$cancreate{'selfcreate'}})) {
$chgtext .= &mt('Creation of a new account for an institutional user is restricted to the following institutional affiliation(s):');
} else {
$chgtext .= &mt('Institutional affiliations permitted to create accounts with institutional authentication were set as follows:');
}
$chgtext .= '
';
foreach my $case (@{$cancreate{$type}}) {
if ($case eq 'default') {
$chgtext .= '
'.$othertitle.'
';
} else {
$chgtext .= '
'.$usertypes->{$case}.'
';
}
}
$chgtext .= '
';
if (!grep(/^(login|sso)$/,@{$cancreate{'selfcreate'}})) {
$chgtext .= ' '.&mt('However, users authenticated by institutional login/single sign on are not currently permitted to create accounts.').'';
}
}
} else {
if (@{$cancreate{$type}} == 0) {
$chgtext .= &mt("Institutional affiliations permitted to create accounts were set to 'none'.");
} else {
$chgtext .= &mt('Although institutional affiliations permitted to create accounts were changed, self creation of accounts is not currently permitted for any authentication types.');
}
}
}
} 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','selfcreate');
my %context_title = (
author => 'In author context',
course => 'In course context',
selfcreate => 'When self creating account',
);
my @fields = ('lastname','firstname','middlename','generation',
'permanentemail','id');
my %roles = (
author => ['ca','aa'],
course => ['st','ep','ta','in','cr'],
);
my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
if (ref($types) eq 'ARRAY') {
push(@{$types},'default');
$usertypes->{'default'} = $othertitle;
}
$roles{'selfcreate'} = $types;
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 ($context eq 'selfcreate') {
$rolename = $role;
if (ref($usertypes) eq 'HASH') {
if ($usertypes->{$role} ne '') {
$rolename = $usertypes->{$role};
}
}
} else {
if ($role eq 'cr') {
$rolename = &mt('Custom');
} else {
$rolename = &Apache::lonnet::plaintext($role);
}
}
my @modifiable;
if ($context eq 'selfcreate') {
$resulttext .= '
'.&mt('Self-creation of account by users with status: [_1] ',$rolename).' - '.&mt('modifiable fields (if institutional data blank): ');
} else {
$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','timezone_def','datelocale_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 ($langcode ne 'x_chef') {
if (code2language($langcode) eq '') {
push(@errors,$item);
}
}
} else {
push(@errors,$item);
}
}
} elsif ($item eq 'timezone_def') {
if ($newvalues{$item} ne '') {
if (!DateTime::TimeZone->is_valid_name($newvalues{$item})) {
push(@errors,$item);
}
}
} elsif ($item eq 'datelocale_def') {
if ($newvalues{$item} ne '') {
my @datelocale_ids = DateTime::Locale->ids();
if (!grep(/^\Q$newvalues{$item}\E$/,@datelocale_ids)) {
push(@errors,$item);
}
}
}
if (grep(/^\Q$item\E$/,@errors)) {
$newvalues{$item} = $domdefaults{$item};
} elsif ($domdefaults{$item} ne $newvalues{$item}) {
$changes{$item} = 1;
}
$domdefaults{$item} = $newvalues{$item};
}
my %defaults_hash = (
defaults => \%newvalues,
);
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,\%domdefaults,$cachetime);
if ($changes{'auth_def'} || $changes{'auth_arg_def'} || $changes{'lang_def'} || $changes{'datelocale_def'}) {
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/timezone 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,%changes,$errors,
$cathash);
my @deletecategory = &Apache::loncommon::get_env_multiple('form.deletecategory');
if (ref($domconfig{'coursecategories'}) eq 'HASH') {
$cathash = $domconfig{'coursecategories'}{'cats'};
if ($domconfig{'coursecategories'}{'togglecats'} ne $env{'form.togglecats'}) {
$changes{'togglecats'} = 1;
$domconfig{'coursecategories'}{'togglecats'} = $env{'form.togglecats'};
}
if ($domconfig{'coursecategories'}{'categorize'} ne $env{'form.categorize'}) {
$changes{'categorize'} = 1;
$domconfig{'coursecategories'}{'categorize'} = $env{'form.categorize'};
}
} else {
$changes{'togglecats'} = 1;
$changes{'categorize'} = 1;
$domconfig{'coursecategories'} = {
togglecats => $env{'form.togglecats'},
categorize => $env{'form.categorize'},
};
}
if (ref($cathash) eq 'HASH') {
if (($domconfig{'coursecategories'}{'cats'}{'instcode::0'} ne '') && ($env{'form.instcode'} == 0)) {
push (@deletecategory,'instcode::0');
}
}
my (@predelcats,@predeltrails,%predelallitems,%sort_by_deltrail);
if (ref($cathash) eq 'HASH') {
if (@deletecategory > 0) {
#FIXME Need to remove category from all courses using a deleted category
&Apache::loncommon::extract_categories($cathash,\@predelcats,\@predeltrails,\%predelallitems);
foreach my $item (@deletecategory) {
if ($domconfig{'coursecategories'}{'cats'}{$item} ne '') {
delete($domconfig{'coursecategories'}{'cats'}{$item});
$deletions{$item} = 1;
&recurse_cat_deletes($item,$cathash,\%deletions);
}
}
}
foreach my $item (keys(%{$cathash})) {
my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
if ($cathash->{$item} ne $env{'form.'.$item}) {
$reorderings{$item} = 1;
$domconfig{'coursecategories'}{'cats'}{$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'}{'cats'}{$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'}{'cats'}{$newitem} = 0;
$adds{$newitem} = 1;
}
}
}
if ($env{'form.instcode'} eq '1') {
if (ref($cathash) eq 'HASH') {
my $newitem = 'instcode::0';
if ($cathash->{$newitem} eq '') {
$domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.instcode_pos'};
$adds{$newitem} = 1;
}
} else {
my $newitem = 'instcode::0';
$domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.instcode_pos'};
$adds{$newitem} = 1;
}
}
if ($env{'form.addcategory_name'} ne '') {
my $newitem = &escape($env{'form.addcategory_name'}).'::0';
$domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.addcategory_pos'};
$adds{$newitem} = 1;
}
my $putresult;
if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
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);
&Apache::loncommon::extract_categories($domconfig{'coursecategories'}{'cats'},\@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'}{'cats'}{$item} -= $chg;
}
$depth ++;
&recurse_check(\@chkcats,$domconfig{'coursecategories'}{'cats'},$depth,$name);
$depth --;
}
}
}
}
if ((keys(%changes) > 0) || (keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
$putresult = &Apache::lonnet::put_dom('configuration',\%domconfig,$dom);
if ($putresult eq 'ok') {
my %title = (
togglecats => 'Show/Hide a course in the catalog',
categorize => 'Category assigned to course',
);
my %level = (
dom => 'set from "Modify Course" (Domain)',
crs => 'set from "Parameters" (Course)',
);
$resulttext = &mt('Changes made:').'
'; } $resulttext .= '
';
}
} else {
if ($confhash->{$role}{$key} eq '') {
$resulttext .= '