--- loncom/interface/domainprefs.pm 2007/07/25 20:12:26 1.23 +++ loncom/interface/domainprefs.pm 2007/09/19 17:36:47 1.29 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.23 2007/07/25 20:12:26 raeburn Exp $ +# $Id: domainprefs.pm,v 1.29 2007/09/19 17:36:47 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -67,7 +67,8 @@ sub handler { } my %domconfig = &Apache::lonnet::get_dom('configuration',['login','rolecolors', - 'quotas','autoenroll','autoupdate','directorysrch'],$dom); + 'quotas','autoenroll','autoupdate','directorysrch', + 'usercreation','contacts'],$dom); my @prefs = ( { text => 'Default color schemes', help => 'Default_Color_Schemes', @@ -113,6 +114,21 @@ 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',}, + {col1 => 'Context', + col2 => 'Assignable Authentication Types'}], + }, ); my @roles = ('student','coordinator','author','admin'); &Apache::lonhtmlcommon::add_breadcrumb @@ -141,9 +157,8 @@ sub handler { &print_header($r,$phase); if (keys(%domconfig) == 0) { my $primarylibserv = &Apache::lonnet::domain($dom,'primary'); - my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf'); - my $hostid = $perlvarref->{'lonHostID'}; - if ($hostid ne $primarylibserv) { + 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'); my $custom_img_count = 0; @@ -159,7 +174,14 @@ 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, (with a Domain Coordinator role selected in the domain) you will be able to update settings when logged in to any server in the LON-CAPA network.").'
'. + &mt("However, you will still need to switch to the domain's primary library server to upload new images or logos.").'

