# The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # # $Id: domainprefs.pm,v 1.155 2011/09/14 02:59:33 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA# # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # ############################################################### ############################################################## =pod =head1 NAME Apache::domainprefs.pm =head1 SYNOPSIS Handles configuration of a LON-CAPA domain. This is part of the LearningOnline Network with CAPA project described at http://www.lon-capa.org. =head1 OVERVIEW Each institution using LON-CAPA will typically have a single domain designated for use by individuals affliated with the institution. Accordingly, each domain may define a default set of logos and a color scheme which can be used to "brand" the LON-CAPA instance. In addition, an institution will typically have a language and timezone which are used for the majority of courses. LON-CAPA provides a mechanism to display and modify these defaults, as well as a host of other domain-wide settings which determine the types of functionality available to users and courses in the domain. There is also a mechanism to configure cataloging of courses in the domain, and controls on the operation of automated processes which govern such things as roster updates, user directory updates and processing of course requests. The domain coordination manual which is built dynamically on install/update of LON-CAPA from the relevant help items provides more information about domain configuration. Most of the domain settings are stored in the configuration.db GDBM file which is housed on the primary library server for the domain in /home/httpd/lonUsers/$dom, where $dom is the domain. The configuration.db stores settings in a number of frozen hashes of hashes. In a few cases, domain information must be uploaded to the domain as files (e.g., image files for logos etc., or plain text files for bubblesheet formats). In this case the domainprefs.pm must be running in a user session hosted on the primary library server in the domain, as these files are stored in author space belonging to a special $dom-domainconfig user. domainprefs.pm in combination with lonconfigsettings.pm will retrieve and display the current settings, and provides an interface to make modifications. =head1 SUBROUTINES =over =item print_quotas() Inputs: 4 $dom,$settings,$rowtotal,$action. $dom is the domain, $settings is a reference to a hash of current settings for the current context, $rowtotal is a reference to the scalar used to record the number of rows displayed on the page, and $action is the context (either quotas or requestcourses). The print_quotas routine was orginally created to display/store information about default quota sizes for portfolio spaces for the different types of institutional affiliation in the domain (e.g., Faculty, Staff, Student etc.), but is now also used to manage availability of user tools: i.e., blogs, aboutme page, and portfolios, and the course request tool, used by course owners to request creation of a course. Outputs: 1 $datatable - HTML containing form elements which allow settings to be changed. In the case of course requests, radio buttons are displayed for each institutional affiliate type (and also default, and _LC_adv) for each of the course types (official, unofficial and community). In each case the radio buttons allow the selection of one of four values: 0, approval, validate, autolimit=N (where N is blank, or a positive integer). which have the following effects: 0 =over - course requests are not allowed for this course types/affiliation =back approval =over - course requests must be approved by a Doman Coordinator in the course's domain =back validate =over - an institutional validation (e.g., check requestor is instructor of record) needs to be passed before the course will be created. The required validation is in localenroll.pm on the primary library server for the course domain. =back autolimit =over - course requests will be processed automatically up to a limit of N requests for the course type for the particular requestor. If N is undefined, there is no limit to the number of course requests which a course owner may submit and have processed automatically. =back =item modify_quotas() =back =cut package Apache::domainprefs; use strict; use Apache::Constants qw(:common :http); use Apache::lonnet; use Apache::loncommon(); use Apache::lonhtmlcommon(); use Apache::lonlocal; use Apache::lonmsg(); use Apache::lonconfigsettings; use LONCAPA qw(:DEFAULT :match); use LONCAPA::Enrollment; use LONCAPA::lonauthcgi(); use File::Copy; use Locale::Language; use DateTime::TimeZone; use DateTime::Locale; my $registered_cleanup; my $modified_urls; sub handler { my $r=shift; if ($r->header_only) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK; } my $context = 'domain'; my $dom = $env{'request.role.domain'}; my $domdesc = &Apache::lonnet::domain($dom,'description'); if (&Apache::lonnet::allowed('mau',$dom)) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; } else { $env{'user.error.msg'}= "/adm/domainprefs:mau:0:0:Cannot modify domain settings"; return HTTP_NOT_ACCEPTABLE; } $registered_cleanup=0; @{$modified_urls}=(); &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['phase','actions']); my $phase = 'pickactions'; if ( exists($env{'form.phase'}) ) { $phase = $env{'form.phase'}; } my %servers = &Apache::lonnet::internet_dom_servers($dom); my %domconfig = &Apache::lonnet::get_dom('configuration',['login','rolecolors', 'quotas','autoenroll','autoupdate','autocreate', 'directorysrch','usercreation','usermodification', 'contacts','defaults','scantron','coursecategories', 'serverstatuses','requestcourses','helpsettings', 'coursedefaults','usersessions','loadbalancing'],$dom); my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll', 'autoupdate','autocreate','directorysrch','contacts', 'usercreation','usermodification','scantron', 'requestcourses','coursecategories','serverstatuses','helpsettings', 'coursedefaults','usersessions'); if (keys(%servers) > 1) { push(@prefs_order,'loadbalancing'); } my %prefs = ( 'rolecolors' => { text => 'Default color schemes', help => 'Domain_Configuration_Color_Schemes', header => [{col1 => 'Student Settings', col2 => '',}, {col1 => 'Coordinator Settings', col2 => '',}, {col1 => 'Author Settings', col2 => '',}, {col1 => 'Administrator Settings', col2 => '',}], }, 'login' => { text => 'Log-in page options', help => 'Domain_Configuration_Login_Page', header => [{col1 => 'Item', col2 => '',}], }, 'defaults' => { text => 'Default authentication/language/timezone/portal', help => 'Domain_Configuration_LangTZAuth', header => [{col1 => 'Setting', col2 => 'Value'}], }, 'quotas' => { text => 'User blogs, personal information pages, portfolios', help => 'Domain_Configuration_Quotas', header => [{col1 => 'User affiliation', col2 => 'Available tools', col3 => 'Portfolio quota',}], }, 'autoenroll' => { text => 'Auto-enrollment settings', help => 'Domain_Configuration_Auto_Enrollment', header => [{col1 => 'Configuration setting', col2 => 'Value(s)'}], }, 'autoupdate' => { text => 'Auto-update settings', help => 'Domain_Configuration_Auto_Updates', header => [{col1 => 'Setting', col2 => 'Value',}, {col1 => 'Setting', col2 => 'Affiliation'}, {col1 => 'User population', col2 => 'Updateable user data'}], }, 'autocreate' => { text => 'Auto-course creation settings', help => 'Domain_Configuration_Auto_Creation', header => [{col1 => 'Configuration Setting', col2 => 'Value',}], }, 'directorysrch' => { text => 'Institutional directory searches', help => 'Domain_Configuration_InstDirectory_Search', header => [{col1 => 'Setting', col2 => 'Value',}], }, 'contacts' => { text => 'Contact Information', help => 'Domain_Configuration_Contact_Info', header => [{col1 => 'Setting', col2 => 'Value',}], }, 'usercreation' => { text => 'User creation', help => 'Domain_Configuration_User_Creation', header => [{col1 => 'Format rule type', col2 => 'Format rules in force'}, {col1 => 'User account creation', col2 => 'Usernames which may be created',}, {col1 => 'Context', col2 => 'Assignable authentication types'}], }, 'usermodification' => { text => 'User modification', help => 'Domain_Configuration_User_Modification', header => [{col1 => 'Target user has role', col2 => 'User information updateable in author context'}, {col1 => 'Target user has role', col2 => 'User information updateable in course context'}, {col1 => "Status of user", col2 => 'Information settable when self-creating account (if directory data blank)'}], }, 'scantron' => { text => 'Bubblesheet format file', help => 'Domain_Configuration_Scantron_Format', header => [ {col1 => 'Item', col2 => '', }], }, 'requestcourses' => {text => 'Request creation of courses', help => 'Domain_Configuration_Request_Courses', header => [{col1 => 'User affiliation', col2 => 'Availability/Processing of requests',}, {col1 => 'Setting', col2 => 'Value'}], }, 'coursecategories' => { text => 'Cataloging of courses/communities', help => 'Domain_Configuration_Cataloging_Courses', header => [{col1 => 'Category settings', col2 => '',}, {col1 => 'Categories', col2 => '', }], }, 'serverstatuses' => {text => 'Access to server status pages', help => 'Domain_Configuration_Server_Status', header => [{col1 => 'Status Page', col2 => 'Other named users', col3 => 'Specific IPs', }], }, 'helpsettings' => {text => 'Help page settings', help => 'Domain_Configuration_Help_Settings', header => [{col1 => 'Authenticated Help Settings', col2 => ''}, {col1 => 'Unauthenticated Help Settings', col2 => ''}], }, 'coursedefaults' => {text => 'Course/Community defaults', help => 'Domain_Configuration_Course_Defaults', header => [{col1 => 'Defaults which can be overridden in each course by a CC', col2 => 'Value',}, {col1 => 'Defaults which can be overridden for each course by a DC', col2 => 'Value',},], }, 'privacy' => {text => 'User Privacy', help => 'Domain_Configuration_User_Privacy', header => [{col1 => 'Setting', col2 => 'Value',}], }, 'usersessions' => {text => 'User session hosting/offloading', help => 'Domain_Configuration_User_Sessions', header => [{col1 => 'Domain server', col2 => 'Servers to offload sessions to when busy'}, {col1 => 'Hosting of users from other domains', col2 => 'Rules'}, {col1 => "Hosting domain's own users elsewhere", col2 => 'Rules'}], }, 'loadbalancing' => {text => 'Dedicated Load Balancer', help => 'Domain_Configuration_Load_Balancing', header => [{col1 => 'Server', col2 => 'Default destinations', col3 => 'User affliation', col4 => 'Overrides'}, ], }, ); if (keys(%servers) > 1) { $prefs{'login'} = { text => 'Log-in page options', help => 'Domain_Configuration_Login_Page', header => [{col1 => 'Log-in Service', col2 => 'Server Setting',}, {col1 => 'Log-in Page Items', col2 => ''}], }; } my @roles = ('student','coordinator','author','admin'); my @actions = &Apache::loncommon::get_env_multiple('form.actions'); &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:changePage(document.$phase,'pickactions')", text=>"Settings to display/modify"}); my $confname = $dom.'-domainconfig'; if ($phase eq 'process') { &Apache::lonconfigsettings::make_changes($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,\@roles); } elsif ($phase eq 'display') { my $js; if (keys(%servers) > 1) { my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); $js = &lonbalance_targets_js($dom,$types,\%servers). &new_spares_js(). &common_domprefs_js(). &Apache::loncommon::javascript_array_indexof(); } &Apache::lonconfigsettings::display_settings($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,$js); } else { if (keys(%domconfig) == 0) { my $primarylibserv = &Apache::lonnet::domain($dom,'primary'); my @ids=&Apache::lonnet::current_machine_ids(); if (!grep(/^\Q$primarylibserv\E$/,@ids)) { my %designhash = &Apache::loncommon::get_domainconf($dom); my @loginimages = ('img','logo','domlogo','login'); my $custom_img_count = 0; foreach my $img (@loginimages) { if ($designhash{$dom.'.login.'.$img} ne '') { $custom_img_count ++; } } foreach my $role (@roles) { if ($designhash{$dom.'.'.$role.'.img'} ne '') { $custom_img_count ++; } } if ($custom_img_count > 0) { &Apache::lonconfigsettings::print_header($r,$phase,$context); my $switch_server = &check_switchserver($dom,$confname); $r->print( &mt('Domain configuration settings have yet to be saved for this domain via the web-based domain preferences interface.').'
'. &mt("While this remains so, you must switch to the domain's primary library server in order to update settings.").'

'. &mt("Thereafter, (with a Domain Coordinator role selected in the domain) you will be able to update settings when logged in to any server in the LON-CAPA network.").'
'. &mt("However, you will still need to switch to the domain's primary library server to upload new images or logos.").'

