--- loncom/interface/domainprefs.pm 2007/06/07 23:36:32 1.22 +++ 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.22 2007/06/07 23:36:32 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'],$dom); + 'quotas','autoenroll','autoupdate','directorysrch', + 'usercreation','contacts'],$dom); my @prefs = ( { text => 'Default color schemes', help => 'Default_Color_Schemes', @@ -106,7 +107,28 @@ sub handler { col2 => 'Value',}, {col1 => 'User Population', col2 => 'Updataeable user data'}], - }, + }, + { text => 'Institutional directory searches', + help => 'Domain_Directory_Search', + action => 'directorysrch', + 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 @@ -135,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; @@ -153,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; } } @@ -189,6 +217,12 @@ sub process_changes { $output = &modify_autoenroll($dom,%domconfig); } elsif ($action eq 'autoupdate') { $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; } @@ -204,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(' @@ -216,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)); } @@ -232,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).' @@ -263,7 +302,7 @@ sub print_config_box { '); - if ($action eq 'login') { + if (($action eq 'login') || ($action eq 'directorysrch')) { $r->print(' '); } else { @@ -274,12 +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)); + } elsif ($action eq 'contacts') { + $r->print(&print_contacts($dom,$settings)); + } } $r->print('
'.$item->{'header'}->[0]->{'col1'}.''.$item->{'header'}->[0]->{'col2'}.'
@@ -732,21 +775,11 @@ ENDCOL sub print_quotas { my ($dom,$settings) = @_; my $datatable; - my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); - my $othertitle = "All users"; - my @types; - if (ref($order) eq 'ARRAY') { - @types = @{$order}; - } - if (@types == 0) { - if (ref($usertypes) eq 'HASH') { - @types = sort(keys(%{$usertypes})); - } - } + my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my $typecount = 0; my $css_class; - if (@types > 0) { - foreach my $type (@types) { + if (ref($types) eq 'ARRAY') { + foreach my $type (@{$types}) { if (defined($usertypes->{$type})) { $typecount ++; $css_class = $typecount%2?' class="LC_odd_row"':''; @@ -758,7 +791,6 @@ sub print_quotas { '" size="5" /> Mb'; } } - $othertitle = "Other users"; } my $defaultquota = '20'; if (ref($settings) eq 'HASH') { @@ -769,7 +801,7 @@ sub print_quotas { $typecount ++; $css_class = $typecount%2?' class="LC_odd_row"':''; $datatable .= ''. - ''.&mt($othertitle).''. + ''.$othertitle.''. ''. ' Mb'; @@ -867,20 +899,7 @@ sub print_autoupdate { $classlistsoff.'value="0" />'.&mt('No').''. ''; } else { - my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); - my @types; - if (ref($order) eq 'ARRAY') { - @types = @{$order}; - } - if (@types == 0) { - if (ref($usertypes) eq 'HASH') { - @types = sort(keys(%{$usertypes})); - } - } - my $othertitle = &mt('All users'); - if (keys(%{$usertypes}) > 0) { - $othertitle = &mt('Other users'); - } + my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my @fields = ('lastname','firstname','middlename','gen', 'permanentemail','id'); my %fieldtitles = &Apache::lonlocal::texthash ( @@ -892,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}, @@ -905,6 +926,440 @@ sub print_autoupdate { return $datatable; } +sub print_directorysrch { + my ($dom,$settings) = @_; + my $srchon = ' '; + my $srchoff = ' checked="checked" '; + 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->{'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('Other domains can search?').''. + ' '. + ''. + ''; + if (ref($usertypes) eq 'HASH') { + if (keys(%{$usertypes}) > 0) { + $datatable .= &users_cansearch_row($settings,$types,$usertypes,$dom, + $numinrow,$othertitle); + $cansrchrow = 1; + } + } + if ($cansrchrow) { + $datatable .= ''; + } else { + $datatable .= ''; + } + $datatable .= ''.&mt('Supported search methods'). + ''; + foreach my $title (@{$titleorder}) { + if (defined($searchtitles->{$title})) { + my $check = ' '; + if (ref($settings->{'searchby'}) eq 'ARRAY') { + if (grep(/^\Q$title\E$/,@{$settings->{'searchby'}})) { + $check = ' checked="checked" '; + } + } + $datatable .= ''; + } + } + $datatable .= '
'. + '
'; + if ($cansrchrow) { + $datatable .= ''; + } else { + $datatable .= ''; + } + $datatable .= ''.&mt('Search latitude').''. + ''. + ' '. + ' '. + ''; + 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 .= ''. + ''.$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 .= ' '; + } + $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'}.''. + ''; + foreach my $item ('author','course') { + $datatable .= ''; + } + $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 .= ''. + ''.$title{$item}. + ''. + ''; + foreach my $auth (@authtypes) { + $datatable .= ' '; + } + $datatable .= ''; + $rownum ++; + } + } + return $datatable; +} + +sub username_formats_row { + my ($settings,$rules,$ruleorder,$numinrow) = @_; + my $output = ''. + ''.&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 .= '
'. + ''. + '  
'; + 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 = ''. + ''.&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 .= '
'; + return $output; +} + +sub sorted_inst_types { + my ($dom) = @_; + my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); + my $othertitle = &mt('All users'); + my @types; + if (ref($order) eq 'ARRAY') { + @types = @{$order}; + } + if (@types == 0) { + if (ref($usertypes) eq 'HASH') { + @types = sort(keys(%{$usertypes})); + } + } + if (keys(%{$usertypes}) > 0) { + $othertitle = &mt('Other users'); + } + return ($othertitle,$usertypes,\@types); +} + +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; @@ -1557,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_(.+)$/) { @@ -1592,8 +2046,14 @@ sub modify_quotas { if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
    '; - foreach my $item (sort(keys(%changes))) { - $resulttext .= '
  • '.&mt('[_1] set to [_2] Mb',$usertypes->{$item},$formhash{$item}).'
    • '; + foreach my $type (@{$types},'default') { + if (defined($changes{$type})) { + my $typetitle = $usertypes->{$type}; + if ($type eq 'default') { + $typetitle = $othertitle; + } + $resulttext .= '
  • '.&mt('[_1] set to [_2] Mb',$typetitle,$formhash{$type}).'
    • '; + } } $resulttext .= '
'; } else { @@ -1642,7 +2102,7 @@ sub modify_autoenroll { } } elsif ($autorun) { if ($env{'form.autoenroll_run'} ne '1') { - $changes{'run'} = 1; + $changes{'run'} = 1; } } if ($currautoenroll{'sender_uname'} ne $sender_uname) { @@ -1687,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', @@ -1698,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_(.+)_([^_]+)$/) { @@ -1720,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; } } @@ -1735,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, @@ -1768,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 { @@ -1794,5 +2256,430 @@ sub modify_autoupdate { return $resulttext; } -1; +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) = &sorted_inst_types($dom); + if (keys(%{$usertypes}) == 0) { + @cansearch = ('default'); + } else { + if (ref($currdirsrch{'cansearch'}) eq 'ARRAY') { + foreach my $type (@{$currdirsrch{'cansearch'}}) { + if (!grep(/^\Q$type\E$/,@cansearch)) { + push(@{$changes{'cansearch'}},$type); + } + } + foreach my $type (@cansearch) { + if (!grep(/^\Q$type\E$/,@{$currdirsrch{'cansearch'}})) { + push(@{$changes{'cansearch'}},$type); + } + } + } else { + push(@{$changes{'cansearch'}},@cansearch); + } + } + if (ref($currdirsrch{'searchby'}) eq 'ARRAY') { + foreach my $by (@{$currdirsrch{'searchby'}}) { + if (!grep(/^\Q$by\E$/,@searchby)) { + push(@{$changes{'searchby'}},$by); + } + } + foreach my $by (@searchby) { + if (!grep(/^\Q$by\E$/,@{$currdirsrch{'searchby'}})) { + push(@{$changes{'searchby'}},$by); + } + } + } else { + push(@{$changes{'searchby'}},@searchby); + } + + if (ref($currdirsrch{'searchtypes'}) eq 'ARRAY') { + foreach my $type (@{$currdirsrch{'searchtypes'}}) { + if (!grep(/^\Q$type\E$/,@searchtypes)) { + push(@{$changes{'searchtypes'}},$type); + } + } + foreach my $type (@searchtypes) { + if (!grep(/^\Q$type\E$/,@{$currdirsrch{'searchtypes'}})) { + push(@{$changes{'searchtypes'}},$type); + } + } + } else { + if (exists($currdirsrch{'searchtypes'})) { + foreach my $type (@searchtypes) { + if ($type ne $currdirsrch{'searchtypes'}) { + push(@{$changes{'searchtypes'}},$type); + } + } + if (!grep(/^\Q$currdirsrch{'searchtypes'}\E/,@searchtypes)) { + push(@{$changes{'searchtypes'}},$currdirsrch{'searchtypes'}); + } + } else { + push(@{$changes{'searchtypes'}},@searchtypes); + } + } + + my %dirsrch_hash = ( + directorysrch => { available => $env{'form.dirsrch_available'}, + cansearch => \@cansearch, + localonly => $env{'form.dirsrch_localonly'}, + searchby => \@searchby, + searchtypes => \@searchtypes, + } + ); + my $putresult = &Apache::lonnet::put_dom('configuration',\%dirsrch_hash, + $dom); + if ($putresult eq 'ok') { + if (exists($currdirsrch{'available'})) { + if ($currdirsrch{'available'} ne $env{'form.dirsrch_available'}) { + $changes{'available'} = 1; + } + } else { + if ($env{'form.dirsrch_available'} eq '1') { + $changes{'available'} = 1; + } + } + if (exists($currdirsrch{'localonly'})) { + if ($currdirsrch{'localonly'} ne $env{'form.dirsrch_localonly'}) { + $changes{'localonly'} = 1; + } + } else { + if ($env{'form.dirsrch_localonly'} eq '1') { + $changes{'localonly'} = 1; + } + } + if (keys(%changes) > 0) { + $resulttext = &mt('Changes made:').'
      '; + if ($changes{'available'}) { + $resulttext .= '
    • '.&mt("$title{'available'} set to: $offon[$env{'form.dirsrch_available'}]").'
      • '; + } + if ($changes{'localonly'}) { + $resulttext .= '
    • '.&mt("$title{'localonly'} set to: $otherdoms[$env{'form.dirsrch_localonly'}]").'
      • '; + } + + if (ref($changes{'cansearch'}) eq 'ARRAY') { + my $chgtext; + if (ref($usertypes) eq 'HASH') { + if (keys(%{$usertypes}) > 0) { + foreach my $type (@{$types}) { + if (grep(/^\Q$type\E$/,@cansearch)) { + $chgtext .= $usertypes->{$type}.'; '; + } + } + if (grep(/^default$/,@cansearch)) { + $chgtext .= $othertitle; + } else { + $chgtext =~ s/\; $//; + } + $resulttext .= '
    • '.&mt("Users from domain '[_1]' permitted to search the institutional directory set to: [_2]",$dom,$chgtext).'
      • '; + } + } + } + if (ref($changes{'searchby'}) eq 'ARRAY') { + my ($searchtitles,$titleorder) = &sorted_searchtitles(); + my $chgtext; + foreach my $type (@{$titleorder}) { + if (grep(/^\Q$type\E$/,@searchby)) { + if (defined($searchtitles->{$type})) { + $chgtext .= $searchtitles->{$type}.'; '; + } + } + } + $chgtext =~ s/\; $//; + $resulttext .= '
    • '.&mt("$title{'searchby'} set to: [_1]",$chgtext).'
      • '; + } + if (ref($changes{'searchtypes'}) eq 'ARRAY') { + my ($srchtypes_desc,$srchtypeorder) = &sorted_searchtypes(); + my $chgtext; + foreach my $type (@{$srchtypeorder}) { + if (grep(/^\Q$type\E$/,@searchtypes)) { + if (defined($srchtypes_desc->{$type})) { + $chgtext .= $srchtypes_desc->{$type}.'; '; + } + } + } + $chgtext =~ s/\; $//; + $resulttext .= '
    • '.&mt("$title{'searchtypes'} set to: \"[_1]\"",$chgtext).'
      • '; + } + $resulttext .= '
    '; + } else { + $resulttext = &mt('No changes made to institution directory search settings'); + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + return $resulttext; +} + +sub modify_contacts { + my ($dom,%domconfig) = @_; + my ($resulttext,%currsetting,%newsetting,%changes,%contacts_hash); + if (ref($domconfig{'contacts'}) eq 'HASH') { + foreach my $key (keys(%{$domconfig{'contacts'}})) { + $currsetting{$key} = $domconfig{'contacts'}{$key}; + } + } + my (%others,%to); + my @contacts = ('supportemail','adminemail'); + my @mailings = ('errormail','packagesmail','helpdeskmail'); + foreach my $type (@mailings) { + @{$newsetting{$type}} = + &Apache::loncommon::get_env_multiple('form.'.$type); + foreach my $item (@contacts) { + if (grep(/^\Q$item\E$/,@{$newsetting{$type}})) { + $contacts_hash{contacts}{$type}{$item} = 1; + } else { + $contacts_hash{contacts}{$type}{$item} = 0; + } + } + $others{$type} = $env{'form.'.$type.'_others'}; + $contacts_hash{contacts}{$type}{'others'} = $others{$type}; + } + foreach my $item (@contacts) { + $to{$item} = $env{'form.'.$item}; + $contacts_hash{'contacts'}{$item} = $to{$item}; + } + if (keys(%currsetting) > 0) { + foreach my $item (@contacts) { + if ($to{$item} ne $currsetting{$item}) { + $changes{$item} = 1; + } + } + foreach my $type (@mailings) { + foreach my $item (@contacts) { + if (ref($currsetting{$type}) eq 'HASH') { + if ($currsetting{$type}{$item} ne $contacts_hash{contacts}{$type}{$item}) { + push(@{$changes{$type}},$item); + } + } else { + push(@{$changes{$type}},@{$newsetting{$type}}); + } + } + if ($others{$type} ne $currsetting{$type}{'others'}) { + push(@{$changes{$type}},'others'); + } + } + } else { + my %default; + $default{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'}; + $default{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'}; + $default{'errormail'} = 'adminemail'; + $default{'packagesmail'} = 'adminemail'; + $default{'helpdeskmail'} = 'supportemail'; + foreach my $item (@contacts) { + if ($to{$item} ne $default{$item}) { + $changes{$item} = 1; + } + } + foreach my $type (@mailings) { + if ((@{$newsetting{$type}} != 1) || ($newsetting{$type}[0] ne $default{$type})) { + + push(@{$changes{$type}},@{$newsetting{$type}}); + } + if ($others{$type} ne '') { + push(@{$changes{$type}},'others'); + } + } + } + my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash, + $dom); + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + my ($titles,$short_titles) = &contact_titles(); + $resulttext = &mt('Changes made:').'
      '; + foreach my $item (@contacts) { + if ($changes{$item}) { + $resulttext .= '
    • '.$titles->{$item}. + &mt(' set to: '). + ''. + $to{$item}.'
      • '; + } + } + foreach my $type (@mailings) { + if (ref($changes{$type}) eq 'ARRAY') { + $resulttext .= '
    • '.$titles->{$type}.': '; + my @text; + foreach my $item (@{$newsetting{$type}}) { + push(@text,$short_titles->{$item}); + } + if ($others{$type} ne '') { + push(@text,$others{$type}); + } + $resulttext .= ''. + join(', ',@text).'
      • '; + } + } + $resulttext .= '
    '; + } else { + $resulttext = &mt('No changes made to contact information.'); + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1].',$putresult).''; + } + return $resulttext; +} + +sub modify_usercreation { + my ($dom,%domconfig) = @_; + my ($resulttext,%curr_usercreation,%changes,%authallowed); + 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:').'
      '; + if (ref($changes{'cancreate'}) eq 'ARRAY') { + my $chgtext = '
        '; + foreach my $type (@cancreate) { + $chgtext .= '
      • '.$title{$type}.'
        • '; + } + $chgtext .= '
      '; + if (@cancreate > 0) { + $resulttext .= '
    • '.&mt('Creation of new users is permitted by a Domain Coordinator, and also by other users when: ').$chgtext.'
      • '; + } else { + $resulttext .= '
    • '.&mt("Creation of new users is now only allowed when the user's role is Domain Coordinator.").'
      • '; + } + } + if (ref($changes{'username_rule'}) eq 'ARRAY') { + my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom); + 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.').'
      • '; + } + } + 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 user creation settings'); + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + return $resulttext; +} + +1;