--- loncom/interface/domainprefs.pm 2007/09/12 12:01:04 1.27
+++ loncom/interface/domainprefs.pm 2007/09/16 17:26:56 1.28
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
-# $Id: domainprefs.pm,v 1.27 2007/09/12 12:01:04 raeburn Exp $
+# $Id: domainprefs.pm,v 1.28 2007/09/16 17:26:56 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -68,7 +68,7 @@ sub handler {
my %domconfig =
&Apache::lonnet::get_dom('configuration',['login','rolecolors',
'quotas','autoenroll','autoupdate','directorysrch',
- 'usercreation'],$dom);
+ 'usercreation','contacts'],$dom);
my @prefs = (
{ text => 'Default color schemes',
help => 'Default_Color_Schemes',
@@ -114,11 +114,20 @@ sub handler {
header => [{col1 => 'Setting',
col2 => 'Value',}],
},
+ { text => 'Contact Information',
+ help => 'Domain_Contact_Information',
+ action => 'contacts',
+ header => [{col1 => 'Setting',
+ col2 => 'Value',}],
+ },
+
{ text => 'User creation',
help => 'Domain_User_Creation',
action => 'usercreation',
header => [{col1 => 'Setting',
- col2 => 'Value',}],
+ col2 => 'Value',},
+ {col1 => 'Context',
+ col2 => 'Assignable Authentication Types'}],
},
);
my @roles = ('student','coordinator','author','admin');
@@ -166,7 +175,7 @@ sub handler {
}
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, you will be able to update settings from this screen when logged in to any server in the LON-CAPA network (with a DC role selected in the domain), although you will still need to switch to the domain's primary library server to upload new images or logos.").' '.$switch_server.' '.&mt('to primary library server for domain: [_1]',$dom));
+ $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, you will be able to update settings from this screen when logged in to any server in the LON-CAPA network (with a Domain Coordinator role selected in the domain), although you will still need to switch to the domain's primary library server to upload new images or logos.").' '.$switch_server.' '.&mt('to primary library server for domain: [_1]',$dom));
return OK;
}
}
@@ -205,7 +214,9 @@ sub process_changes {
} elsif ($action eq 'directorysrch') {
$output = &modify_directorysrch($dom,%domconfig);
} elsif ($action eq 'usercreation') {
- $output = &modify_user_creation($dom,%domconfig);
+ $output = &modify_usercreation($dom,%domconfig);
+ } elsif ($action eq 'contacts') {
+ $output = &modify_contacts($dom,%domconfig);
}
return $output;
}
@@ -221,7 +232,8 @@ sub print_config_box {
#
'.&mt($item->{text}).' '.
# &Apache::loncommon::help_open_topic($item->{'help'}).'
# ');
- if (($action eq 'autoupdate') || ($action eq 'rolecolors')) {
+ if (($action eq 'autoupdate') || ($action eq 'rolecolors') ||
+ ($action eq 'usercreation')) {
my $colspan = ($action eq 'rolecolors')?' colspan="2"':'';
$r->print('
@@ -233,6 +245,8 @@ sub print_config_box {
');
if ($action eq 'autoupdate') {
$r->print(&print_autoupdate('top',$dom,$settings));
+ } elsif ($action eq 'usercreation') {
+ $r->print(&print_usercreation('top',$dom,$settings));
} else {
$r->print(&print_rolecolors($phase,'student',$dom,$confname,$settings));
}
@@ -249,6 +263,8 @@ sub print_config_box {
');
if ($action eq 'autoupdate') {
$r->print(&print_autoupdate('bottom',$dom,$settings));
+ } elsif ($action eq 'usercreation') {
+ $r->print(&print_usercreation('bottom',$dom,$settings));
} else {
$r->print(&print_rolecolors($phase,'coordinator',$dom,$confname,$settings).'
@@ -291,15 +307,15 @@ sub print_config_box {
'.$item->{'header'}->[0]->{'col2'}.'
');
if ($action eq 'login') {
- $r->print(&print_login($dom,$confname,$phase,$settings));
+ $r->print(&print_login($dom,$confname,$phase,$settings));
} elsif ($action eq 'quotas') {
- $r->print(&print_quotas($dom,$settings));
+ $r->print(&print_quotas($dom,$settings));
} elsif ($action eq 'autoenroll') {
- $r->print(&print_autoenroll($dom,$settings));
+ $r->print(&print_autoenroll($dom,$settings));
} elsif ($action eq 'directorysrch') {
- $r->print(&print_directorysrch($dom,$settings));
- } elsif ($action eq 'usercreation') {
- $r->print(&print_usercreation($dom,$settings));
+ $r->print(&print_directorysrch($dom,$settings));
+ } elsif ($action eq 'contacts') {
+ $r->print(&print_contacts($dom,$settings));
}
}
$r->print('
@@ -1011,35 +1027,175 @@ sub print_directorysrch {
return $datatable;
}
-sub print_usercreation {
+sub print_contacts {
my ($dom,$settings) = @_;
- my $numinrow = 4;
- my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom);
- my %checked;
+ my $datatable;
+ my @contacts = ('adminemail','supportemail');
+ my (%checked,%to,%otheremails);
+ my @mailings = ('errormail','packagesmail','helpdeskmail');
+ foreach my $type (@mailings) {
+ $otheremails{$type} = '';
+ }
if (ref($settings) eq 'HASH') {
- if (ref($settings->{'cancreate'}) eq 'ARRAY') {
- foreach my $item (@{$settings->{'cancreate'}}) {
- $checked{$item} = ' checked="checked" ';
+ foreach my $item (@contacts) {
+ if (exists($settings->{$item})) {
+ $to{$item} = $settings->{$item};
}
}
+ foreach my $type (@mailings) {
+ if (exists($settings->{$type})) {
+ if (ref($settings->{$type}) eq 'HASH') {
+ foreach my $item (@contacts) {
+ if ($settings->{$type}{$item}) {
+ $checked{$type}{$item} = ' checked="checked" ';
+ }
+ }
+ $otheremails{$type} = $settings->{$type}{'others'};
+ }
+ }
+ }
+ } else {
+ $to{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'};
+ $to{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'};
+ $checked{'errormail'}{'adminemail'} = ' checked="checked" ';
+ $checked{'packagesmail'}{'adminemail'} = ' checked="checked" ';
+ $checked{'helpdeskmail'}{'supportemail'} = ' checked="checked" ';
}
- my $datatable = ''.&mt('User creation other than by DC: ').' '.
- ' ';
- if (ref($rules) eq 'HASH') {
- if (keys(%{$rules}) > 0) {
- $datatable .= &username_formats_row($settings,$rules,$ruleorder,
- $numinrow);
+ my ($titles,$short_titles) = &contact_titles();
+ my $rownum = 0;
+ my $css_class;
+ foreach my $item (@contacts) {
+ if ($rownum%2) {
+ $css_class = '';
+ } else {
+ $css_class = ' class="LC_odd_row" ';
+ }
+ $datatable .= ''.
+ ''.$titles->{$item}.' '.
+ ''.
+ ' ';
+ $rownum ++;
+ }
+ foreach my $type (@mailings) {
+ if ($rownum%2) {
+ $css_class = '';
+ } else {
+ $css_class = ' class="LC_odd_row" ';
+ }
+ $datatable .= ''.
+ ''.$titles->{$type}.': '.
+ ''.
+ '';
+ foreach my $item (@contacts) {
+ $datatable .= ''.
+ ' '.$short_titles->{$item}.
+ ' ';
+ }
+ $datatable .= ' '.&mt('Others').': '.
+ ' '.
+ ' '."\n";
+ $rownum ++;
+ }
+ return $datatable;
+}
+
+sub contact_titles {
+ my %titles = &Apache::lonlocal::texthash (
+ 'supportemail' => 'Support E-mail address',
+ 'adminemail' => 'Default Server Admin E-mail address',
+ 'errormail' => 'Error reports to be e-mailed to',
+ 'packagesmail' => 'Package update alerts to be e-mailed to',
+ 'helpdeskmail' => 'Helpdesk requests to be e-mailed to'
+ );
+ my %short_titles = &Apache::lonlocal::texthash (
+ adminemail => 'Admin E-mail address',
+ supportemail => 'Support E-mail',
+ );
+ return (\%titles,\%short_titles);
+}
+
+sub print_usercreation {
+ my ($position,$dom,$settings) = @_;
+ my $numinrow = 4;
+ my $rowcount = 0;
+ my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom);
+ my $datatable;
+ my %lt = &Apache::lonlocal::texthash (
+ nondc => 'User creation other than by Domain Coordinator: ',
+ author => 'When adding a co-author/assistant author',
+ course => 'When adding users to a course',
+ );
+ if ($position eq 'top') {
+ my %checked;
+ if (ref($settings) eq 'HASH') {
+ if (ref($settings->{'cancreate'}) eq 'ARRAY') {
+ foreach my $item (@{$settings->{'cancreate'}}) {
+ $checked{$item} = ' checked="checked" ';
+ }
+ }
+ }
+ $datatable = ''.
+ ''.$lt{'nondc'}.' '.
+ ' ';
+ $rowcount ++;
+ if (ref($rules) eq 'HASH') {
+ if (keys(%{$rules}) > 0) {
+ $datatable .= &username_formats_row($settings,$rules,
+ $ruleorder,$numinrow);
+ $rowcount ++;
+ }
+ }
+ } else {
+ my @contexts = ('author','course','domain');
+ my @authtypes = ('int','krb4','krb5','loc');
+ my %checked;
+ if (ref($settings) eq 'HASH') {
+ if (ref($settings->{'authtypes'}) eq 'HASH') {
+ foreach my $item (@contexts) {
+ if (ref($settings->{'authtypes'}{$item}) eq 'HASH') {
+ foreach my $auth (@authtypes) {
+ if ($settings->{'authtypes'}{$item}{$auth}) {
+ $checked{$item}{$auth} = ' checked="checked" ';
+ }
+ }
+ }
+ }
+ }
+ }
+ my @authtypes = ('int','krb4','krb5','loc');
+ my %title = &context_names();
+ my %authname = &authtype_names();
+ my $rownum = 0;
+ my $css_class;
+ foreach my $item (@contexts) {
+ if ($rownum%2) {
+ $css_class = '';
+ } else {
+ $css_class = ' class="LC_odd_row" ';
+ }
+ $datatable .= ''.
+ ''.$title{$item}.
+ ' '.
+ '';
+ foreach my $auth (@authtypes) {
+ $datatable .= ''.
+ ' '.
+ $authname{$auth}.' ';
+ }
+ $datatable .= ' ';
+ $rownum ++;
}
}
return $datatable;
@@ -1047,8 +1203,8 @@ sub print_usercreation {
sub username_formats_row {
my ($settings,$rules,$ruleorder,$numinrow) = @_;
- my $output = ''.
- ''.&mt('Format rules to check for new usernames').
+ my $output = ' '.
+ ''.&mt('Format rules to check for new usernames: ').
' ';
my $rem;
if (ref($ruleorder) eq 'ARRAY') {
@@ -1087,6 +1243,26 @@ sub username_formats_row {
return $output;
}
+sub authtype_names {
+ my %lt = &Apache::lonlocal::texthash(
+ int => 'Internal',
+ krb4 => 'Kerberos 4',
+ krb5 => 'Kerberos 5',
+ loc => 'Local',
+ );
+ return %lt;
+}
+
+sub context_names {
+ my %context_title = &Apache::lonlocal::texthash(
+ author => 'Creating users when an Author',
+ course => 'Creating users when in a course',
+ domain => 'Creating users when a Domain Coordinator',
+ );
+ return %context_title;
+}
+
+
sub users_cansearch_row {
my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle) = @_;
my $output = ''.
@@ -2248,9 +2424,118 @@ sub modify_directorysrch {
return $resulttext;
}
-sub modify_user_creation {
+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);
+ my ($resulttext,%curr_usercreation,%changes,%authallowed);
if (ref($domconfig{'usercreation'}) eq 'HASH') {
foreach my $key (keys(%{$domconfig{'usercreation'}})) {
$curr_usercreation{$key} = $domconfig{'usercreation'}{$key};
@@ -2291,10 +2576,41 @@ sub modify_user_creation {
push(@{$changes{'username_rule'}},@username_rule);
}
+ my @contexts = ('author','course','domain');
+ my @authtypes = ('int','krb4','krb5','loc');
+ my %authhash;
+ foreach my $item (@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 (@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 (@contexts) {
+ push(@{$changes{'authtypes'}},$item);
+ }
+ }
+
my %usercreation_hash = (
- usercreation => {
+ usercreation => {
cancreate => \@cancreate,
username_rule => \@username_rule,
+ authtypes => \%authhash,
}
);
@@ -2303,7 +2619,6 @@ sub modify_user_creation {
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
$resulttext = &mt('Changes made:').'';
- my $chgtext;
if (ref($changes{'cancreate'}) eq 'ARRAY') {
my $chgtext = '';
foreach my $type (@cancreate) {
@@ -2328,12 +2643,31 @@ sub modify_user_creation {
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 currenty restricted to verified users in the institutional directory.').' ';
+ $resulttext .= ''.&mt('There are now no username formats restricted to verified users in the institutional directory.').' ';
}
}
+ my %authname = &authtype_names();
+ my %context_title = &context_names();
+ if (ref($changes{'authtypes'}) eq 'ARRAY') {
+ my @unchanged;
+ 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});
+ }
+ }
+ $chgtext .= join(', ',@allowed).' ';
+ }
+ $chgtext .= ' ';
+ $resulttext .= ''.&mt('Authentication types available for assignment to new users').' '.$chgtext;
+ $resulttext .= ' ';
+ }
$resulttext .= ' ';
} else {
- $resulttext = &mt('No changes made to log-in page settings');
+ $resulttext = &mt('No changes made to user creation settings');
}
} else {
$resulttext = ''.