'); if ($switch_server) { $r->print($switch_server.' '.&mt('to primary library server for domain: [_1]',$dom)); } $r->print(&Apache::loncommon::end_page()); return OK; } } } &Apache::lonconfigsettings::display_choices($r,$phase,$context,\@prefs_order,\%prefs); } return OK; } sub process_changes { my ($r,$dom,$confname,$action,$roles,$values) = @_; my %domconfig; if (ref($values) eq 'HASH') { %domconfig = %{$values}; } my $output; if ($action eq 'login') { $output = &modify_login($r,$dom,$confname,%domconfig); } elsif ($action eq 'rolecolors') { $output = &modify_rolecolors($r,$dom,$confname,$roles, %domconfig); } elsif ($action eq 'quotas') { $output = &modify_quotas($dom,$action,%domconfig); } elsif ($action eq 'autoenroll') { $output = &modify_autoenroll($dom,%domconfig); } elsif ($action eq 'autoupdate') { $output = &modify_autoupdate($dom,%domconfig); } elsif ($action eq 'autocreate') { $output = &modify_autocreate($dom,%domconfig); } elsif ($action eq 'directorysrch') { $output = &modify_directorysrch($dom,%domconfig); } elsif ($action eq 'usercreation') { $output = &modify_usercreation($dom,%domconfig); } elsif ($action eq 'usermodification') { $output = &modify_usermodification($dom,%domconfig); } elsif ($action eq 'contacts') { $output = &modify_contacts($dom,%domconfig); } elsif ($action eq 'defaults') { $output = &modify_defaults($dom,$r); } elsif ($action eq 'scantron') { $output = &modify_scantron($r,$dom,$confname,%domconfig); } elsif ($action eq 'coursecategories') { $output = &modify_coursecategories($dom,%domconfig); } elsif ($action eq 'serverstatuses') { $output = &modify_serverstatuses($dom,%domconfig); } elsif ($action eq 'requestcourses') { $output = &modify_quotas($dom,$action,%domconfig); } elsif ($action eq 'helpsettings') { $output = &modify_helpsettings($r,$dom,$confname,%domconfig); } elsif ($action eq 'coursedefaults') { $output = &modify_coursedefaults($dom,%domconfig); } elsif ($action eq 'usersessions') { $output = &modify_usersessions($dom,%domconfig); } elsif ($action eq 'loadbalancing') { $output = &modify_loadbalancing($dom,%domconfig); } return $output; } sub print_config_box { my ($r,$dom,$confname,$phase,$action,$item,$settings) = @_; my $rowtotal = 0; my $output; if ($action eq 'coursecategories') { $output = &coursecategories_javascript($settings); } $output .= ''."\n". ''; $rowtotal ++; my $numheaders = 1; if (ref($item->{'header'}) eq 'ARRAY') { $numheaders = scalar(@{$item->{'header'}}); } if ($numheaders > 1) { my $colspan = ''; my $rightcolspan = ''; if (($action eq 'rolecolors') || ($action eq 'coursecategories') || ($action eq 'helpsettings')) { $colspan = ' colspan="2"'; } if ($action eq 'usersessions') { $rightcolspan = ' colspan="3"'; } $output .= ' '. ''; return $datatable; } my %defaultchecked = ( 'coursecatalog' => 'on', 'adminmail' => 'off', 'newuser' => 'off', ); my @toggles = ('coursecatalog','adminmail','newuser'); my (%checkedon,%checkedoff); foreach my $item (@toggles) { if ($defaultchecked{$item} eq 'on') { $checkedon{$item} = ' checked="checked" '; $checkedoff{$item} = ' '; } elsif ($defaultchecked{$item} eq 'off') { $checkedoff{$item} = ' checked="checked" '; $checkedon{$item} = ' '; } } my @images = ('img','logo','domlogo','login'); my @logintext = ('textcol','bgcol'); my @bgs = ('pgbg','mainbg','sidebg'); my @links = ('link','alink','vlink'); my %designhash = &Apache::loncommon::get_domainconf($dom); my %defaultdesign = %Apache::loncommon::defaultdesign; my (%is_custom,%designs); my %defaults = ( font => $defaultdesign{'login.font'}, ); foreach my $item (@images) { $defaults{$item} = $defaultdesign{'login.'.$item}; $defaults{'showlogo'}{$item} = 1; } foreach my $item (@bgs) { $defaults{'bgs'}{$item} = $defaultdesign{'login.'.$item}; } foreach my $item (@logintext) { $defaults{'logintext'}{$item} = $defaultdesign{'login.'.$item}; } foreach my $item (@links) { $defaults{'links'}{$item} = $defaultdesign{'login.'.$item}; } if (ref($settings) eq 'HASH') { foreach my $item (@toggles) { if ($settings->{$item} eq '1') { $checkedon{$item} = ' checked="checked" '; $checkedoff{$item} = ' '; } elsif ($settings->{$item} eq '0') { $checkedoff{$item} = ' checked="checked" '; $checkedon{$item} = ' '; } } foreach my $item (@images) { if (defined($settings->{$item})) { $designs{$item} = $settings->{$item}; $is_custom{$item} = 1; } if (defined($settings->{'showlogo'}{$item})) { $designs{'showlogo'}{$item} = $settings->{'showlogo'}{$item}; } } foreach my $item (@logintext) { if ($settings->{$item} ne '') { $designs{'logintext'}{$item} = $settings->{$item}; $is_custom{$item} = 1; } } if ($settings->{'font'} ne '') { $designs{'font'} = $settings->{'font'}; $is_custom{'font'} = 1; } foreach my $item (@bgs) { if ($settings->{$item} ne '') { $designs{'bgs'}{$item} = $settings->{$item}; $is_custom{$item} = 1; } } foreach my $item (@links) { if ($settings->{$item} ne '') { $designs{'links'}{$item} = $settings->{$item}; $is_custom{$item} = 1; } } } else { if ($designhash{$dom.'.login.font'} ne '') { $designs{'font'} = $designhash{$dom.'.login.font'}; $is_custom{'font'} = 1; } foreach my $item (@images) { if ($designhash{$dom.'.login.'.$item} ne '') { $designs{$item} = $designhash{$dom.'.login.'.$item}; $is_custom{$item} = 1; } } foreach my $item (@bgs) { if ($designhash{$dom.'.login.'.$item} ne '') { $designs{'bgs'}{$item} = $designhash{$dom.'.login.'.$item}; $is_custom{$item} = 1; } } foreach my $item (@links) { if ($designhash{$dom.'.login.'.$item} ne '') { $designs{'links'}{$item} = $designhash{$dom.'.login.'.$item}; $is_custom{$item} = 1; } } } my %alt_text = &Apache::lonlocal::texthash ( img => 'Log-in banner', logo => 'Institution Logo', domlogo => 'Domain Logo', login => 'Login box'); my $itemcount = 1; foreach my $item (@toggles) { $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''. ''; $itemcount ++; } $datatable .= &display_color_options($dom,$confname,$phase,'login',$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal,\@logintext); $datatable .= '
'. &mt($item->{text}).' '. &Apache::loncommon::help_open_topic($item->{'help'}).'
'; $rowtotal ++; if ($action eq 'autoupdate') { $output .= &print_autoupdate('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'usercreation') { $output .= &print_usercreation('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'usermodification') { $output .= &print_usermodification('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'coursecategories') { $output .= &print_coursecategories('top',$dom,$item,$settings,\$rowtotal); } elsif ($action eq 'login') { $output .= &print_login('top',$dom,$confname,$phase,$settings,\$rowtotal); $colspan = ' colspan="2"'; } elsif ($action eq 'requestcourses') { $output .= &print_quotas($dom,$settings,\$rowtotal,$action); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'usersessions') { $output .= &print_usersessions('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'rolecolors') { $output .= &print_rolecolors($phase,'student',$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'coursedefaults') { $output .= &print_coursedefaults('top',$dom,$settings,\$rowtotal); } $output .= '
'.&mt($item->{'header'}->[0]->{'col1'}).' '.&mt($item->{'header'}->[0]->{'col2'}).'
'; $output .= ' '; $rowtotal ++; if ($action eq 'autoupdate') { $output .= &print_autoupdate('middle',$dom,$settings,\$rowtotal).'
'.&mt($item->{'header'}->[1]->{'col1'}).''.&mt($item->{'header'}->[1]->{'col2'}).'
'. &print_autoupdate('bottom',$dom,$settings,\$rowtotal); $rowtotal ++; } elsif ($action eq 'usercreation') { $output .= &print_usercreation('middle',$dom,$settings,\$rowtotal).'
'.&mt($item->{'header'}->[2]->{'col1'}).' '.&mt($item->{'header'}->[2]->{'col2'}).'
'. &print_usercreation('bottom',$dom,$settings,\$rowtotal); $rowtotal ++; } elsif ($action eq 'usermodification') { $output .= &print_usermodification('middle',$dom,$settings,\$rowtotal).'
'.&mt($item->{'header'}->[2]->{'col1'}).' '.&mt($item->{'header'}->[2]->{'col2'}).'
'. &print_usermodification('bottom',$dom,$settings,\$rowtotal); $rowtotal ++; } elsif ($action eq 'coursecategories') { $output .= &print_coursecategories('bottom',$dom,$item,$settings,\$rowtotal); } elsif ($action eq 'login') { $output .= &print_login('bottom',$dom,$confname,$phase,$settings,\$rowtotal); } elsif ($action eq 'requestcourses') { $output .= &print_courserequestmail($dom,$settings,\$rowtotal); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('bottom',$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'usersessions') { $output .= &print_usersessions('middle',$dom,$settings,\$rowtotal).'
'.&mt($item->{'header'}->[2]->{'col1'}).' '.&mt($item->{'header'}->[2]->{'col2'}).'
'. &print_usersessions('bottom',$dom,$settings,\$rowtotal); $rowtotal ++; } elsif ($action eq 'coursedefaults') { $output .= &print_coursedefaults('bottom',$dom,$settings,\$rowtotal); } elsif ($action eq 'rolecolors') { $output .= &print_rolecolors($phase,'coordinator',$dom,$confname,$settings,\$rowtotal).'
'.&mt($item->{'header'}->[2]->{'col1'}).' '.&mt($item->{'header'}->[2]->{'col2'}).'
'. &print_rolecolors($phase,'author',$dom,$confname,$settings,\$rowtotal).'
'. &mt($item->{'header'}->[2]->{'col1'}).' '. &mt($item->{'header'}->[2]->{'col2'}).'
'. &print_rolecolors($phase,'admin',$dom,$confname,$settings,\$rowtotal); $rowtotal += 2; } } else { $output .= '
'.&mt($item->{'header'}->[3]->{'col1'}).' '.&mt($item->{'header'}->[3]->{'col2'}).'
'; if (($action eq 'login') || ($action eq 'directorysrch')) { $output .= ' '; } elsif ($action eq 'serverstatuses') { $output .= ' '; } else { $output .= ' '; } if (defined($item->{'header'}->[0]->{'col3'})) { $output .= ''; if ($item->{'header'}->[0]->{'col3'}) { if (defined($item->{'header'}->[0]->{'col4'})) { $output .= ''; } if ($item->{'header'}->[0]->{'col4'}) { $output .= ''; $rowtotal ++; if ($action eq 'login') { $output .= &print_login('bottom',$dom,$confname,$phase,$settings, \$rowtotal); } elsif ($action eq 'quotas') { $output .= &print_quotas($dom,$settings,\$rowtotal,$action); } elsif ($action eq 'autoenroll') { $output .= &print_autoenroll($dom,$settings,\$rowtotal); } elsif ($action eq 'autocreate') { $output .= &print_autocreate($dom,$settings,\$rowtotal); } elsif ($action eq 'directorysrch') { $output .= &print_directorysrch($dom,$settings,\$rowtotal); } elsif ($action eq 'contacts') { $output .= &print_contacts($dom,$settings,\$rowtotal); } elsif ($action eq 'defaults') { $output .= &print_defaults($dom,\$rowtotal); } elsif ($action eq 'scantron') { $output .= &print_scantronformat($r,$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'serverstatuses') { $output .= &print_serverstatuses($dom,$settings,\$rowtotal); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'loadbalancing') { $output .= &print_loadbalancing($dom,$settings,\$rowtotal); } } $output .= '
'.&mt($item->{'header'}->[0]->{'col1'}).''.&mt($item->{'header'}->[0]->{'col1'}). '
('.&mt('Automatic access for Dom. Coords.').')		'.&mt($item->{'header'}->[0]->{'col1'}).''. &mt($item->{'header'}->[0]->{'col2'}); if ($action eq 'serverstatuses') { $output .= '
('.&mt('user1:domain1,user2:domain2 etc.').')'; } } else { $output .= '		'. &mt($item->{'header'}->[0]->{'col2'}); } $output .= ''. &mt($item->{'header'}->[0]->{'col3'}); } else { $output .= ''. &mt($item->{'header'}->[0]->{'col3'}); } if ($action eq 'serverstatuses') { $output .= '
('.&mt('IP1,IP2 etc.').')'; } $output .= '		'. &mt($item->{'header'}->[0]->{'col4'}); } $output .= '

'; return ($output,$rowtotal); } sub print_login { my ($position,$dom,$confname,$phase,$settings,$rowtotal) = @_; my ($css_class,$datatable); my %choices = &login_choices(); if ($position eq 'top') { my %servers = &Apache::lonnet::internet_dom_servers($dom); my $choice = $choices{'disallowlogin'}; $css_class = ' class="LC_odd_row"'; $datatable .= '		'.$choice.''. ''. ''. ''. ''."\n"; my %disallowed; if (ref($settings) eq 'HASH') { if (ref($settings->{'loginvia'}) eq 'HASH') { %disallowed = %{$settings->{'loginvia'}}; } } foreach my $lonhost (sort(keys(%servers))) { my $direct = 'selected="selected"'; if (ref($disallowed{$lonhost}) eq 'HASH') { if ($disallowed{$lonhost}{'server'} ne '') { $direct = ''; } } $datatable .= ''. ''. ''; my ($custom,$exempt); if (ref($disallowed{$lonhost}) eq 'HASH') { $custom = $disallowed{$lonhost}{'custompath'}; $exempt = $disallowed{$lonhost}{'exempt'}; } $datatable .= ''. ''. ''; } $datatable .= '
'.$choices{'hostid'}.''.$choices{'server'}.''.$choices{'serverpath'}.''.$choices{'custompath'}.''.$choices{'exempt'}.'
'.$servers{$lonhost}.'
'.$choices{$item}. ''. ' 
'; return $datatable; } sub login_choices { my %choices = &Apache::lonlocal::texthash ( coursecatalog => 'Display Course/Community Catalog link?', adminmail => "Display Administrator's E-mail Address?", disallowlogin => "Login page requests redirected", hostid => "Server", server => "Redirect to:", serverpath => "Path", custompath => "Custom", exempt => "Exempt IP(s)", directlogin => "No redirect", newuser => "Link to create a user account", img => "Header", logo => "Main Logo", domlogo => "Domain Logo", login => "Log-in Header", textcol => "Text color", bgcol => "Box color", bgs => "Background colors", links => "Link colors", font => "Font color", pgbg => "Header", mainbg => "Page", sidebg => "Login box", link => "Link", alink => "Active link", vlink => "Visited link", ); return %choices; } sub print_rolecolors { my ($phase,$role,$dom,$confname,$settings,$rowtotal) = @_; my %choices = &color_font_choices(); my @bgs = ('pgbg','tabbg','sidebg'); my @links = ('link','alink','vlink'); my @images = ('img'); my %alt_text = &Apache::lonlocal::texthash(img => "Banner for $role role"); my %designhash = &Apache::loncommon::get_domainconf($dom); my %defaultdesign = %Apache::loncommon::defaultdesign; my (%is_custom,%designs); my %defaults = ( img => $defaultdesign{$role.'.img'}, font => $defaultdesign{$role.'.font'}, fontmenu => $defaultdesign{$role.'.fontmenu'}, ); foreach my $item (@bgs) { $defaults{'bgs'}{$item} = $defaultdesign{$role.'.'.$item}; } foreach my $item (@links) { $defaults{'links'}{$item} = $defaultdesign{$role.'.'.$item}; } if (ref($settings) eq 'HASH') { if (ref($settings->{$role}) eq 'HASH') { if ($settings->{$role}->{'img'} ne '') { $designs{'img'} = $settings->{$role}->{'img'}; $is_custom{'img'} = 1; } if ($settings->{$role}->{'font'} ne '') { $designs{'font'} = $settings->{$role}->{'font'}; $is_custom{'font'} = 1; } if ($settings->{$role}->{'fontmenu'} ne '') { $designs{'fontmenu'} = $settings->{$role}->{'fontmenu'}; $is_custom{'fontmenu'} = 1; } foreach my $item (@bgs) { if ($settings->{$role}->{$item} ne '') { $designs{'bgs'}{$item} = $settings->{$role}->{$item}; $is_custom{$item} = 1; } } foreach my $item (@links) { if ($settings->{$role}->{$item} ne '') { $designs{'links'}{$item} = $settings->{$role}->{$item}; $is_custom{$item} = 1; } } } } else { if ($designhash{$dom.'.'.$role.'.img'} ne '') { $designs{img} = $designhash{$dom.'.'.$role.'.img'}; $is_custom{'img'} = 1; } if ($designhash{$dom.'.'.$role.'.fontmenu'} ne '') { $designs{fontmenu} = $designhash{$dom.'.'.$role.'.fontmenu'}; $is_custom{'fontmenu'} = 1; } if ($designhash{$dom.'.'.$role.'.font'} ne '') { $designs{font} = $designhash{$dom.'.'.$role.'.font'}; $is_custom{'font'} = 1; } foreach my $item (@bgs) { if ($designhash{$dom.'.'.$role.'.'.$item} ne '') { $designs{'bgs'}{$item} = $designhash{$dom.'.'.$role.'.'.$item}; $is_custom{$item} = 1; } } foreach my $item (@links) { if ($designhash{$dom.'.'.$role.'.'.$item} ne '') { $designs{'links'}{$item} = $designhash{$dom.'.'.$role.'.'.$item}; $is_custom{$item} = 1; } } } my $itemcount = 1; my $datatable = &display_color_options($dom,$confname,$phase,$role,$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal); $datatable .= ''; return $datatable; } sub display_color_options { my ($dom,$confname,$phase,$role,$itemcount,$choices,$is_custom,$defaults,$designs, $images,$bgs,$links,$alt_text,$rowtotal,$logintext) = @_; my $css_class = $itemcount%2?' class="LC_odd_row"':''; my $datatable = ''. ''.$choices->{'font'}.''; if (!$is_custom->{'font'}) { $datatable .= ''.&mt('Default in use:').' '.$defaults->{'font'}.''; } else { $datatable .= ' '; } my $fontlink = &color_pick($phase,$role,'font',$choices->{'font'},$designs->{'font'}); $datatable .= ''. ' '.$fontlink. '    '. ''; unless ($role eq 'login') { $datatable .= ''. ''.$choices->{'fontmenu'}.''; if (!$is_custom->{'fontmenu'}) { $datatable .= ''.&mt('Default in use:').' '.$defaults->{'fontmenu'}.''; } else { $datatable .= ' '; } $fontlink = &color_pick($phase,$role,'fontmenu',$choices->{'fontmenu'},$designs->{'fontmenu'}); $datatable .= ''. ' '.$fontlink. '    '. ''; } my $switchserver = &check_switchserver($dom,$confname); foreach my $img (@{$images}) { $itemcount ++; $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''. ''.$choices->{$img}; my ($imgfile,$img_import,$login_hdr_pick,$logincolors); if ($role eq 'login') { if ($img eq 'login') { $login_hdr_pick = &login_header_options($img,$role,$defaults,$is_custom,$choices); $logincolors = &login_text_colors($img,$role,$logintext,$phase,$choices, $designs); } elsif ($img ne 'domlogo') { $datatable.= &logo_display_options($img,$defaults,$designs); } } $datatable .= ''; if ($designs->{$img} ne '') { $imgfile = $designs->{$img}; $img_import = ($imgfile =~ m{^/adm/}); } else { $imgfile = $defaults->{$img}; } if ($imgfile) { my ($showfile,$fullsize); if ($imgfile =~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) { my $urldir = $1; my $filename = $2; my @info = &Apache::lonnet::stat_file($designs->{$img}); if (@info) { my $thumbfile = 'tn-'.$filename; my @thumb=&Apache::lonnet::stat_file($urldir.'/'.$thumbfile); if (@thumb) { $showfile = $urldir.'/'.$thumbfile; } else { $showfile = $imgfile; } } else { $showfile = ''; } } elsif ($imgfile =~ m-^/(adm/[^/]+)/([^/]+)$-) { $showfile = $imgfile; my $imgdir = $1; my $filename = $2; if (-e "/home/httpd/html/$imgdir/tn-".$filename) { $showfile = "/$imgdir/tn-".$filename; } else { my $input = "/home/httpd/html".$imgfile; my $output = '/home/httpd/html/'.$imgdir.'/tn-'.$filename; if (!-e $output) { my ($width,$height) = &thumb_dimensions(); my ($fullwidth,$fullheight) = &check_dimensions($input); if ($fullwidth ne '' && $fullheight ne '') { if ($fullwidth > $width && $fullheight > $height) { my $size = $width.'x'.$height; system("convert -sample $size $input $output"); $showfile = '/'.$imgdir.'/tn-'.$filename; } } } } } if ($showfile) { if ($showfile =~ m{^/(adm|res)/}) { if ($showfile =~ m{^/res/}) { my $local_showfile = &Apache::lonnet::filelocation('',$showfile); &Apache::lonnet::repcopy($local_showfile); } $showfile = &Apache::loncommon::lonhttpdurl($showfile); } if ($imgfile) { if ($imgfile =~ m{^/(adm|res)/}) { if ($imgfile =~ m{^/res/}) { my $local_imgfile = &Apache::lonnet::filelocation('',$imgfile); &Apache::lonnet::repcopy($local_imgfile); } $fullsize = &Apache::loncommon::lonhttpdurl($imgfile); } else { $fullsize = $imgfile; } } $datatable .= ''; if ($img eq 'login') { $datatable .= $login_hdr_pick; } $datatable .= &image_changes($is_custom->{$img},$alt_text->{$img},$img_import, $showfile,$fullsize,$role,$img,$imgfile,$logincolors); } else { $datatable .= '
'. &mt('Upload:'); } } else { $datatable .= '
'. &mt('Upload:'); } if ($switchserver) { $datatable .= &mt('Upload to library server: [_1]',$switchserver); } else { if ($img ne 'login') { # suppress file selection for Log-in header $datatable .=' '; } } $datatable .= ''; } $itemcount ++; $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''. ''.$choices->{'bgs'}.''; my $bgs_def; foreach my $item (@{$bgs}) { if (!$is_custom->{$item}) { $bgs_def .= ''.$choices->{$item}.'    
'.$defaults->{'bgs'}{$item}.''; } } if ($bgs_def) { $datatable .= ''.&mt('Default(s) in use:').'
'.$bgs_def.'
'; } else { $datatable .= ' '; } $datatable .= ''. ''; foreach my $item (@{$bgs}) { my $link = &color_pick($phase,$role,$item,$choices->{$item},$designs->{'bgs'}{$item}); $datatable .= ''; } $datatable .= '
'.$link; if ($designs->{'bgs'}{$item}) { $datatable .= '    '; } $datatable .= '
'; $itemcount ++; $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''. ''.$choices->{'links'}.''; my $links_def; foreach my $item (@{$links}) { if (!$is_custom->{$item}) { $links_def .= ''.$choices->{$item}.'
'.$defaults->{'links'}{$item}.''; } } if ($links_def) { $datatable .= ''.&mt('Default(s) in use:').'
'.$links_def.'
'; } else { $datatable .= ' '; } $datatable .= ''. ''; foreach my $item (@{$links}) { $datatable .= ''; } $$rowtotal += $itemcount; return $datatable; } sub logo_display_options { my ($img,$defaults,$designs) = @_; my $checkedon; if (ref($defaults) eq 'HASH') { if (ref($defaults->{'showlogo'}) eq 'HASH') { if ($defaults->{'showlogo'}{$img}) { $checkedon = 'checked="checked" '; } } } if (ref($designs) eq 'HASH') { if (ref($designs->{'showlogo'}) eq 'HASH') { if (defined($designs->{'showlogo'}{$img})) { if ($designs->{'showlogo'}{$img} == 0) { $checkedon = ''; } elsif ($designs->{'showlogo'}{$img} == 1) { $checkedon = 'checked="checked" '; } } } } return '
'."\n"; } sub login_header_options { my ($img,$role,$defaults,$is_custom,$choices) = @_; my $output = ''; if ((!$is_custom->{'textcol'}) || (!$is_custom->{'bgcol'})) { $output .= &mt('Text default(s):').'
'; if (!$is_custom->{'textcol'}) { $output .= $choices->{'textcol'}.': '.$defaults->{'logintext'}{'textcol'}. '   '; } if (!$is_custom->{'bgcol'}) { $output .= $choices->{'bgcol'}.': '. '   '; } $output .= '
'; } $output .='
'; return $output; } sub login_text_colors { my ($img,$role,$logintext,$phase,$choices,$designs) = @_; my $color_menu = '
'."\n". &color_pick($phase,$role,$item,$choices->{$item}, $designs->{'links'}{$item}); if ($designs->{'links'}{$item}) { $datatable.='    '; } $datatable .= '
'; foreach my $item (@{$logintext}) { my $link = &color_pick($phase,$role,$item,$choices->{$item},$designs->{'logintext'}{$item}); $color_menu .= ''. ''; } $color_menu .= '
'.$link; if ($designs->{'logintext'}{$item}) { $color_menu .= '    '; } $color_menu .= '
 

'; return $color_menu; } sub image_changes { my ($is_custom,$alt_text,$img_import,$showfile,$fullsize,$role,$img,$imgfile,$logincolors) = @_; my $output; if ($img eq 'login') { # suppress image for Log-in header } elsif (!$is_custom) { if ($img ne 'domlogo') { $output .= &mt('Default image:').'
'; } else { $output .= &mt('Default in use:').'
'; } } if ($img eq 'login') { # suppress image for Log-in header $output .= ''.$logincolors; } else { if ($img_import) { $output .= ''; } $output .= ''.$alt_text.''; if ($is_custom) { $output .= ''.$logincolors.' '.&mt('Replace:').'
'; } else { $output .= ''.$logincolors.&mt('Upload:').'
'; } } return $output; } sub color_pick { my ($phase,$role,$item,$desc,$curcol) = @_; my $link = ''.$desc.''; return $link; } sub print_quotas { my ($dom,$settings,$rowtotal,$action) = @_; my $context; if ($action eq 'quotas') { $context = 'tools'; } else { $context = $action; } my ($datatable,$defaultquota,@usertools,@options,%validations); my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); my $typecount = 0; my ($css_class,%titles); if ($context eq 'requestcourses') { @usertools = ('official','unofficial','community'); @options =('norequest','approval','validate','autolimit'); %validations = &Apache::lonnet::auto_courserequest_checks($dom); %titles = &courserequest_titles(); } else { @usertools = ('aboutme','blog','portfolio'); %titles = &tool_titles(); } if (ref($types) eq 'ARRAY') { foreach my $type (@{$types}) { my $currdefquota; unless ($context eq 'requestcourses') { if (ref($settings) eq 'HASH') { if (ref($settings->{defaultquota}) eq 'HASH') { $currdefquota = $settings->{defaultquota}->{$type}; } else { $currdefquota = $settings->{$type}; } } } if (defined($usertypes->{$type})) { $typecount ++; $css_class = $typecount%2?' class="LC_odd_row"':''; $datatable .= ''. ''.$usertypes->{$type}.''. ''; if ($context eq 'requestcourses') { $datatable .= ''; } my %cell; foreach my $item (@usertools) { if ($context eq 'requestcourses') { my ($curroption,$currlimit); if (ref($settings) eq 'HASH') { if (ref($settings->{$item}) eq 'HASH') { $curroption = $settings->{$item}->{$type}; if ($curroption =~ /^autolimit=(\d*)$/) { $currlimit = $1; } } } if (!$curroption) { $curroption = 'norequest'; } $datatable .= ''; foreach my $option (@options) { my $val = $option; if ($option eq 'norequest') { $val = 0; } if ($option eq 'validate') { my $canvalidate = 0; if (ref($validations{$item}) eq 'HASH') { if ($validations{$item}{$type}) { $canvalidate = 1; } } next if (!$canvalidate); } my $checked = ''; if ($option eq $curroption) { $checked = ' checked="checked"'; } elsif ($option eq 'autolimit') { if ($curroption =~ /^autolimit/) { $checked = ' checked="checked"'; } } $cell{$item} .= ''; if ($option eq 'autolimit') { $cell{$item} .= ' '; } $cell{$item} .= ' '; if ($option eq 'autolimit') { $cell{$item} .= $titles{'unlimited'}; } } } else { my $checked = 'checked="checked" '; if (ref($settings) eq 'HASH') { if (ref($settings->{$item}) eq 'HASH') { if ($settings->{$item}->{$type} == 0) { $checked = ''; } elsif ($settings->{$item}->{$type} == 1) { $checked = 'checked="checked" '; } } } $datatable .= '  '; } } if ($context eq 'requestcourses') { $datatable .= ''; foreach my $item (@usertools) { $datatable .= ''; } $datatable .= '
'.$titles{$item}.'
'.$cell{$item}.'
'; } $datatable .= ''; unless ($context eq 'requestcourses') { $datatable .= ''. ' Mb'; } $datatable .= ''; } } } unless ($context eq 'requestcourses') { $defaultquota = '20'; if (ref($settings) eq 'HASH') { if (ref($settings->{'defaultquota'}) eq 'HASH') { $defaultquota = $settings->{'defaultquota'}->{'default'}; } elsif (defined($settings->{'default'})) { $defaultquota = $settings->{'default'}; } } } $typecount ++; $css_class = $typecount%2?' class="LC_odd_row"':''; $datatable .= ''. ''.$othertitle.''. ''; if ($context eq 'requestcourses') { $datatable .= ''; } my %defcell; foreach my $item (@usertools) { if ($context eq 'requestcourses') { my ($curroption,$currlimit); if (ref($settings) eq 'HASH') { if (ref($settings->{$item}) eq 'HASH') { $curroption = $settings->{$item}->{'default'}; if ($curroption =~ /^autolimit=(\d*)$/) { $currlimit = $1; } } } if (!$curroption) { $curroption = 'norequest'; } $datatable .= ''; foreach my $option (@options) { my $val = $option; if ($option eq 'norequest') { $val = 0; } if ($option eq 'validate') { my $canvalidate = 0; if (ref($validations{$item}) eq 'HASH') { if ($validations{$item}{'default'}) { $canvalidate = 1; } } next if (!$canvalidate); } my $checked = ''; if ($option eq $curroption) { $checked = ' checked="checked"'; } elsif ($option eq 'autolimit') { if ($curroption =~ /^autolimit/) { $checked = ' checked="checked"'; } } $defcell{$item} .= ''; if ($option eq 'autolimit') { $defcell{$item} .= ' '; } $defcell{$item} .= ' '; if ($option eq 'autolimit') { $defcell{$item} .= $titles{'unlimited'}; } } } else { my $checked = 'checked="checked" '; if (ref($settings) eq 'HASH') { if (ref($settings->{$item}) eq 'HASH') { if ($settings->{$item}->{'default'} == 0) { $checked = ''; } elsif ($settings->{$item}->{'default'} == 1) { $checked = 'checked="checked" '; } } } $datatable .= '  '; } } if ($context eq 'requestcourses') { $datatable .= ''; foreach my $item (@usertools) { $datatable .= ''; } $datatable .= '
'.$titles{$item}.'
'.$defcell{$item}.'
'; } $datatable .= ''; unless ($context eq 'requestcourses') { $datatable .= ''. ' Mb'; } $datatable .= ''; $typecount ++; $css_class = $typecount%2?' class="LC_odd_row"':''; $datatable .= ''. ''.&mt('LON-CAPA Advanced Users').' '; if ($context eq 'requestcourses') { $datatable .= &mt('(overrides affiliation, if set)'). ''. ''. ''; } else { $datatable .= &mt('(overrides affiliation, if checked)'). ''. ''; my $checked = ''; if ($curroption eq '') { $checked = ' checked="checked"'; } $advcell{$item} .= '  '; foreach my $option (@options) { my $val = $option; if ($option eq 'norequest') { $val = 0; } if ($option eq 'validate') { my $canvalidate = 0; if (ref($validations{$item}) eq 'HASH') { if ($validations{$item}{'_LC_adv'}) { $canvalidate = 1; } } next if (!$canvalidate); } my $checked = ''; if ($val eq $curroption) { $checked = ' checked="checked"'; } elsif ($option eq 'autolimit') { if ($curroption =~ /^autolimit/) { $checked = ' checked="checked"'; } } $advcell{$item} .= ''; if ($option eq 'autolimit') { $advcell{$item} .= ' '; } $advcell{$item} .= ' '; if ($option eq 'autolimit') { $advcell{$item} .= $titles{'unlimited'}; } } } else { my $checked = 'checked="checked" '; if (ref($settings) eq 'HASH') { if (ref($settings->{$item}) eq 'HASH') { if ($settings->{$item}->{'_LC_adv'} == 0) { $checked = ''; } elsif ($settings->{$item}->{'_LC_adv'} == 1) { $checked = 'checked="checked" '; } } } $datatable .= '  '; } } if ($context eq 'requestcourses') { $datatable .= ''; foreach my $item (@usertools) { $datatable .= ''; } $datatable .= '
'. '
'; } my %advcell; foreach my $item (@usertools) { if ($context eq 'requestcourses') { my ($curroption,$currlimit); if (ref($settings) eq 'HASH') { if (ref($settings->{$item}) eq 'HASH') { $curroption = $settings->{$item}->{'_LC_adv'}; if ($curroption =~ /^autolimit=(\d*)$/) { $currlimit = $1; } } } $datatable .= '		'.$titles{$item}.'
'.$advcell{$item}.'
'; } $datatable .= ''; $$rowtotal += $typecount; return $datatable; } sub print_courserequestmail { my ($dom,$settings,$rowtotal) = @_; my ($now,$datatable,%dompersonnel,@domcoord,@currapproval,$rows); $now = time; $rows = 0; %dompersonnel = &Apache::lonnet::get_domain_roles($dom,['dc'],$now,$now); foreach my $server (keys(%dompersonnel)) { foreach my $user (sort(keys(%{$dompersonnel{$server}}))) { my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user); if (!grep(/^$uname:$udom$/,@domcoord)) { push(@domcoord,$uname.':'.$udom); } } } if (ref($settings) eq 'HASH') { if (ref($settings->{'notify'}) eq 'HASH') { if ($settings->{'notify'}{'approval'} ne '') { @currapproval = split(',',$settings->{'notify'}{'approval'}); } } } if (@currapproval) { foreach my $dc (@currapproval) { unless (grep(/^\Q$dc\E$/,@domcoord)) { push(@domcoord,$dc); } } } @domcoord = sort(@domcoord); my $numinrow = 4; my $numdc = @domcoord; my $css_class = 'class="LC_odd_row"'; $datatable = ''. ' '.&mt('Receive notification of course requests requiring approval.'). ' '. ' '; if (@domcoord > 0) { $datatable .= ''; for (my $i=0; $i<$numdc; $i++) { my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $datatable .= ''; } $datatable .= ''; $rows ++; } my $check = ' '; if (grep(/^\Q$domcoord[$i]\E$/,@currapproval)) { $check = ' checked="checked" '; } my ($uname,$udom) = split(':',$domcoord[$i]); my $fullname = &Apache::loncommon::plainname($uname,$udom); if ($i == $numdc-1) { my $colsleft = $numinrow-$rem; if ($colsleft > 1) { $datatable .= ''; } $datatable .= '
'; } else { $datatable .= ''; } } else { $datatable .= ''; } $datatable .= '
'; } else { $datatable .= &mt('There are no active Domain Coordinators'); $rows ++; } $datatable .=''; $$rowtotal += $rows; return $datatable; } sub print_autoenroll { my ($dom,$settings,$rowtotal) = @_; my $autorun = &Apache::lonnet::auto_run(undef,$dom), my ($defdom,$runon,$runoff,$coownerson,$coownersoff); if (ref($settings) eq 'HASH') { if (exists($settings->{'run'})) { if ($settings->{'run'} eq '0') { $runoff = ' checked="checked" '; $runon = ' '; } else { $runon = ' checked="checked" '; $runoff = ' '; } } else { if ($autorun) { $runon = ' checked="checked" '; $runoff = ' '; } else { $runoff = ' checked="checked" '; $runon = ' '; } } if (exists($settings->{'co-owners'})) { if ($settings->{'co-owners'} eq '0') { $coownersoff = ' checked="checked" '; $coownerson = ' '; } else { $coownerson = ' checked="checked" '; $coownersoff = ' '; } } else { $coownersoff = ' checked="checked" '; $coownerson = ' '; } if (exists($settings->{'sender_domain'})) { $defdom = $settings->{'sender_domain'}; } } else { if ($autorun) { $runon = ' checked="checked" '; $runoff = ' '; } else { $runoff = ' checked="checked" '; $runon = ' '; } } my $domform = &Apache::loncommon::select_dom_form($defdom,'sender_domain',1); my $notif_sender; if (ref($settings) eq 'HASH') { $notif_sender = $settings->{'sender_uname'}; } my $datatable=''. ''.&mt('Auto-enrollment active?').''. ' '. ''. ''. ''.&mt('Notification messages - sender'). ''. &mt('username').': '. '  '.&mt('domain'). ': '.$domform.''. ''. ''.&mt('Automatically assign co-ownership').''. ' '. ''. ''; $$rowtotal += 3; return $datatable; } sub print_autoupdate { my ($position,$dom,$settings,$rowtotal) = @_; my $datatable; if ($position eq 'top') { my $updateon = ' '; my $updateoff = ' checked="checked" '; my $classlistson = ' '; my $classlistsoff = ' checked="checked" '; if (ref($settings) eq 'HASH') { if ($settings->{'run'} eq '1') { $updateon = $updateoff; $updateoff = ' '; } if ($settings->{'classlists'} eq '1') { $classlistson = $classlistsoff; $classlistsoff = ' '; } } my %title = ( run => 'Auto-update active?', classlists => 'Update information in classlists?', ); $datatable = ''. ''.&mt($title{'run'}).''. ' '. ''. ''. ''.&mt($title{'classlists'}).''. ''. ' '. ''. ''; $$rowtotal += 2; } elsif ($position eq 'middle') { my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); my $numinrow = 3; my $locknamesettings; $datatable .= &insttypes_row($settings,$types,$usertypes, $dom,$numinrow,$othertitle, 'lockablenames'); $$rowtotal ++; } else { my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); my @fields = ('lastname','firstname','middlename','generation', 'permanentemail','id'); my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); my $numrows = 0; if (ref($types) eq 'ARRAY') { if (@{$types} > 0) { $datatable = &usertype_update_row($settings,$usertypes,\%fieldtitles, \@fields,$types,\$numrows); $$rowtotal += @{$types}; } } $datatable .= &usertype_update_row($settings,{'default' => $othertitle}, \%fieldtitles,\@fields,['default'], \$numrows); $$rowtotal ++; } return $datatable; } sub print_autocreate { my ($dom,$settings,$rowtotal) = @_; my (%createon,%createoff); my $curr_dc; my @types = ('xml','req'); if (ref($settings) eq 'HASH') { foreach my $item (@types) { $createoff{$item} = ' checked="checked" '; $createon{$item} = ' '; if (exists($settings->{$item})) { if ($settings->{$item}) { $createon{$item} = ' checked="checked" '; $createoff{$item} = ' '; } } } $curr_dc = $settings->{'xmldc'}; } else { foreach my $item (@types) { $createoff{$item} = ' checked="checked" '; $createon{$item} = ' '; } } $$rowtotal += 2; my $datatable=''. ''.&mt('Create pending official courses from XML files').''. ' '. ''. ''. ''.&mt('Create pending requests for official courses (if validated)').''. ' '. ''; my ($numdc,$dctable) = &active_dc_picker($dom,$curr_dc); if ($numdc > 1) { $datatable .= ''. &mt('Course creation processed as: (choose Dom. Coord.)'). ''.$dctable.''; $$rowtotal ++ ; } else { $datatable .= $dctable.''; } return $datatable; } sub print_directorysrch { my ($dom,$settings,$rowtotal) = @_; 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) = &Apache::loncommon::sorted_inst_types($dom); my $numinrow = 4; my $cansrchrow = 0; my $datatable=''. ''.&mt('Directory search available?').''. ' '. ''. ''. ''.&mt('Other domains can search?').''. ' '. ''. ''; $$rowtotal += 2; if (ref($usertypes) eq 'HASH') { if (keys(%{$usertypes}) > 0) { $datatable .= &insttypes_row($settings,$types,$usertypes,$dom, $numinrow,$othertitle,'cansearch'); $cansrchrow = 1; } } if ($cansrchrow) { $$rowtotal ++; $datatable .= ''; } else { $datatable .= ''; } $datatable .= ''.&mt('Supported search methods'). ''; foreach my $title (@{$titleorder}) { if (defined($searchtitles->{$title})) { my $check = ' '; if (ref($settings) eq 'HASH') { if (ref($settings->{'searchby'}) eq 'ARRAY') { if (grep(/^\Q$title\E$/,@{$settings->{'searchby'}})) { $check = ' checked="checked" '; } } } $datatable .= ''; } } $datatable .= '
'. '
'; $$rowtotal ++; if ($cansrchrow) { $datatable .= ''; } else { $datatable .= ''; } $datatable .= ''.&mt('Search latitude').''. ''. ' '. ' '. ''; $$rowtotal ++; return $datatable; } sub print_contacts { my ($dom,$settings,$rowtotal) = @_; my $datatable; my @contacts = ('adminemail','supportemail'); my (%checked,%to,%otheremails,%bccemails); my @mailings = ('errormail','packagesmail','lonstatusmail','helpdeskmail', 'requestsmail'); foreach my $type (@mailings) { $otheremails{$type} = ''; } $bccemails{'helpdeskmail'} = ''; 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'}; if ($type eq 'helpdeskmail') { $bccemails{$type} = $settings->{$type}{'bcc'}; } } } elsif ($type eq 'lonstatusmail') { $checked{'lonstatusmail'}{'adminemail'} = ' checked="checked" '; } } } 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" '; $checked{'lonstatusmail'}{'adminemail'} = ' checked="checked" '; $checked{'requestsmail'}{'adminemail'} = ' checked="checked" '; } my ($titles,$short_titles) = &contact_titles(); my $rownum = 0; my $css_class; foreach my $item (@contacts) { $rownum ++; $css_class = $rownum%2?' class="LC_odd_row"':''; $datatable .= ''. ''.$titles->{$item}. ''. ''; } foreach my $type (@mailings) { $rownum ++; $css_class = $rownum%2?' class="LC_odd_row"':''; $datatable .= ''. ''. $titles->{$type}.': '. ''. ''; foreach my $item (@contacts) { $datatable .= ' '; } $datatable .= '
'.&mt('Others').':  '. ''; if ($type eq 'helpdeskmail') { $datatable .= '
'.&mt('Bcc:').(' 'x6). ''; } $datatable .= ''."\n"; } $$rowtotal += $rownum; return $datatable; } sub print_helpsettings { my ($position,$dom,$confname,$settings,$rowtotal) = @_; my ($css_class,$datatable); my $switchserver = &check_switchserver($dom,$confname); my $itemcount = 1; if ($position eq 'top') { my (%checkedon,%checkedoff,%choices,%defaultchecked,@toggles); %choices = &Apache::lonlocal::texthash ( submitbugs => 'Display "Submit a bug" link?', ); %defaultchecked = ('submitbugs' => 'on'); @toggles = ('submitbugs',); foreach my $item (@toggles) { if ($defaultchecked{$item} eq 'on') { $checkedon{$item} = ' checked="checked" '; $checkedoff{$item} = ' '; } elsif ($defaultchecked{$item} eq 'off') { $checkedoff{$item} = ' checked="checked" '; $checkedon{$item} = ' '; } } if (ref($settings) eq 'HASH') { foreach my $item (@toggles) { if ($settings->{$item} eq '1') { $checkedon{$item} = ' checked="checked" '; $checkedoff{$item} = ' '; } elsif ($settings->{$item} eq '0') { $checkedoff{$item} = ' checked="checked" '; $checkedon{$item} = ' '; } } } foreach my $item (@toggles) { $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; $datatable .= ' '.$choices{$item}.'     '. ''. ''; $itemcount ++; } } else { $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; $datatable .= ''; if (ref($settings) eq 'HASH') { if ($settings->{'loginhelpurl'} ne '') { my($directory, $filename) = $settings->{'loginhelpurl'} =~ m/(.*\/)(.*)$/; $datatable .= ''; $datatable .= '' } else { $datatable .= ''; $datatable .= ' '; } } else { $datatable .= ' '; $datatable .= ' '; } $datatable .= ''; if ($switchserver) { $datatable .= &mt('Upload to library server: [_1]',$switchserver); } else { $datatable .= &mt('Upload Custom Login Page Help File:'); $datatable .=''; } $datatable .= ''; } return $datatable; } sub radiobutton_prefs { my ($settings,$toggles,$defaultchecked,$choices,$itemcount) = @_; return unless ((ref($toggles) eq 'ARRAY') && (ref($defaultchecked) eq 'HASH') && (ref($choices) eq 'HASH')); my (%checkedon,%checkedoff,$datatable,$css_class); foreach my $item (@{$toggles}) { if ($defaultchecked->{$item} eq 'on') { $checkedon{$item} = ' checked="checked" '; $checkedoff{$item} = ' '; } elsif ($defaultchecked->{$item} eq 'off') { $checkedoff{$item} = ' checked="checked" '; $checkedon{$item} = ' '; } } if (ref($settings) eq 'HASH') { foreach my $item (@{$toggles}) { if ($settings->{$item} eq '1') { $checkedon{$item} = ' checked="checked" '; $checkedoff{$item} = ' '; } elsif ($settings->{$item} eq '0') { $checkedoff{$item} = ' checked="checked" '; $checkedon{$item} = ' '; } } } foreach my $item (@{$toggles}) { $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''.$choices->{$item}. ''. ''. ' '. ''. ''; $itemcount ++; } return ($datatable,$itemcount); } sub print_coursedefaults { my ($position,$dom,$settings,$rowtotal) = @_; my ($css_class,$datatable); my $itemcount = 1; if ($position eq 'top') { my (%checkedon,%checkedoff,%choices,%defaultchecked,@toggles); %choices = &Apache::lonlocal::texthash ( canuse_pdfforms => 'Course/Community users can create/upload PDF forms', ); %defaultchecked = ('canuse_pdfforms' => 'off'); @toggles = ('canuse_pdfforms',); ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked, \%choices,$itemcount); $$rowtotal += $itemcount; } else { $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; my %choices = &Apache::lonlocal::texthash ( anonsurvey_threshold => 'Responder count needed before showing submissions for anonymous surveys', ); my $currdefresponder; if (ref($settings) eq 'HASH') { $currdefresponder = $settings->{'anonsurvey_threshold'}; } if (!$currdefresponder) { $currdefresponder = 10; } elsif ($currdefresponder < 1) { $currdefresponder = 1; } $datatable .= ''.$choices{'anonsurvey_threshold'}. ''. ''. ''. ''; } return $datatable; } sub print_usersessions { my ($position,$dom,$settings,$rowtotal) = @_; my ($css_class,$datatable,%checked,%choices); my (%by_ip,%by_location,@intdoms); &build_location_hashes(\@intdoms,\%by_ip,\%by_location); my @alldoms = &Apache::lonnet::all_domains(); my %serverhomes = %Apache::lonnet::serverhomeIDs; my %servers = &Apache::lonnet::internet_dom_servers($dom); my %altids = &id_for_thisdom(%servers); my $itemcount = 1; if ($position eq 'top') { if (keys(%serverhomes) > 1) { my %spareid = ¤t_offloads_to($dom,$settings,\%servers); $datatable .= &spares_row($dom,\%servers,\%spareid,\%serverhomes,\%altids,$rowtotal); } else { $datatable .= ''. &mt('Nothing to set here, as the cluster to which this domain belongs only contains one server.'); } } else { if (keys(%by_location) == 0) { $datatable .= ''. &mt('Nothing to set here, as the cluster to which this domain belongs only contains one institution.'); } else { my %lt = &usersession_titles(); my $numinrow = 5; my $prefix; my @types; if ($position eq 'bottom') { $prefix = 'remote'; @types = ('version','excludedomain','includedomain'); } else { $prefix = 'hosted'; @types = ('excludedomain','includedomain'); } my (%current,%checkedon,%checkedoff); my @lcversions = &Apache::lonnet::all_loncaparevs(); my @locations = sort(keys(%by_location)); foreach my $type (@types) { $checkedon{$type} = ''; $checkedoff{$type} = ' checked="checked"'; } if (ref($settings) eq 'HASH') { if (ref($settings->{$prefix}) eq 'HASH') { foreach my $key (keys(%{$settings->{$prefix}})) { $current{$key} = $settings->{$prefix}{$key}; if ($key eq 'version') { if ($current{$key} ne '') { $checkedon{$key} = ' checked="checked"'; $checkedoff{$key} = ''; } } elsif (ref($current{$key}) eq 'ARRAY') { $checkedon{$key} = ' checked="checked"'; $checkedoff{$key} = ''; } } } } foreach my $type (@types) { next if ($type ne 'version' && !@locations); $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; $datatable .= ' '.$lt{$type}.'
    '; if ($type eq 'version') { my $selector = ' '; $datatable .= &mt('remote server must be version: [_1] or later',$selector); } else { $datatable.= '