'); + if ($switch_server) { + $r->print($switch_server.' '.&mt('to primary library server for domain: [_1]',$dom)); + } return OK; } } @@ -197,6 +219,10 @@ sub process_changes { $output = &modify_autoupdate($dom,%domconfig); } elsif ($action eq 'directorysrch') { $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; } @@ -212,7 +238,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(' @@ -224,6 +251,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)); } @@ -240,6 +269,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).' @@ -271,7 +302,7 @@ sub print_config_box { '); - if ($action eq 'login') { + if (($action eq 'login') || ($action eq 'directorysrch')) { $r->print(' '); } else { @@ -282,14 +313,16 @@ sub print_config_box { '); 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)); - } + $r->print(&print_directorysrch($dom,$settings)); + } elsif ($action eq 'contacts') { + $r->print(&print_contacts($dom,$settings)); + } } $r->print('
'.$item->{'header'}->[0]->{'col1'}.''.$item->{'header'}->[0]->{'col2'}.'
@@ -745,7 +778,7 @@ sub print_quotas { my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my $typecount = 0; my $css_class; - if (@{$types} > 0) { + if (ref($types) eq 'ARRAY') { foreach my $type (@{$types}) { if (defined($usertypes->{$type})) { $typecount ++; @@ -768,7 +801,7 @@ sub print_quotas { $typecount ++; $css_class = $typecount%2?' class="LC_odd_row"':''; $datatable .= ''. - ''.&mt($othertitle).''. + ''.$othertitle.''. ''. ' Mb'; @@ -878,10 +911,12 @@ sub print_autoupdate { gen => 'Generation', ); my $numrows = 0; - if (@{$types} > 0) { - $datatable = - &usertype_update_row($settings,$usertypes,\%fieldtitles, - \@fields,$types,\$numrows); + if (ref($types) eq 'ARRAY') { + if (@{$types} > 0) { + $datatable = + &usertype_update_row($settings,$usertypes,\%fieldtitles, + \@fields,$types,\$numrows); + } } $datatable .= &usertype_update_row($settings,{'default' => $othertitle}, @@ -895,92 +930,73 @@ sub print_directorysrch { my ($dom,$settings) = @_; my $srchon = ' '; my $srchoff = ' checked="checked" '; - my $exacton = ''; - my $containson = ' checked="checked" '; - my $specifyon = ''; + my ($exacton,$containson,$beginson); + my $localon = ' '; + my $localoff = ' checked="checked" '; if (ref($settings) eq 'HASH') { if ($settings->{'available'} eq '1') { $srchon = $srchoff; $srchoff = ' '; } - if ($settings->{'searchtypes'} eq 'exact') { - $exacton = $containson; - $containson = ' '; - } - if ($settings->{'searchtypes'} eq 'specify') { - $specifyon = $containson; - $containson = ' '; + if ($settings->{'localonly'} eq '1') { + $localon = $localoff; + $localoff = ' '; + } + if (ref($settings->{'searchtypes'}) eq 'ARRAY') { + foreach my $type (@{$settings->{'searchtypes'}}) { + if ($type eq 'exact') { + $exacton = ' checked="checked" '; + } elsif ($type eq 'contains') { + $containson = ' checked="checked" '; + } elsif ($type eq 'begins') { + $beginson = ' checked="checked" '; + } + } + } else { + if ($settings->{'searchtypes'} eq 'exact') { + $exacton = ' checked="checked" '; + } elsif ($settings->{'searchtypes'} eq 'contains') { + $containson = ' checked="checked" '; + } elsif ($settings->{'searchtypes'} eq 'specify') { + $exacton = ' checked="checked" '; + $containson = ' checked="checked" '; + } } } my ($searchtitles,$titleorder) = &sorted_searchtitles(); my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my $numinrow = 4; + my $cansrchrow = 0; my $datatable=''. - ''.&mt('Directory search available?').''. + ''.&mt('Directory search available?').''. ' '. ''. ''. - ''.&mt('Search latitude').''. + ''.&mt('Other domains can search?').''. ' '. - ''. - ' '. - ''. - ''.&mt('Users permitted to search'). - ''; - for (my $i=0; $i<@{$types}; $i++) { - if (defined($usertypes->{$types->[$i]})) { - my $rem = $i%($numinrow); - if ($rem == 0) { - if ($i > 0) { - $datatable .= ''; - } - $datatable .= ''; - } - my $check = ' '; - if (ref($settings->{'cansearch'}) eq 'ARRAY') { - if (grep(/^\Q$types->[$i]\E$/,@{$settings->{'cansearch'}})) { - $check = ' checked="checked" '; - } - } - $datatable .= ''; + ''.&mt('Yes').' '. + ''. + ''; + if (ref($usertypes) eq 'HASH') { + if (keys(%{$usertypes}) > 0) { + $datatable .= &users_cansearch_row($settings,$types,$usertypes,$dom, + $numinrow,$othertitle); + $cansrchrow = 1; } } - - my $rem = @{$types}%($numinrow); - my $colsleft = $numinrow - $rem; - if ($colsleft > 1) { - $datatable .= ''; } else { - $datatable .= ''; } - my $defcheck = ' '; - if (ref($settings->{'cansearch'}) eq 'ARRAY') { - if (grep(/^default$/,@{$settings->{'cansearch'}})) { - $defcheck = ' checked="checked" '; - } - } - $datatable .= ''. - '
'. - '
'; + if ($cansrchrow) { + $datatable .= '
'; + $datatable .= '
'; - - $datatable .= ''. - ''.&mt('Supported search methods'). - ''; + $datatable .= ''; + if ($cansrchrow) { + $datatable .= ''; + } else { + $datatable .= ''; + } + $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 .= ''. + ''. + ''; + $rownum ++; + } + foreach my $type (@mailings) { + if ($rownum%2) { + $css_class = ''; + } else { + $css_class = ' class="LC_odd_row" '; + } + $datatable .= ''. + ''. + ''."\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 = ''. + ''. + ''; + $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 .= ''. + ''; + $rownum ++; + } + } + return $datatable; +} + +sub username_formats_row { + my ($settings,$rules,$ruleorder,$numinrow) = @_; + my $output = ''. + ''; + 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 = ''. + ''; + return $output; +} + sub sorted_inst_types { my ($dom) = @_; my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); - my $othertitle = "All users"; + my $othertitle = &mt('All users'); my @types; if (ref($order) eq 'ARRAY') { @types = @{$order}; @@ -1029,6 +1350,16 @@ sub sorted_searchtitles { 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; @@ -1681,8 +2012,7 @@ sub check_switchserver { sub modify_quotas { my ($dom,%domconfig) = @_; my ($resulttext,%changes); - my ($usertypes,$order) = - &Apache::lonnet::retrieve_inst_usertypes($dom); + my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my %formhash; foreach my $key (keys(%env)) { if ($key =~ /^form\.quota_(.+)$/) { @@ -1716,8 +2046,14 @@ sub modify_quotas { if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').''; } else { @@ -1811,7 +2147,7 @@ sub modify_autoupdate { run => 'Auto-update:', classlists => 'Updates to user information in classlists?' ); - my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); + my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my %fieldtitles = &Apache::lonlocal::texthash ( id => 'Student/Employee ID', permanentemail => 'E-mail address', @@ -1822,7 +2158,7 @@ sub modify_autoupdate { ); my $othertitle = &mt('All users'); if (keys(%{$usertypes}) > 0) { - $othertitle = "Other users"; + $othertitle = &mt('Other users'); } foreach my $key (keys(%env)) { if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) { @@ -1844,14 +2180,14 @@ sub modify_autoupdate { } } elsif ($key eq 'fields') { if (ref($currautoupdate{$key}) eq 'HASH') { - foreach my $item (keys(%{$currautoupdate{$key}})) { + foreach my $item (@{$types},'default') { if (ref($currautoupdate{$key}{$item}) eq 'ARRAY') { my $change = 0; foreach my $type (@{$currautoupdate{$key}{$item}}) { if (!exists($fields{$item})) { $change = 1; } elsif (ref($fields{$item}) eq 'ARRAY') { - if (!grep/^\Q$type\E$/,@{$fields{$item}}) { + if (!grep(/^\Q$type\E$/,@{$fields{$item}})) { $change = 1; } } @@ -1859,18 +2195,20 @@ sub modify_autoupdate { if ($change) { push(@{$changes{$key}},$item); } - } + } } } } } - foreach my $key (keys(%fields)) { - if (ref($currautoupdate{'fields'}) eq 'HASH') { - if (!exists($currautoupdate{'fields'}{$key})) { - push(@{$changes{'fields'}},$key); + foreach my $item (@{$types},'default') { + if (defined($fields{$item})) { + if (ref($currautoupdate{'fields'}) eq 'HASH') { + if (!exists($currautoupdate{'fields'}{$item})) { + push(@{$changes{'fields'}},$item); + } + } else { + push(@{$changes{'fields'}},$item); } - } else { - push(@{$changes{'fields'}},$key); } } my $putresult = &Apache::lonnet::put_dom('configuration',\%updatehash, @@ -1892,9 +2230,9 @@ sub modify_autoupdate { $newvaluestr = &mt('none'); } if ($item eq 'default') { - $resulttext .= '
  • '.&mt("Updates for $othertitle set to: [_1]",$newvaluestr).'
    • '; + $resulttext .= '
  • '.&mt("Updates for '[_1]' set to: '[_2]'",$othertitle,$newvaluestr).'
    • '; } else { - $resulttext .= '
  • '.&mt("Updates for [_1] set to: [_2]",$usertypes->{$item},$newvaluestr).'
    • '; + $resulttext .= '
  • '.&mt("Updates for '[_1]' set to: '[_2]'",$usertypes->{$item},$newvaluestr).'
    • '; } } } else { @@ -1928,28 +2266,34 @@ sub modify_directorysrch { } } my %title = ( available => 'Directory search available', - cansearch => 'Users permitted to search', + 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'); - if (ref($currdirsrch{'cansearch'}) eq 'ARRAY') { - foreach my $type (@{$currdirsrch{'cansearch'}}) { - if (!grep(/^\Q$type\E$/,@cansearch)) { - push(@{$changes{'cansearch'}},$type); + my ($othertitle,$usertypes,$types) = &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); + foreach my $type (@cansearch) { + if (!grep(/^\Q$type\E$/,@{$currdirsrch{'cansearch'}})) { + push(@{$changes{'cansearch'}},$type); + } } + } else { + push(@{$changes{'cansearch'}},@cansearch); } - } else { - push(@{$changes{'cansearch'}},@cansearch); } if (ref($currdirsrch{'searchby'}) eq 'ARRAY') { @@ -1966,12 +2310,39 @@ sub modify_directorysrch { } 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 => $env{'form.searchtypes'}, + searchtypes => \@searchtypes, } ); my $putresult = &Apache::lonnet::put_dom('configuration',\%dirsrch_hash, @@ -1986,13 +2357,13 @@ sub modify_directorysrch { $changes{'available'} = 1; } } - if (exists($currdirsrch{'searchtypes'})) { - if ($currdirsrch{'searchtypes'} ne $env{'form.searchtypes'}) { - $changes{'searchtypes'} = 1; + if (exists($currdirsrch{'localonly'})) { + if ($currdirsrch{'localonly'} ne $env{'form.dirsrch_localonly'}) { + $changes{'localonly'} = 1; } } else { - if ($env{'form.searchtypes'}) { - $changes{'searchtypes'} = 1; + if ($env{'form.dirsrch_localonly'} eq '1') { + $changes{'localonly'} = 1; } } if (keys(%changes) > 0) { @@ -2000,20 +2371,27 @@ sub modify_directorysrch { 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 ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my $chgtext; - foreach my $type (@cansearch) { - if (defined($usertypes->{$type})) { - $chgtext .= $usertypes->{$type}.'; '; + 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 (grep(/^default$/,@cansearch)) { - $chgtext .= $othertitle; - } else { - $chgtext =~ s/\; $//; - } - $resulttext .= '
  • '.&mt("$title{'cansearch'} set to: [_1]",$chgtext).'
    • '; } if (ref($changes{'searchby'}) eq 'ARRAY') { my ($searchtitles,$titleorder) = &sorted_searchtitles(); @@ -2028,13 +2406,18 @@ sub modify_directorysrch { $chgtext =~ s/\; $//; $resulttext .= '
  • '.&mt("$title{'searchby'} set to: [_1]",$chgtext).'
    • '; } - if ($changes{'searchtypes'}) { - my %srchtypes_desc = ( - exact => 'Exact match only', - contains => 'Contains is a match', - specify => 'Match type specifiable', - ); - $resulttext .= '
  • '.&mt("$title{'searchtypes'} set to: \"$srchtypes_desc{$env{'form.searchtypes'}}\"").'
    • '; + 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 { @@ -2042,10 +2425,261 @@ sub modify_directorysrch { } } else { $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + return $resulttext; +} + +sub modify_contacts { + my ($dom,%domconfig) = @_; + my ($resulttext,%currsetting,%newsetting,%changes,%contacts_hash); + if (ref($domconfig{'contacts'}) eq 'HASH') { + foreach my $key (keys(%{$domconfig{'contacts'}})) { + $currsetting{$key} = $domconfig{'contacts'}{$key}; + } + } + my (%others,%to); + my @contacts = ('supportemail','adminemail'); + my @mailings = ('errormail','packagesmail','helpdeskmail'); + foreach my $type (@mailings) { + @{$newsetting{$type}} = + &Apache::loncommon::get_env_multiple('form.'.$type); + foreach my $item (@contacts) { + if (grep(/^\Q$item\E$/,@{$newsetting{$type}})) { + $contacts_hash{contacts}{$type}{$item} = 1; + } else { + $contacts_hash{contacts}{$type}{$item} = 0; + } + } + $others{$type} = $env{'form.'.$type.'_others'}; + $contacts_hash{contacts}{$type}{'others'} = $others{$type}; + } + foreach my $item (@contacts) { + $to{$item} = $env{'form.'.$item}; + $contacts_hash{'contacts'}{$item} = $to{$item}; + } + if (keys(%currsetting) > 0) { + foreach my $item (@contacts) { + if ($to{$item} ne $currsetting{$item}) { + $changes{$item} = 1; + } + } + foreach my $type (@mailings) { + foreach my $item (@contacts) { + if (ref($currsetting{$type}) eq 'HASH') { + if ($currsetting{$type}{$item} ne $contacts_hash{contacts}{$type}{$item}) { + push(@{$changes{$type}},$item); + } + } else { + push(@{$changes{$type}},@{$newsetting{$type}}); + } + } + if ($others{$type} ne $currsetting{$type}{'others'}) { + push(@{$changes{$type}},'others'); + } + } + } else { + my %default; + $default{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'}; + $default{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'}; + $default{'errormail'} = 'adminemail'; + $default{'packagesmail'} = 'adminemail'; + $default{'helpdeskmail'} = 'supportemail'; + foreach my $item (@contacts) { + if ($to{$item} ne $default{$item}) { + $changes{$item} = 1; + } + } + foreach my $type (@mailings) { + if ((@{$newsetting{$type}} != 1) || ($newsetting{$type}[0] ne $default{$type})) { + + push(@{$changes{$type}},@{$newsetting{$type}}); + } + if ($others{$type} ne '') { + push(@{$changes{$type}},'others'); + } + } + } + my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash, + $dom); + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + my ($titles,$short_titles) = &contact_titles(); + $resulttext = &mt('Changes made:').''; + } 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); + 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:').''; + } else { + $resulttext = &mt('No changes made to user creation settings'); + } + } else { + $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } 1; -
    '.&mt('Supported search methods'). + ''; foreach my $title (@{$titleorder}) { if (defined($searchtitles->{$title})) { my $check = ' '; @@ -997,13 +1013,318 @@ sub print_directorysrch { } } $datatable .= '
    '.&mt('Search latitude').''. + ' '. + ' '. + '
    '.$titles->{$item}.''. + '
    '.$titles->{$type}.': '. + ''; + foreach my $item (@contacts) { + $datatable .= ' '; + } + $datatable .= '
    '.&mt('Others').':  '. + ''. + '
    '.$lt{'nondc'}.''; + foreach my $item ('author','course') { + $datatable .= ''; + } + $datatable .= '
    '.$title{$item}. + ''. + ''; + foreach my $auth (@authtypes) { + $datatable .= ' '; + } + $datatable .= '
    '.&mt('Format rules to check for new usernames: '). + ''; + 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 .= ''; + } + $output .= ''; + } + my $check = ' '; + if (ref($settings->{'username_rule'}) eq 'ARRAY') { + if (grep(/^\Q$ruleorder->[$i]\E$/,@{$settings->{'username_rule'}})) { + $check = ' checked="checked" '; + } + } + $output .= ''; + } + } + $rem = @{$ruleorder}%($numinrow); + } + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $output .= ''; + } elsif ($colsleft == 1) { + $output .= ''; + } + $output .= '
    '. + ''. + '  
    '.&mt('Users allowed to search').' ('.$dom.')'. + ''; + 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 .= ''; + } + my $check = ' '; + if (ref($settings->{'cansearch'}) eq 'ARRAY') { + if (grep(/^\Q$types->[$i]\E$/,@{$settings->{'cansearch'}})) { + $check = ' checked="checked" '; + } + } + $output .= ''; + } + } + + $rem = @{$types}%($numinrow); + } + my $colsleft = $numinrow - $rem; + if ($colsleft > 1) { + $output .= ''. + '
    '. + ''; + } else { + $output .= ''; + } + my $defcheck = ' '; + if (ref($settings->{'cansearch'}) eq 'ARRAY') { + if (grep(/^default$/,@{$settings->{'cansearch'}})) { + $defcheck = ' checked="checked" '; + } + } + $output .= '