version 1.26, 2007/09/01 21:20:14
|
version 1.29, 2007/09/19 17:36:47
|
Line 67 sub handler {
|
Line 67 sub handler {
|
} |
} |
my %domconfig = |
my %domconfig = |
&Apache::lonnet::get_dom('configuration',['login','rolecolors', |
&Apache::lonnet::get_dom('configuration',['login','rolecolors', |
'quotas','autoenroll','autoupdate','directorysrch'],$dom); |
'quotas','autoenroll','autoupdate','directorysrch', |
|
'usercreation','contacts'],$dom); |
my @prefs = ( |
my @prefs = ( |
{ text => 'Default color schemes', |
{ text => 'Default color schemes', |
help => 'Default_Color_Schemes', |
help => 'Default_Color_Schemes', |
Line 113 sub handler {
|
Line 114 sub handler {
|
header => [{col1 => 'Setting', |
header => [{col1 => 'Setting', |
col2 => 'Value',}], |
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',}, |
|
{col1 => 'Context', |
|
col2 => 'Assignable Authentication Types'}], |
|
}, |
); |
); |
my @roles = ('student','coordinator','author','admin'); |
my @roles = ('student','coordinator','author','admin'); |
&Apache::lonhtmlcommon::add_breadcrumb |
&Apache::lonhtmlcommon::add_breadcrumb |
Line 141 sub handler {
|
Line 157 sub handler {
|
&print_header($r,$phase); |
&print_header($r,$phase); |
if (keys(%domconfig) == 0) { |
if (keys(%domconfig) == 0) { |
my $primarylibserv = &Apache::lonnet::domain($dom,'primary'); |
my $primarylibserv = &Apache::lonnet::domain($dom,'primary'); |
my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf'); |
my @ids=&Apache::lonnet::current_machine_ids(); |
my $hostid = $perlvarref->{'lonHostID'}; |
if (!grep(/^\Q$primarylibserv\E$/,@ids)) { |
if ($hostid ne $primarylibserv) { |
|
my %designhash = &Apache::loncommon::get_domainconf($dom); |
my %designhash = &Apache::loncommon::get_domainconf($dom); |
my @loginimages = ('img','logo','domlogo'); |
my @loginimages = ('img','logo','domlogo'); |
my $custom_img_count = 0; |
my $custom_img_count = 0; |
Line 159 sub handler {
|
Line 174 sub handler {
|
} |
} |
if ($custom_img_count > 0) { |
if ($custom_img_count > 0) { |
my $switch_server = &check_switchserver($dom,$confname); |
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.').'<br />'.&mt("While this remains so, you must switch to the domain's primary library server in order to update settings.").'<br /><br />'.&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.").'<br /><br />'.$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.').'<br />'. |
|
&mt("While this remains so, you must switch to the domain's primary library server in order to update settings.").'<br /><br />'. |
|
&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.").'<br />'. |
|
&mt("However, you will still need to switch to the domain's primary library server to upload new images or logos.").'<br /><br />'); |
|
if ($switch_server) { |
|
$r->print($switch_server.' '.&mt('to primary library server for domain: [_1]',$dom)); |
|
} |
return OK; |
return OK; |
} |
} |
} |
} |
Line 197 sub process_changes {
|
Line 219 sub process_changes {
|
$output = &modify_autoupdate($dom,%domconfig); |
$output = &modify_autoupdate($dom,%domconfig); |
} elsif ($action eq 'directorysrch') { |
} elsif ($action eq 'directorysrch') { |
$output = &modify_directorysrch($dom,%domconfig); |
$output = &modify_directorysrch($dom,%domconfig); |
|
} elsif ($action eq 'usercreation') { |
|
$output = &modify_usercreation($dom,%domconfig); |
|
} elsif ($action eq 'contacts') { |
|
$output = &modify_contacts($dom,%domconfig); |
} |
} |
return $output; |
return $output; |
} |
} |
Line 212 sub print_config_box {
|
Line 238 sub print_config_box {
|
# <th>'.&mt($item->{text}).' '. |
# <th>'.&mt($item->{text}).' '. |
# &Apache::loncommon::help_open_topic($item->{'help'}).'</th> |
# &Apache::loncommon::help_open_topic($item->{'help'}).'</th> |
# </tr>'); |
# </tr>'); |
if (($action eq 'autoupdate') || ($action eq 'rolecolors')) { |
if (($action eq 'autoupdate') || ($action eq 'rolecolors') || |
|
($action eq 'usercreation')) { |
my $colspan = ($action eq 'rolecolors')?' colspan="2"':''; |
my $colspan = ($action eq 'rolecolors')?' colspan="2"':''; |
$r->print(' |
$r->print(' |
<tr> |
<tr> |
Line 224 sub print_config_box {
|
Line 251 sub print_config_box {
|
</tr>'); |
</tr>'); |
if ($action eq 'autoupdate') { |
if ($action eq 'autoupdate') { |
$r->print(&print_autoupdate('top',$dom,$settings)); |
$r->print(&print_autoupdate('top',$dom,$settings)); |
|
} elsif ($action eq 'usercreation') { |
|
$r->print(&print_usercreation('top',$dom,$settings)); |
} else { |
} else { |
$r->print(&print_rolecolors($phase,'student',$dom,$confname,$settings)); |
$r->print(&print_rolecolors($phase,'student',$dom,$confname,$settings)); |
} |
} |
Line 240 sub print_config_box {
|
Line 269 sub print_config_box {
|
</tr>'); |
</tr>'); |
if ($action eq 'autoupdate') { |
if ($action eq 'autoupdate') { |
$r->print(&print_autoupdate('bottom',$dom,$settings)); |
$r->print(&print_autoupdate('bottom',$dom,$settings)); |
|
} elsif ($action eq 'usercreation') { |
|
$r->print(&print_usercreation('bottom',$dom,$settings)); |
} else { |
} else { |
$r->print(&print_rolecolors($phase,'coordinator',$dom,$confname,$settings).' |
$r->print(&print_rolecolors($phase,'coordinator',$dom,$confname,$settings).' |
</table> |
</table> |
Line 282 sub print_config_box {
|
Line 313 sub print_config_box {
|
<td class="LC_right_item">'.$item->{'header'}->[0]->{'col2'}.'</td> |
<td class="LC_right_item">'.$item->{'header'}->[0]->{'col2'}.'</td> |
</tr>'); |
</tr>'); |
if ($action eq 'login') { |
if ($action eq 'login') { |
$r->print(&print_login($dom,$confname,$phase,$settings)); |
$r->print(&print_login($dom,$confname,$phase,$settings)); |
} elsif ($action eq 'quotas') { |
} elsif ($action eq 'quotas') { |
$r->print(&print_quotas($dom,$settings)); |
$r->print(&print_quotas($dom,$settings)); |
} elsif ($action eq 'autoenroll') { |
} elsif ($action eq 'autoenroll') { |
$r->print(&print_autoenroll($dom,$settings)); |
$r->print(&print_autoenroll($dom,$settings)); |
} elsif ($action eq 'directorysrch') { |
} elsif ($action eq 'directorysrch') { |
$r->print(&print_directorysrch($dom,$settings)); |
$r->print(&print_directorysrch($dom,$settings)); |
} |
} elsif ($action eq 'contacts') { |
|
$r->print(&print_contacts($dom,$settings)); |
|
} |
} |
} |
$r->print(' |
$r->print(' |
</table> |
</table> |
Line 1000 sub print_directorysrch {
|
Line 1033 sub print_directorysrch {
|
return $datatable; |
return $datatable; |
} |
} |
|
|
|
sub print_contacts { |
|
my ($dom,$settings) = @_; |
|
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') { |
|
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 ($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 .= '<tr'.$css_class.' ">'. |
|
'<td>'.$titles->{$item}.'</td>'. |
|
'<td class="LC_right_item">'. |
|
'<input type="text" name="'.$item.'" value="'. |
|
$to{$item}.'" /></td></tr>'; |
|
$rownum ++; |
|
} |
|
foreach my $type (@mailings) { |
|
if ($rownum%2) { |
|
$css_class = ''; |
|
} else { |
|
$css_class = ' class="LC_odd_row" '; |
|
} |
|
$datatable .= '<tr'.$css_class.'>'. |
|
'<td>'.$titles->{$type}.': </td>'. |
|
'<td class="LC_left_item">'. |
|
'<span class="LC_nobreak">'; |
|
foreach my $item (@contacts) { |
|
$datatable .= '<label>'. |
|
'<input type="checkbox" name="'.$type.'"'. |
|
$checked{$type}{$item}. |
|
' value="'.$item.'" />'.$short_titles->{$item}. |
|
'</label> '; |
|
} |
|
$datatable .= '</span><br />'.&mt('Others').': '. |
|
'<input type="text" name="'.$type.'_others" '. |
|
'value="'.$otheremails{$type}.'" />'. |
|
'</td></tr>'."\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 = '<tr class="LC_odd_row">'. |
|
'<td>'.$lt{'nondc'}.'</td>'. |
|
'<td class="LC_left_item"><table>'; |
|
foreach my $item ('author','course') { |
|
$datatable .= '<tr><td><span class="LC_nobreak"><label>'. |
|
'<input type="checkbox" name="can_createuser" '. |
|
$checked{$item}.' value="'.$item.'" />'. |
|
$lt{$item}.'</label><span></td></tr>'; |
|
} |
|
$datatable .= '</table></td></tr>'; |
|
$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 .= '<tr'.$css_class.'">'. |
|
'<td>'.$title{$item}. |
|
'</td><td class="LC_left_item">'. |
|
'<span class="LC_nobreak">'; |
|
foreach my $auth (@authtypes) { |
|
$datatable .= '<label>'. |
|
'<input type="checkbox" name="'.$item.'_auth" '. |
|
$checked{$item}{$auth}.' value="'.$auth.'" />'. |
|
$authname{$auth}.'</label> '; |
|
} |
|
$datatable .= '</span></td></tr>'; |
|
$rownum ++; |
|
} |
|
} |
|
return $datatable; |
|
} |
|
|
|
sub username_formats_row { |
|
my ($settings,$rules,$ruleorder,$numinrow) = @_; |
|
my $output = '<tr>'. |
|
'<td>'.&mt('Format rules to check for new usernames: '). |
|
'</td><td class="LC_left_item" colspan="2"><table>'; |
|
my $rem; |
|
if (ref($ruleorder) eq 'ARRAY') { |
|
for (my $i=0; $i<@{$ruleorder}; $i++) { |
|
if (ref($rules->{$ruleorder->[$i]}) eq 'HASH') { |
|
my $rem = $i%($numinrow); |
|
if ($rem == 0) { |
|
if ($i > 0) { |
|
$output .= '</tr>'; |
|
} |
|
$output .= '<tr>'; |
|
} |
|
my $check = ' '; |
|
if (ref($settings->{'username_rule'}) eq 'ARRAY') { |
|
if (grep(/^\Q$ruleorder->[$i]\E$/,@{$settings->{'username_rule'}})) { |
|
$check = ' checked="checked" '; |
|
} |
|
} |
|
$output .= '<td class="LC_left_item">'. |
|
'<span class="LC_nobreak"><label>'. |
|
'<input type="checkbox" name="username_rule" '. |
|
'value="'.$ruleorder->[$i].'"'.$check.'/>'. |
|
$rules->{$ruleorder->[$i]}{'name'}.'</label></span></td>'; |
|
} |
|
} |
|
$rem = @{$ruleorder}%($numinrow); |
|
} |
|
my $colsleft = $numinrow - $rem; |
|
if ($colsleft > 1 ) { |
|
$output .= '<td colspan="'.$colsleft.'" class="LC_left_item">'. |
|
' </td>'; |
|
} elsif ($colsleft == 1) { |
|
$output .= '<td class="LC_left_item"> </td>'; |
|
} |
|
$output .= '</tr></table></td></tr>'; |
|
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 { |
sub users_cansearch_row { |
my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle) = @_; |
my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle) = @_; |
my $output = '<tr class="LC_odd_row">'. |
my $output = '<tr class="LC_odd_row">'. |
Line 2156 sub modify_directorysrch {
|
Line 2425 sub modify_directorysrch {
|
} |
} |
} else { |
} else { |
$resulttext = '<span class="LC_error">'. |
$resulttext = '<span class="LC_error">'. |
|
&mt('An error occurred: [_1]',$putresult).'</span>'; |
|
} |
|
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:').'<ul>'; |
|
foreach my $item (@contacts) { |
|
if ($changes{$item}) { |
|
$resulttext .= '<li>'.$titles->{$item}. |
|
&mt(' set to: '). |
|
'<span class="LC_cusr_emph">'. |
|
$to{$item}.'</span></li>'; |
|
} |
|
} |
|
foreach my $type (@mailings) { |
|
if (ref($changes{$type}) eq 'ARRAY') { |
|
$resulttext .= '<li>'.$titles->{$type}.': '; |
|
my @text; |
|
foreach my $item (@{$newsetting{$type}}) { |
|
push(@text,$short_titles->{$item}); |
|
} |
|
if ($others{$type} ne '') { |
|
push(@text,$others{$type}); |
|
} |
|
$resulttext .= '<span class="LC_cusr_emph">'. |
|
join(', ',@text).'</span></li>'; |
|
} |
|
} |
|
$resulttext .= '</ul>'; |
|
} else { |
|
$resulttext = &mt('No changes made to contact information.'); |
|
} |
|
} else { |
|
$resulttext = '<span class="LC_error">'. |
|
&mt('An error occurred: [_1].',$putresult).'</span>'; |
|
} |
|
return $resulttext; |
|
} |
|
|
|
sub modify_usercreation { |
|
my ($dom,%domconfig) = @_; |
|
my ($resulttext,%curr_usercreation,%changes,%authallowed); |
|
if (ref($domconfig{'usercreation'}) eq 'HASH') { |
|
foreach my $key (keys(%{$domconfig{'usercreation'}})) { |
|
$curr_usercreation{$key} = $domconfig{'usercreation'}{$key}; |
|
} |
|
} |
|
my %title = &Apache::lonlocal::texthash ( |
|
author => 'adding co-authors/assistant authors', |
|
course => 'adding users to a course', |
|
); |
|
my @username_rule = &Apache::loncommon::get_env_multiple('form.username_rule'); |
|
my @cancreate = &Apache::loncommon::get_env_multiple('form.can_createuser'); |
|
if (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') { |
|
foreach my $type (@{$curr_usercreation{'cancreate'}}) { |
|
if (!grep(/^\Q$type\E$/,@cancreate)) { |
|
push(@{$changes{'cancreate'}},$type); |
|
} |
|
} |
|
foreach my $type (@cancreate) { |
|
if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'cancreate'}})) { |
|
push(@{$changes{'cancreate'}},$type); |
|
} |
|
} |
|
} else { |
|
push(@{$changes{'cancreate'}},@cancreate); |
|
} |
|
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); |
|
} |
|
|
|
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 => { |
|
cancreate => \@cancreate, |
|
username_rule => \@username_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:').'<ul>'; |
|
if (ref($changes{'cancreate'}) eq 'ARRAY') { |
|
my $chgtext = '<ul>'; |
|
foreach my $type (@cancreate) { |
|
$chgtext .= '<li>'.$title{$type}.'</li>'; |
|
} |
|
$chgtext .= '</ul>'; |
|
if (@cancreate > 0) { |
|
$resulttext .= '<li>'.&mt('Creation of new users is permitted by a Domain Coordinator, and also by other users when: ').$chgtext.'</li>'; |
|
} else { |
|
$resulttext .= '<li>'.&mt("Creation of new users is now only allowed when the user's role is Domain Coordinator.").'</li>'; |
|
} |
|
} |
|
if (ref($changes{'username_rule'}) eq 'ARRAY') { |
|
my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom); |
|
my $chgtext = '<ul>'; |
|
foreach my $type (@username_rule) { |
|
if (ref($rules->{$type}) eq 'HASH') { |
|
$chgtext .= '<li>'.$rules->{$type}{'name'}.'</li>'; |
|
} |
|
} |
|
$chgtext .= '</ul>'; |
|
if (@username_rule > 0) { |
|
$resulttext .= '<li>'.&mt('Usernames with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'</li>'; |
|
} else { |
|
$resulttext .= '<li>'.&mt('There are now no username formats restricted to verified users in the institutional directory.').'</li>'; |
|
} |
|
} |
|
my %authname = &authtype_names(); |
|
my %context_title = &context_names(); |
|
if (ref($changes{'authtypes'}) eq 'ARRAY') { |
|
my @unchanged; |
|
my $chgtext = '<ul>'; |
|
foreach my $type (@{$changes{'authtypes'}}) { |
|
my @allowed; |
|
$chgtext .= '<li><span class="LC_cusr_emph">'.$context_title{$type}.'</span> - '.&mt('assignable authentication types: '); |
|
foreach my $auth (@authtypes) { |
|
if ($authhash{$type}{$auth}) { |
|
push(@allowed,$authname{$auth}); |
|
} |
|
} |
|
$chgtext .= join(', ',@allowed).'</li>'; |
|
} |
|
$chgtext .= '</ul>'; |
|
$resulttext .= '<li>'.&mt('Authentication types available for assignment to new users').'<br />'.$chgtext; |
|
$resulttext .= '</li>'; |
|
} |
|
$resulttext .= '</ul>'; |
|
} else { |
|
$resulttext = &mt('No changes made to user creation settings'); |
|
} |
|
} else { |
|
$resulttext = '<span class="LC_error">'. |
&mt('An error occurred: [_1]',$putresult).'</span>'; |
&mt('An error occurred: [_1]',$putresult).'</span>'; |
} |
} |
return $resulttext; |
return $resulttext; |