'.(' 'x2). ''. "\n". '
'; my $rem; for (my $i=0; $i<@locations; $i++) { my ($showloc,$value,$checkedtype); if (ref($by_location{$locations[$i]}) eq 'ARRAY') { my $ip = $by_location{$locations[$i]}->[0]; if (ref($by_ip{$ip}) eq 'ARRAY') { $value = join(':',@{$by_ip{$ip}}); $showloc = join(', ',@{$by_ip{$ip}}); if (ref($current{$type}) eq 'ARRAY') { foreach my $loc (@{$by_ip{$ip}}) { if (grep(/^\Q$loc\E$/,@{$current{$type}})) { $checkedtype = ' checked="checked"'; last; } } } } } $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $datatable .= ''; } $datatable .= ''; } $datatable .= ''; } $rem = @locations%($numinrow); my $colsleft = $numinrow - $rem; if ($colsleft > 1 ) { $datatable .= ''; } elsif ($colsleft == 1) { $datatable .= ''; } $datatable .= '
'. ''. '  
'; } $datatable .= ''; $itemcount ++; } } } $$rowtotal += $itemcount; return $datatable; } sub build_location_hashes { my ($intdoms,$by_ip,$by_location) = @_; return unless((ref($intdoms) eq 'ARRAY') && (ref($by_ip) eq 'HASH') && (ref($by_location) eq 'HASH')); my %iphost = &Apache::lonnet::get_iphost(); my $primary_id = &Apache::lonnet::domain($env{'request.role.domain'},'primary'); my $primary_ip = &Apache::lonnet::get_host_ip($primary_id); if (ref($iphost{$primary_ip}) eq 'ARRAY') { foreach my $id (@{$iphost{$primary_ip}}) { my $intdom = &Apache::lonnet::internet_dom($id); unless(grep(/^\Q$intdom\E$/,@{$intdoms})) { push(@{$intdoms},$intdom); } } } foreach my $ip (keys(%iphost)) { if (ref($iphost{$ip}) eq 'ARRAY') { foreach my $id (@{$iphost{$ip}}) { my $location = &Apache::lonnet::internet_dom($id); if ($location) { next if (grep(/^\Q$location\E$/,@{$intdoms})); if (ref($by_ip->{$ip}) eq 'ARRAY') { unless(grep(/^\Q$location\E$/,@{$by_ip->{$ip}})) { push(@{$by_ip->{$ip}},$location); } } else { $by_ip->{$ip} = [$location]; } } } } } foreach my $ip (sort(keys(%{$by_ip}))) { if (ref($by_ip->{$ip}) eq 'ARRAY') { @{$by_ip->{$ip}} = sort(@{$by_ip->{$ip}}); my $first = $by_ip->{$ip}->[0]; if (ref($by_location->{$first}) eq 'ARRAY') { unless (grep(/^\Q$ip\E$/,@{$by_location->{$first}})) { push(@{$by_location->{$first}},$ip); } } else { $by_location->{$first} = [$ip]; } } } return; } sub current_offloads_to { my ($dom,$settings,$servers) = @_; my (%spareid,%otherdomconfigs); if (ref($servers) eq 'HASH') { foreach my $lonhost (sort(keys(%{$servers}))) { my $gotspares; if (ref($settings) eq 'HASH') { if (ref($settings->{'spares'}) eq 'HASH') { if (ref($settings->{'spares'}{$lonhost}) eq 'HASH') { $spareid{$lonhost}{'primary'} = $settings->{'spares'}{$lonhost}{'primary'}; $spareid{$lonhost}{'default'} = $settings->{'spares'}{$lonhost}{'default'}; $gotspares = 1; } } } unless ($gotspares) { my $gotspares; my $serverhomeID = &Apache::lonnet::get_server_homeID($servers->{$lonhost}); my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); if ($serverhomedom ne $dom) { if (ref($otherdomconfigs{$serverhomedom} eq 'HASH')) { if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}) eq 'HASH') { if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}) eq 'HASH') { $spareid{$lonhost}{'primary'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'primary'}; $spareid{$lonhost}{'default'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'default'}; $gotspares = 1; } } } else { $otherdomconfigs{$serverhomedom} = &Apache::lonnet::get_dom('configuration',['usersessions'],$serverhomedom); if (ref($otherdomconfigs{$serverhomedom}) eq 'HASH') { if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}) eq 'HASH') { if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}) eq 'HASH') { if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{$lonhost}) eq 'HASH') { $spareid{$lonhost}{'primary'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'primary'}; $spareid{$lonhost}{'default'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'default'}; $gotspares = 1; } } } } } } } unless ($gotspares) { if ($lonhost eq $Apache::lonnet::perlvar{'lonHostID'}) { $spareid{$lonhost}{'primary'} = $Apache::lonnet::spareid{'primary'}; $spareid{$lonhost}{'default'} = $Apache::lonnet::spareid{'default'}; } else { my $server_hostname = &Apache::lonnet::hostname($lonhost); my $server_homeID = &Apache::lonnet::get_server_homeID($server_hostname); if ($server_homeID eq $Apache::lonnet::perlvar{'lonHostID'}) { $spareid{$lonhost}{'primary'} = $Apache::lonnet::spareid{'primary'}; $spareid{$lonhost}{'default'} = $Apache::lonnet::spareid{'default'}; } else { my %what = ( spareid => 1, ); my ($result,$returnhash) = &Apache::lonnet::get_remote_globals($lonhost,\%what); if ($result eq 'ok') { if (ref($returnhash) eq 'HASH') { if (ref($returnhash->{'spareid'}) eq 'HASH') { $spareid{$lonhost}{'primary'} = $returnhash->{'spareid'}->{'primary'}; $spareid{$lonhost}{'default'} = $returnhash->{'spareid'}->{'default'}; } } } } } } } } return %spareid; } sub spares_row { my ($dom,$servers,$spareid,$serverhomes,$altids,$rowtotal) = @_; my $css_class; my $numinrow = 4; my $itemcount = 1; my $datatable; my %typetitles = &sparestype_titles(); if ((ref($servers) eq 'HASH') && (ref($spareid) eq 'HASH') && (ref($altids) eq 'HASH')) { foreach my $server (sort(keys(%{$servers}))) { my $serverhome = &Apache::lonnet::get_server_homeID($servers->{$server}); my ($othercontrol,$serverdom); if ($serverhome ne $server) { $serverdom = &Apache::lonnet::host_domain($serverhome); $othercontrol = &mt('Session offloading controlled by domain: [_1]',''.$serverdom.''); } else { $serverdom = &Apache::lonnet::host_domain($server); if ($serverdom ne $dom) { $othercontrol = &mt('Session offloading controlled by domain: [_1]',''.$serverdom.''); } } next unless (ref($spareid->{$server}) eq 'HASH'); $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; $datatable .= ' '.$server.' when busy, offloads to:'."\n"; my (%current,%canselect); my @choices = &possible_newspares($server,$spareid->{$server},$serverhomes,$altids); foreach my $type ('primary','default') { if (ref($spareid->{$server}) eq 'HASH') { if (ref($spareid->{$server}{$type}) eq 'ARRAY') { my @spares = @{$spareid->{$server}{$type}}; if (@spares > 0) { if ($othercontrol) { $current{$type} = join(', ',@spares); } else { $current{$type} .= ''; my $numspares = scalar(@spares); for (my $i=0; $i<@spares; $i++) { my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $current{$type} .= ''; } $current{$type} .= ''; } $current{$type} .= ''."\n"; } my $rem = @spares%($numinrow); my $colsleft = $numinrow - $rem; if ($colsleft > 1 ) { $current{$type} .= ''; } elsif ($colsleft == 1) { $current{$type} .= ''."\n"; } $current{$type} .= '
'. '  
'; } } } if ($current{$type} eq '') { $current{$type} = &mt('None specified'); } if ($othercontrol) { if ($type eq 'primary') { $canselect{$type} = $othercontrol; } } else { $canselect{$type} = &mt('Add new [_1]'.$type.'[_2]:','','').' '. ''."\n"; } } else { $current{$type} = &mt('Could not be determined'); if ($type eq 'primary') { $canselect{$type} = $othercontrol; } } if ($type eq 'default') { $datatable .= ''; } $datatable .= ''.$typetitles{$type}.''."\n". ''.$current{$type}.''."\n". ''.$canselect{$type}.''."\n"; } $itemcount ++; } } $$rowtotal += $itemcount; return $datatable; } sub possible_newspares { my ($server,$currspares,$serverhomes,$altids) = @_; my $serverhostname = &Apache::lonnet::hostname($server); my %excluded; if ($serverhostname ne '') { %excluded = ( $serverhostname => 1, ); } if (ref($currspares) eq 'HASH') { foreach my $type (keys(%{$currspares})) { if (ref($currspares->{$type}) eq 'ARRAY') { if (@{$currspares->{$type}} > 0) { foreach my $curr (@{$currspares->{$type}}) { my $hostname = &Apache::lonnet::hostname($curr); $excluded{$hostname} = 1; } } } } } my @choices; if ((ref($serverhomes) eq 'HASH') && (ref($altids) eq 'HASH')) { if (keys(%{$serverhomes}) > 1) { foreach my $name (sort(keys(%{$serverhomes}))) { unless ($excluded{$name}) { if (exists($altids->{$serverhomes->{$name}})) { push(@choices,$altids->{$serverhomes->{$name}}); } else { push(@choices,$serverhomes->{$name}); } } } } } return sort(@choices); } sub print_loadbalancing { my ($dom,$settings,$rowtotal) = @_; my $primary_id = &Apache::lonnet::domain($dom,'primary'); my $intdom = &Apache::lonnet::internet_dom($primary_id); my $numinrow = 1; my $datatable; my %servers = &Apache::lonnet::internet_dom_servers($dom); my ($currbalancer,$currtargets,$currrules); if (keys(%servers) > 1) { if (ref($settings) eq 'HASH') { $currbalancer = $settings->{'lonhost'}; $currtargets = $settings->{'targets'}; $currrules = $settings->{'rules'}; } else { ($currbalancer,$currtargets) = &Apache::lonnet::get_lonbalancer_config(\%servers); } } else { return; } my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); my $rownum = 6; if (ref($types) eq 'ARRAY') { $rownum += scalar(@{$types}); } my $css_class = ' class="LC_odd_row"'; my $targets_div_style = 'display: none'; my $disabled_div_style = 'display: block'; my $homedom_div_style = 'display: none'; $datatable = ''. ''. '

'. '
'.&mt('No dedicated Load Balancer').'
'."\n". '
'.&mt('Offloads to:').'
'; my ($numspares,@spares) = &count_servers($currbalancer,%servers); my @sparestypes = ('primary','default'); my %typetitles = &sparestype_titles(); foreach my $sparetype (@sparestypes) { my $targettable; for (my $i=0; $i<$numspares; $i++) { my $checked; if (ref($currtargets) eq 'HASH') { if (ref($currtargets->{$sparetype}) eq 'ARRAY') { if (grep(/^\Q$spares[$i]\E$/,@{$currtargets->{$sparetype}})) { $checked = ' checked="checked"'; } } } my $chkboxval; if (($currbalancer ne '') && (grep((/^\Q$currbalancer\E$/,keys(%servers))))) { $chkboxval = $spares[$i]; } $targettable .= ''; my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $targettable .= ''; } $targettable .= ''; } } if ($targettable ne '') { my $rem = $numspares%($numinrow); my $colsleft = $numinrow - $rem; if ($colsleft > 1 ) { $targettable .= ''. ' '; } elsif ($colsleft == 1) { $targettable .= ' '; } $datatable .= ''.$typetitles{$sparetype}.'
'. ''.$targettable.'

'; } } $datatable .= '
'. &loadbalancing_rules($dom,$intdom,$currrules,$othertitle, $usertypes,$types,\%servers,$currbalancer, $targets_div_style,$homedom_div_style,$css_class); $$rowtotal += $rownum; return $datatable; } sub loadbalancing_rules { my ($dom,$intdom,$currrules,$othertitle,$usertypes,$types,$servers, $currbalancer,$targets_div_style,$homedom_div_style,$css_class) = @_; my $output; my ($alltypes,$othertypes,$titles) = &loadbalancing_titles($dom,$intdom,$usertypes,$types); if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH')) { foreach my $type (@{$alltypes}) { my $current; if (ref($currrules) eq 'HASH') { $current = $currrules->{$type}; } if (($type eq '_LC_external') || ($type eq '_LC_internetdom')) { if ($dom ne &Apache::lonnet::host_domain($currbalancer)) { $current = ''; } } $output .= &loadbalance_rule_row($type,$titles->{$type},$current, $servers,$currbalancer,$dom, $targets_div_style,$homedom_div_style,$css_class); } } return $output; } sub loadbalancing_titles { my ($dom,$intdom,$usertypes,$types) = @_; my %othertypes = ( '_LC_adv' => &mt('Advanced users from [_1]',$dom), '_LC_author' => &mt('Users from [_1] with author role',$dom), '_LC_internetdom' => &mt('Users not from [_1], but from [_2]',$dom,$intdom), '_LC_external' => &mt('Users not from [_1]',$intdom), ); my @alltypes = ('_LC_adv','_LC_author','_LC_internetdom','_LC_external'); if (ref($types) eq 'ARRAY') { unshift(@alltypes,@{$types},'default'); } my %titles; foreach my $type (@alltypes) { if ($type =~ /^_LC_/) { $titles{$type} = $othertypes{$type}; } elsif ($type eq 'default') { $titles{$type} = &mt('All users from [_1]',$dom); if (ref($types) eq 'ARRAY') { if (@{$types} > 0) { $titles{$type} = &mt('Other users from [_1]',$dom); } } } elsif (ref($usertypes) eq 'HASH') { $titles{$type} = $usertypes->{$type}; } } return (\@alltypes,\%othertypes,\%titles); } sub loadbalance_rule_row { my ($type,$title,$current,$servers,$currbalancer,$dom,$targets_div_style, $homedom_div_style,$css_class) = @_; my @rulenames = ('default','homeserver'); my %ruletitles = &offloadtype_text(); if ($type eq '_LC_external') { push(@rulenames,'externalbalancer'); } else { push(@rulenames,'specific'); } my $style = $targets_div_style; if (($type eq '_LC_external') || ($type eq '_LC_internetdom')) { $style = $homedom_div_style; } my $output = '
'.$title.'
'."\n". '
'."\n"; for (my $i=0; $i<@rulenames; $i++) { my $rule = $rulenames[$i]; my ($checked,$extra); if ($rulenames[$i] eq 'default') { $rule = ''; } if ($rulenames[$i] eq 'specific') { if (ref($servers) eq 'HASH') { my $default; if (($current ne '') && (exists($servers->{$current}))) { $checked = ' checked="checked"'; } unless ($checked) { $default = ' selected="selected"'; } $extra = ': '; } } elsif ($rule eq $current) { $checked = ' checked="checked"'; } $output .= ''.$extra.'
'."\n"; } $output .= '
'."\n"; return $output; } sub offloadtype_text { my %ruletitles = &Apache::lonlocal::texthash ( 'default' => 'Offloads to default destinations', 'homeserver' => "Offloads to user's home server", 'externalbalancer' => "Offloads to Load Balancer in user's domain", 'specific' => 'Offloads to specific server', ); return %ruletitles; } sub sparestype_titles { my %typestitles = &Apache::lonlocal::texthash ( 'primary' => 'primary', 'default' => 'default', ); return %typestitles; } 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', 'lonstatusmail' => 'E-mail from nightly status check (warnings/errors)', 'requestsmail' => 'E-mail from course requests requiring approval', ); my %short_titles = &Apache::lonlocal::texthash ( adminemail => 'Admin E-mail address', supportemail => 'Support E-mail', ); return (\%titles,\%short_titles); } sub tool_titles { my %titles = &Apache::lonlocal::texthash ( aboutme => 'Personal Information Page', blog => 'Blog', portfolio => 'Portfolio', official => 'Official courses (with institutional codes)', unofficial => 'Unofficial courses', community => 'Communities', ); return %titles; } sub courserequest_titles { my %titles = &Apache::lonlocal::texthash ( official => 'Official', unofficial => 'Unofficial', community => 'Communities', norequest => 'Not allowed', approval => 'Approval by Dom. Coord.', validate => 'With validation', autolimit => 'Numerical limit', unlimited => '(blank for unlimited)', ); return %titles; } sub courserequest_conditions { my %conditions = &Apache::lonlocal::texthash ( approval => '(Processing of request subject to approval by Domain Coordinator).', validate => '(Processing of request subject to instittutional validation).', ); return %conditions; } sub print_usercreation { my ($position,$dom,$settings,$rowtotal) = @_; my $numinrow = 4; my $datatable; if ($position eq 'top') { $$rowtotal ++; my $rowcount = 0; my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom,'username'); if (ref($rules) eq 'HASH') { if (keys(%{$rules}) > 0) { $datatable .= &user_formats_row('username',$settings,$rules, $ruleorder,$numinrow,$rowcount); $$rowtotal ++; $rowcount ++; } } my ($idrules,$idruleorder) = &Apache::lonnet::inst_userrules($dom,'id'); if (ref($idrules) eq 'HASH') { if (keys(%{$idrules}) > 0) { $datatable .= &user_formats_row('id',$settings,$idrules, $idruleorder,$numinrow,$rowcount); $$rowtotal ++; $rowcount ++; } } my ($emailrules,$emailruleorder) = &Apache::lonnet::inst_userrules($dom,'email'); if (ref($emailrules) eq 'HASH') { if (keys(%{$emailrules}) > 0) { $datatable .= &user_formats_row('email',$settings,$emailrules, $emailruleorder,$numinrow,$rowcount); $$rowtotal ++; $rowcount ++; } } if ($rowcount == 0) { $datatable .= ''.&mt('No format rules have been defined for usernames or IDs in this domain.').''; $$rowtotal ++; $rowcount ++; } } elsif ($position eq 'middle') { my @creators = ('author','course','requestcrs','selfcreate'); my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom,'username'); my %lt = &usercreation_types(); my %checked; my @selfcreate; if (ref($settings) eq 'HASH') { if (ref($settings->{'cancreate'}) eq 'HASH') { foreach my $item (@creators) { $checked{$item} = $settings->{'cancreate'}{$item}; } if (ref($settings->{'cancreate'}{'selfcreate'}) eq 'ARRAY') { @selfcreate = @{$settings->{'cancreate'}{'selfcreate'}}; } elsif ($settings->{'cancreate'}{'selfcreate'} ne '') { if ($settings->{'cancreate'}{'selfcreate'} eq 'any') { @selfcreate = ('email','login','sso'); } elsif ($settings->{'cancreate'}{'selfcreate'} ne 'none') { @selfcreate = ($settings->{'cancreate'}{'selfcreate'}); } } } elsif (ref($settings->{'cancreate'}) eq 'ARRAY') { foreach my $item (@creators) { if (grep(/^\Q$item\E$/,@{$settings->{'cancreate'}})) { $checked{$item} = 'none'; } } } } my $rownum = 0; foreach my $item (@creators) { $rownum ++; if ($item ne 'selfcreate') { if ($checked{$item} eq '') { $checked{$item} = 'any'; } } my $css_class; if ($rownum%2) { $css_class = ''; } else { $css_class = ' class="LC_odd_row" '; } $datatable .= ''. ''.$lt{$item}. ''; my @options; if ($item eq 'selfcreate') { push(@options,('email','login','sso')); } else { @options = ('any'); if (ref($rules) eq 'HASH') { if (keys(%{$rules}) > 0) { push(@options,('official','unofficial')); } } push(@options,'none'); } foreach my $option (@options) { my $type = 'radio'; my $check = ' '; if ($item eq 'selfcreate') { $type = 'checkbox'; if (grep(/^\Q$option\E$/,@selfcreate)) { $check = ' checked="checked" '; } } else { if ($checked{$item} eq $option) { $check = ' checked="checked" '; } } $datatable .= '  '; } $datatable .= ''; } my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); if (ref($usertypes) eq 'HASH') { if (keys(%{$usertypes}) > 0) { my $createsettings; if (ref($settings) eq 'HASH') { $createsettings = $settings->{cancreate}; } $datatable .= &insttypes_row($createsettings,$types,$usertypes, $dom,$numinrow,$othertitle, 'statustocreate'); $$rowtotal ++; } } } 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" '; } } } } } } else { foreach my $item (@contexts) { foreach my $auth (@authtypes) { $checked{$item}{$auth} = ' checked="checked" '; } } } 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 ++; } $$rowtotal += $rownum; } return $datatable; } sub user_formats_row { my ($type,$settings,$rules,$ruleorder,$numinrow,$rowcount) = @_; my $output; my %text = ( 'username' => 'new usernames', 'id' => 'IDs', 'email' => 'self-created accounts (e-mail)', ); my $css_class = $rowcount%2?' class="LC_odd_row"':''; $output = ''. ''; if ($type eq 'email') { $output .= &mt("Formats disallowed for $text{$type}: "); } else { $output .= &mt("Format rules to check for $text{$type}: "); } $output .= ''. ''; 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) eq 'HASH') { if (ref($settings->{$type.'_rule'}) eq 'ARRAY') { if (grep(/^\Q$ruleorder->[$i]\E$/,@{$settings->{$type.'_rule'}})) { $check = ' checked="checked" '; } } } $output .= ''; } } $rem = @{$ruleorder}%($numinrow); } my $colsleft = $numinrow - $rem; if ($colsleft > 1 ) { $output .= ''; } elsif ($colsleft == 1) { $output .= ''; } $output .= '
'. ''. '  
'; return $output; } sub usercreation_types { my %lt = &Apache::lonlocal::texthash ( author => 'When adding a co-author', course => 'When adding a user to a course', requestcrs => 'When requesting a course', selfcreate => 'User creates own account', any => 'Any', official => 'Institutional only ', unofficial => 'Non-institutional only', email => 'E-mail address', login => 'Institutional Login', sso => 'SSO', none => 'None', ); return %lt; } 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 print_usermodification { my ($position,$dom,$settings,$rowtotal) = @_; my $numinrow = 4; my ($context,$datatable,$rowcount); if ($position eq 'top') { $rowcount = 0; $context = 'author'; foreach my $role ('ca','aa') { $datatable .= &modifiable_userdata_row($context,$role,$settings, $numinrow,$rowcount); $$rowtotal ++; $rowcount ++; } } elsif ($position eq 'middle') { $context = 'course'; $rowcount = 0; foreach my $role ('st','ep','ta','in','cr') { $datatable .= &modifiable_userdata_row($context,$role,$settings, $numinrow,$rowcount); $$rowtotal ++; $rowcount ++; } } elsif ($position eq 'bottom') { $context = 'selfcreate'; my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); $usertypes->{'default'} = $othertitle; if (ref($types) eq 'ARRAY') { push(@{$types},'default'); $usertypes->{'default'} = $othertitle; foreach my $status (@{$types}) { $datatable .= &modifiable_userdata_row($context,$status,$settings, $numinrow,$rowcount,$usertypes); $$rowtotal ++; $rowcount ++; } } } return $datatable; } sub print_defaults { my ($dom,$rowtotal) = @_; my @items = ('auth_def','auth_arg_def','lang_def','timezone_def', 'datelocale_def','portal_def'); my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); my $titles = &defaults_titles($dom); my $rownum = 0; my ($datatable,$css_class); foreach my $item (@items) { if ($rownum%2) { $css_class = ''; } else { $css_class = ' class="LC_odd_row" '; } $datatable .= ''. ''.$titles->{$item}. ''; if ($item eq 'auth_def') { my @authtypes = ('internal','krb4','krb5','localauth'); my %shortauth = ( internal => 'int', krb4 => 'krb4', krb5 => 'krb5', localauth => 'loc' ); my %authnames = &authtype_names(); foreach my $auth (@authtypes) { my $checked = ' '; if ($domdefaults{$item} eq $auth) { $checked = ' checked="checked" '; } $datatable .= '  '; } } elsif ($item eq 'timezone_def') { my $includeempty = 1; $datatable .= &Apache::loncommon::select_timezone($item,$domdefaults{$item},undef,$includeempty); } elsif ($item eq 'datelocale_def') { my $includeempty = 1; $datatable .= &Apache::loncommon::select_datelocale($item,$domdefaults{$item},undef,$includeempty); } else { my $size; if ($item eq 'portal_def') { $size = ' size="25"'; } $datatable .= ''; } $datatable .= ''; $rownum ++; } $$rowtotal += $rownum; return $datatable; } sub defaults_titles { my ($dom) = @_; my %titles = &Apache::lonlocal::texthash ( 'auth_def' => 'Default authentication type', 'auth_arg_def' => 'Default authentication argument', 'lang_def' => 'Default language', 'timezone_def' => 'Default timezone', 'datelocale_def' => 'Default locale for dates', 'portal_def' => 'Portal/Default URL', ); if ($dom) { my $uprimary_id = &Apache::lonnet::domain($dom,'primary'); my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id); my $protocol = $Apache::lonnet::protocol{$uprimary_id}; $protocol = 'http' if ($protocol ne 'https'); if ($uint_dom) { $titles{'portal_def'} .= ' '.&mt('(for example: [_1])',$protocol.'://loncapa.'. $uint_dom); } } return (\%titles); } sub print_scantronformat { my ($r,$dom,$confname,$settings,$rowtotal) = @_; my $itemcount = 1; my ($datatable,$css_class,$scantronurl,$is_custom,%error,%scantronurls, %confhash); my $switchserver = &check_switchserver($dom,$confname); my %lt = &Apache::lonlocal::texthash ( default => 'Default bubblesheet format file error', custom => 'Custom bubblesheet format file error', ); my %scantronfiles = ( default => 'default.tab', custom => 'custom.tab', ); foreach my $key (keys(%scantronfiles)) { $scantronurls{$key} = '/res/'.$dom.'/'.$confname.'/scantron/' .$scantronfiles{$key}; } my @defaultinfo = &Apache::lonnet::stat_file($scantronurls{'default'}); if ((!@defaultinfo) || ($defaultinfo[0] eq 'no_such_dir')) { if (!$switchserver) { my $servadm = $r->dir_config('lonAdmEMail'); my ($configuserok,$author_ok) = &config_check($dom,$confname,$servadm); if ($configuserok eq 'ok') { if ($author_ok eq 'ok') { my %legacyfile = ( default => $Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab', custom => $Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab', ); my %md5chk; foreach my $type (keys(%legacyfile)) { ($md5chk{$type}) = split(/ /,`md5sum $legacyfile{$type}`); chomp($md5chk{$type}); } if ($md5chk{'default'} ne $md5chk{'custom'}) { foreach my $type (keys(%legacyfile)) { ($scantronurls{$type},my $error) = &legacy_scantronformat($r,$dom,$confname, $type,$legacyfile{$type}, $scantronurls{$type}, $scantronfiles{$type}); if ($error ne '') { $error{$type} = $error; } } if (keys(%error) == 0) { $is_custom = 1; $confhash{'scantron'}{'scantronformat'} = $scantronurls{'custom'}; my $putresult = &Apache::lonnet::put_dom('configuration', \%confhash,$dom); if ($putresult ne 'ok') { $error{'custom'} = ''. &mt('An error occurred updating the domain configuration: [_1]',$putresult).''; } } } else { ($scantronurls{'default'},my $error) = &legacy_scantronformat($r,$dom,$confname, 'default',$legacyfile{'default'}, $scantronurls{'default'}, $scantronfiles{'default'}); if ($error eq '') { $confhash{'scantron'}{'scantronformat'} = ''; my $putresult = &Apache::lonnet::put_dom('configuration', \%confhash,$dom); if ($putresult ne 'ok') { $error{'default'} = ''. &mt('An error occurred updating the domain configuration: [_1]',$putresult).''; } } else { $error{'default'} = $error; } } } } } else { $error{'default'} = &mt("Unable to copy default bubblesheet formatfile to domain's RES space: [_1]",$switchserver); } } if (ref($settings) eq 'HASH') { if ($settings->{'scantronformat'} eq "/res/$dom/$confname/scantron/custom.tab") { my @info = &Apache::lonnet::stat_file($settings->{'scantronformat'}); if ((!@info) || ($info[0] eq 'no_such_dir')) { $scantronurl = ''; } else { $scantronurl = $settings->{'scantronformat'}; } $is_custom = 1; } else { $scantronurl = $scantronurls{'default'}; } } else { if ($is_custom) { $scantronurl = $scantronurls{'custom'}; } else { $scantronurl = $scantronurls{'default'}; } } $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''; if (!$is_custom) { $datatable .= ''.&mt('Default in use:').'
'. ''; if ($scantronurl) { $datatable .= ''. &mt('Default bubblesheet format file').''; } else { $datatable = &mt('File unavailable for display'); } $datatable .= ''; if (keys(%error) == 0) { $datatable .= ''; if (!$switchserver) { $datatable .= &mt('Upload:').'
'; } } else { my $errorstr; foreach my $key (sort(keys(%error))) { $errorstr .= $lt{$key}.': '.$error{$key}.'
'; } $datatable .= ''.$errorstr; } } else { if (keys(%error) > 0) { my $errorstr; foreach my $key (sort(keys(%error))) { $errorstr .= $lt{$key}.': '.$error{$key}.'
'; } $datatable .= ''.$errorstr.' '; } elsif ($scantronurl) { $datatable .= ''. ''. &mt('Custom bubblesheet format file').''. ' '. &mt('Replace:').'
'; } } if (keys(%error) == 0) { if ($switchserver) { $datatable .= &mt('Upload to library server: [_1]',$switchserver); } else { $datatable .=' '. ''; } } $datatable .= ''; $$rowtotal ++; return $datatable; } sub legacy_scantronformat { my ($r,$dom,$confname,$file,$legacyfile,$newurl,$newfile) = @_; my ($url,$error); my @statinfo = &Apache::lonnet::stat_file($newurl); if ((!@statinfo) || ($statinfo[0] eq 'no_such_dir')) { (my $result,$url) = &publishlogo($r,'copy',$legacyfile,$dom,$confname,'scantron', '','',$newfile); if ($result ne 'ok') { $error = &mt("An error occurred publishing the [_1] bubblesheet format file in RES space. Error was: [_2].",$newfile,$result); } } return ($url,$error); } sub print_coursecategories { my ($position,$dom,$hdritem,$settings,$rowtotal) = @_; my $datatable; if ($position eq 'top') { my $toggle_cats_crs = ' '; my $toggle_cats_dom = ' checked="checked" '; my $can_cat_crs = ' '; my $can_cat_dom = ' checked="checked" '; my $toggle_catscomm_comm = ' '; my $toggle_catscomm_dom = ' checked="checked" '; my $can_catcomm_comm = ' '; my $can_catcomm_dom = ' checked="checked" '; if (ref($settings) eq 'HASH') { if ($settings->{'togglecats'} eq 'crs') { $toggle_cats_crs = $toggle_cats_dom; $toggle_cats_dom = ' '; } if ($settings->{'categorize'} eq 'crs') { $can_cat_crs = $can_cat_dom; $can_cat_dom = ' '; } if ($settings->{'togglecatscomm'} eq 'comm') { $toggle_catscomm_comm = $toggle_catscomm_dom; $toggle_catscomm_dom = ' '; } if ($settings->{'categorizecomm'} eq 'comm') { $can_catcomm_comm = $can_catcomm_dom; $can_catcomm_dom = ' '; } } my %title = &Apache::lonlocal::texthash ( togglecats => 'Show/Hide a course in catalog', togglecatscomm => 'Show/Hide a community in catalog', categorize => 'Assign a category to a course', categorizecomm => 'Assign a category to a community', ); my %level = &Apache::lonlocal::texthash ( dom => 'Set in Domain', crs => 'Set in Course', comm => 'Set in Community', ); $datatable = ''. ''.$title{'togglecats'}.''. ' '. ''. ''. ''.$title{'categorize'}.''. ''. ' '. ''. ''. ''.$title{'togglecatscomm'}.''. ' '. ''. ''. ''.$title{'categorizecomm'}.''. ''. ' '. ''. ''; $$rowtotal += 4; } else { my $css_class; my $itemcount = 1; my $cathash; if (ref($settings) eq 'HASH') { $cathash = $settings->{'cats'}; } if (ref($cathash) eq 'HASH') { my (@cats,@trails,%allitems,%idx,@jsarray); &Apache::loncommon::extract_categories($cathash,\@cats,\@trails, \%allitems,\%idx,\@jsarray); my $maxdepth = scalar(@cats); my $colattrib = ''; if ($maxdepth > 2) { $colattrib = ' colspan="2" '; } my @path; if (@cats > 0) { if (ref($cats[0]) eq 'ARRAY') { my $numtop = @{$cats[0]}; my $maxnum = $numtop; my %default_names = ( instcode => &mt('Official courses'), communities => &mt('Communities'), ); if ((!grep(/^instcode$/,@{$cats[0]})) || ($cathash->{'instcode::0'} eq '') || (!grep(/^communities$/,@{$cats[0]})) || ($cathash->{'communities::0'} eq '')) { $maxnum ++; } my $lastidx; for (my $i=0; $i<$numtop; $i++) { my $parent = $cats[0][$i]; $css_class = $itemcount%2?' class="LC_odd_row"':''; my $item = &escape($parent).'::0'; my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','$item','$idx{$item}'".');"'; $lastidx = $idx{$item}; $datatable .= '' .''; if ($parent eq 'instcode' || $parent eq 'communities') { $datatable .= '' .$default_names{$parent}.''; if ($parent eq 'instcode') { $datatable .= '
(' .&mt('with institutional codes') .')'; } else { $datatable .= '
'; } $datatable .= '' .''; if ($parent eq 'instcode') { $datatable .= ' '; } else { $datatable .= '
' .''; } $datatable .= ''; if ($parent eq 'communities') { $datatable .= '
'; } $datatable .= ''; } else { $datatable .= $parent .' '; } my $depth = 1; push(@path,$parent); $datatable .= &build_category_rows($itemcount,\@cats,$depth,$parent,\@path,\%idx); pop(@path); $datatable .= ''; $itemcount ++; } $css_class = $itemcount%2?' class="LC_odd_row"':''; my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','addcategory_pos','$lastidx'".');"'; $datatable .= ''.&mt('Add category:').' ' .'' .''."\n"; $itemcount ++; foreach my $default ('instcode','communities') { if ((!grep(/^\Q$default\E$/,@{$cats[0]})) || ($cathash->{$default.'::0'} eq '')) { $css_class = $itemcount%2?' class="LC_odd_row"':''; my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','$default"."_pos','$lastidx'".');"'; $datatable .= ''. ''. ''. $default_names{$default}.''; if ($default eq 'instcode') { $datatable .= '
(' .&mt('with institutional codes').')'; } $datatable .= '' .' ' .''; } } } } else { $datatable .= &initialize_categories($itemcount); } } else { $datatable .= ''.$hdritem->{'header'}->[0]->{'col2'}.'' .&initialize_categories($itemcount); } $$rowtotal += $itemcount; } return $datatable; } sub print_serverstatuses { my ($dom,$settings,$rowtotal) = @_; my $datatable; my @pages = &serverstatus_pages(); my (%namedaccess,%machineaccess); foreach my $type (@pages) { $namedaccess{$type} = ''; $machineaccess{$type}= ''; } if (ref($settings) eq 'HASH') { foreach my $type (@pages) { if (exists($settings->{$type})) { if (ref($settings->{$type}) eq 'HASH') { foreach my $key (keys(%{$settings->{$type}})) { if ($key eq 'namedusers') { $namedaccess{$type} = $settings->{$type}->{$key}; } elsif ($key eq 'machines') { $machineaccess{$type} = $settings->{$type}->{$key}; } } } } } } my $titles= &LONCAPA::lonauthcgi::serverstatus_titles(); my $rownum = 0; my $css_class; foreach my $type (@pages) { $rownum ++; $css_class = $rownum%2?' class="LC_odd_row"':''; $datatable .= ''. ''. $titles->{$type}.''. ''. ''. ''. ''. ''. ''."\n"; } $$rowtotal += $rownum; return $datatable; } sub serverstatus_pages { return ('userstatus','lonstatus','loncron','server-status','codeversions', 'clusterstatus','metadata_keywords','metadata_harvest', 'takeoffline','takeonline','showenv','toggledebug'); } sub coursecategories_javascript { my ($settings) = @_; my ($output,$jstext,$cathash); if (ref($settings) eq 'HASH') { $cathash = $settings->{'cats'}; } if (ref($cathash) eq 'HASH') { my (@cats,@jsarray,%idx); &Apache::loncommon::gather_categories($cathash,\@cats,\%idx,\@jsarray); if (@jsarray > 0) { $jstext = ' var categories = Array('.scalar(@jsarray).');'."\n"; for (my $i=0; $i<@jsarray; $i++) { if (ref($jsarray[$i]) eq 'ARRAY') { my $catstr = join('","',@{$jsarray[$i]}); $jstext .= ' categories['.$i.'] = Array("'.$catstr.'");'."\n"; } } } } else { $jstext = ' var categories = Array(1);'."\n". ' categories[0] = Array("instcode_pos");'."\n"; } my $instcode_reserved = &mt('The name: "instcode" is a reserved category'); my $communities_reserved = &mt('The name: "communities" is a reserved category'); my $choose_again = '\\n'.&mt('Please use a different name for the new top level category'); $output = <<"ENDSCRIPT"; ENDSCRIPT return $output; } sub initialize_categories { my ($itemcount) = @_; my ($datatable,$css_class,$chgstr); my %default_names = ( instcode => 'Official courses (with institutional codes)', communities => 'Communities', ); my $select0 = ' selected="selected"'; my $select1 = ''; foreach my $default ('instcode','communities') { $css_class = $itemcount%2?' class="LC_odd_row"':''; $chgstr = ' onchange="javascript:reorderCats(this.form,'."'',$default"."_pos','0'".');"'; if ($default eq 'communities') { $select1 = $select0; $select0 = ''; } $datatable .= '' .' ' .$default_names{$default} .'' .' '; $itemcount ++; } $css_class = $itemcount%2?' class="LC_odd_row"':''; $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','addcategory_pos','0'".');"'; $datatable .= '' .' ' .&mt('Add category').''.&mt('Name:') .' '; return $datatable; } sub build_category_rows { my ($itemcount,$cats,$depth,$parent,$path,$idx) = @_; my ($text,$name,$item,$chgstr); if (ref($cats) eq 'ARRAY') { my $maxdepth = scalar(@{$cats}); if (ref($cats->[$depth]) eq 'HASH') { if (ref($cats->[$depth]{$parent}) eq 'ARRAY') { my $numchildren = @{$cats->[$depth]{$parent}}; my $css_class = $itemcount%2?' class="LC_odd_row"':''; $text .= ''; my ($idxnum,$parent_name,$parent_item); my $higher = $depth - 1; if ($higher == 0) { $parent_name = &escape($parent).'::'.$higher; } else { if (ref($path) eq 'ARRAY') { $parent_name = &escape($parent).':'.&escape($path->[-2]).':'.$higher; } } $parent_item = 'addcategory_pos_'.$parent_name; for (my $j=0; $j<=$numchildren; $j++) { if ($j < $numchildren) { $name = $cats->[$depth]{$parent}[$j]; $item = &escape($name).':'.&escape($parent).':'.$depth; $idxnum = $idx->{$item}; } else { $name = $parent_name; $item = $parent_item; } $chgstr = ' onchange="javascript:reorderCats(this.form,'."'$parent_name','$item','$idxnum'".');"'; $text .= ''; } $text .= '
 '; if ($j < $numchildren) { my $deeper = $depth+1; $text .= $name.' ' .''; if(ref($path) eq 'ARRAY') { push(@{$path},$name); $text .= &build_category_rows($itemcount,$cats,$deeper,$name,$path,$idx); pop(@{$path}); } } else { $text .= &mt('Add subcategory:').' '; } $text .= '
'; } else { my $higher = $depth-1; if ($higher == 0) { $name = &escape($parent).'::'.$higher; } else { if (ref($path) eq 'ARRAY') { $name = &escape($parent).':'.&escape($path->[-2]).':'.$higher; } } my $colspan; if ($parent ne 'instcode') { $colspan = $maxdepth - $depth - 1; $text .= ''.&mt('Add subcategory:').''; } } } } return $text; } sub modifiable_userdata_row { my ($context,$role,$settings,$numinrow,$rowcount,$usertypes) = @_; my $rolename; if ($context eq 'selfcreate') { if (ref($usertypes) eq 'HASH') { $rolename = $usertypes->{$role}; } else { $rolename = $role; } } else { if ($role eq 'cr') { $rolename = &mt('Custom role'); } else { $rolename = &Apache::lonnet::plaintext($role); } } my @fields = ('lastname','firstname','middlename','generation', 'permanentemail','id'); my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); my $output; my $css_class = $rowcount%2?' class="LC_odd_row"':''; $output = ''. ''.$rolename.''. ''; my $rem; my %checks; if (ref($settings) eq 'HASH') { if (ref($settings->{$context}) eq 'HASH') { if (ref($settings->{$context}->{$role}) eq 'HASH') { foreach my $field (@fields) { if ($settings->{$context}->{$role}->{$field}) { $checks{$field} = ' checked="checked" '; } } } } } for (my $i=0; $i<@fields; $i++) { my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $output .= ''; } $output .= ''; } my $check = ' '; if (exists($checks{$fields[$i]})) { $check = $checks{$fields[$i]} } else { if ($role eq 'st') { if (ref($settings) ne 'HASH') { $check = ' checked="checked" '; } } } $output .= ''; $rem = @fields%($numinrow); } my $colsleft = $numinrow - $rem; if ($colsleft > 1 ) { $output .= ''; } elsif ($colsleft == 1) { $output .= ''; } $output .= '
'. ''. '  
'; return $output; } sub insttypes_row { my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle,$context) = @_; my %lt = &Apache::lonlocal::texthash ( cansearch => 'Users allowed to search', statustocreate => 'Institutional affiliation(s) able to create own account (login/SSO)', lockablenames => 'User preference to lock name', ); my $showdom; if ($context eq 'cansearch') { $showdom = ' ('.$dom.')'; } my $output = ''. ''.$lt{$context}.$showdom. ''; my $rem; if (ref($types) eq 'ARRAY') { for (my $i=0; $i<@{$types}; $i++) { if (defined($usertypes->{$types->[$i]})) { my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $output .= ''; } $output .= ''; } my $check = ' '; if (ref($settings) eq 'HASH') { if (ref($settings->{$context}) eq 'ARRAY') { if (grep(/^\Q$types->[$i]\E$/,@{$settings->{$context}})) { $check = ' checked="checked" '; } } elsif ($context eq 'statustocreate') { $check = ' checked="checked" '; } } $output .= ''; } } $rem = @{$types}%($numinrow); } my $colsleft = $numinrow - $rem; if (($rem == 0) && (@{$types} > 0)) { $output .= ''; } if ($colsleft > 1) { $output .= ''. '
'. '
'; } else { $output .= ''; } my $defcheck = ' '; if (ref($settings) eq 'HASH') { if (ref($settings->{$context}) eq 'ARRAY') { if (grep(/^default$/,@{$settings->{$context}})) { $defcheck = ' checked="checked" '; } } elsif ($context eq 'statustocreate') { $defcheck = ' checked="checked" '; } } $output .= '
'; return $output; } sub sorted_searchtitles { my %searchtitles = &Apache::lonlocal::texthash( 'uname' => 'username', 'lastname' => 'last name', 'lastfirst' => 'last name, first name', ); my @titleorder = ('uname','lastname','lastfirst'); return (\%searchtitles,\@titleorder); } sub sorted_searchtypes { my %srchtypes_desc = ( exact => 'is exact match', contains => 'contains ..', begins => 'begins with ..', ); my @srchtypeorder = ('exact','begins','contains'); return (\%srchtypes_desc,\@srchtypeorder); } sub usertype_update_row { my ($settings,$usertypes,$fieldtitles,$fields,$types,$rownums) = @_; my $datatable; my $numinrow = 4; foreach my $type (@{$types}) { if (defined($usertypes->{$type})) { $$rownums ++; my $css_class = $$rownums%2?' class="LC_odd_row"':''; $datatable .= ''.$usertypes->{$type}. ''; for (my $i=0; $i<@{$fields}; $i++) { my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $datatable .= ''; } $datatable .= ''; } my $check = ' '; if (ref($settings) eq 'HASH') { if (ref($settings->{'fields'}) eq 'HASH') { if (ref($settings->{'fields'}{$type}) eq 'ARRAY') { if (grep(/^\Q$fields->[$i]\E$/,@{$settings->{'fields'}{$type}})) { $check = ' checked="checked" '; } } } } if ($i == @{$fields}-1) { my $colsleft = $numinrow - $rem; if ($colsleft > 1) { $datatable .= ''; } $datatable .= '
'; } else { $datatable .= ''; } } else { $datatable .= ''; } $datatable .= '
'; } } return $datatable; } sub modify_login { my ($r,$dom,$confname,%domconfig) = @_; my ($resulttext,$errors,$colchgtext,%changes,%colchanges); my %title = ( coursecatalog => 'Display course catalog', adminmail => 'Display administrator E-mail address', newuser => 'Link for visitors to create a user account', loginheader => 'Log-in box header'); my @offon = ('off','on'); my %curr_loginvia; if (ref($domconfig{login}) eq 'HASH') { if (ref($domconfig{login}{loginvia}) eq 'HASH') { foreach my $lonhost (keys(%{$domconfig{login}{loginvia}})) { $curr_loginvia{$lonhost} = $domconfig{login}{loginvia}{$lonhost}; } } } my %loginhash; ($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'], \%domconfig,\%loginhash); my @toggles = ('coursecatalog','adminmail','newuser'); foreach my $item (@toggles) { $loginhash{login}{$item} = $env{'form.'.$item}; } $loginhash{login}{loginheader} = $env{'form.loginheader'}; if (ref($colchanges{'login'}) eq 'HASH') { $colchgtext = &display_colorchgs($dom,\%colchanges,['login'], \%loginhash); } my %servers = &Apache::lonnet::internet_dom_servers($dom); my @loginvia_attribs = ('serverpath','custompath','exempt'); if (keys(%servers) > 1) { foreach my $lonhost (keys(%servers)) { next if ($env{'form.'.$lonhost.'_server'} eq $lonhost); if (ref($curr_loginvia{$lonhost}) eq 'HASH') { if ($env{'form.'.$lonhost.'_server'} eq $curr_loginvia{$lonhost}{'server'}) { $loginhash{login}{loginvia}{$lonhost}{'server'} = $curr_loginvia{$lonhost}{'server'}; } elsif ($curr_loginvia{$lonhost}{'server'} ne '') { if (defined($servers{$env{'form.'.$lonhost.'_server'}})) { $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'}; $changes{'loginvia'}{$lonhost} = 1; } else { $loginhash{login}{loginvia}{$lonhost}{'server'} = ''; $changes{'loginvia'}{$lonhost} = 1; } } else { if (defined($servers{$env{'form.'.$lonhost.'_server'}})) { $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'}; $changes{'loginvia'}{$lonhost} = 1; } } if ($loginhash{login}{loginvia}{$lonhost}{'server'} eq '') { foreach my $item (@loginvia_attribs) { $loginhash{login}{loginvia}{$lonhost}{$item} = ''; } } else { foreach my $item (@loginvia_attribs) { my $new = $env{'form.'.$lonhost.'_'.$item}; if (($item eq 'serverpath') && ($new eq 'custom')) { $env{'form.'.$lonhost.'_custompath'} =~ s/\s+//g; if ($env{'form.'.$lonhost.'_custompath'} eq '') { $new = '/'; } } if (($item eq 'custompath') && ($env{'form.'.$lonhost.'_serverpath'} ne 'custom')) { $new = ''; } if ($new ne $curr_loginvia{$lonhost}{$item}) { $changes{'loginvia'}{$lonhost} = 1; } if ($item eq 'exempt') { $new =~ s/^\s+//; $new =~ s/\s+$//; my @poss_ips = split(/\s*[,:]\s*/,$new); my @okips; foreach my $ip (@poss_ips) { if ($ip =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { if (($1 <= 255) && ($2 <= 255) && ($3 <= 255) && ($4 <= 255)) { push(@okips,$ip); } } } if (@okips > 0) { $new = join(',',@okips); } else { $new = ''; } } $loginhash{login}{loginvia}{$lonhost}{$item} = $new; } } } else { if (defined($servers{$env{'form.'.$lonhost.'_server'}})) { $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'}; $changes{'loginvia'}{$lonhost} = 1; foreach my $item (@loginvia_attribs) { my $new = $env{'form.'.$lonhost.'_'.$item}; if (($item eq 'serverpath') && ($new eq 'custom')) { if ($env{'form.'.$lonhost.'_custompath'} eq '') { $new = '/'; } } if (($item eq 'custompath') && ($env{'form.'.$lonhost.'_serverpath'} ne 'custom')) { $new = ''; } $loginhash{login}{loginvia}{$lonhost}{$item} = $new; } } } } } my $putresult = &Apache::lonnet::put_dom('configuration',\%loginhash, $dom); if ($putresult eq 'ok') { my @toggles = ('coursecatalog','adminmail','newuser'); my %defaultchecked = ( 'coursecatalog' => 'on', 'adminmail' => 'off', 'newuser' => 'off', ); if (ref($domconfig{'login'}) eq 'HASH') { foreach my $item (@toggles) { if ($defaultchecked{$item} eq 'on') { if (($domconfig{'login'}{$item} eq '0') && ($env{'form.'.$item} eq '1')) { $changes{$item} = 1; } elsif (($domconfig{'login'}{$item} eq '' || $domconfig{'login'}{$item} eq '1') && ($env{'form.'.$item} eq '0')) { $changes{$item} = 1; } } elsif ($defaultchecked{$item} eq 'off') { if (($domconfig{'login'}{$item} eq '1') && ($env{'form.'.$item} eq '0')) { $changes{$item} = 1; } elsif (($domconfig{'login'}{$item} eq '' || $domconfig{'login'}{$item} eq '0') && ($env{'form.'.$item} eq '1')) { $changes{$item} = 1; } } } } if (keys(%changes) > 0 || $colchgtext) { &Apache::loncommon::devalidate_domconfig_cache($dom); $resulttext = &mt('Changes made:').'
    '; foreach my $item (sort(keys(%changes))) { if ($item eq 'loginvia') { if (ref($changes{$item}) eq 'HASH') { $resulttext .= '
  • '.&mt('Log-in page availability:').'
      '; foreach my $lonhost (sort(keys(%{$changes{$item}}))) { if (defined($servers{$loginhash{login}{loginvia}{$lonhost}{'server'}})) { if (ref($loginhash{login}{loginvia}{$lonhost}) eq 'HASH') { my $protocol = $Apache::lonnet::protocol{$env{'form.'.$lonhost.'_server'}}; $protocol = 'http' if ($protocol ne 'https'); my $target = $protocol.'://'.$servers{$env{'form.'.$lonhost.'_server'}}; if ($loginhash{login}{loginvia}{$lonhost}{'serverpath'} eq 'custom') { $target .= $loginhash{login}{loginvia}{$lonhost}{'custompath'}; } else { $target .= $loginhash{login}{loginvia}{$lonhost}{'serverpath'}; } $resulttext .= '
    • '.&mt('Server: [_1] log-in page redirects to [_2].',$servers{$lonhost},''.$target.''); if ($loginhash{login}{loginvia}{$lonhost}{'exempt'} ne '') { $resulttext .= ' '.&mt('No redirection for clients from following IPs:').' '.$loginhash{login}{loginvia}{$lonhost}{'exempt'}; } $resulttext .= '
      • '; } else { $resulttext .= '
    • '.&mt('Server: [_1] has standard log-in page.',$lonhost).'
      • '; } } else { $resulttext .= '
    • '.&mt('Server: [_1] has standard log-in page.',$servers{$lonhost}).'
      • '; } } $resulttext .= '
    • '; } } else { $resulttext .= '
  • '.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'
    • '; } } $resulttext .= $colchgtext.'
'; } else { $resulttext = &mt('No changes made to log-in page settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } if ($errors) { $resulttext .= '
'.&mt('The following errors occurred: ').'
    '. $errors.'
'; } return $resulttext; } sub color_font_choices { my %choices = &Apache::lonlocal::texthash ( img => "Header", bgs => "Background colors", links => "Link colors", images => "Images", font => "Font color", fontmenu => "Font Menu", pgbg => "Page", tabbg => "Header", sidebg => "Border", link => "Link", alink => "Active link", vlink => "Visited link", ); return %choices; } sub modify_rolecolors { my ($r,$dom,$confname,$roles,%domconfig) = @_; my ($resulttext,%rolehash); $rolehash{'rolecolors'} = {}; if (ref($domconfig{'rolecolors'}) ne 'HASH') { if ($domconfig{'rolecolors'} eq '') { $domconfig{'rolecolors'} = {}; } } my ($errors,%changes) = &modify_colors($r,$dom,$confname,$roles, $domconfig{'rolecolors'},$rolehash{'rolecolors'}); my $putresult = &Apache::lonnet::put_dom('configuration',\%rolehash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { &Apache::loncommon::devalidate_domconfig_cache($dom); $resulttext = &display_colorchgs($dom,\%changes,$roles, $rolehash{'rolecolors'}); } else { $resulttext = &mt('No changes made to default color schemes'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } if ($errors) { $resulttext .= &mt('The following errors occurred: ').'
    '. $errors.'
'; } return $resulttext; } sub modify_colors { my ($r,$dom,$confname,$roles,$domconfig,$confhash) = @_; my (%changes,%choices); my @bgs; my @links = ('link','alink','vlink'); my @logintext; my @images; my $servadm = $r->dir_config('lonAdmEMail'); my $errors; foreach my $role (@{$roles}) { if ($role eq 'login') { %choices = &login_choices(); @logintext = ('textcol','bgcol'); } else { %choices = &color_font_choices(); $confhash->{$role}{'fontmenu'} = $env{'form.'.$role.'_fontmenu'}; } if ($role eq 'login') { @images = ('img','logo','domlogo','login'); @bgs = ('pgbg','mainbg','sidebg'); } else { @images = ('img'); @bgs = ('pgbg','tabbg','sidebg'); } $confhash->{$role}{'font'} = $env{'form.'.$role.'_font'}; foreach my $item (@bgs,@links,@logintext) { $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item}; } my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm); my ($width,$height) = &thumb_dimensions(); if (ref($domconfig->{$role}) ne 'HASH') { $domconfig->{$role} = {}; } foreach my $img (@images) { if (($role eq 'login') && (($img eq 'img') || ($img eq 'logo'))) { if (defined($env{'form.login_showlogo_'.$img})) { $confhash->{$role}{'showlogo'}{$img} = 1; } else { $confhash->{$role}{'showlogo'}{$img} = 0; } } if ( ! $env{'form.'.$role.'_'.$img.'.filename'} && !defined($domconfig->{$role}{$img}) && !$env{'form.'.$role.'_del_'.$img} && $env{'form.'.$role.'_import_'.$img}) { # import the old configured image from the .tab setting # if they haven't provided a new one $domconfig->{$role}{$img} = $env{'form.'.$role.'_import_'.$img}; } if ($env{'form.'.$role.'_'.$img.'.filename'} ne '') { my $error; if ($configuserok eq 'ok') { if ($switchserver) { $error = &mt("Upload of [_1] image for $role page(s) is not permitted to this server: [_2]",$choices{$img},$switchserver); } else { if ($author_ok eq 'ok') { my ($result,$logourl) = &publishlogo($r,'upload',$role.'_'.$img, $dom,$confname,$img,$width,$height); if ($result eq 'ok') { $confhash->{$role}{$img} = $logourl; $changes{$role}{'images'}{$img} = 1; } else { $error = &mt("Upload of [_1] image for $role page(s) failed because an error occurred publishing the file in RES space. Error was: [_2].",$choices{img},$result); } } else { $error = &mt("Upload of [_1] image for $role page(s) failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3]. Error was: [_4].",$choices{$img},$confname,$dom,$author_ok); } } } else { $error = &mt("Upload of [_1] image for $role page(s) failed because a Domain Configuration user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$choices{$img},$confname,$dom,$configuserok); } if ($error) { &Apache::lonnet::logthis($error); $errors .= '
  • '.$error.'
    • '; } } elsif ($domconfig->{$role}{$img} ne '') { if ($domconfig->{$role}{$img} !~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) { my $error; if ($configuserok eq 'ok') { # is confname an author? if ($switchserver eq '') { if ($author_ok eq 'ok') { my ($result,$logourl) = &publishlogo($r,'copy',$domconfig->{$role}{$img}, $dom,$confname,$img,$width,$height); if ($result eq 'ok') { $confhash->{$role}{$img} = $logourl; $changes{$role}{'images'}{$img} = 1; } } } } } } } if (ref($domconfig) eq 'HASH') { if (ref($domconfig->{$role}) eq 'HASH') { foreach my $img (@images) { if ($domconfig->{$role}{$img} ne '') { if ($env{'form.'.$role.'_del_'.$img}) { $confhash->{$role}{$img} = ''; $changes{$role}{'images'}{$img} = 1; } else { if ($confhash->{$role}{$img} eq '') { $confhash->{$role}{$img} = $domconfig->{$role}{$img}; } } } else { if ($env{'form.'.$role.'_del_'.$img}) { $confhash->{$role}{$img} = ''; $changes{$role}{'images'}{$img} = 1; } } if (($role eq 'login') && (($img eq 'logo') || ($img eq 'img'))) { if (ref($domconfig->{'login'}{'showlogo'}) eq 'HASH') { if ($confhash->{$role}{'showlogo'}{$img} ne $domconfig->{$role}{'showlogo'}{$img}) { $changes{$role}{'showlogo'}{$img} = 1; } } else { if ($confhash->{$role}{'showlogo'}{$img} == 0) { $changes{$role}{'showlogo'}{$img} = 1; } } } } if ($domconfig->{$role}{'font'} ne '') { if ($confhash->{$role}{'font'} ne $domconfig->{$role}{'font'}) { $changes{$role}{'font'} = 1; } } else { if ($confhash->{$role}{'font'}) { $changes{$role}{'font'} = 1; } } if ($role ne 'login') { if ($domconfig->{$role}{'fontmenu'} ne '') { if ($confhash->{$role}{'fontmenu'} ne $domconfig->{$role}{'fontmenu'}) { $changes{$role}{'fontmenu'} = 1; } } else { if ($confhash->{$role}{'fontmenu'}) { $changes{$role}{'fontmenu'} = 1; } } } foreach my $item (@bgs) { if ($domconfig->{$role}{$item} ne '') { if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) { $changes{$role}{'bgs'}{$item} = 1; } } else { if ($confhash->{$role}{$item}) { $changes{$role}{'bgs'}{$item} = 1; } } } foreach my $item (@links) { if ($domconfig->{$role}{$item} ne '') { if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) { $changes{$role}{'links'}{$item} = 1; } } else { if ($confhash->{$role}{$item}) { $changes{$role}{'links'}{$item} = 1; } } } foreach my $item (@logintext) { if ($domconfig->{$role}{$item} ne '') { if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) { $changes{$role}{'logintext'}{$item} = 1; } } else { if ($confhash->{$role}{$item}) { $changes{$role}{'logintext'}{$item} = 1; } } } } else { &default_change_checker($role,\@images,\@links,\@bgs, \@logintext,$confhash,\%changes); } } else { &default_change_checker($role,\@images,\@links,\@bgs, \@logintext,$confhash,\%changes); } } return ($errors,%changes); } sub config_check { my ($dom,$confname,$servadm) = @_; my ($configuserok,$author_ok,$switchserver,%currroles); my $uhome = &Apache::lonnet::homeserver($confname,$dom,1); ($configuserok,%currroles) = &check_configuser($uhome,$dom, $confname,$servadm); if ($configuserok eq 'ok') { $switchserver = &check_switchserver($dom,$confname); if ($switchserver eq '') { $author_ok = &check_authorstatus($dom,$confname,%currroles); } } return ($configuserok,$author_ok,$switchserver); } sub default_change_checker { my ($role,$images,$links,$bgs,$logintext,$confhash,$changes) = @_; foreach my $item (@{$links}) { if ($confhash->{$role}{$item}) { $changes->{$role}{'links'}{$item} = 1; } } foreach my $item (@{$bgs}) { if ($confhash->{$role}{$item}) { $changes->{$role}{'bgs'}{$item} = 1; } } foreach my $item (@{$logintext}) { if ($confhash->{$role}{$item}) { $changes->{$role}{'logintext'}{$item} = 1; } } foreach my $img (@{$images}) { if ($env{'form.'.$role.'_del_'.$img}) { $confhash->{$role}{$img} = ''; $changes->{$role}{'images'}{$img} = 1; } if ($role eq 'login') { if ($confhash->{$role}{'showlogo'}{$img} == 0) { $changes->{$role}{'showlogo'}{$img} = 1; } } } if ($confhash->{$role}{'font'}) { $changes->{$role}{'font'} = 1; } } sub display_colorchgs { my ($dom,$changes,$roles,$confhash) = @_; my (%choices,$resulttext); if (!grep(/^login$/,@{$roles})) { $resulttext = &mt('Changes made:').'
    '; } foreach my $role (@{$roles}) { if ($role eq 'login') { %choices = &login_choices(); } else { %choices = &color_font_choices(); } if (ref($changes->{$role}) eq 'HASH') { if ($role ne 'login') { $resulttext .= '

    '.&mt($role).'

    '; } foreach my $key (sort(keys(%{$changes->{$role}}))) { if ($role ne 'login') { $resulttext .= '
      '; } if (ref($changes->{$role}{$key}) eq 'HASH') { if ($role ne 'login') { $resulttext .= '
    • '.&mt($choices{$key}).':
        '; } foreach my $item (sort(keys(%{$changes->{$role}{$key}}))) { if (($role eq 'login') && ($key eq 'showlogo')) { if ($confhash->{$role}{$key}{$item}) { $resulttext .= '
      • '.&mt("$choices{$item} set to be displayed").'
        • '; } else { $resulttext .= '
      • '.&mt("$choices{$item} set to not be displayed").'
        • '; } } elsif ($confhash->{$role}{$item} eq '') { $resulttext .= '
      • '.&mt("$choices{$item} set to default").'
        • '; } else { my $newitem = $confhash->{$role}{$item}; if ($key eq 'images') { $newitem = ''.$choices{$item}.''; } $resulttext .= '
      • '.&mt("$choices{$item} set to [_1]",$newitem).'
        • '; } } if ($role ne 'login') { $resulttext .= '
      • '; } } else { if ($confhash->{$role}{$key} eq '') { $resulttext .= '
    • '.&mt("$choices{$key} set to default").'
      • '; } else { $resulttext .= '
    • '.&mt("$choices{$key} set to [_1]",$confhash->{$role}{$key}).'
      • '; } } if ($role ne 'login') { $resulttext .= '
    '; } } } } return $resulttext; } sub thumb_dimensions { return ('200','50'); } sub check_dimensions { my ($inputfile) = @_; my ($fullwidth,$fullheight); if ($inputfile =~ m|^[/\w.\-]+$|) { if (open(PIPE,"identify $inputfile 2>&1 |")) { my $imageinfo = ; if (!close(PIPE)) { &Apache::lonnet::logthis("Failed to close PIPE opened to retrieve image information for $inputfile"); } chomp($imageinfo); my ($fullsize) = ($imageinfo =~ /^\Q$inputfile\E\s+\w+\s+(\d+x\d+)/); if ($fullsize) { ($fullwidth,$fullheight) = split(/x/,$fullsize); } } } return ($fullwidth,$fullheight); } sub check_configuser { my ($uhome,$dom,$confname,$servadm) = @_; my ($configuserok,%currroles); if ($uhome eq 'no_host') { srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. my $configpass = &LONCAPA::Enrollment::create_password(); $configuserok = &Apache::lonnet::modifyuser($dom,$confname,'','internal', $configpass,'','','','','',undef,$servadm); } else { $configuserok = 'ok'; %currroles = &Apache::lonnet::get_my_roles($confname,$dom,'userroles'); } return ($configuserok,%currroles); } sub check_authorstatus { my ($dom,$confname,%currroles) = @_; my $author_ok; if (!$currroles{':'.$dom.':au'}) { my $start = time; my $end = 0; $author_ok = &Apache::lonnet::assignrole($dom,$confname,'/'.$dom.'/', 'au',$end,$start,'','','domconfig'); } else { $author_ok = 'ok'; } return $author_ok; } sub publishlogo { my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight,$savefileas) = @_; my ($output,$fname,$logourl); if ($action eq 'upload') { $fname=$env{'form.'.$formname.'.filename'}; chop($env{'form.'.$formname}); } else { ($fname) = ($formname =~ /([^\/]+)$/); } if ($savefileas ne '') { $fname = $savefileas; } $fname=&Apache::lonnet::clean_filename($fname); # See if there is anything left unless ($fname) { return ('error: no uploaded file'); } $fname="$subdir/$fname"; my $filepath='/home/'.$confname.'/public_html'; my ($fnamepath,$file,$fetchthumb); $file=$fname; if ($fname=~m|/|) { ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|); } my @parts=split(/\//,$filepath.'/'.$fnamepath); my $count; for ($count=4;$count<=$#parts;$count++) { $filepath.="/$parts[$count]"; if ((-e $filepath)!=1) { mkdir($filepath,02770); } } # Check for bad extension and disallow upload if ($file=~/\.(\w+)$/ && (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { $output = &mt('Invalid file extension ([_1]) - reserved for LONCAPA use.',$1); } elsif ($file=~/\.(\w+)$/ && !defined(&Apache::loncommon::fileembstyle($1))) { $output = &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1); } elsif ($file=~/\.(\d+)\.(\w+)$/) { $output = &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2); } elsif (-d "$filepath/$file") { $output = &mt('File name is a directory name - rename the file and re-upload'); } else { my $source = $filepath.'/'.$file; my $logfile; if (!open($logfile,">>$source".'.log')) { return (&mt('No write permission to Construction Space')); } print $logfile "\n================= Publish ".localtime()." ================\n". $env{'user.name'}.':'.$env{'user.domain'}."\n"; # Save the file if (!open(FH,'>'.$source)) { &Apache::lonnet::logthis('Failed to create '.$source); return (&mt('Failed to create file')); } if ($action eq 'upload') { if (!print FH ($env{'form.'.$formname})) { &Apache::lonnet::logthis('Failed to write to '.$source); return (&mt('Failed to write file')); } } else { my $original = &Apache::lonnet::filelocation('',$formname); if(!copy($original,$source)) { &Apache::lonnet::logthis('Failed to copy '.$original.' to '.$source); return (&mt('Failed to write file')); } } close(FH); chmod(0660, $source); # Permissions to rw-rw---. my $docroot=$r->dir_config('lonDocRoot'); my $targetdir=$docroot.'/res/'.$dom.'/'.$confname .'/'.$fnamepath; my $copyfile=$targetdir.'/'.$file; my @parts=split(/\//,$targetdir); my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; for (my $count=5;$count<=$#parts;$count++) { $path.="/$parts[$count]"; if (!-e $path) { print $logfile "\nCreating directory ".$path; mkdir($path,02770); } } my $versionresult; if (-e $copyfile) { $versionresult = &logo_versioning($targetdir,$file,$logfile); } else { $versionresult = 'ok'; } if ($versionresult eq 'ok') { if (copy($source,$copyfile)) { print $logfile "\nCopied original source to ".$copyfile."\n"; $output = 'ok'; $logourl = '/res/'.$dom.'/'.$confname.'/'.$fname; push(@{$modified_urls},[$copyfile,$source]); my $metaoutput = &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile); unless ($registered_cleanup) { my $handlers = $r->get_handlers('PerlCleanupHandler'); $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]); $registered_cleanup=1; } } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; $output = &mt('Failed to copy file to RES space').", $!"; } if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { my $inputfile = $filepath.'/'.$file; my $outfile = $filepath.'/'.'tn-'.$file; my ($fullwidth,$fullheight) = &check_dimensions($inputfile); if ($fullwidth ne '' && $fullheight ne '') { if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) { my $thumbsize = $thumbwidth.'x'.$thumbheight; system("convert -sample $thumbsize $inputfile $outfile"); chmod(0660, $filepath.'/tn-'.$file); if (-e $outfile) { my $copyfile=$targetdir.'/tn-'.$file; if (copy($outfile,$copyfile)) { print $logfile "\nCopied source to ".$copyfile."\n"; my $thumb_metaoutput = &write_metadata($dom,$confname,$formname, $targetdir,'tn-'.$file,$logfile); push(@{$modified_urls},[$copyfile,$outfile]); unless ($registered_cleanup) { my $handlers = $r->get_handlers('PerlCleanupHandler'); $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]); $registered_cleanup=1; } } else { print $logfile "\nUnable to write ".$copyfile. ':'.$!."\n"; } } } } } } else { $output = $versionresult; } } return ($output,$logourl); } sub logo_versioning { my ($targetdir,$file,$logfile) = @_; my $target = $targetdir.'/'.$file; my ($maxversion,$fn,$extn,$output); $maxversion = 0; if ($file =~ /^(.+)\.(\w+)$/) { $fn=$1; $extn=$2; } opendir(DIR,$targetdir); while (my $filename=readdir(DIR)) { if ($filename=~/\Q$fn\E\.(\d+)\.\Q$extn\E$/) { $maxversion=($1>$maxversion)?$1:$maxversion; } } $maxversion++; print $logfile "\nCreating old version ".$maxversion."\n"; my $copyfile=$targetdir.'/'.$fn.'.'.$maxversion.'.'.$extn; if (copy($target,$copyfile)) { print $logfile "Copied old target to ".$copyfile."\n"; $copyfile=$copyfile.'.meta'; if (copy($target.'.meta',$copyfile)) { print $logfile "Copied old target metadata to ".$copyfile."\n"; $output = 'ok'; } else { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; $output = &mt('Failed to copy old meta').", $!, "; } } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; $output = &mt('Failed to copy old target').", $!, "; } return $output; } sub write_metadata { my ($dom,$confname,$formname,$targetdir,$file,$logfile) = @_; my (%metadatafields,%metadatakeys,$output); $metadatafields{'title'}=$formname; $metadatafields{'creationdate'}=time; $metadatafields{'lastrevisiondate'}=time; $metadatafields{'copyright'}='public'; $metadatafields{'modifyinguser'}=$env{'user.name'}.':'. $env{'user.domain'}; $metadatafields{'authorspace'}=$confname.':'.$dom; $metadatafields{'domain'}=$dom; { print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file; my $mfh; if (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) { foreach (sort keys %metadatafields) { unless ($_=~/\./) { my $unikey=$_; $unikey=~/^([A-Za-z]+)/; my $tag=$1; $tag=~tr/A-Z/a-z/; print $mfh "\n\<$tag"; foreach (split(/\,/,$metadatakeys{$unikey})) { my $value=$metadatafields{$unikey.'.'.$_}; $value=~s/\"/\'\'/g; print $mfh ' '.$_.'="'.$value.'"'; } print $mfh '>'. &HTML::Entities::encode($metadatafields{$unikey},'<>&"') .''; } } $output = 'ok'; print $logfile "\nWrote metadata"; close($mfh); } else { print $logfile "\nFailed to open metadata file"; $output = &mt('Could not write metadata'); } } return $output; } sub notifysubscribed { foreach my $targetsource (@{$modified_urls}){ next unless (ref($targetsource) eq 'ARRAY'); my ($target,$source)=@{$targetsource}; if ($source ne '') { if (open(my $logfh,'>>'.$source.'.log')) { print $logfh "\nCleanup phase: Notifications\n"; my @subscribed=&subscribed_hosts($target); foreach my $subhost (@subscribed) { print $logfh "\nNotifying host ".$subhost.':'; my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); print $logfh $reply; } my @subscribedmeta=&subscribed_hosts("$target.meta"); foreach my $subhost (@subscribedmeta) { print $logfh "\nNotifying host for metadata only ".$subhost.':'; my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', $subhost); print $logfh $reply; } print $logfh "\n============ Done ============\n"; close(logfh); } } } return OK; } sub subscribed_hosts { my ($target) = @_; my @subscribed; if (open(my $fh,"<$target.subscription")) { while (my $subline=<$fh>) { if ($subline =~ /^($match_lonid):/) { my $host = $1; if ($host ne $Apache::lonnet::perlvar{'lonHostID'}) { unless (grep(/^\Q$host\E$/,@subscribed)) { push(@subscribed,$host); } } } } } return @subscribed; } sub check_switchserver { my ($dom,$confname) = @_; my ($allowed,$switchserver); my $home = &Apache::lonnet::homeserver($confname,$dom); if ($home eq 'no_host') { $home = &Apache::lonnet::domain($dom,'primary'); } my @ids=&Apache::lonnet::current_machine_ids(); foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } } if (!$allowed) { $switchserver=''.&mt('Switch Server').''; } return $switchserver; } sub modify_quotas { my ($dom,$action,%domconfig) = @_; my ($context,@usertools,@options,%validations,%titles,%confhash,%toolshash, %limithash,$toolregexp,%conditions,$resulttext,%changes); if ($action eq 'quotas') { $context = 'tools'; } else { $context = $action; } if ($context eq 'requestcourses') { @usertools = ('official','unofficial','community'); @options =('norequest','approval','validate','autolimit'); %validations = &Apache::lonnet::auto_courserequest_checks($dom); %titles = &courserequest_titles(); $toolregexp = join('|',@usertools); %conditions = &courserequest_conditions(); } else { @usertools = ('aboutme','blog','portfolio'); %titles = &tool_titles(); } my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); foreach my $key (keys(%env)) { if ($context eq 'requestcourses') { if ($key =~ /^form\.crsreq_($toolregexp)_(.+)$/) { my $item = $1; my $type = $2; if ($type =~ /^limit_(.+)/) { $limithash{$item}{$1} = $env{$key}; } else { $confhash{$item}{$type} = $env{$key}; } } } else { if ($key =~ /^form\.quota_(.+)$/) { $confhash{'defaultquota'}{$1} = $env{$key}; } if ($key =~ /^form\.\Q$context\E_(.+)$/) { @{$toolshash{$1}} = &Apache::loncommon::get_env_multiple($key); } } } if ($context eq 'requestcourses') { my @approvalnotify = &Apache::loncommon::get_env_multiple('form.reqapprovalnotify'); @approvalnotify = sort(@approvalnotify); $confhash{'notify'}{'approval'} = join(',',@approvalnotify); if (ref($domconfig{$action}) eq 'HASH') { if (ref($domconfig{$action}{'notify'}) eq 'HASH') { if ($domconfig{$action}{'notify'}{'approval'} ne $confhash{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } else { if ($confhash{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } } else { if ($confhash{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } } else { $confhash{'defaultquota'}{'default'} = $env{'form.defaultquota'}; } foreach my $item (@usertools) { foreach my $type (@{$types},'default','_LC_adv') { my $unset; if ($context eq 'requestcourses') { $unset = '0'; if ($type eq '_LC_adv') { $unset = ''; } if ($confhash{$item}{$type} eq 'autolimit') { $confhash{$item}{$type} .= '='; unless ($limithash{$item}{$type} =~ /\D/) { $confhash{$item}{$type} .= $limithash{$item}{$type}; } } } else { if (grep(/^\Q$type\E$/,@{$toolshash{$item}})) { $confhash{$item}{$type} = 1; } else { $confhash{$item}{$type} = 0; } } if (ref($domconfig{$action}) eq 'HASH') { if (ref($domconfig{$action}{$item}) eq 'HASH') { if ($domconfig{$action}{$item}{$type} ne $confhash{$item}{$type}) { $changes{$item}{$type} = 1; } } else { if ($context eq 'requestcourses') { if ($confhash{$item}{$type} ne $unset) { $changes{$item}{$type} = 1; } } else { if (!$confhash{$item}{$type}) { $changes{$item}{$type} = 1; } } } } else { if ($context eq 'requestcourses') { if ($confhash{$item}{$type} ne $unset) { $changes{$item}{$type} = 1; } } else { if (!$confhash{$item}{$type}) { $changes{$item}{$type} = 1; } } } } } unless ($context eq 'requestcourses') { if (ref($domconfig{'quotas'}) eq 'HASH') { if (ref($domconfig{'quotas'}{'defaultquota'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'quotas'}{'defaultquota'}})) { if (exists($confhash{'defaultquota'}{$key})) { if ($confhash{'defaultquota'}{$key} ne $domconfig{'quotas'}{'defaultquota'}{$key}) { $changes{'defaultquota'}{$key} = 1; } } else { $confhash{'defaultquota'}{$key} = $domconfig{'quotas'}{'defaultquota'}{$key}; } } } else { foreach my $key (keys(%{$domconfig{'quotas'}})) { if (exists($confhash{'defaultquota'}{$key})) { if ($confhash{'defaultquota'}{$key} ne $domconfig{'quotas'}{$key}) { $changes{'defaultquota'}{$key} = 1; } } else { $confhash{'defaultquota'}{$key} = $domconfig{'quotas'}{$key}; } } } } if (ref($confhash{'defaultquota'}) eq 'HASH') { foreach my $key (keys(%{$confhash{'defaultquota'}})) { if (ref($domconfig{'quotas'}) eq 'HASH') { if (ref($domconfig{'quotas'}{'defaultquota'}) eq 'HASH') { if (!exists($domconfig{'quotas'}{'defaultquota'}{$key})) { $changes{'defaultquota'}{$key} = 1; } } else { if (!exists($domconfig{'quotas'}{$key})) { $changes{'defaultquota'}{$key} = 1; } } } else { $changes{'defaultquota'}{$key} = 1; } } } } foreach my $key (keys(%confhash)) { $domdefaults{$key} = $confhash{$key}; } my %quotahash = ( $action => { %confhash } ); my $putresult = &Apache::lonnet::put_dom('configuration',\%quotahash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { my $cachetime = 24*60*60; &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); $resulttext = &mt('Changes made:').'
      '; unless ($context eq 'requestcourses') { if (ref($changes{'defaultquota'}) eq 'HASH') { $resulttext .= '
    • '.&mt('Portfolio default quotas').'
        '; foreach my $type (@{$types},'default') { if (defined($changes{'defaultquota'}{$type})) { my $typetitle = $usertypes->{$type}; if ($type eq 'default') { $typetitle = $othertitle; } $resulttext .= '
      • '.&mt('[_1] set to [_2] Mb',$typetitle,$confhash{'defaultquota'}{$type}).'
        • '; } } $resulttext .= '
      • '; } } my %newenv; foreach my $item (@usertools) { if (ref($changes{$item}) eq 'HASH') { my $newacc = &Apache::lonnet::usertools_access($env{'user.name'}, $env{'user.domain'}, $item,'reload',$context); if ($context eq 'requestcourses') { if ($env{'environment.canrequest.'.$item} ne $newacc) { $newenv{'environment.canrequest.'.$item} = $newacc; } } else { if ($env{'environment.availabletools.'.$item} ne $newacc) { $newenv{'environment.availabletools.'.$item} = $newacc; } } $resulttext .= '
    • '.$titles{$item}.'
        '; foreach my $type (@{$types},'default','_LC_adv') { if ($changes{$item}{$type}) { my $typetitle = $usertypes->{$type}; if ($type eq 'default') { $typetitle = $othertitle; } elsif ($type eq '_LC_adv') { $typetitle = 'LON-CAPA Advanced Users'; } if ($confhash{$item}{$type}) { if ($context eq 'requestcourses') { my $cond; if ($confhash{$item}{$type} =~ /^autolimit=(\d*)$/) { if ($1 eq '') { $cond = &mt('(Automatic processing of any request).'); } else { $cond = &mt('(Automatic processing of requests up to limit of [quant,_1,request] per user).',$1); } } else { $cond = $conditions{$confhash{$item}{$type}}; } $resulttext .= '
      • '.&mt('Set to be available to [_1].',$typetitle).' '.$cond.'
        • '; } else { $resulttext .= '
      • '.&mt('Set to be available to [_1]',$typetitle).'
        • '; } } else { if ($type eq '_LC_adv') { if ($confhash{$item}{$type} eq '0') { $resulttext .= '
      • '.&mt('Set to be unavailable to [_1]',$typetitle).'
        • '; } else { $resulttext .= '
      • '.&mt('No override set for [_1]',$typetitle).'
        • '; } } else { $resulttext .= '
      • '.&mt('Set to be unavailable to [_1]',$typetitle).'
        • '; } } } } $resulttext .= '
      • '; } } if ($action eq 'requestcourses') { if (ref($changes{'notify'}) eq 'HASH') { if ($changes{'notify'}{'approval'}) { if (ref($confhash{'notify'}) eq 'HASH') { if ($confhash{'notify'}{'approval'}) { $resulttext .= '
    • '.&mt('Notification of requests requiring approval will be sent to: ').$confhash{'notify'}{'approval'}.'
      • '; } else { $resulttext .= '
    • '.&mt('No Domain Coordinators will receive notification of course requests requiring approval.').'
      • '; } } } } } $resulttext .= '
    '; if (keys(%newenv)) { &Apache::lonnet::appenv(\%newenv); } } else { if ($context eq 'requestcourses') { $resulttext = &mt('No changes made to rights to request creation of courses.'); } else { $resulttext = &mt('No changes made to availability of personal information pages, blogs, portfolios or default quotas'); } } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_autoenroll { my ($dom,%domconfig) = @_; my ($resulttext,%changes); my %currautoenroll; if (ref($domconfig{'autoenroll'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'autoenroll'}})) { $currautoenroll{$key} = $domconfig{'autoenroll'}{$key}; } } my $autorun = &Apache::lonnet::auto_run(undef,$dom), my %title = ( run => 'Auto-enrollment active', sender => 'Sender for notification messages', coowners => 'Automatic assignment of co-ownership to instructors of record (institutional data)'); my @offon = ('off','on'); my $sender_uname = $env{'form.sender_uname'}; my $sender_domain = $env{'form.sender_domain'}; if ($sender_domain eq '') { $sender_uname = ''; } elsif ($sender_uname eq '') { $sender_domain = ''; } my $coowners = $env{'form.autoassign_coowners'}; my %autoenrollhash = ( autoenroll => { 'run' => $env{'form.autoenroll_run'}, 'sender_uname' => $sender_uname, 'sender_domain' => $sender_domain, 'co-owners' => $coowners, } ); my $putresult = &Apache::lonnet::put_dom('configuration',\%autoenrollhash, $dom); if ($putresult eq 'ok') { if (exists($currautoenroll{'run'})) { if ($currautoenroll{'run'} ne $env{'form.autoenroll_run'}) { $changes{'run'} = 1; } } elsif ($autorun) { if ($env{'form.autoenroll_run'} ne '1') { $changes{'run'} = 1; } } if ($currautoenroll{'sender_uname'} ne $sender_uname) { $changes{'sender'} = 1; } if ($currautoenroll{'sender_domain'} ne $sender_domain) { $changes{'sender'} = 1; } if ($currautoenroll{'co-owners'} ne '') { if ($currautoenroll{'co-owners'} ne $coowners) { $changes{'coowners'} = 1; } } elsif ($coowners) { $changes{'coowners'} = 1; } if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; if ($changes{'run'}) { $resulttext .= '
    • '.&mt("$title{'run'} set to $offon[$env{'form.autoenroll_run'}]").'
      • '; } if ($changes{'sender'}) { if ($sender_uname eq '' || $sender_domain eq '') { $resulttext .= '
    • '.&mt("$title{'sender'} set to default (course owner).").'
      • '; } else { $resulttext .= '
    • '.&mt("$title{'sender'} set to [_1]",$sender_uname.':'.$sender_domain).'
      • '; } } if ($changes{'coowners'}) { $resulttext .= '
    • '.&mt("$title{'coowners'} set to $offon[$env{'form.autoassign_coowners'}]").'
      • '; &Apache::loncommon::devalidate_domconfig_cache($dom); } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to auto-enrollment settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_autoupdate { my ($dom,%domconfig) = @_; my ($resulttext,%currautoupdate,%fields,%changes); if (ref($domconfig{'autoupdate'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'autoupdate'}})) { $currautoupdate{$key} = $domconfig{'autoupdate'}{$key}; } } my @offon = ('off','on'); my %title = &Apache::lonlocal::texthash ( run => 'Auto-update:', classlists => 'Updates to user information in classlists?' ); my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); my %fieldtitles = &Apache::lonlocal::texthash ( id => 'Student/Employee ID', permanentemail => 'E-mail address', lastname => 'Last Name', firstname => 'First Name', middlename => 'Middle Name', generation => 'Generation', ); $othertitle = &mt('All users'); if (keys(%{$usertypes}) > 0) { $othertitle = &mt('Other users'); } foreach my $key (keys(%env)) { if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) { my ($usertype,$item) = ($1,$2); if (grep(/^\Q$item\E$/,keys(%fieldtitles))) { if ($usertype eq 'default') { push(@{$fields{$1}},$2); } elsif (ref($types) eq 'ARRAY') { if (grep(/^\Q$usertype\E$/,@{$types})) { push(@{$fields{$1}},$2); } } } } } my @lockablenames = &Apache::loncommon::get_env_multiple('form.lockablenames'); @lockablenames = sort(@lockablenames); if (ref($currautoupdate{'lockablenames'}) eq 'ARRAY') { my @changed = &Apache::loncommon::compare_arrays($currautoupdate{'lockablenames'},\@lockablenames); if (@changed) { $changes{'lockablenames'} = 1; } } else { if (@lockablenames) { $changes{'lockablenames'} = 1; } } my %updatehash = ( autoupdate => { run => $env{'form.autoupdate_run'}, classlists => $env{'form.classlists'}, fields => {%fields}, lockablenames => \@lockablenames, } ); foreach my $key (keys(%currautoupdate)) { if (($key eq 'run') || ($key eq 'classlists')) { if (exists($updatehash{autoupdate}{$key})) { if ($currautoupdate{$key} ne $updatehash{autoupdate}{$key}) { $changes{$key} = 1; } } } elsif ($key eq 'fields') { if (ref($currautoupdate{$key}) eq 'HASH') { 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; last; } elsif (ref($fields{$item}) eq 'ARRAY') { if (!grep(/^\Q$type\E$/,@{$fields{$item}})) { $change = 1; last; } } } if ($change) { push(@{$changes{$key}},$item); } } } } } elsif ($key eq 'lockablenames') { if (ref($currautoupdate{$key}) eq 'ARRAY') { my @changed = &Apache::loncommon::compare_arrays($currautoupdate{'lockablenames'},\@lockablenames); if (@changed) { $changes{'lockablenames'} = 1; } } else { if (@lockablenames) { $changes{'lockablenames'} = 1; } } } } unless (grep(/^\Qlockablenames\E$/,keys(%currautoupdate))) { if (@lockablenames) { $changes{'lockablenames'} = 1; } } foreach my $item (@{$types},'default') { if (defined($fields{$item})) { if (ref($currautoupdate{'fields'}) eq 'HASH') { if (ref($currautoupdate{'fields'}{$item}) eq 'ARRAY') { my $change = 0; if (ref($fields{$item}) eq 'ARRAY') { foreach my $type (@{$fields{$item}}) { if (!grep(/^\Q$type\E$/,@{$currautoupdate{'fields'}{$item}})) { $change = 1; last; } } } if ($change) { push(@{$changes{'fields'}},$item); } } else { push(@{$changes{'fields'}},$item); } } else { push(@{$changes{'fields'}},$item); } } } my $putresult = &Apache::lonnet::put_dom('configuration',\%updatehash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; foreach my $key (sort(keys(%changes))) { if ($key eq 'lockablenames') { $resulttext .= '
    • '; if (@lockablenames) { $usertypes->{'default'} = $othertitle; $resulttext .= &mt("User preference to disable replacement of user's name with institutional data (by auto-update), available for the following affiliations:").' '. join(', ', map { $usertypes->{$_}; } @lockablenames).'
      • '; } else { $resulttext .= &mt("User preference to disable replacement of user's name with institutional data (by auto-update) is unavailable."); } $resulttext .= ''; } elsif (ref($changes{$key}) eq 'ARRAY') { foreach my $item (@{$changes{$key}}) { my @newvalues; foreach my $type (@{$fields{$item}}) { push(@newvalues,$fieldtitles{$type}); } my $newvaluestr; if (@newvalues > 0) { $newvaluestr = join(', ',@newvalues); } else { $newvaluestr = &mt('none'); } if ($item eq 'default') { $resulttext .= '
    • '.&mt("Updates for '[_1]' set to: '[_2]'",$othertitle,$newvaluestr).'
      • '; } else { $resulttext .= '
    • '.&mt("Updates for '[_1]' set to: '[_2]'",$usertypes->{$item},$newvaluestr).'
      • '; } } } else { my $newvalue; if ($key eq 'run') { $newvalue = $offon[$env{'form.autoupdate_run'}]; } else { $newvalue = $offon[$env{'form.'.$key}]; } $resulttext .= '
    • '.&mt("[_1] set to $newvalue",$title{$key}).'
      • '; } } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to autoupdates'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_autocreate { my ($dom,%domconfig) = @_; my ($resulttext,%changes,%currautocreate,%newvals,%autocreatehash); if (ref($domconfig{'autocreate'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'autocreate'}})) { $currautocreate{$key} = $domconfig{'autocreate'}{$key}; } } my %title= ( xml => 'Auto-creation of courses in XML course description files', req => 'Auto-creation of validated requests for official courses', xmldc => 'Identity of course creator of courses from XML files', ); my @types = ('xml','req'); foreach my $item (@types) { $newvals{$item} = $env{'form.autocreate_'.$item}; $newvals{$item} =~ s/\D//g; $newvals{$item} = 0 if ($newvals{$item} eq ''); } $newvals{'xmldc'} = $env{'form.autocreate_xmldc'}; my %domcoords = &get_active_dcs($dom); unless (exists($domcoords{$newvals{'xmldc'}})) { $newvals{'xmldc'} = ''; } %autocreatehash = ( autocreate => { xml => $newvals{'xml'}, req => $newvals{'req'}, } ); if ($newvals{'xmldc'} ne '') { $autocreatehash{'autocreate'}{'xmldc'} = $newvals{'xmldc'}; } my $putresult = &Apache::lonnet::put_dom('configuration',\%autocreatehash, $dom); if ($putresult eq 'ok') { my @items = @types; if ($newvals{'xml'}) { push(@items,'xmldc'); } foreach my $item (@items) { if (exists($currautocreate{$item})) { if ($currautocreate{$item} ne $newvals{$item}) { $changes{$item} = 1; } } elsif ($newvals{$item}) { $changes{$item} = 1; } } if (keys(%changes) > 0) { my @offon = ('off','on'); $resulttext = &mt('Changes made:').'
      '; foreach my $item (@types) { if ($changes{$item}) { my $newtxt = $offon[$newvals{$item}]; $resulttext .= '
    • '.&mt("$title{$item} set to [_1]$newtxt [_2]",'','').'
      • '; } } if ($changes{'xmldc'}) { my ($dcname,$dcdom) = split(':',$newvals{'xmldc'}); my $newtxt = &Apache::loncommon::plainname($dcname,$dcdom); $resulttext .= '
    • '.&mt("$title{'xmldc'} set to [_1]$newtxt [_2]",'','').'
      • '; } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to auto-creation settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_directorysrch { my ($dom,%domconfig) = @_; my ($resulttext,%changes); my %currdirsrch; if (ref($domconfig{'directorysrch'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'directorysrch'}})) { $currdirsrch{$key} = $domconfig{'directorysrch'}{$key}; } } my %title = ( available => 'Directory search available', localonly => 'Other domains can search', searchby => 'Search types', searchtypes => 'Search latitude'); my @offon = ('off','on'); my @otherdoms = ('Yes','No'); my @searchtypes = &Apache::loncommon::get_env_multiple('form.searchtypes'); my @cansearch = &Apache::loncommon::get_env_multiple('form.cansearch'); my @searchby = &Apache::loncommon::get_env_multiple('form.searchby'); my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); if (keys(%{$usertypes}) == 0) { @cansearch = ('default'); } else { if (ref($currdirsrch{'cansearch'}) eq 'ARRAY') { foreach my $type (@{$currdirsrch{'cansearch'}}) { if (!grep(/^\Q$type\E$/,@cansearch)) { push(@{$changes{'cansearch'}},$type); } } foreach my $type (@cansearch) { if (!grep(/^\Q$type\E$/,@{$currdirsrch{'cansearch'}})) { push(@{$changes{'cansearch'}},$type); } } } else { push(@{$changes{'cansearch'}},@cansearch); } } if (ref($currdirsrch{'searchby'}) eq 'ARRAY') { foreach my $by (@{$currdirsrch{'searchby'}}) { if (!grep(/^\Q$by\E$/,@searchby)) { push(@{$changes{'searchby'}},$by); } } foreach my $by (@searchby) { if (!grep(/^\Q$by\E$/,@{$currdirsrch{'searchby'}})) { push(@{$changes{'searchby'}},$by); } } } else { push(@{$changes{'searchby'}},@searchby); } if (ref($currdirsrch{'searchtypes'}) eq 'ARRAY') { foreach my $type (@{$currdirsrch{'searchtypes'}}) { if (!grep(/^\Q$type\E$/,@searchtypes)) { push(@{$changes{'searchtypes'}},$type); } } foreach my $type (@searchtypes) { if (!grep(/^\Q$type\E$/,@{$currdirsrch{'searchtypes'}})) { push(@{$changes{'searchtypes'}},$type); } } } else { if (exists($currdirsrch{'searchtypes'})) { foreach my $type (@searchtypes) { if ($type ne $currdirsrch{'searchtypes'}) { push(@{$changes{'searchtypes'}},$type); } } if (!grep(/^\Q$currdirsrch{'searchtypes'}\E/,@searchtypes)) { push(@{$changes{'searchtypes'}},$currdirsrch{'searchtypes'}); } } else { push(@{$changes{'searchtypes'}},@searchtypes); } } my %dirsrch_hash = ( directorysrch => { available => $env{'form.dirsrch_available'}, cansearch => \@cansearch, localonly => $env{'form.dirsrch_localonly'}, searchby => \@searchby, searchtypes => \@searchtypes, } ); my $putresult = &Apache::lonnet::put_dom('configuration',\%dirsrch_hash, $dom); if ($putresult eq 'ok') { if (exists($currdirsrch{'available'})) { if ($currdirsrch{'available'} ne $env{'form.dirsrch_available'}) { $changes{'available'} = 1; } } else { if ($env{'form.dirsrch_available'} eq '1') { $changes{'available'} = 1; } } if (exists($currdirsrch{'localonly'})) { if ($currdirsrch{'localonly'} ne $env{'form.dirsrch_localonly'}) { $changes{'localonly'} = 1; } } else { if ($env{'form.dirsrch_localonly'} eq '1') { $changes{'localonly'} = 1; } } if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; if ($changes{'available'}) { $resulttext .= '
    • '.&mt("$title{'available'} set to: $offon[$env{'form.dirsrch_available'}]").'
      • '; } if ($changes{'localonly'}) { $resulttext .= '
    • '.&mt("$title{'localonly'} set to: $otherdoms[$env{'form.dirsrch_localonly'}]").'
      • '; } if (ref($changes{'cansearch'}) eq 'ARRAY') { my $chgtext; if (ref($usertypes) eq 'HASH') { if (keys(%{$usertypes}) > 0) { foreach my $type (@{$types}) { if (grep(/^\Q$type\E$/,@cansearch)) { $chgtext .= $usertypes->{$type}.'; '; } } if (grep(/^default$/,@cansearch)) { $chgtext .= $othertitle; } else { $chgtext =~ s/\; $//; } $resulttext .= '
    • '.&mt("Users from domain '[_1]' permitted to search the institutional directory set to: [_2]",$dom,$chgtext).'
      • '; } } } if (ref($changes{'searchby'}) eq 'ARRAY') { my ($searchtitles,$titleorder) = &sorted_searchtitles(); my $chgtext; foreach my $type (@{$titleorder}) { if (grep(/^\Q$type\E$/,@searchby)) { if (defined($searchtitles->{$type})) { $chgtext .= $searchtitles->{$type}.'; '; } } } $chgtext =~ s/\; $//; $resulttext .= '
    • '.&mt("$title{'searchby'} set to: [_1]",$chgtext).'
      • '; } if (ref($changes{'searchtypes'}) eq 'ARRAY') { my ($srchtypes_desc,$srchtypeorder) = &sorted_searchtypes(); my $chgtext; foreach my $type (@{$srchtypeorder}) { if (grep(/^\Q$type\E$/,@searchtypes)) { if (defined($srchtypes_desc->{$type})) { $chgtext .= $srchtypes_desc->{$type}.'; '; } } } $chgtext =~ s/\; $//; $resulttext .= '
    • '.&mt("$title{'searchtypes'} set to: \"[_1]\"",$chgtext).'
      • '; } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to institution directory search settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_contacts { my ($dom,%domconfig) = @_; my ($resulttext,%currsetting,%newsetting,%changes,%contacts_hash); if (ref($domconfig{'contacts'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'contacts'}})) { $currsetting{$key} = $domconfig{'contacts'}{$key}; } } my (%others,%to,%bcc); my @contacts = ('supportemail','adminemail'); my @mailings = ('errormail','packagesmail','helpdeskmail','lonstatusmail', 'requestsmail'); foreach my $type (@mailings) { @{$newsetting{$type}} = &Apache::loncommon::get_env_multiple('form.'.$type); foreach my $item (@contacts) { if (grep(/^\Q$item\E$/,@{$newsetting{$type}})) { $contacts_hash{contacts}{$type}{$item} = 1; } else { $contacts_hash{contacts}{$type}{$item} = 0; } } $others{$type} = $env{'form.'.$type.'_others'}; $contacts_hash{contacts}{$type}{'others'} = $others{$type}; if ($type eq 'helpdeskmail') { $bcc{$type} = $env{'form.'.$type.'_bcc'}; $contacts_hash{contacts}{$type}{'bcc'} = $bcc{$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'); } if ($type eq 'helpdeskmail') { if ($bcc{$type} ne $currsetting{$type}{'bcc'}) { push(@{$changes{$type}},'bcc'); } } } } else { my %default; $default{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'}; $default{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'}; $default{'errormail'} = 'adminemail'; $default{'packagesmail'} = 'adminemail'; $default{'helpdeskmail'} = 'supportemail'; $default{'lonstatusmail'} = 'adminemail'; $default{'requestsmail'} = 'adminemail'; foreach my $item (@contacts) { if ($to{$item} ne $default{$item}) { $changes{$item} = 1; } } foreach my $type (@mailings) { if ((@{$newsetting{$type}} != 1) || ($newsetting{$type}[0] ne $default{$type})) { push(@{$changes{$type}},@{$newsetting{$type}}); } if ($others{$type} ne '') { push(@{$changes{$type}},'others'); } if ($type eq 'helpdeskmail') { if ($bcc{$type} ne '') { push(@{$changes{$type}},'bcc'); } } } } 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).''; if ($type eq 'helpdeskmail') { if ($bcc{$type} ne '') { $resulttext .= ' '.&mt('with Bcc to').': '.$bcc{$type}.''; } } $resulttext .= '
      • '; } } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to contact information'); } } else { $resulttext = ''. &mt('An error occurred: [_1].',$putresult).''; } return $resulttext; } sub modify_usercreation { my ($dom,%domconfig) = @_; my ($resulttext,%curr_usercreation,%changes,%authallowed,%cancreate); my $warningmsg; if (ref($domconfig{'usercreation'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'usercreation'}})) { $curr_usercreation{$key} = $domconfig{'usercreation'}{$key}; } } my @username_rule = &Apache::loncommon::get_env_multiple('form.username_rule'); my @id_rule = &Apache::loncommon::get_env_multiple('form.id_rule'); my @email_rule = &Apache::loncommon::get_env_multiple('form.email_rule'); my @contexts = ('author','course','requestcrs','selfcreate'); foreach my $item(@contexts) { if ($item eq 'selfcreate') { @{$cancreate{$item}} = &Apache::loncommon::get_env_multiple('form.can_createuser_'.$item); my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); if (!((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth'))) { if (ref($cancreate{$item}) eq 'ARRAY') { if (grep(/^login$/,@{$cancreate{$item}})) { $warningmsg = &mt('Although account creation has been set to be available for institutional logins, currently default authentication in this domain has not been set to support this.').' '.&mt('You need to set the default authentication type to Kerberos 4 or 5 (with a Kerberos domain specified), or to Local authentication, if the localauth module has been customized in your domain to authenticate institutional logins.'); } } } } else { $cancreate{$item} = $env{'form.can_createuser_'.$item}; } } my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); if (ref($types) eq 'ARRAY') { if (@{$types} > 0) { @{$cancreate{'statustocreate'}} = &Apache::loncommon::get_env_multiple('form.statustocreate'); } else { @{$cancreate{'statustocreate'}} = (); } push(@contexts,'statustocreate'); } if (ref($curr_usercreation{'cancreate'}) eq 'HASH') { foreach my $item (@contexts) { if (($item eq 'selfcreate') || ($item eq 'statustocreate')) { if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') { foreach my $curr (@{$curr_usercreation{'cancreate'}{$item}}) { if (ref($cancreate{$item}) eq 'ARRAY') { if (!grep(/^$curr$/,@{$cancreate{$item}})) { if (!grep(/^$item$/,@{$changes{'cancreate'}})) { push(@{$changes{'cancreate'}},$item); } } } } } else { if ($curr_usercreation{'cancreate'}{$item} eq '') { if (@{$cancreate{$item}} > 0) { if (!grep(/^$item$/,@{$changes{'cancreate'}})) { push(@{$changes{'cancreate'}},$item); } } } else { if ($curr_usercreation{'cancreate'}{$item} eq 'any') { if (@{$cancreate{$item}} < 3) { if (!grep(/^$item$/,@{$changes{'cancreate'}})) { push(@{$changes{'cancreate'}},$item); } } } elsif ($curr_usercreation{'cancreate'}{$item} eq 'none') { if (@{$cancreate{$item}} > 0) { if (!grep(/^$item$/,@{$changes{'cancreate'}})) { push(@{$changes{'cancreate'}},$item); } } } elsif (!grep(/^$curr_usercreation{'cancreate'}{$item}$/,@{$cancreate{$item}})) { if (!grep(/^$item$/,@{$changes{'cancreate'}})) { push(@{$changes{'cancreate'}},$item); } } } } if (!grep(/^$item$/,@{$changes{'cancreate'}})) { foreach my $type (@{$cancreate{$item}}) { if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') { if (!grep(/^$type$/,@{$curr_usercreation{'cancreate'}{$item}})) { if (!grep(/^$item$/,@{$changes{'cancreate'}})) { push(@{$changes{'cancreate'}},$item); } } } elsif (($curr_usercreation{'cancreate'}{$item} ne 'any') && ($curr_usercreation{'cancreate'}{$item} ne 'none')) { if ($curr_usercreation{'cancreate'}{$item} ne $type) { if (!grep(/^$item$/,@{$changes{'cancreate'}})) { push(@{$changes{'cancreate'}},$item); } } } } } } else { if ($curr_usercreation{'cancreate'}{$item} ne $cancreate{$item}) { push(@{$changes{'cancreate'}},$item); } } } } elsif (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') { foreach my $item (@contexts) { if (!grep(/^\Q$item\E$/,@{$curr_usercreation{'cancreate'}})) { if ($cancreate{$item} ne 'any') { push(@{$changes{'cancreate'}},$item); } } else { if ($cancreate{$item} ne 'none') { push(@{$changes{'cancreate'}},$item); } } } } else { foreach my $item (@contexts) { push(@{$changes{'cancreate'}},$item); } } if (ref($curr_usercreation{'username_rule'}) eq 'ARRAY') { foreach my $type (@{$curr_usercreation{'username_rule'}}) { if (!grep(/^\Q$type\E$/,@username_rule)) { push(@{$changes{'username_rule'}},$type); } } foreach my $type (@username_rule) { if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'username_rule'}})) { push(@{$changes{'username_rule'}},$type); } } } else { push(@{$changes{'username_rule'}},@username_rule); } if (ref($curr_usercreation{'id_rule'}) eq 'ARRAY') { foreach my $type (@{$curr_usercreation{'id_rule'}}) { if (!grep(/^\Q$type\E$/,@id_rule)) { push(@{$changes{'id_rule'}},$type); } } foreach my $type (@id_rule) { if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'id_rule'}})) { push(@{$changes{'id_rule'}},$type); } } } else { push(@{$changes{'id_rule'}},@id_rule); } if (ref($curr_usercreation{'email_rule'}) eq 'ARRAY') { foreach my $type (@{$curr_usercreation{'email_rule'}}) { if (!grep(/^\Q$type\E$/,@email_rule)) { push(@{$changes{'email_rule'}},$type); } } foreach my $type (@email_rule) { if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'email_rule'}})) { push(@{$changes{'email_rule'}},$type); } } } else { push(@{$changes{'email_rule'}},@email_rule); } my @authen_contexts = ('author','course','domain'); my @authtypes = ('int','krb4','krb5','loc'); my %authhash; foreach my $item (@authen_contexts) { my @authallowed = &Apache::loncommon::get_env_multiple('form.'.$item.'_auth'); foreach my $auth (@authtypes) { if (grep(/^\Q$auth\E$/,@authallowed)) { $authhash{$item}{$auth} = 1; } else { $authhash{$item}{$auth} = 0; } } } if (ref($curr_usercreation{'authtypes'}) eq 'HASH') { foreach my $item (@authen_contexts) { if (ref($curr_usercreation{'authtypes'}{$item}) eq 'HASH') { foreach my $auth (@authtypes) { if ($authhash{$item}{$auth} ne $curr_usercreation{'authtypes'}{$item}{$auth}) { push(@{$changes{'authtypes'}},$item); last; } } } } } else { foreach my $item (@authen_contexts) { push(@{$changes{'authtypes'}},$item); } } my %usercreation_hash = ( usercreation => { cancreate => \%cancreate, username_rule => \@username_rule, id_rule => \@id_rule, email_rule => \@email_rule, authtypes => \%authhash, } ); my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash, $dom); my %selfcreatetypes = ( sso => 'users authenticated by institutional single sign on', login => 'users authenticated by institutional log-in', email => 'users who provide a valid e-mail address for use as the username', ); if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; if (ref($changes{'cancreate'}) eq 'ARRAY') { my %lt = &usercreation_types(); foreach my $type (@{$changes{'cancreate'}}) { my $chgtext; unless ($type eq 'statustocreate') { $chgtext = $lt{$type}.', '; } if ($type eq 'selfcreate') { if (@{$cancreate{$type}} == 0) { $chgtext .= &mt('creation of a new user account is not permitted.'); } else { $chgtext .= &mt('creation of a new account is permitted for:').'
        '; foreach my $case (@{$cancreate{$type}}) { $chgtext .= '
      • '.$selfcreatetypes{$case}.'
        • '; } $chgtext .= '
      '; if (ref($cancreate{$type}) eq 'ARRAY') { if (grep(/^(login|sso)$/,@{$cancreate{$type}})) { if (ref($cancreate{'statustocreate'}) eq 'ARRAY') { if (@{$cancreate{'statustocreate'}} == 0) { $chgtext .= '
      '.&mt("However, no institutional affiliations (including 'other') are currently permitted to create accounts.").''; } } } } } } elsif ($type eq 'statustocreate') { if ((ref($cancreate{'selfcreate'}) eq 'ARRAY') && (ref($cancreate{'statustocreate'}) eq 'ARRAY')) { if (@{$cancreate{'selfcreate'}} > 0) { if (@{$cancreate{'statustocreate'}} == 0) { $chgtext .= &mt("Institutional affiliations permitted to create accounts set to 'None'."); if (!grep(/^email$/,@{$cancreate{'selfcreate'}})) { $chgtext .= '
      '.&mt("However, no institutional affiliations (including 'other') are currently permitted to create accounts.").''; } } elsif (ref($usertypes) eq 'HASH') { if (grep(/^(login|sso)$/,@{$cancreate{'selfcreate'}})) { $chgtext .= &mt('Creation of a new account for an institutional user is restricted to the following institutional affiliation(s):'); } else { $chgtext .= &mt('Institutional affiliations permitted to create accounts with institutional authentication were set as follows:'); } $chgtext .= '
        '; foreach my $case (@{$cancreate{$type}}) { if ($case eq 'default') { $chgtext .= '
      • '.$othertitle.'
        • '; } else { $chgtext .= '
      • '.$usertypes->{$case}.'
        • '; } } $chgtext .= '
      '; if (!grep(/^(login|sso)$/,@{$cancreate{'selfcreate'}})) { $chgtext .= '
      '.&mt('However, users authenticated by institutional login/single sign on are not currently permitted to create accounts.').''; } } } else { if (@{$cancreate{$type}} == 0) { $chgtext .= &mt("Institutional affiliations permitted to create accounts were set to 'none'."); } else { $chgtext .= &mt('Although institutional affiliations permitted to create accounts were changed, self creation of accounts is not currently permitted for any authentication types.'); } } } } else { if ($cancreate{$type} eq 'none') { $chgtext .= &mt('creation of new users is not permitted, except by a Domain Coordinator.'); } elsif ($cancreate{$type} eq 'any') { $chgtext .= &mt('creation of new users is permitted for both institutional and non-institutional usernames.'); } elsif ($cancreate{$type} eq 'official') { $chgtext .= &mt('creation of new users is only permitted for institutional usernames.'); } elsif ($cancreate{$type} eq 'unofficial') { $chgtext .= &mt('creation of new users is only permitted for non-institutional usernames.'); } } $resulttext .= '
    • '.$chgtext.'
      • '; } } if (ref($changes{'username_rule'}) eq 'ARRAY') { my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom,'username'); my $chgtext = '
        '; foreach my $type (@username_rule) { if (ref($rules->{$type}) eq 'HASH') { $chgtext .= '
      • '.$rules->{$type}{'name'}.'
        • '; } } $chgtext .= '
      '; if (@username_rule > 0) { $resulttext .= '
    • '.&mt('Usernames with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'
      • '; } else { $resulttext .= '
    • '.&mt('There are now no username formats restricted to verified users in the institutional directory.').'
      • '; } } if (ref($changes{'id_rule'}) eq 'ARRAY') { my ($idrules,$idruleorder) = &Apache::lonnet::inst_userrules($dom,'id'); my $chgtext = '
        '; foreach my $type (@id_rule) { if (ref($idrules->{$type}) eq 'HASH') { $chgtext .= '
      • '.$idrules->{$type}{'name'}.'
        • '; } } $chgtext .= '
      '; if (@id_rule > 0) { $resulttext .= '
    • '.&mt('IDs with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'
      • '; } else { $resulttext .= '
    • '.&mt('There are now no ID formats restricted to verified users in the institutional directory.').'
      • '; } } if (ref($changes{'email_rule'}) eq 'ARRAY') { my ($emailrules,$emailruleorder) = &Apache::lonnet::inst_userrules($dom,'email'); my $chgtext = '
        '; foreach my $type (@email_rule) { if (ref($emailrules->{$type}) eq 'HASH') { $chgtext .= '
      • '.$emailrules->{$type}{'name'}.'
        • '; } } $chgtext .= '
      '; if (@email_rule > 0) { $resulttext .= '
    • '.&mt('Accounts may not be created by users self-enrolling with e-mail addresses of the following types: ').$chgtext.'
      • '; } else { $resulttext .= '
    • '.&mt('There are now no restrictions on e-mail addresses which may be used as a username when self-enrolling.').'
      • '; } } my %authname = &authtype_names(); my %context_title = &context_names(); if (ref($changes{'authtypes'}) eq 'ARRAY') { my $chgtext = '
        '; foreach my $type (@{$changes{'authtypes'}}) { my @allowed; $chgtext .= '
      • '.$context_title{$type}.' - '.&mt('assignable authentication types: '); foreach my $auth (@authtypes) { if ($authhash{$type}{$auth}) { push(@allowed,$authname{$auth}); } } if (@allowed > 0) { $chgtext .= join(', ',@allowed).'
        • '; } else { $chgtext .= &mt('none').''; } } $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).''; } if ($warningmsg ne '') { $resulttext .= '
    '.$warningmsg.'
    '; } return $resulttext; } sub modify_usermodification { my ($dom,%domconfig) = @_; my ($resulttext,%curr_usermodification,%changes); if (ref($domconfig{'usermodification'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'usermodification'}})) { $curr_usermodification{$key} = $domconfig{'usermodification'}{$key}; } } my @contexts = ('author','course','selfcreate'); my %context_title = ( author => 'In author context', course => 'In course context', selfcreate => 'When self creating account', ); my @fields = ('lastname','firstname','middlename','generation', 'permanentemail','id'); my %roles = ( author => ['ca','aa'], course => ['st','ep','ta','in','cr'], ); my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); if (ref($types) eq 'ARRAY') { push(@{$types},'default'); $usertypes->{'default'} = $othertitle; } $roles{'selfcreate'} = $types; my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); my %modifyhash; foreach my $context (@contexts) { foreach my $role (@{$roles{$context}}) { my @modifiable = &Apache::loncommon::get_env_multiple('form.canmodify_'.$role); foreach my $item (@fields) { if (grep(/^\Q$item\E$/,@modifiable)) { $modifyhash{$context}{$role}{$item} = 1; } else { $modifyhash{$context}{$role}{$item} = 0; } } } if (ref($curr_usermodification{$context}) eq 'HASH') { foreach my $role (@{$roles{$context}}) { if (ref($curr_usermodification{$context}{$role}) eq 'HASH') { foreach my $field (@fields) { if ($modifyhash{$context}{$role}{$field} ne $curr_usermodification{$context}{$role}{$field}) { push(@{$changes{$context}},$role); last; } } } } } else { foreach my $context (@contexts) { foreach my $role (@{$roles{$context}}) { push(@{$changes{$context}},$role); } } } } my %usermodification_hash = ( usermodification => \%modifyhash, ); my $putresult = &Apache::lonnet::put_dom('configuration', \%usermodification_hash,$dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made: ').'
      '; foreach my $context (@contexts) { if (ref($changes{$context}) eq 'ARRAY') { $resulttext .= '
    • '.$context_title{$context}.':
        '; if (ref($changes{$context}) eq 'ARRAY') { foreach my $role (@{$changes{$context}}) { my $rolename; if ($context eq 'selfcreate') { $rolename = $role; if (ref($usertypes) eq 'HASH') { if ($usertypes->{$role} ne '') { $rolename = $usertypes->{$role}; } } } else { if ($role eq 'cr') { $rolename = &mt('Custom'); } else { $rolename = &Apache::lonnet::plaintext($role); } } my @modifiable; if ($context eq 'selfcreate') { $resulttext .= '
      • '.&mt('Self-creation of account by users with status: [_1]',$rolename).' - '.&mt('modifiable fields (if institutional data blank): '); } else { $resulttext .= '
      • '.&mt('Target user with [_1] role',$rolename).' - '.&mt('modifiable fields: '); } foreach my $field (@fields) { if ($modifyhash{$context}{$role}{$field}) { push(@modifiable,$fieldtitles{$field}); } } if (@modifiable > 0) { $resulttext .= join(', ',@modifiable); } else { $resulttext .= &mt('none'); } $resulttext .= '
        • '; } $resulttext .= '
      • '; } } } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to user modification settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_defaults { my ($dom,$r) = @_; my ($resulttext,$mailmsgtxt,%newvalues,%changes,@errors); my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def','portal_def'); my @authtypes = ('internal','krb4','krb5','localauth'); foreach my $item (@items) { $newvalues{$item} = $env{'form.'.$item}; if ($item eq 'auth_def') { if ($newvalues{$item} ne '') { if (!grep(/^\Q$newvalues{$item}\E$/,@authtypes)) { push(@errors,$item); } } } elsif ($item eq 'lang_def') { if ($newvalues{$item} ne '') { if ($newvalues{$item} =~ /^(\w+)/) { my $langcode = $1; if ($langcode ne 'x_chef') { if (code2language($langcode) eq '') { push(@errors,$item); } } } else { push(@errors,$item); } } } elsif ($item eq 'timezone_def') { if ($newvalues{$item} ne '') { if (!DateTime::TimeZone->is_valid_name($newvalues{$item})) { push(@errors,$item); } } } elsif ($item eq 'datelocale_def') { if ($newvalues{$item} ne '') { my @datelocale_ids = DateTime::Locale->ids(); if (!grep(/^\Q$newvalues{$item}\E$/,@datelocale_ids)) { push(@errors,$item); } } } elsif ($item eq 'portal_def') { if ($newvalues{$item} ne '') { unless ($newvalues{$item} =~ /^https?\:\/\/(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z]|[A-Za-z][A-Za-z0-9\-]*[A-Za-z0-9])\/?$/) { push(@errors,$item); } } } if (grep(/^\Q$item\E$/,@errors)) { $newvalues{$item} = $domdefaults{$item}; } elsif ($domdefaults{$item} ne $newvalues{$item}) { $changes{$item} = 1; } $domdefaults{$item} = $newvalues{$item}; } my %defaults_hash = ( defaults => \%newvalues, ); my $title = &defaults_titles(); my $putresult = &Apache::lonnet::put_dom('configuration',\%defaults_hash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; my $version = $r->dir_config('lonVersion'); my $mailmsgtext = "Changes made to domain settings in a LON-CAPA installation - domain: $dom (running version: $version) - dns_domain.tab needs to be updated with the following changes, to support legacy 2.4, 2.5 and 2.6 versions of LON-CAPA.\n\n"; foreach my $item (sort(keys(%changes))) { my $value = $env{'form.'.$item}; if ($value eq '') { $value = &mt('none'); } elsif ($item eq 'auth_def') { my %authnames = &authtype_names(); my %shortauth = ( internal => 'int', krb4 => 'krb4', krb5 => 'krb5', localauth => 'loc', ); $value = $authnames{$shortauth{$value}}; } $resulttext .= '
    • '.&mt('[_1] set to "[_2]"',$title->{$item},$value).'
      • '; $mailmsgtext .= "$title->{$item} set to $value\n"; } $resulttext .= '
    '; $mailmsgtext .= "\n"; my $cachetime = 24*60*60; &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); if ($changes{'auth_def'} || $changes{'auth_arg_def'} || $changes{'lang_def'} || $changes{'datelocale_def'}) { my $sysmail = $r->dir_config('lonSysEMail'); &Apache::lonmsg::sendemail($sysmail,"LON-CAPA Domain Settings Change - $dom",$mailmsgtext); } } else { $resulttext = &mt('No changes made to default authentication/language/timezone settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } if (@errors > 0) { $resulttext .= '
    '.&mt('The following were left unchanged because the values entered were invalid:'); foreach my $item (@errors) { $resulttext .= ' "'.$title->{$item}.'",'; } $resulttext =~ s/,$//; } return $resulttext; } sub modify_scantron { my ($r,$dom,$confname,%domconfig) = @_; my ($resulttext,%confhash,%changes,$errors); my $custom = 'custom.tab'; my $default = 'default.tab'; my $servadm = $r->dir_config('lonAdmEMail'); my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm); if ($env{'form.scantronformat.filename'} ne '') { my $error; if ($configuserok eq 'ok') { if ($switchserver) { $error = &mt("Upload of bubblesheet format file is not permitted to this server: [_1]",$switchserver); } else { if ($author_ok eq 'ok') { my ($result,$scantronurl) = &publishlogo($r,'upload','scantronformat',$dom, $confname,'scantron','','',$custom); if ($result eq 'ok') { $confhash{'scantron'}{'scantronformat'} = $scantronurl; $changes{'scantronformat'} = 1; } else { $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$custom,$result); } } else { $error = &mt("Upload of [_1] failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3]. Error was: [_4].",$custom,$confname,$dom,$author_ok); } } } else { $error = &mt("Upload of [_1] failed because a Domain Configuration user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$custom,$confname,$dom,$configuserok); } if ($error) { &Apache::lonnet::logthis($error); $errors .= '
  • '.$error.'
    • '; } } if (ref($domconfig{'scantron'}) eq 'HASH') { if ($domconfig{'scantron'}{'scantronformat'} ne '') { if ($env{'form.scantronformat_del'}) { $confhash{'scantron'}{'scantronformat'} = ''; $changes{'scantronformat'} = 1; } } } if (keys(%confhash) > 0) { my $putresult = &Apache::lonnet::put_dom('configuration',\%confhash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { if (ref($confhash{'scantron'}) eq 'HASH') { $resulttext = &mt('Changes made:').'
      '; if ($confhash{'scantron'}{'scantronformat'} eq '') { $resulttext .= '
    • '.&mt('[_1] bubblesheet format file removed; [_2] file will be used for courses in this domain.',$custom,$default).'
      • '; } else { $resulttext .= '
    • '.&mt('Custom bubblesheet format file ([_1]) uploaded for use with courses in this domain.',$custom).'
      • '; } $resulttext .= '
    '; } else { $resulttext = &mt('Changes made to bubblesheet format file.'); } $resulttext .= ''; &Apache::loncommon::devalidate_domconfig_cache($dom); } else { $resulttext = &mt('No changes made to bubblesheet format file'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } } else { $resulttext = &mt('No changes made to bubblesheet format file'); } if ($errors) { $resulttext .= &mt('The following errors occurred: ').'
      '. $errors.'
    '; } return $resulttext; } sub modify_coursecategories { my ($dom,%domconfig) = @_; my ($resulttext,%deletions,%reorderings,%needreordering,%adds,%changes,$errors, $cathash); my @deletecategory = &Apache::loncommon::get_env_multiple('form.deletecategory'); if (ref($domconfig{'coursecategories'}) eq 'HASH') { $cathash = $domconfig{'coursecategories'}{'cats'}; if ($domconfig{'coursecategories'}{'togglecats'} ne $env{'form.togglecats'}) { $changes{'togglecats'} = 1; $domconfig{'coursecategories'}{'togglecats'} = $env{'form.togglecats'}; } if ($domconfig{'coursecategories'}{'categorize'} ne $env{'form.categorize'}) { $changes{'categorize'} = 1; $domconfig{'coursecategories'}{'categorize'} = $env{'form.categorize'}; } if ($domconfig{'coursecategories'}{'togglecatscomm'} ne $env{'form.togglecatscomm'}) { $changes{'togglecatscomm'} = 1; $domconfig{'coursecategories'}{'togglecatscomm'} = $env{'form.togglecatscomm'}; } if ($domconfig{'coursecategories'}{'categorizecomm'} ne $env{'form.categorizecomm'}) { $changes{'categorizecomm'} = 1; $domconfig{'coursecategories'}{'categorizecomm'} = $env{'form.categorizecomm'}; } } else { $changes{'togglecats'} = 1; $changes{'categorize'} = 1; $changes{'togglecatscomm'} = 1; $changes{'categorizecomm'} = 1; $domconfig{'coursecategories'} = { togglecats => $env{'form.togglecats'}, categorize => $env{'form.categorize'}, togglecatscomm => $env{'form.togglecatscomm'}, categorizecomm => $env{'form.categorizecomm'}, }; } if (ref($cathash) eq 'HASH') { if (($domconfig{'coursecategories'}{'cats'}{'instcode::0'} ne '') && ($env{'form.instcode'} == 0)) { push (@deletecategory,'instcode::0'); } if (($domconfig{'coursecategories'}{'cats'}{'communities::0'} ne '') && ($env{'form.communities'} == 0)) { push(@deletecategory,'communities::0'); } } my (@predelcats,@predeltrails,%predelallitems,%sort_by_deltrail); if (ref($cathash) eq 'HASH') { if (@deletecategory > 0) { #FIXME Need to remove category from all courses using a deleted category &Apache::loncommon::extract_categories($cathash,\@predelcats,\@predeltrails,\%predelallitems); foreach my $item (@deletecategory) { if ($domconfig{'coursecategories'}{'cats'}{$item} ne '') { delete($domconfig{'coursecategories'}{'cats'}{$item}); $deletions{$item} = 1; &recurse_cat_deletes($item,$cathash,\%deletions); } } } foreach my $item (keys(%{$cathash})) { my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item); if ($cathash->{$item} ne $env{'form.'.$item}) { $reorderings{$item} = 1; $domconfig{'coursecategories'}{'cats'}{$item} = $env{'form.'.$item}; } if ($env{'form.addcategory_name_'.$item} ne '') { my $newcat = $env{'form.addcategory_name_'.$item}; my $newdepth = $depth+1; my $newitem = &escape($newcat).':'.&escape($cat).':'.$newdepth; $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.addcategory_pos_'.$item}; $adds{$newitem} = 1; } if ($env{'form.subcat_'.$item} ne '') { my $newcat = $env{'form.subcat_'.$item}; my $newdepth = $depth+1; my $newitem = &escape($newcat).':'.&escape($cat).':'.$newdepth; $domconfig{'coursecategories'}{'cats'}{$newitem} = 0; $adds{$newitem} = 1; } } } if ($env{'form.instcode'} eq '1') { if (ref($cathash) eq 'HASH') { my $newitem = 'instcode::0'; if ($cathash->{$newitem} eq '') { $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.instcode_pos'}; $adds{$newitem} = 1; } } else { my $newitem = 'instcode::0'; $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.instcode_pos'}; $adds{$newitem} = 1; } } if ($env{'form.communities'} eq '1') { if (ref($cathash) eq 'HASH') { my $newitem = 'communities::0'; if ($cathash->{$newitem} eq '') { $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.communities_pos'}; $adds{$newitem} = 1; } } else { my $newitem = 'communities::0'; $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.communities_pos'}; $adds{$newitem} = 1; } } if ($env{'form.addcategory_name'} ne '') { if (($env{'form.addcategory_name'} ne 'instcode') && ($env{'form.addcategory_name'} ne 'communities')) { my $newitem = &escape($env{'form.addcategory_name'}).'::0'; $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.addcategory_pos'}; $adds{$newitem} = 1; } } my $putresult; if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) { if (keys(%deletions) > 0) { foreach my $key (keys(%deletions)) { if ($predelallitems{$key} ne '') { $sort_by_deltrail{$predelallitems{$key}} = $predeltrails[$predelallitems{$key}]; } } } my (@chkcats,@chktrails,%chkallitems); &Apache::loncommon::extract_categories($domconfig{'coursecategories'}{'cats'},\@chkcats,\@chktrails,\%chkallitems); if (ref($chkcats[0]) eq 'ARRAY') { my $depth = 0; my $chg = 0; for (my $i=0; $i<@{$chkcats[0]}; $i++) { my $name = $chkcats[0][$i]; my $item; if ($name eq '') { $chg ++; } else { $item = &escape($name).'::0'; if ($chg) { $domconfig{'coursecategories'}{'cats'}{$item} -= $chg; } $depth ++; &recurse_check(\@chkcats,$domconfig{'coursecategories'}{'cats'},$depth,$name); $depth --; } } } } if ((keys(%changes) > 0) || (keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) { $putresult = &Apache::lonnet::put_dom('configuration',\%domconfig,$dom); if ($putresult eq 'ok') { my %title = ( togglecats => 'Show/Hide a course in catalog', categorize => 'Assign a category to a course', togglecatscomm => 'Show/Hide a community in catalog', categorizecomm => 'Assign a category to a community', ); my %level = ( dom => 'set in Domain ("Modify Course/Community")', crs => 'set in Course ("Course Configuration")', comm => 'set in Community ("Community Configuration")', ); $resulttext = &mt('Changes made:').'
      '; if ($changes{'togglecats'}) { $resulttext .= '
    • '.&mt("$title{'togglecats'} $level{$env{'form.togglecats'}}").'
      • '; } if ($changes{'categorize'}) { $resulttext .= '
    • '.&mt("$title{'categorize'} $level{$env{'form.categorize'}}").'
      • '; } if ($changes{'togglecatscomm'}) { $resulttext .= '
    • '.&mt("$title{'togglecatscomm'} $level{$env{'form.togglecatscomm'}}").'
      • '; } if ($changes{'categorizecomm'}) { $resulttext .= '
    • '.&mt("$title{'categorizecomm'} $level{$env{'form.categorizecomm'}}").'
      • '; } if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) { my $cathash; if (ref($domconfig{'coursecategories'}) eq 'HASH') { $cathash = $domconfig{'coursecategories'}{'cats'}; } else { $cathash = {}; } my (@cats,@trails,%allitems); &Apache::loncommon::extract_categories($cathash,\@cats,\@trails,\%allitems); if (keys(%deletions) > 0) { $resulttext .= '
    • '.&mt('Deleted categories:').'
        '; foreach my $predeltrail (sort {$a <=> $b } (keys(%sort_by_deltrail))) { $resulttext .= '
      • '.$predeltrails[$predeltrail].'
        • '; } $resulttext .= '
      • '; } if (keys(%reorderings) > 0) { my %sort_by_trail; $resulttext .= '
    • '.&mt('Reordered categories:').'
        '; foreach my $key (keys(%reorderings)) { if ($allitems{$key} ne '') { $sort_by_trail{$allitems{$key}} = $trails[$allitems{$key}]; } } foreach my $trail (sort {$a <=> $b } (keys(%sort_by_trail))) { $resulttext .= '
      • '.$trails[$trail].'
        • '; } $resulttext .= '
      • '; } if (keys(%adds) > 0) { my %sort_by_trail; $resulttext .= '
    • '.&mt('Added categories:').'
        '; foreach my $key (keys(%adds)) { if ($allitems{$key} ne '') { $sort_by_trail{$allitems{$key}} = $trails[$allitems{$key}]; } } foreach my $trail (sort {$a <=> $b } (keys(%sort_by_trail))) { $resulttext .= '
      • '.$trails[$trail].'
        • '; } $resulttext .= '
      • '; } } $resulttext .= '
    '; } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } } else { $resulttext = &mt('No changes made to course and community categories'); } return $resulttext; } sub modify_serverstatuses { my ($dom,%domconfig) = @_; my ($resulttext,%changes,%currserverstatus,%newserverstatus); if (ref($domconfig{'serverstatuses'}) eq 'HASH') { %currserverstatus = %{$domconfig{'serverstatuses'}}; } my @pages = &serverstatus_pages(); foreach my $type (@pages) { $newserverstatus{$type}{'namedusers'} = ''; $newserverstatus{$type}{'machines'} = ''; if (defined($env{'form.'.$type.'_namedusers'})) { my @users = split(/,/,$env{'form.'.$type.'_namedusers'}); my @okusers; foreach my $user (@users) { my ($uname,$udom) = split(/:/,$user); if (($udom =~ /^$match_domain$/) && (&Apache::lonnet::domain($udom)) && ($uname =~ /^$match_username$/)) { if (!grep(/^\Q$user\E/,@okusers)) { push(@okusers,$user); } } } if (@okusers > 0) { @okusers = sort(@okusers); $newserverstatus{$type}{'namedusers'} = join(',',@okusers); } } if (defined($env{'form.'.$type.'_machines'})) { my @machines = split(/,/,$env{'form.'.$type.'_machines'}); my @okmachines; foreach my $ip (@machines) { my @parts = split(/\./,$ip); next if (@parts < 4); my $badip = 0; for (my $i=0; $i<4; $i++) { if (!(($parts[$i] >= 0) && ($parts[$i] <= 255))) { $badip = 1; last; } } if (!$badip) { push(@okmachines,$ip); } } @okmachines = sort(@okmachines); $newserverstatus{$type}{'machines'} = join(',',@okmachines); } } my %serverstatushash = ( serverstatuses => \%newserverstatus, ); foreach my $type (@pages) { foreach my $setting ('namedusers','machines') { my (@current,@new); if (ref($currserverstatus{$type}) eq 'HASH') { if ($currserverstatus{$type}{$setting} ne '') { @current = split(/,/,$currserverstatus{$type}{$setting}); } } if ($newserverstatus{$type}{$setting} ne '') { @new = split(/,/,$newserverstatus{$type}{$setting}); } if (@current > 0) { if (@new > 0) { foreach my $item (@current) { if (!grep(/^\Q$item\E$/,@new)) { $changes{$type}{$setting} = 1; last; } } foreach my $item (@new) { if (!grep(/^\Q$item\E$/,@current)) { $changes{$type}{$setting} = 1; last; } } } else { $changes{$type}{$setting} = 1; } } elsif (@new > 0) { $changes{$type}{$setting} = 1; } } } if (keys(%changes) > 0) { my $titles= &LONCAPA::lonauthcgi::serverstatus_titles(); my $putresult = &Apache::lonnet::put_dom('configuration', \%serverstatushash,$dom); if ($putresult eq 'ok') { $resulttext .= &mt('Changes made:').'
      '; foreach my $type (@pages) { if (ref($changes{$type}) eq 'HASH') { $resulttext .= '
    • '.$titles->{$type}.'
        '; if ($changes{$type}{'namedusers'}) { if ($newserverstatus{$type}{'namedusers'} eq '') { $resulttext .= '
      • '.&mt("Access terminated for all specific (named) users").'
        • '."\n"; } else { $resulttext .= '
      • '.&mt("Access available for the following specified users: ").$newserverstatus{$type}{'namedusers'}.'
        • '."\n"; } } if ($changes{$type}{'machines'}) { if ($newserverstatus{$type}{'machines'} eq '') { $resulttext .= '
      • '.&mt("Access terminated for all specific IP addresses").'
        • '."\n"; } else { $resulttext .= '
      • '.&mt("Access available for the following specified IP addresses: ").$newserverstatus{$type}{'machines'}.'
        • '."\n"; } } $resulttext .= '
      • '; } } $resulttext .= '
    '; } else { $resulttext = ''. &mt('An error occurred saving access settings for server status pages: [_1].',$putresult).''; } } else { $resulttext = &mt('No changes made to access to server status pages'); } return $resulttext; } sub modify_helpsettings { my ($r,$dom,$confname,%domconfig) = @_; my ($resulttext,$errors,%changes,%helphash); my $customhelpfile = $env{'form.loginhelpurl.filename'}; my $defaulthelpfile = 'defaulthelp.html'; my $servadm = $r->dir_config('lonAdmEMail'); my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm); my %defaultchecked = ('submitbugs' => 'on'); my @offon = ('off','on'); my %title = ( submitbugs => 'Display link for users to submit a bug', loginhelpurl => 'Unauthenticated login help page set to custom file'); my @toggles = ('submitbugs'); $helphash{'helpsettings'} = {}; if (ref($domconfig{'helpsettings'}) ne 'HASH') { if ($domconfig{'helpsettings'} eq '') { $domconfig{'helpsettings'} = {}; } } if (ref($domconfig{'helpsettings'}) eq 'HASH') { foreach my $item (@toggles) { if ($defaultchecked{$item} eq 'on') { if (($domconfig{'helpsettings'}{$item} eq '') && ($env{'form.'.$item} eq '0')) { $changes{$item} = 1; } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) { $changes{$item} = 1; } } elsif ($defaultchecked{$item} eq 'off') { if (($domconfig{'helpsettings'}{$item} eq '') && ($env{'form.'.$item} eq '1')) { $changes{$item} = 1; } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) { $changes{$item} = 1; } } $helphash{'helpsettings'}{$item} = $env{'form.'.$item}; } if ($customhelpfile ne '') { my $error; if ($configuserok eq 'ok') { if ($switchserver) { $error = &mt("Upload of custom help file is not permitted to this server: [_1]",$switchserver); } else { if ($author_ok eq 'ok') { my ($result,$loginhelpurl) = &publishlogo($r,'upload','loginhelpurl',$dom, $confname,'help','','',$customhelpfile); if ($result eq 'ok') { $helphash{'helpsettings'}{'loginhelpurl'} = $loginhelpurl; $changes{'loginhelpurl'} = 1; } else { $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$customhelpfile,$result); } } else { $error = &mt("Upload of [_1] failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3]. Error was: [_4].",$customhelpfile,$confname,$dom,$author_ok); } } } else { $error = &mt("Upload of [_1] failed because a Domain Configuration user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$customhelpfile,$confname,$dom,$configuserok); } if ($error) { &Apache::lonnet::logthis($error); $errors .= '
  • '.$error.'
    • '; } } if ($domconfig{'helpsettings'}{'loginhelpurl'} ne '') { if ($env{'form.loginhelpurl_del'}) { $helphash{'helpsettings'}{'loginhelpurl'} = ''; $changes{'loginhelpurl'} = 1; } } } my $putresult; if (keys(%changes) > 0) { $putresult = &Apache::lonnet::put_dom('configuration',\%helphash,$dom); } else { $putresult = 'ok'; } if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; foreach my $item (sort(keys(%changes))) { if ($item eq 'submitbugs') { $resulttext .= '
    • '.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'
      • '; } if ($item eq 'loginhelpurl') { if ($helphash{'helpsettings'}{'loginhelpurl'} eq '') { $resulttext .= '
    • '.&mt('[_1] help file removed; [_2] file will be used for the unathorized help page in this domain.',$customhelpfile,$defaulthelpfile).'
      • '; } else { $resulttext .= '
    • '.&mt("$title{$item} [_1]",$customhelpfile).'
      • '; } } } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to help settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } if ($errors) { $resulttext .= &mt('The following errors occurred: ').'
      '. $errors.'
    '; } return $resulttext; } sub modify_coursedefaults { my ($dom,%domconfig) = @_; my ($resulttext,$errors,%changes,%defaultshash); my %defaultchecked = ('canuse_pdfforms' => 'off'); my @offon = ('off','on'); my @toggles = ('canuse_pdfforms'); $defaultshash{'coursedefaults'} = {}; if (ref($domconfig{'coursedefaults'}) ne 'HASH') { if ($domconfig{'coursedefaults'} eq '') { $domconfig{'coursedefaults'} = {}; } } if (ref($domconfig{'coursedefaults'}) eq 'HASH') { foreach my $item (@toggles) { if ($defaultchecked{$item} eq 'on') { if (($domconfig{'coursedefaults'}{$item} eq '') && ($env{'form.'.$item} eq '0')) { $changes{$item} = 1; } elsif ($domconfig{'coursdefaults'}{$item} ne $env{'form.'.$item}) { $changes{$item} = 1; } } elsif ($defaultchecked{$item} eq 'off') { if (($domconfig{'coursedefaults'}{$item} eq '') && ($env{'form.'.$item} eq '1')) { $changes{$item} = 1; } elsif ($domconfig{'coursedefaults'}{$item} ne $env{'form.'.$item}) { $changes{$item} = 1; } } $defaultshash{'coursedefaults'}{$item} = $env{'form.'.$item}; } my $currdefresponder = $domconfig{'coursedefaults'}{'anonsurvey_threshold'}; my $newdefresponder = $env{'form.anonsurvey_threshold'}; $newdefresponder =~ s/\D//g; if ($newdefresponder eq '' || $newdefresponder < 1) { $newdefresponder = 1; } $defaultshash{'coursedefaults'}{'anonsurvey_threshold'} = $newdefresponder; if ($currdefresponder ne $newdefresponder) { unless ($currdefresponder eq '' && $newdefresponder == 10) { $changes{'anonsurvey_threshold'} = 1; } } } my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { if ($changes{'canuse_pdfforms'}) { my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); $domdefaults{'canuse_pdfforms'}=$defaultshash{'coursedefaults'}{'canuse_pdfforms'}; my $cachetime = 24*60*60; &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); } $resulttext = &mt('Changes made:').'
      '; foreach my $item (sort(keys(%changes))) { if ($item eq 'canuse_pdfforms') { if ($env{'form.'.$item} eq '1') { $resulttext .= '
    • '.&mt("Course/Community users can create/upload PDF forms set to 'on'").'
      • '; } else { $resulttext .= '
    • '.&mt('Course/Community users can create/upload PDF forms set to "off"').'
      • '; } } elsif ($item eq 'anonsurvey_threshold') { $resulttext .= '
    • '.&mt('Responder count required for display of anonymous survey submissions set to [_1].',$defaultshash{'coursedefaults'}{'anonsurvey_threshold'}).'
      • '; } } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to course defaults'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_usersessions { my ($dom,%domconfig) = @_; my @hostingtypes = ('version','excludedomain','includedomain'); my @offloadtypes = ('primary','default'); my %types = ( remote => \@hostingtypes, hosted => \@hostingtypes, spares => \@offloadtypes, ); my @prefixes = ('remote','hosted','spares'); my @lcversions = &Apache::lonnet::all_loncaparevs(); my (%by_ip,%by_location,@intdoms); &build_location_hashes(\@intdoms,\%by_ip,\%by_location); my @locations = sort(keys(%by_location)); my (%defaultshash,%changes); foreach my $prefix (@prefixes) { $defaultshash{'usersessions'}{$prefix} = {}; } my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); my $resulttext; my %iphost = &Apache::lonnet::get_iphost(); foreach my $prefix (@prefixes) { next if ($prefix eq 'spares'); foreach my $type (@{$types{$prefix}}) { my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'}; if ($type eq 'version') { my $value = $env{'form.'.$prefix.'_'.$type}; my $okvalue; if ($value ne '') { if (grep(/^\Q$value\E$/,@lcversions)) { $okvalue = $value; } } if (ref($domconfig{'usersessions'}) eq 'HASH') { if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') { if ($domconfig{'usersessions'}{$prefix}{$type} ne '') { if ($inuse == 0) { $changes{$prefix}{$type} = 1; } else { if ($okvalue ne $domconfig{'usersessions'}{$prefix}{$type}) { $changes{$prefix}{$type} = 1; } if ($okvalue ne '') { $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; } } } else { if (($inuse == 1) && ($okvalue ne '')) { $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; $changes{$prefix}{$type} = 1; } } } else { if (($inuse == 1) && ($okvalue ne '')) { $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; $changes{$prefix}{$type} = 1; } } } else { if (($inuse == 1) && ($okvalue ne '')) { $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; $changes{$prefix}{$type} = 1; } } } else { my @vals = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_'.$type); my @okvals; foreach my $val (@vals) { if ($val =~ /:/) { my @items = split(/:/,$val); foreach my $item (@items) { if (ref($by_location{$item}) eq 'ARRAY') { push(@okvals,$item); } } } else { if (ref($by_location{$val}) eq 'ARRAY') { push(@okvals,$val); } } } @okvals = sort(@okvals); if (ref($domconfig{'usersessions'}) eq 'HASH') { if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') { if (ref($domconfig{'usersessions'}{$prefix}{$type}) eq 'ARRAY') { if ($inuse == 0) { $changes{$prefix}{$type} = 1; } else { $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; my @changed = &Apache::loncommon::compare_arrays($domconfig{'usersessions'}{$prefix}{$type},$defaultshash{'usersessions'}{$prefix}{$type}); if (@changed > 0) { $changes{$prefix}{$type} = 1; } } } else { if ($inuse == 1) { $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; $changes{$prefix}{$type} = 1; } } } else { if ($inuse == 1) { $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; $changes{$prefix}{$type} = 1; } } } else { if ($inuse == 1) { $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; $changes{$prefix}{$type} = 1; } } } } } my @alldoms = &Apache::lonnet::all_domains(); my %servers = &Apache::lonnet::internet_dom_servers($dom); my %spareid = ¤t_offloads_to($dom,$domconfig{'usersessions'},\%servers); my $savespares; foreach my $lonhost (sort(keys(%servers))) { my $serverhomeID = &Apache::lonnet::get_server_homeID($servers{$lonhost}); my $serverhostname = &Apache::lonnet::hostname($lonhost); $defaultshash{'usersessions'}{'spares'}{$lonhost} = {}; my %spareschg; foreach my $type (@{$types{'spares'}}) { my @okspares; my @checked = &Apache::loncommon::get_env_multiple('form.spare_'.$type.'_'.$lonhost); foreach my $server (@checked) { if (&Apache::lonnet::hostname($server) ne '') { unless (&Apache::lonnet::hostname($server) eq $serverhostname) { unless (grep(/^\Q$server\E$/,@okspares)) { push(@okspares,$server); } } } } my $new = $env{'form.newspare_'.$type.'_'.$lonhost}; my $newspare; if (($new ne '') && (&Apache::lonnet::hostname($new))) { unless (&Apache::lonnet::hostname($new) eq $serverhostname) { $newspare = $new; } } my @spares; if (($newspare ne '') && (!grep(/^\Q$newspare\E$/,@okspares))) { @spares = sort(@okspares,$newspare); } else { @spares = sort(@okspares); } $defaultshash{'usersessions'}{'spares'}{$lonhost}{$type} = \@spares; if (ref($spareid{$lonhost}) eq 'HASH') { if (ref($spareid{$lonhost}{$type}) eq 'ARRAY') { my @diffs = &Apache::loncommon::compare_arrays($spareid{$lonhost}{$type},\@spares); if (@diffs > 0) { $spareschg{$type} = 1; } } } } if (keys(%spareschg) > 0) { $changes{'spares'}{$lonhost} = \%spareschg; } } if (ref($domconfig{'usersessions'}) eq 'HASH') { if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') { if (ref($changes{'spares'}) eq 'HASH') { if (keys(%{$changes{'spares'}}) > 0) { $savespares = 1; } } } else { $savespares = 1; } } my $nochgmsg = &mt('No changes made to settings for user session hosting/offloading.'); if ((keys(%changes) > 0) || ($savespares)) { my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash, $dom); if ($putresult eq 'ok') { if (ref($defaultshash{'usersessions'}) eq 'HASH') { if (ref($defaultshash{'usersessions'}{'remote'}) eq 'HASH') { $domdefaults{'remotesessions'} = $defaultshash{'usersessions'}{'remote'}; } if (ref($defaultshash{'usersessions'}{'hosted'}) eq 'HASH') { $domdefaults{'hostedsessions'} = $defaultshash{'usersessions'}{'hosted'}; } } my $cachetime = 24*60*60; &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); if (keys(%changes) > 0) { my %lt = &usersession_titles(); $resulttext = &mt('Changes made:').'
      '; foreach my $prefix (@prefixes) { if (ref($changes{$prefix}) eq 'HASH') { $resulttext .= '
    • '.$lt{$prefix}.'
        '; if ($prefix eq 'spares') { if (ref($changes{$prefix}) eq 'HASH') { foreach my $lonhost (sort(keys(%{$changes{$prefix}}))) { $resulttext .= '
      • '.$lonhost.' '; my $lonhostdom = &Apache::lonnet::host_domain($lonhost); &Apache::lonnet::remote_devalidate_cache($lonhost,'spares',$lonhostdom); if (ref($changes{$prefix}{$lonhost}) eq 'HASH') { foreach my $type (@{$types{$prefix}}) { if ($changes{$prefix}{$lonhost}{$type}) { my $offloadto = &mt('None'); if (ref($defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}) eq 'ARRAY') { if (@{$defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}} > 0) { $offloadto = join(', ',@{$defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}}); } } $resulttext .= &mt('[_1] set to: [_2].',''.$lt{$type}.'',$offloadto).(' 'x3); } } } $resulttext .= '
        • '; } } } else { foreach my $type (@{$types{$prefix}}) { if (defined($changes{$prefix}{$type})) { my $newvalue; if (ref($defaultshash{'usersessions'}) eq 'HASH') { if (ref($defaultshash{'usersessions'}{$prefix})) { if ($type eq 'version') { $newvalue = $defaultshash{'usersessions'}{$prefix}{$type}; } elsif (ref($defaultshash{'usersessions'}{$prefix}{$type}) eq 'ARRAY') { if (@{$defaultshash{'usersessions'}{$prefix}{$type}} > 0) { $newvalue = join(', ',@{$defaultshash{'usersessions'}{$prefix}{$type}}); } } } } if ($newvalue eq '') { if ($type eq 'version') { $resulttext .= '
      • '.&mt('[_1] set to: off',$lt{$type}).'
        • '; } else { $resulttext .= '
      • '.&mt('[_1] set to: none',$lt{$type}).'
        • '; } } else { if ($type eq 'version') { $newvalue .= ' '.&mt('(or later)'); } $resulttext .= '
      • '.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'
        • '; } } } } $resulttext .= '
      '; } } $resulttext .= '
    '; } else { $resulttext = $nochgmsg; } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } } else { $resulttext = $nochgmsg; } return $resulttext; } sub modify_loadbalancing { my ($dom,%domconfig) = @_; my $primary_id = &Apache::lonnet::domain($dom,'primary'); my $intdom = &Apache::lonnet::internet_dom($primary_id); my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); my %servers = &Apache::lonnet::internet_dom_servers($dom); my @sparestypes = ('primary','default'); my %typetitles = &sparestype_titles(); my $resulttext; if (keys(%servers) > 1) { my ($currbalancer,$currtargets,$currrules); if (ref($domconfig{'loadbalancing'}) eq 'HASH') { $currbalancer = $domconfig{'loadbalancing'}{'lonhost'}; $currtargets = $domconfig{'loadbalancing'}{'targets'}; $currrules = $domconfig{'loadbalancing'}{'rules'}; } else { ($currbalancer,$currtargets) = &Apache::lonnet::get_lonbalancer_config(\%servers); } my ($saveloadbalancing,%defaultshash,%changes); my ($alltypes,$othertypes,$titles) = &loadbalancing_titles($dom,$intdom,$usertypes,$types); my %ruletitles = &offloadtype_text(); my $balancer = $env{'form.loadbalancing_lonhost'}; if (!$servers{$balancer}) { undef($balancer); } if ($currbalancer ne $balancer) { $changes{'lonhost'} = 1; } $defaultshash{'loadbalancing'}{'lonhost'} = $balancer; if ($balancer ne '') { unless (ref($domconfig{'loadbalancing'}) eq 'HASH') { $saveloadbalancing = 1; } foreach my $sparetype (@sparestypes) { my @targets = &Apache::loncommon::get_env_multiple('form.loadbalancing_target_'.$sparetype); my @offloadto; foreach my $target (@targets) { if (($servers{$target}) && ($target ne $balancer)) { if ($sparetype eq 'default') { if (ref($defaultshash{'loadbalancing'}{'targets'}{'primary'}) eq 'ARRAY') { next if (grep(/^\Q$target\E$/,@{$defaultshash{'loadbalancing'}{'targets'}{'primary'}})); } } unless(grep(/^\Q$target\E$/,@offloadto)) { push(@offloadto,$target); } } $defaultshash{'loadbalancing'}{'targets'}{$sparetype} = \@offloadto; } } } else { foreach my $sparetype (@sparestypes) { $defaultshash{'loadbalancing'}{'targets'}{$sparetype} = []; } } if (ref($currtargets) eq 'HASH') { foreach my $sparetype (@sparestypes) { if (ref($currtargets->{$sparetype}) eq 'ARRAY') { my @targetdiffs = &Apache::loncommon::compare_arrays($currtargets->{$sparetype},$defaultshash{'loadbalancing'}{'targets'}{$sparetype}); if (@targetdiffs > 0) { $changes{'targets'} = 1; } } elsif (ref($defaultshash{'loadbalancing'}{'targets'}{$sparetype}) eq 'ARRAY') { if (@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}} > 0) { $changes{'targets'} = 1; } } } } else { foreach my $sparetype (@sparestypes) { if (ref($defaultshash{'loadbalancing'}{'targets'}{$sparetype}) eq 'ARRAY') { if (@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}} > 0) { $changes{'targets'} = 1; } } } } my $ishomedom; if ($balancer ne '') { if (&Apache::lonnet::host_domain($balancer) eq $dom) { $ishomedom = 1; } } if (ref($alltypes) eq 'ARRAY') { foreach my $type (@{$alltypes}) { my $rule; if ($balancer ne '') { unless ((($type eq '_LC_external') || ($type eq '_LC_internetdom')) && (!$ishomedom)) { $rule = $env{'form.loadbalancing_rules_'.$type}; } if ($rule eq 'specific') { $rule = $env{'form.loadbalancing_singleserver_'.$type}; } } $defaultshash{'loadbalancing'}{'rules'}{$type} = $rule; if (ref($currrules) eq 'HASH') { if ($rule ne $currrules->{$type}) { $changes{'rules'}{$type} = 1; } } elsif ($rule ne '') { $changes{'rules'}{$type} = 1; } } } my $nochgmsg = &mt('No changes made to Load Balancer settings.'); if ((keys(%changes) > 0) || ($saveloadbalancing)) { my $putresult = &Apache::lonnet::put_dom('configuration', \%defaultshash,$dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { if ($changes{'lonhost'}) { if ($currbalancer ne '') { &Apache::lonnet::remote_devalidate_cache($currbalancer,'loadbalancing',$dom); } if ($balancer eq '') { $resulttext .= '
  • '.&mt('Load Balancing with dedicated server discontinued').'
    • '; } else { &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom); $resulttext .= '
  • '.&mt('Dedicated Load Balancer server set to [_1]',$balancer); } } else { &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom); } if (($changes{'targets'}) && ($balancer ne '')) { my %offloadstr; foreach my $sparetype (@sparestypes) { if (ref($defaultshash{'loadbalancing'}{'targets'}{$sparetype}) eq 'ARRAY') { if (@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}} > 0) { $offloadstr{$sparetype} = join(', ',@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}}); } } } if (keys(%offloadstr) == 0) { $resulttext .= '
  • '.&mt("Servers to which Load Balance server offloads set to 'None', by default").'
    • '; } else { my $showoffload; foreach my $sparetype (@sparestypes) { $showoffload .= ''.$typetitles{$sparetype}.': '; if (defined($offloadstr{$sparetype})) { $showoffload .= $offloadstr{$sparetype}; } else { $showoffload .= &mt('None'); } $showoffload .= (' 'x3); } $resulttext .= '
  • '.&mt('By default, Load Balancer server set to offload to: [_1]',$showoffload).'
    • '; } } if ((ref($changes{'rules'}) eq 'HASH') && ($balancer ne '')) { if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH')) { foreach my $type (@{$alltypes}) { if ($changes{'rules'}{$type}) { my $rule = $defaultshash{'loadbalancing'}{'rules'}{$type}; my $balancetext; if ($rule eq '') { $balancetext = $ruletitles{'default'}; } elsif (($rule eq 'homeserver') || ($rule eq 'externalbalancer')) { $balancetext = $ruletitles{$rule}; } else { $balancetext = &mt('offload to [_1]',$defaultshash{'loadbalancing'}{'rules'}{$type}); } $resulttext .= '
  • '.&mt('Load Balancing for [_1] set to: [_2]',$titles->{$type},$balancetext).'
    • '; } } } } if ($resulttext ne '') { $resulttext = &mt('Changes made:').'
      '.$resulttext.'
    '; } else { $resulttext = $nochgmsg; } } else { $resulttext = $nochgmsg; if ($balancer ne '') { &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom); } } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } } else { $resulttext = $nochgmsg; } } else { $resulttext = &mt('Load Balancing unavailable as this domain only has one server.'); } return $resulttext; } sub recurse_check { my ($chkcats,$categories,$depth,$name) = @_; if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') { my $chg = 0; for (my $j=0; $j<@{$chkcats->[$depth]{$name}}; $j++) { my $category = $chkcats->[$depth]{$name}[$j]; my $item; if ($category eq '') { $chg ++; } else { my $deeper = $depth + 1; $item = &escape($category).':'.&escape($name).':'.$depth; if ($chg) { $categories->{$item} -= $chg; } &recurse_check($chkcats,$categories,$deeper,$category); $deeper --; } } } return; } sub recurse_cat_deletes { my ($item,$coursecategories,$deletions) = @_; my ($deleted,$container,$depth) = map { &unescape($_); } split(/:/,$item); my $subdepth = $depth + 1; if (ref($coursecategories) eq 'HASH') { foreach my $subitem (keys(%{$coursecategories})) { my ($child,$parent,$itemdepth) = map { &unescape($_); } split(/:/,$subitem); if (($parent eq $deleted) && ($itemdepth == $subdepth)) { delete($coursecategories->{$subitem}); $deletions->{$subitem} = 1; &recurse_cat_deletes($subitem,$coursecategories,$deletions); } } } return; } sub get_active_dcs { my ($dom) = @_; my %dompersonnel = &Apache::lonnet::get_domain_roles($dom,['dc']); my %domcoords; my $numdcs = 0; my $now = time; foreach my $server (keys(%dompersonnel)) { foreach my $user (sort(keys(%{$dompersonnel{$server}}))) { my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user); my ($end,$start) = split(':',$dompersonnel{$server}{$user}); if (($end eq '') || ($end == 0) || ($end > $now)) { if ($start <= $now) { $domcoords{$uname.':'.$udom} = $dompersonnel{$server}{$user}; } } } } return %domcoords; } sub active_dc_picker { my ($dom,$curr_dc) = @_; my %domcoords = &get_active_dcs($dom); my @dcs = sort(keys(%domcoords)); my $numdcs = scalar(@dcs); my $datatable; my $numinrow = 2; if ($numdcs > 1) { $datatable = ''; for (my $i=0; $i<@dcs; $i++) { my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $datatable .= ''; } $datatable .= ''; } my $check = ' '; if ($curr_dc eq '') { if (!$i) { $check = ' checked="checked" '; } } elsif ($dcs[$i] eq $curr_dc) { $check = ' checked="checked" '; } if ($i == @dcs - 1) { my $colsleft = $numinrow - $rem; if ($colsleft > 1) { $datatable .= ''; } $datatable .= '
    '; } else { $datatable .= ''; } } else { $datatable .= ''; } my ($dcname,$dcdom) = split(':',$dcs[$i]); $datatable .= '
    '; } elsif (@dcs) { $datatable .= ''; } return ($numdcs,$datatable); } sub usersession_titles { return &Apache::lonlocal::texthash( hosted => 'Hosting of sessions for users from other domains on servers in this domain', remote => 'Hosting of sessions for users in this domain on servers in other domains', spares => 'Servers offloaded to, when busy', version => 'LON-CAPA version requirement', excludedomain => 'Allow all, but exclude specific domains', includedomain => 'Deny all, but include specific domains', primary => 'Primary (checked first)', default => 'Default', ); } sub id_for_thisdom { my (%servers) = @_; my %altids; foreach my $server (keys(%servers)) { my $serverhome = &Apache::lonnet::get_server_homeID($servers{$server}); if ($serverhome ne $server) { $altids{$serverhome} = $server; } } return %altids; } sub count_servers { my ($currbalancer,%servers) = @_; my (@spares,$numspares); foreach my $lonhost (sort(keys(%servers))) { next if ($currbalancer eq $lonhost); push(@spares,$lonhost); } if ($currbalancer) { $numspares = scalar(@spares); } else { $numspares = scalar(@spares) - 1; } return ($numspares,@spares); } sub lonbalance_targets_js { my ($dom,$types,$servers) = @_; my $select = &mt('Select'); my ($alltargets,$allishome,$allinsttypes,@alltypes); if (ref($servers) eq 'HASH') { $alltargets = join("','",sort(keys(%{$servers}))); my @homedoms; foreach my $server (sort(keys(%{$servers}))) { if (&Apache::lonnet::host_domain($server) eq $dom) { push(@homedoms,'1'); } else { push(@homedoms,'0'); } } $allishome = join("','",@homedoms); } if (ref($types) eq 'ARRAY') { if (@{$types} > 0) { @alltypes = @{$types}; } } push(@alltypes,'default','_LC_adv','_LC_author','_LC_internetdom','_LC_external'); $allinsttypes = join("','",@alltypes); return <<"END"; END } sub new_spares_js { my @sparestypes = ('primary','default'); my $types = join("','",@sparestypes); my $select = &mt('Select'); return <<"END"; END } sub common_domprefs_js { return <<"END"; END } 1;