--- loncom/interface/domainprefs.pm 2007/03/01 18:24:09 1.4 +++ loncom/interface/domainprefs.pm 2015/05/11 18:11:42 1.263 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.4 2007/03/01 18:24:09 raeburn Exp $ +# $Id: domainprefs.pm,v 1.263 2015/05/11 18:11:42 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -28,6 +28,132 @@ ############################################################### ############################################################## +=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 affiliated 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 (quotas, +requestcourses or requestauthor). + +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, and to display/store +default quota sizes for Authoring Spaces. + +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, community, and textbook). 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; @@ -36,7 +162,20 @@ use Apache::lonnet; use Apache::loncommon(); use Apache::lonhtmlcommon(); use Apache::lonlocal; -use LONCAPA(); +use Apache::lonmsg(); +use Apache::lonconfigsettings; +use Apache::lonuserutils(); +use Apache::loncoursequeueadmin(); +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; @@ -46,8 +185,9 @@ sub handler { return OK; } + my $context = 'domain'; my $dom = $env{'request.role.domain'}; - my $domdesc = $Apache::lonnet::domaindescription{$dom}; + my $domdesc = &Apache::lonnet::domain($dom,'description'); if (&Apache::lonnet::allowed('mau',$dom)) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; @@ -56,121 +196,637 @@ sub handler { "/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']); - my $phase = "display"; + ['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','quotas', - 'autoenroll','autoupdate'],$dom); - - my @prefs = ( - { text => 'Log-in page options', - help => 'Domain_Log-in_Page', - action => 'login', - header => [{col1 => 'Item', - col2 => 'Selection',}], - }, - { text => 'Default quotas for user portfolios', - help => 'Default_User_Quota', - action => 'quotas', - header => [{col1 => 'User type', - col2 => 'Default quota'}], - }, - { text => 'Auto-enrollment settings', - help => 'Domain_Auto_Enrollment', - action => 'autoenroll', - header => [{col1 => 'Configuration setting', - col2 => 'Value(s)'}], - }, - { text => 'Auto-update settings', - help => 'Domain_Auto_Update', - action => 'autoupdate', - header => [{col1 => 'Setting', - col2 => 'Value',}, - {col1 => 'User Population', - col2 => 'Updataeable user data'}], - }, + &Apache::lonnet::get_dom('configuration',['login','rolecolors', + 'quotas','autoenroll','autoupdate','autocreate', + 'directorysrch','usercreation','usermodification', + 'contacts','defaults','scantron','coursecategories', + 'serverstatuses','requestcourses','helpsettings', + 'coursedefaults','usersessions','loadbalancing', + 'requestauthor','selfenrollment','inststatus'],$dom); + my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll', + 'autoupdate','autocreate','directorysrch','contacts', + 'usercreation','selfcreation','usermodification','scantron', + 'requestcourses','requestauthor','coursecategories', + 'serverstatuses','helpsettings', + 'coursedefaults','selfenrollment','usersessions'); + my %existing; + if (ref($domconfig{'loadbalancing'}) eq 'HASH') { + %existing = %{$domconfig{'loadbalancing'}}; + } + if ((keys(%servers) > 1) || (keys(%existing) > 0)) { + 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 => '',}], + print => \&print_rolecolors, + modify => \&modify_rolecolors, + }, + 'login' => + { text => 'Log-in page options', + help => 'Domain_Configuration_Login_Page', + header => [{col1 => 'Log-in Page Items', + col2 => '',}, + {col1 => 'Log-in Help', + col2 => 'Value'}, + {col1 => 'Custom HTML in document head', + col2 => 'Value'}], + print => \&print_login, + modify => \&modify_login, + }, + 'defaults' => + { text => 'Default authentication/language/timezone/portal/types', + help => 'Domain_Configuration_LangTZAuth', + header => [{col1 => 'Setting', + col2 => 'Value'}, + {col1 => 'Institutional user types', + col2 => 'Assignable to e-mail usernames'}], + print => \&print_defaults, + modify => \&modify_defaults, + }, + 'quotas' => + { text => 'Blogs, personal web pages, webDAV/quotas, portfolios', + help => 'Domain_Configuration_Quotas', + header => [{col1 => 'User affiliation', + col2 => 'Available tools', + col3 => 'Quotas, MB; (Authoring requires role)',}], + print => \&print_quotas, + modify => \&modify_quotas, + }, + 'autoenroll' => + { text => 'Auto-enrollment settings', + help => 'Domain_Configuration_Auto_Enrollment', + header => [{col1 => 'Configuration setting', + col2 => 'Value(s)'}], + print => \&print_autoenroll, + modify => \&modify_autoenroll, + }, + 'autoupdate' => + { text => 'Auto-update settings', + help => 'Domain_Configuration_Auto_Updates', + header => [{col1 => 'Setting', + col2 => 'Value',}, + {col1 => 'Setting', + col2 => 'Affiliation'}, + {col1 => 'User population', + col2 => 'Updatable user data'}], + print => \&print_autoupdate, + modify => \&modify_autoupdate, + }, + 'autocreate' => + { text => 'Auto-course creation settings', + help => 'Domain_Configuration_Auto_Creation', + header => [{col1 => 'Configuration Setting', + col2 => 'Value',}], + print => \&print_autocreate, + modify => \&modify_autocreate, + }, + 'directorysrch' => + { text => 'Institutional directory searches', + help => 'Domain_Configuration_InstDirectory_Search', + header => [{col1 => 'Setting', + col2 => 'Value',}], + print => \&print_directorysrch, + modify => \&modify_directorysrch, + }, + 'contacts' => + { text => 'Contact Information', + help => 'Domain_Configuration_Contact_Info', + header => [{col1 => 'Setting', + col2 => 'Value',}], + print => \&print_contacts, + modify => \&modify_contacts, + }, + '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'}], + print => \&print_usercreation, + modify => \&modify_usercreation, + }, + 'selfcreation' => + { text => 'Users self-creating accounts', + help => 'Domain_Configuration_Self_Creation', + header => [{col1 => 'Self-creation with institutional username', + col2 => 'Enabled?'}, + {col1 => 'Institutional user type (login/SSO self-creation)', + col2 => 'Information user can enter'}, + {col1 => 'Self-creation with e-mail as username', + col2 => 'Settings'}], + print => \&print_selfcreation, + modify => \&modify_selfcreation, + }, + 'usermodification' => + { text => 'User modification', + help => 'Domain_Configuration_User_Modification', + header => [{col1 => 'Target user has role', + col2 => 'User information updatable in author context'}, + {col1 => 'Target user has role', + col2 => 'User information updatable in course context'}], + print => \&print_usermodification, + modify => \&modify_usermodification, + }, + 'scantron' => + { text => 'Bubblesheet format file', + help => 'Domain_Configuration_Scantron_Format', + header => [ {col1 => 'Item', + col2 => '', + }], + print => \&print_scantron, + modify => \&modify_scantron, + }, + 'requestcourses' => + {text => 'Request creation of courses', + help => 'Domain_Configuration_Request_Courses', + header => [{col1 => 'User affiliation', + col2 => 'Availability/Processing of requests',}, + {col1 => 'Setting', + col2 => 'Value'}, + {col1 => 'Available textbooks', + col2 => ''}, + {col1 => 'Available templates', + col2 => ''}, + {col1 => 'Validation (not official courses)', + col2 => 'Value'},], + print => \&print_quotas, + modify => \&modify_quotas, + }, + 'requestauthor' => + {text => 'Request Authoring Space', + help => 'Domain_Configuration_Request_Author', + header => [{col1 => 'User affiliation', + col2 => 'Availability/Processing of requests',}, + {col1 => 'Setting', + col2 => 'Value'}], + print => \&print_quotas, + modify => \&modify_quotas, + }, + 'coursecategories' => + { text => 'Cataloging of courses/communities', + help => 'Domain_Configuration_Cataloging_Courses', + header => [{col1 => 'Catalog type/availability', + col2 => '',}, + {col1 => 'Category settings for standard catalog', + col2 => '',}, + {col1 => 'Categories', + col2 => '', + }], + print => \&print_coursecategories, + modify => \&modify_coursecategories, + }, + 'serverstatuses' => + {text => 'Access to server status pages', + help => 'Domain_Configuration_Server_Status', + header => [{col1 => 'Status Page', + col2 => 'Other named users', + col3 => 'Specific IPs', + }], + print => \&print_serverstatuses, + modify => \&modify_serverstatuses, + }, + 'helpsettings' => + {text => 'Help page settings', + help => 'Domain_Configuration_Help_Settings', + header => [{col1 => 'Help Settings (logged-in users)', + col2 => 'Value'}], + print => \&print_helpsettings, + modify => \&modify_helpsettings, + }, + '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',},], + print => \&print_coursedefaults, + modify => \&modify_coursedefaults, + }, + 'selfenrollment' => + {text => 'Self-enrollment in Course/Community', + help => 'Domain_Configuration_Selfenrollment', + header => [{col1 => 'Configuration Rights', + col2 => 'Configured by Course Personnel or Domain Coordinator?'}, + {col1 => 'Defaults', + col2 => 'Value'}, + {col1 => 'Self-enrollment validation (optional)', + col2 => 'Value'},], + print => \&print_selfenrollment, + modify => \&modify_selfenrollment, + }, + 'privacy' => + {text => 'User Privacy', + help => 'Domain_Configuration_User_Privacy', + header => [{col1 => 'Setting', + col2 => 'Value',}], + print => \&print_privacy, + modify => \&modify_privacy, + }, + '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'}], + print => \&print_usersessions, + modify => \&modify_usersessions, + }, + 'loadbalancing' => + {text => 'Dedicated Load Balancer(s)', + help => 'Domain_Configuration_Load_Balancing', + header => [{col1 => 'Balancers', + col2 => 'Default destinations', + col3 => 'User affiliation', + col4 => 'Overrides'}, + ], + print => \&print_loadbalancing, + modify => \&modify_loadbalancing, + }, ); + 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 => ''}, + {col1 => 'Log-in Help', + col2 => 'Value'}, + {col1 => 'Custom HTML in document head', + col2 => 'Value'}], + print => \&print_login, + modify => \&modify_login, + }; + } + + my @roles = ('student','coordinator','author','admin'); + my @actions = &Apache::loncommon::get_env_multiple('form.actions'); &Apache::lonhtmlcommon::add_breadcrumb - ({href=>"javascript:changePage(document.$phase,'display')", - text=>"Domain Configuration"}); + ({href=>"javascript:changePage(document.$phase,'pickactions')", + text=>"Settings to display/modify"}); + my $confname = $dom.'-domainconfig'; + if ($phase eq 'process') { - &Apache::lonhtmlcommon::add_breadcrumb - ({href=>"javascript:changePage(document.$phase,'$phase')", - text=>"Updated"}); - &print_header($r,$phase); - foreach my $item (@prefs) { - $r->print('

'.&mt($item->{'text'}).'

'. - &process_changes($dom,$item->{'action'},%domconfig)); - } - $r->print('

'); - &print_footer($r,$phase,'display','Back to actions menu'); - $r->print('

'); - } else { - if ($phase eq '') { - $phase = 'display'; - } - my %helphash; - my $numprefs = @prefs; - &print_header($r,$phase); - $r->print('
'); - foreach my $item (@prefs) { - if ($item->{'action'} eq 'autoupdate') { - $r->print(' '); + my $result = &Apache::lonconfigsettings::make_changes($r,$dom,$phase,$context,\@prefs_order, + \%prefs,\%domconfig,$confname,\@roles); + if ((ref($result) eq 'HASH') && (keys(%{$result}))) { + $r->rflush(); + &devalidate_remote_domconfs($dom,$result); + } + } elsif ($phase eq 'display') { + my $js = &recaptcha_js(). + &toggle_display_js(); + if ((keys(%servers) > 1) || (keys(%existing) > 0)) { + my ($othertitle,$usertypes,$types) = + &Apache::loncommon::sorted_inst_types($dom); + $js .= &lonbalance_targets_js($dom,$types,\%servers, + $domconfig{'loadbalancing'}). + &new_spares_js(). + &common_domprefs_js(). + &Apache::loncommon::javascript_array_indexof(); + } + if (grep(/^requestcourses$/,@actions)) { + my $javascript_validations; + my $coursebrowserjs=&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'}); + $js .= < +$javascript_validations + +$coursebrowserjs +END + } + &Apache::lonconfigsettings::display_settings($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,$js); + } else { +# check if domconfig user exists for the domain. + my $servadm = $r->dir_config('lonAdmEMail'); + my ($configuserok,$author_ok,$switchserver) = + &config_check($dom,$confname,$servadm); + unless ($configuserok eq 'ok') { + &Apache::lonconfigsettings::print_header($r,$phase,$context); + $r->print(&mt('The domain configuration user "[_1]" has yet to be created.', + $confname). + '
' + ); + if ($switchserver) { + $r->print(&mt('Ordinarily, that domain configuration user is created when the ./UPDATE script is run to install LON-CAPA for the first time.'). + '
'. + &mt('However, that does not apply when new domains are added to a multi-domain server, and ./UPDATE has not been run recently.'). + '
'. + &mt('The "[_1]" user can be created automatically when a Domain Coordinator visits the web-based "Set domain configuration" screen, in a session hosted on the primary library server.',$confname). + '
'. + &mt('To do that now, use the following link: [_1]',$switchserver) + ); + } else { + $r->print(&mt('To create that user from the command line run the ./UPDATE script found in the top level directory of the extracted LON-CAPA tarball.'). + '
'. + &mt('Once that is done, you will be able to use the web-based "Set domain configuration" to configure the domain') + ); } - &print_config_box($r,$dom,$item->{'action'},$item, - $domconfig{$item->{'action'}}); + $r->print(&Apache::loncommon::end_page()); + return OK; } - $r->print(' -
- - - - - - '); - &print_footer($r,$phase,'process','Store changes'); + 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 ($dom,$action,%domconfig) = @_; + my ($r,$dom,$confname,$action,$roles,$values,$lastactref) = @_; + my %domconfig; + if (ref($values) eq 'HASH') { + %domconfig = %{$values}; + } my $output; if ($action eq 'login') { - $output = &modify_login($dom,%domconfig); + $output = &modify_login($r,$dom,$confname,$lastactref,%domconfig); + } elsif ($action eq 'rolecolors') { + $output = &modify_rolecolors($r,$dom,$confname,$roles, + $lastactref,%domconfig); } elsif ($action eq 'quotas') { - $output = &modify_quotas($dom,%domconfig); + $output = &modify_quotas($r,$dom,$action,$lastactref,%domconfig); } elsif ($action eq 'autoenroll') { - $output = &modify_autoenroll($dom,%domconfig); + $output = &modify_autoenroll($dom,$lastactref,%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 'selfcreation') { + $output = &modify_selfcreation($dom,%domconfig); + } elsif ($action eq 'usermodification') { + $output = &modify_usermodification($dom,%domconfig); + } elsif ($action eq 'contacts') { + $output = &modify_contacts($dom,$lastactref,%domconfig); + } elsif ($action eq 'defaults') { + $output = &modify_defaults($dom,$lastactref,%domconfig); + } elsif ($action eq 'scantron') { + $output = &modify_scantron($r,$dom,$confname,$lastactref,%domconfig); + } elsif ($action eq 'coursecategories') { + $output = &modify_coursecategories($dom,$lastactref,%domconfig); + } elsif ($action eq 'serverstatuses') { + $output = &modify_serverstatuses($dom,%domconfig); + } elsif ($action eq 'requestcourses') { + $output = &modify_quotas($r,$dom,$action,$lastactref,%domconfig); + } elsif ($action eq 'requestauthor') { + $output = &modify_quotas($r,$dom,$action,$lastactref,%domconfig); + } elsif ($action eq 'helpsettings') { + $output = &modify_helpsettings($r,$dom,$confname,%domconfig); + } elsif ($action eq 'coursedefaults') { + $output = &modify_coursedefaults($dom,$lastactref,%domconfig); + } elsif ($action eq 'selfenrollment') { + $output = &modify_selfenrollment($dom,$lastactref,%domconfig) + } elsif ($action eq 'usersessions') { + $output = &modify_usersessions($dom,$lastactref,%domconfig); + } elsif ($action eq 'loadbalancing') { + $output = &modify_loadbalancing($dom,%domconfig); } return $output; } sub print_config_box { - my ($r,$dom,$action,$item,$settings) = @_; - $r->print(' - + my ($r,$dom,$confname,$phase,$action,$item,$settings) = @_; + my $rowtotal = 0; + my $output; + if ($action eq 'coursecategories') { + $output = &coursecategories_javascript($settings); + } elsif ($action eq 'defaults') { + $output = &defaults_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 'defaults') || + (($action eq 'login') && ($numheaders < 4))) { + $colspan = ' colspan="2"'; + } + if ($action eq 'usersessions') { + $rightcolspan = ' colspan="3"'; + } + $output .= ' - - '); - if ($action eq 'autoupdate') { - $r->print(' + + + + + + + + + + + + + + + + + + + + @@ -178,159 +834,1589 @@ sub print_config_box { + + +
'. + &mt($item->{text}).' '. + &Apache::loncommon::help_open_topic($item->{'help'}).'
'.&mt($item->{text}).' '. - &Apache::loncommon::help_open_topic($item->{'help'}).'
+ + + + + '; + $rowtotal ++; + if (($action eq 'autoupdate') || ($action eq 'usercreation') || ($action eq 'selfcreation') || + ($action eq 'usermodification') || ($action eq 'defaults') || ($action eq 'coursedefaults') || + ($action eq 'selfenrollment') || ($action eq 'usersessions')) { + $output .= $item->{'print'}->('top',$dom,$settings,\$rowtotal); + } elsif ($action eq 'coursecategories') { + $output .= $item->{'print'}->('top',$dom,$item,$settings,\$rowtotal); + } elsif ($action eq 'login') { + if ($numheaders == 4) { + $colspan = ' colspan="2"'; + $output .= &print_login('service',$dom,$confname,$phase,$settings,\$rowtotal); + } else { + $output .= &print_login('page',$dom,$confname,$phase,$settings,\$rowtotal); + } + } elsif (($action eq 'requestcourses') || ($action eq 'requestauthor')) { + $output .= &print_quotas($dom,$settings,\$rowtotal,$action); + } elsif ($action eq 'rolecolors') { + $output .= &print_rolecolors($phase,'student',$dom,$confname,$settings,\$rowtotal); + } + $output .= ' +
'.&mt($item->{'header'}->[0]->{'col1'}).''.&mt($item->{'header'}->[0]->{'col2'}).'
+
+ + + + + '; + $rowtotal ++; + if (($action eq 'autoupdate') || ($action eq 'usercreation') || + ($action eq 'selfcreation') || ($action eq 'selfenrollment') || + ($action eq 'usersessions') || ($action eq 'coursecategories')) { + if ($action eq 'coursecategories') { + $output .= &print_coursecategories('middle',$dom,$item,$settings,\$rowtotal); + $colspan = ' colspan="2"'; + } else { + $output .= $item->{'print'}->('middle',$dom,$settings,\$rowtotal); + } + $output .= ' +
'.&mt($item->{'header'}->[1]->{'col1'}).''.&mt($item->{'header'}->[1]->{'col2'}).'
+
+ + + + + '."\n"; + if ($action eq 'coursecategories') { + $output .= &print_coursecategories('bottom',$dom,$item,$settings,\$rowtotal); + } else { + $output .= $item->{'print'}->('bottom',$dom,$settings,\$rowtotal); + } + $rowtotal ++; + } elsif (($action eq 'usermodification') || ($action eq 'coursedefaults') || + ($action eq 'defaults')) { + $output .= $item->{'print'}->('bottom',$dom,$settings,\$rowtotal); + } elsif ($action eq 'login') { + if ($numheaders == 4) { + $output .= &print_login('page',$dom,$confname,$phase,$settings,\$rowtotal).' +
'.&mt($item->{'header'}->[2]->{'col1'}).''.&mt($item->{'header'}->[2]->{'col2'}).'
+
+ + + + '. + &print_login('help',$dom,$confname,$phase,$settings,\$rowtotal); + $rowtotal ++; + } else { + $output .= &print_login('help',$dom,$confname,$phase,$settings,\$rowtotal); + } + $output .= ' +
'.&mt($item->{'header'}->[2]->{'col1'}).''.&mt($item->{'header'}->[2]->{'col2'}).'
+
+ + '; + if ($numheaders == 4) { + $output .= ' + + + '; + } else { + $output .= ' + + + '; + } + $rowtotal ++; + $output .= &print_login('headtag',$dom,$confname,$phase,$settings,\$rowtotal); + } elsif ($action eq 'requestcourses') { + $output .= &print_requestmail($dom,$action,$settings,\$rowtotal); + $rowtotal ++; + $output .= &print_studentcode($settings,\$rowtotal).' +
'.&mt($item->{'header'}->[3]->{'col1'}).''.&mt($item->{'header'}->[3]->{'col2'}).'
'.&mt($item->{'header'}->[2]->{'col1'}).''.&mt($item->{'header'}->[2]->{'col2'}).'
+
+ + + + '. + &textbookcourses_javascript($settings). + &print_textbookcourses($dom,'textbooks',$settings,\$rowtotal).' +
'.&mt($item->{'header'}->[2]->{'col1'}).''.&mt($item->{'header'}->[2]->{'col2'}).'
+
+ + + + '. + &print_textbookcourses($dom,'templates',$settings,\$rowtotal).' +
'.&mt($item->{'header'}->[3]->{'col1'}).''.&mt($item->{'header'}->[3]->{'col2'}).'
+
- - + + '. - &print_autoupdate('top',$dom,$settings).' + &print_validation_rows('requestcourses',$dom,$settings,\$rowtotal); + } elsif ($action eq 'requestauthor') { + $output .= &print_requestmail($dom,$action,$settings,\$rowtotal); + $rowtotal ++; + } elsif ($action eq 'rolecolors') { + $output .= &print_rolecolors($phase,'coordinator',$dom,$confname,$settings,\$rowtotal).'
'.$item->{'header'}->[0]->{'col1'}.''.$item->{'header'}->[0]->{'col2'}.''.&mt($item->{'header'}->[4]->{'col1'}).''.&mt($item->{'header'}->[4]->{'col2'}).'
- - + + '. - &print_autoupdate('bottom',$dom,$settings)); + &print_rolecolors($phase,'author',$dom,$confname,$settings,\$rowtotal).' +
'.$item->{'header'}->[1]->{'col1'}.''.$item->{'header'}->[1]->{'col2'}.''. + &mt($item->{'header'}->[2]->{'col1'}).''. + &mt($item->{'header'}->[2]->{'col2'}).'
+
+ + + + + '. + &print_rolecolors($phase,'admin',$dom,$confname,$settings,\$rowtotal); + $rowtotal += 2; + } } else { - $r->print(' + $output .= ' -
'.&mt($item->{'header'}->[3]->{'col1'}).''.&mt($item->{'header'}->[3]->{'col2'}).'
- - - - '); - if ($action eq 'login') { - $r->print(&print_login($settings)); - } elsif ($action eq 'quotas') { - $r->print(&print_quotas($dom,$settings)); - } elsif ($action eq 'autoenroll') { - $r->print(&print_autoenroll($dom,$settings)); - } + '; + 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 'quotas') { + $output .= &print_quotas($dom,$settings,\$rowtotal,$action); + } elsif (($action eq 'autoenroll') || ($action eq 'autocreate') || ($action eq 'directorysrch') || + ($action eq 'contacts') || ($action eq 'serverstatuses') || ($action eq 'loadbalancing')) { + $output .= $item->{'print'}->($dom,$settings,\$rowtotal); + } elsif ($action eq 'scantron') { + $output .= &print_scantronformat($r,$dom,$confname,$settings,\$rowtotal); + } elsif ($action eq 'helpsettings') { + $output .= &print_helpsettings($dom,$confname,$settings,\$rowtotal); + } } - $r->print(' + $output .= '
'.$item->{'header'}->[0]->{'col1'}.''.$item->{'header'}->[0]->{'col2'}.'
'.&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; +

'; + return ($output,$rowtotal); } -sub print_header { - my ($r,$phase) = @_; - my $js = qq| - -|; - $r->print(&Apache::loncommon::start_page('View/Modify Domain Settings', - $js)); - $r->print(&Apache::lonhtmlcommon::breadcrumbs('Domain Settings')); - $r->print('
'); - return; + +sub login_choices { + my %choices = + &Apache::lonlocal::texthash ( + coursecatalog => 'Display Course/Community Catalog link?', + adminmail => "Display Administrator's E-mail Address?", + helpdesk => 'Display "Contact Helpdesk" link', + 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", + headtag => "Custom markup", + action => "Action", + current => "Current", + ); + return %choices; } -sub print_footer { - my ($r,$phase,$newphase,$button_text) = @_; - $button_text = &mt($button_text); - $r->print(''); - my $dest='"javascript:changePage(document.'.$phase.','."'$newphase'".')"'; - if ($phase eq 'process') { - $r->print(''.$button_text.''); +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 = &role_defaults($role,\@bgs,\@links,\@images); + 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 { - $r->print(''); + 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; + } + } } - $r->print('
'); - $r->print('
'.&Apache::loncommon::end_page()); - return; + 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 print_login { - my ($settings) = @_; - my $catalogon = ' checked="checked" '; - my $catalogoff; - my $adminmailon = ' '; - my $adminmailoff = ' checked="checked" '; - if (ref($settings) eq 'HASH') { - if ($settings->{'coursecatalog'} eq '0') { - $catalogoff = $catalogon; - $catalogon = ' '; - } - if ($settings->{'adminmail'} eq '1') { - $adminmailon = $adminmailoff; - $adminmailoff = ' '; - } - } - my %choices = - &Apache::lonlocal::texthash( - coursecatalog => 'Display Course Catalog link?', - adminmail => "Display Administrator's E-mail Address?" - ); - my $datatable = - ''.$choices{'coursecatalog'}. - ''. - ''.&mt('Yes').' '. - ''.&mt('No').''. - ''. - ''.$choices{'adminmail'}.''. - ''. - ''.&mt('Yes').' '. - ''.&mt('No').''. - ''; +sub role_defaults { + my ($role,$bgs,$links,$images,$logintext) = @_; + my %defaults; + unless ((ref($bgs) eq 'ARRAY') && (ref($links) eq 'ARRAY') && (ref($images) eq 'ARRAY')) { + return %defaults; + } + my %defaultdesign = %Apache::loncommon::defaultdesign; + if ($role eq 'login') { + %defaults = ( + font => $defaultdesign{$role.'.font'}, + ); + if (ref($logintext) eq 'ARRAY') { + foreach my $item (@{$logintext}) { + $defaults{'logintext'}{$item} = $defaultdesign{$role.'.'.$item}; + } + } + foreach my $item (@{$images}) { + $defaults{'showlogo'}{$item} = 1; + } + } else { + %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}; + } + foreach my $item (@{$images}) { + $defaults{$item} = $defaultdesign{$role.'.'.$item}; + } + return %defaults; +} + +sub display_color_options { + my ($dom,$confname,$phase,$role,$itemcount,$choices,$is_custom,$defaults,$designs, + $images,$bgs,$links,$alt_text,$rowtotal,$logintext) = @_; + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; + 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 $current_color = $designs->{'font'} ? $designs->{'font'} : $defaults->{'font'}; + + $datatable .= ''. + ' '. + ' '; + unless ($role eq 'login') { + $datatable .= ''. + ''.$choices->{'fontmenu'}.''; + if (!$is_custom->{'fontmenu'}) { + $datatable .= ''.&mt('Default in use:').' '.$defaults->{'fontmenu'}.''; + } else { + $datatable .= ' '; + } + $current_color = $designs->{'fontmenu'} ? + $designs->{'fontmenu'} : $defaults->{'fontmenu'}; + $datatable .= ''. + ' '. + ' '; + } + 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,$defaults); + } 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 "$londocroot/$imgdir/tn-".$filename) { + $showfile = "/$imgdir/tn-".$filename; + } else { + my $input = $londocroot.$imgfile; + my $output = "$londocroot/$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}) { + $datatable .= ''; + } + $datatable .= '
'.$choices->{$item}; + my $color = $designs->{'bgs'}{$item} ? $designs->{'bgs'}{$item} : $defaults->{'bgs'}{$item}; + 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}) { + my $color = $designs->{'links'}{$item} ? $designs->{'links'}{$item} : $defaults->{'links'}{$item}; + $datatable .= ''; + } + $$rowtotal += $itemcount; return $datatable; } -sub print_quotas { - my ($dom,$settings) = @_; - my $datatable; - my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); - my $othertitle = "All users"; - my @types; - if (ref($order) eq 'ARRAY') { - @types = @{$order}; +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 (@types == 0) { - if (ref($usertypes) eq 'HASH') { - @types = sort(keys(%{$usertypes})); + 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,$defaults) = @_; + my $color_menu = '
'.$choices->{$item}."\n"; + if ($designs->{'links'}{$item}) { + $datatable.=' '; + } + $datatable .= '
'; + foreach my $item (@{$logintext}) { + $color_menu .= ''; + } + $color_menu .= '
'.$choices->{$item}; + my $color = $designs->{'logintext'}{$item} ? $designs->{'logintext'}{$item} : $defaults->{'logintext'}{$item}; + $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 print_quotas { + my ($dom,$settings,$rowtotal,$action) = @_; + my $context; + if ($action eq 'quotas') { + $context = 'tools'; + } else { + $context = $action; + } + my ($datatable,$defaultquota,$authorquota,@usertools,@options,%validations); + my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); my $typecount = 0; - my $css_class; - if (@types > 0) { - foreach my $type (@types) { + my ($css_class,%titles); + if ($context eq 'requestcourses') { + @usertools = ('official','unofficial','community','textbook'); + @options =('norequest','approval','validate','autolimit'); + %validations = &Apache::lonnet::auto_courserequest_checks($dom); + %titles = &courserequest_titles(); + } elsif ($context eq 'requestauthor') { + @usertools = ('author'); + @options = ('norequest','approval','automatic'); + %titles = &authorrequest_titles(); + } else { + @usertools = ('aboutme','blog','webdav','portfolio'); + %titles = &tool_titles(); + } + if (ref($types) eq 'ARRAY') { + foreach my $type (@{$types}) { + my ($currdefquota,$currauthorquota); + unless (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { + if (ref($settings) eq 'HASH') { + if (ref($settings->{defaultquota}) eq 'HASH') { + $currdefquota = $settings->{defaultquota}->{$type}; + } else { + $currdefquota = $settings->{$type}; + } + if (ref($settings->{authorquota}) eq 'HASH') { + $currauthorquota = $settings->{authorquota}->{$type}; + } + } + } if (defined($usertypes->{$type})) { $typecount ++; $css_class = $typecount%2?' class="LC_odd_row"':''; - $datatable .= ''. + $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'}; + } + } + } elsif ($context eq 'requestauthor') { + my $curroption; + if (ref($settings) eq 'HASH') { + $curroption = $settings->{$type}; + } + if (!$curroption) { + $curroption = 'norequest'; + } + foreach my $option (@options) { + my $val = $option; + if ($option eq 'norequest') { + $val = 0; + } + my $checked = ''; + if ($option eq $curroption) { + $checked = ' checked="checked"'; + } + $datatable .= '  '; + } + } 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') || + ($context eq 'requestauthor')) { + $datatable .= + ''. + ''.&mt('Portfolio').': '. ' Mb'; + '" value="'.$currdefquota. + '" size="5" />'.(' ' x 2). + ''.&mt('Authoring').': '. + ''; + } + $datatable .= ''; } } - $othertitle = "Other users"; } - my $defaultquota = '20'; - if (ref($settings) eq 'HASH') { - if (defined($settings->{'default'})) { - $defaultquota = $settings->{'default'}; + unless (($context eq 'requestcourses') || ($context eq 'requestauthor')) { + $defaultquota = '20'; + $authorquota = '500'; + if (ref($settings) eq 'HASH') { + if (ref($settings->{'defaultquota'}) eq 'HASH') { + $defaultquota = $settings->{'defaultquota'}->{'default'}; + } elsif (defined($settings->{'default'})) { + $defaultquota = $settings->{'default'}; + } + if (ref($settings->{'authorquota'}) eq 'HASH') { + $authorquota = $settings->{'authorquota'}->{'default'}; + } } } $typecount ++; $css_class = $typecount%2?' class="LC_odd_row"':''; $datatable .= ''. - ''.&mt($othertitle).''. - ''. - ' Mb'; + ''.$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'}; + } + } + } elsif ($context eq 'requestauthor') { + my $curroption; + if (ref($settings) eq 'HASH') { + $curroption = $settings->{'default'}; + } + if (!$curroption) { + $curroption = 'norequest'; + } + foreach my $option (@options) { + my $val = $option; + if ($option eq 'norequest') { + $val = 0; + } + my $checked = ''; + if ($option eq $curroption) { + $checked = ' checked="checked"'; + } + $datatable .= '  '; + } + } 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') || ($context eq 'requestauthor')) { + $datatable .= ''. + ''.&mt('Portfolio').': '. + ''.(' ' x2). + ''.&mt('Authoring').': '. + ''; + } + $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'}; + } + } + } elsif ($context eq 'requestauthor') { + my $curroption; + if (ref($settings) eq 'HASH') { + $curroption = $settings->{'_LC_adv'}; + } + my $checked = ''; + if ($curroption eq '') { + $checked = ' checked="checked"'; + } + $datatable .= '  '; + foreach my $option (@options) { + my $val = $option; + if ($option eq 'norequest') { + $val = 0; + } + my $checked = ''; + if ($val eq $curroption) { + $checked = ' checked="checked"'; + } + $datatable .= '  '; + } + } 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_requestmail { + my ($dom,$action,$settings,$rowtotal) = @_; + my ($now,$datatable,%currapp); + $now = time; + if (ref($settings) eq 'HASH') { + if (ref($settings->{'notify'}) eq 'HASH') { + if ($settings->{'notify'}{'approval'} ne '') { + map {$currapp{$_}=1;} split(/,/,$settings->{'notify'}{'approval'}); + } + } + } + my $numinrow = 2; + my $css_class; + $css_class = ($$rowtotal%2? ' class="LC_odd_row"':''); + my $text; + if ($action eq 'requestcourses') { + $text = &mt('Receive notification of course requests requiring approval'); + } elsif ($action eq 'requestauthor') { + $text = &mt('Receive notification of Authoring Space requests requiring approval'); + } else { + $text = &mt('Receive notification of queued requests for self-created user accounts requiring approval'); + } + $datatable = ''. + ' '.$text.''. + ' '; + my ($numdc,$table,$rows) = &active_dc_picker($dom,$numinrow,'checkbox', + $action.'notifyapproval',%currapp); + if ($numdc > 0) { + $datatable .= $table; + } else { + $datatable .= &mt('There are no active Domain Coordinators'); + } + $datatable .=''; return $datatable; } +sub print_studentcode { + my ($settings,$rowtotal) = @_; + my $rownum = 0; + my ($output,%current); + my @crstypes = ('official','unofficial','community','textbook'); + if (ref($settings) eq 'HASH') { + if (ref($settings->{'uniquecode'}) eq 'HASH') { + foreach my $type (@crstypes) { + $current{$type} = $settings->{'uniquecode'}{$type}; + } + } + } + $output .= ''. + ''.&mt('Generate unique six character code as course identifier?').''. + ''; + foreach my $type (@crstypes) { + my $check = ' '; + if ($current{$type}) { + $check = ' checked="checked" '; + } + $output .= ''.(' 'x2).' '; + } + $output .= ''; + $$rowtotal ++; + return $output; +} + +sub print_textbookcourses { + my ($dom,$type,$settings,$rowtotal) = @_; + my $rownum = 0; + my $css_class; + my $itemcount = 1; + my $maxnum = 0; + my $bookshash; + if (ref($settings) eq 'HASH') { + $bookshash = $settings->{$type}; + } + my %ordered; + if (ref($bookshash) eq 'HASH') { + foreach my $item (keys(%{$bookshash})) { + if (ref($bookshash->{$item}) eq 'HASH') { + my $num = $bookshash->{$item}{'order'}; + $ordered{$num} = $item; + } + } + } + my $confname = $dom.'-domainconfig'; + my $switchserver = &check_switchserver($dom,$confname); + my $maxnum = scalar(keys(%ordered)); + my $datatable; + if (keys(%ordered)) { + my @items = sort { $a <=> $b } keys(%ordered); + for (my $i=0; $i<@items; $i++) { + $css_class = $itemcount%2?' class="LC_odd_row"':''; + my $key = $ordered{$items[$i]}; + my %coursehash=&Apache::lonnet::coursedescription($key); + my $coursetitle = $coursehash{'description'}; + my ($subject,$title,$author,$publisher,$image,$imgsrc,$cdom,$cnum); + if (ref($bookshash->{$key}) eq 'HASH') { + $subject = $bookshash->{$key}->{'subject'}; + $title = $bookshash->{$key}->{'title'}; + if ($type eq 'textbooks') { + $publisher = $bookshash->{$key}->{'publisher'}; + $author = $bookshash->{$key}->{'author'}; + $image = $bookshash->{$key}->{'image'}; + if ($image ne '') { + my ($path,$imagefile) = ($image =~ m{^(.+)/([^/]+)$}); + my $imagethumb = "$path/tn-".$imagefile; + $imgsrc = ''.&mt('Textbook image').''; + } + } + } + my $chgstr = ' onchange="javascript:reorderBooks(this.form,'."'$type".'_'."$key','$type'".');"'; + $datatable .= '' + .''.(' 'x2). + ''. + ''. + ''.&mt('Subject:').' '. + (' 'x2). + ''.&mt('Title:').' '; + if ($type eq 'textbooks') { + $datatable .= (' 'x2). + ''.&mt('Publisher:').' '. + (' 'x2). + ''.&mt('Author(s):').' '. + (' 'x2). + ''.&mt('Thumbnail:'); + if ($image) { + $datatable .= ''. + $imgsrc. + ' '. + ' '.&mt('Replace:').' '; + } + if ($switchserver) { + $datatable .= &mt('Upload to library server: [_1]',$switchserver); + } else { + $datatable .= ''; + } + } + $datatable .= ' '. + ''.&mt('LON-CAPA course:').' '. + $coursetitle.''."\n"; + $itemcount ++; + } + } + $css_class = $itemcount%2?' class="LC_odd_row"':''; + my $chgstr = ' onchange="javascript:reorderBooks(this.form,'."'$type"."_addbook_pos','$type'".');"'; + $datatable .= ''."\n". + ''."\n". + ' '."\n". + ''.&mt('Add').''."\n". + ''. + ''.&mt('Subject:').' '."\n". + (' 'x2). + ''.&mt('Title:').' '."\n". + (' 'x2); + if ($type eq 'textbooks') { + $datatable .= ''.&mt('Publisher:').' '."\n". + (' 'x2). + ''.&mt('Author(s):').' '."\n". + (' 'x2). + ''.&mt('Image:').' '; + if ($switchserver) { + $datatable .= &mt('Upload to library server: [_1]',$switchserver); + } else { + $datatable .= ''; + } + } + $datatable .= ''."\n". + ''.&mt('LON-CAPA course:').' '. + &Apache::loncommon::select_dom_form($env{'request.role.domain'},$type.'_addbook_cdom'). + ''. + &Apache::loncommon::selectcourse_link + ('display',$type.'_addbook_cnum',$type.'_addbook_cdom',undef,undef,undef,'Course'); + ''."\n". + ''."\n"; + $itemcount ++; + return $datatable; +} + +sub textbookcourses_javascript { + my ($settings) = @_; + return unless(ref($settings) eq 'HASH'); + my (%ordered,%total,%jstext); + foreach my $type ('textbooks','templates') { + $total{$type} = 0; + if (ref($settings->{$type}) eq 'HASH') { + foreach my $item (keys(%{$settings->{$type}})) { + if (ref($settings->{$type}->{$item}) eq 'HASH') { + my $num = $settings->{$type}->{$item}{'order'}; + $ordered{$type}{$num} = $item; + } + } + $total{$type} = scalar(keys(%{$settings->{$type}})); + } + my @jsarray = (); + foreach my $item (sort {$a <=> $b } (keys(%{$ordered{$type}}))) { + push(@jsarray,$ordered{$type}{$item}); + } + $jstext{$type} = ' var '.$type.' = Array('."'".join("','",@jsarray)."'".');'."\n"; + } + return <<"ENDSCRIPT"; + + +ENDSCRIPT +} + sub print_autoenroll { - my ($dom,$settings) = @_; - my $defdom = $dom; + my ($dom,$settings,$rowtotal) = @_; my $autorun = &Apache::lonnet::auto_run(undef,$dom), - my ($runon,$runoff); + my ($defdom,$runon,$runoff,$coownerson,$coownersoff); if (ref($settings) eq 'HASH') { if (exists($settings->{'run'})) { if ($settings->{'run'} eq '0') { @@ -349,31 +2435,63 @@ sub print_autoenroll { $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?').''. - ''. + ''. + $runon.' value="1" />'.&mt('Yes').' '. + ''. ''. ''.&mt('Notification messages - sender'). - ''. + ''. &mt('username').': '. '  '.&mt('domain'). - ': '.$domform.''; + $notif_sender.'" size="10" />  '.&mt('domain'). + ': '.$domform.''. + ''. + ''.&mt('Automatically assign co-ownership').''. + ' '. + ''. + ''; + $$rowtotal += 3; return $datatable; } sub print_autoupdate { - my ($position,$dom,$settings) = @_; + my ($position,$dom,$settings,$rowtotal) = @_; my $datatable; if ($position eq 'top') { my $updateon = ' '; @@ -396,57 +2514,3340 @@ sub print_autoupdate { ); $datatable = ''. ''.&mt($title{'run'}).''. - ''. + ''. + $updateon.' value="1" />'.&mt('Yes').' '. + ''. ''. ''.&mt($title{'classlists'}).''. - ''. - ''.&mt('Yes').' '. - ''.&mt('No').''. + ''. + ' '. + ''. ''; + $$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 ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); - my @types; - if (ref($order) eq 'ARRAY') { - @types = @{$order}; + 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}; + } } - if (@types == 0) { - if (ref($usertypes) eq 'HASH') { - @types = sort(keys(%{$usertypes})); + $datatable .= + &usertype_update_row($settings,{'default' => $othertitle}, + \%fieldtitles,\@fields,['default'], + \$numrows); + $$rowtotal ++; + } + return $datatable; +} + +sub print_autocreate { + my ($dom,$settings,$rowtotal) = @_; + my (%createon,%createoff,%currhash); + 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} = ' '; + } + } + } + if ($settings->{'xmldc'} ne '') { + $currhash{$settings->{'xmldc'}} = 1; + } + } else { + foreach my $item (@types) { + $createoff{$item} = ' checked="checked" '; + $createon{$item} = ' '; + } + } + $$rowtotal += 2; + my $numinrow = 2; + my $datatable=''. + ''.&mt('Create pending official courses from XML files').''. + ' '. + ''. + ''. + ''.&mt('Create pending requests for official courses (if validated)').''. + ' '. + ''; + my ($numdc,$dctable,$rows) = &active_dc_picker($dom,$numinrow,'radio', + 'autocreate_xmldc',%currhash); + $datatable .= ''; + if ($numdc > 1) { + $datatable .= &mt('Course creation processed as: (choose Dom. Coord.)'). + ''; + } else { + $datatable .= &mt('Course creation processed as:'). + ''; + } + $datatable .= $dctable.''; + $$rowtotal += $rows; + 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 $othertitle = &mt('All users'); + } + 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) { - $othertitle = &mt('Other users'); + $datatable .= &insttypes_row($settings,$types,$usertypes,$dom, + $numinrow,$othertitle,'cansearch'); + $cansrchrow = 1; } - my @fields = ('lastname','firstname','middlename','gen','email','id'); - my %fieldtitles = &Apache::lonlocal::texthash ( - id => 'Student/Employee ID', - email => 'E-mail address', - lastname => 'Last Name', - firstname => 'First Name', - middlename => 'Middle Name', - gen => 'Generation', - ); - my $numrows = 0; - if (@types > 0) { - $datatable = - &usertype_update_row($settings,$usertypes,\%fieldtitles, - \@fields,\@types,\$numrows); + } + 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','updatesmail','idconflictsmail'); + 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" '; + $checked{'updatesmail'}{'adminemail'} = ' checked="checked" '; + $checked{'idconflictsmail'}{'adminemail'} = ' checked="checked" '; + } + my ($titles,$short_titles) = &contact_titles(); + my $rownum = 0; + my $css_class; + foreach my $item (@contacts) { + $css_class = $rownum%2?' class="LC_odd_row"':''; + $datatable .= ''. + ''.$titles->{$item}. + ''. + ''; + $rownum ++; + } + foreach my $type (@mailings) { + $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"; + $rownum ++; + } + my %choices; + $choices{'reporterrors'} = &mt('E-mail error reports to [_1]', + &Apache::loncommon::modal_link('http://loncapa.org/core.html', + &mt('LON-CAPA core group - MSU'),600,500)); + $choices{'reportupdates'} = &mt('E-mail record of completed LON-CAPA updates to [_1]', + &Apache::loncommon::modal_link('http://loncapa.org/core.html', + &mt('LON-CAPA core group - MSU'),600,500)); + my @toggles = ('reporterrors','reportupdates'); + my %defaultchecked = ('reporterrors' => 'on', + 'reportupdates' => 'on'); + (my $reports,$rownum) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked, + \%choices,$rownum); + $datatable .= $reports; + $$rowtotal += $rownum; + return $datatable; +} + +sub print_helpsettings { + my ($dom,$confname,$settings,$rowtotal) = @_; + my ($datatable,$itemcount); + $itemcount = 1; + my (%choices,%defaultchecked,@toggles); + $choices{'submitbugs'} = &mt('Display link to: [_1]?', + &Apache::loncommon::modal_link('http://bugs.loncapa.org', + &mt('LON-CAPA bug tracker'),600,500)); + %defaultchecked = ('submitbugs' => 'on'); + @toggles = ('submitbugs',); + + ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked, + \%choices,$itemcount); + return $datatable; +} + +sub radiobutton_prefs { + my ($settings,$toggles,$defaultchecked,$choices,$itemcount,$onclick, + $additional,$align) = @_; + 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} = ' '; + } + } + } + if ($onclick) { + $onclick = ' onclick="'.$onclick.'"'; + } + foreach my $item (@{$toggles}) { + $css_class = $itemcount%2?' class="LC_odd_row"':''; + $datatable .= + ''. + ''.$choices->{$item}. + ''; + if ($align eq 'left') { + $datatable .= ''; + } else { + $datatable .= ''; } $datatable .= - &usertype_update_row($settings,{'default' => $othertitle}, - \%fieldtitles,\@fields,['default'], - \$numrows); + ''. + ' '. + ''.$additional. + ''. + ''; + $itemcount ++; } + return ($datatable,$itemcount); +} + +sub print_coursedefaults { + my ($position,$dom,$settings,$rowtotal) = @_; + my ($css_class,$datatable,%checkedon,%checkedoff,%defaultchecked,@toggles); + my $itemcount = 1; + my %choices = &Apache::lonlocal::texthash ( + canuse_pdfforms => 'Course/Community users can create/upload PDF forms', + uploadquota => 'Default quota for files uploaded directly to course/community using Course Editor (MB)', + anonsurvey_threshold => 'Responder count needed before showing submissions for anonymous surveys', + coursecredits => 'Credits can be specified for courses', + uselcmath => 'Math preview uses LON-CAPA previewer (javascript) in place of DragMath (Java)', + usejsme => 'Molecule editor uses JSME (HTML5) in place of JME (Java)', + postsubmit => 'Disable submit button/keypress following student submission', + ); + my %staticdefaults = ( + anonsurvey_threshold => 10, + uploadquota => 500, + postsubmit => 60, + ); + if ($position eq 'top') { + %defaultchecked = ( + 'canuse_pdfforms' => 'off', + 'uselcmath' => 'on', + 'usejsme' => 'on', + ); + @toggles = ('canuse_pdfforms','uselcmath','usejsme'); + ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked, + \%choices,$itemcount); + } else { + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + my ($currdefresponder,%defcredits,%curruploadquota,%deftimeout); + my $currusecredits = 0; + my $postsubmitclient = 1; + my @types = ('official','unofficial','community','textbook'); + if (ref($settings) eq 'HASH') { + $currdefresponder = $settings->{'anonsurvey_threshold'}; + if (ref($settings->{'uploadquota'}) eq 'HASH') { + foreach my $type (keys(%{$settings->{'uploadquota'}})) { + $curruploadquota{$type} = $settings->{'uploadquota'}{$type}; + } + } + if (ref($settings->{'coursecredits'}) eq 'HASH') { + foreach my $type (@types) { + next if ($type eq 'community'); + $defcredits{$type} = $settings->{'coursecredits'}->{$type}; + if ($defcredits{$type} ne '') { + $currusecredits = 1; + } + } + } + if (ref($settings->{'postsubmit'}) eq 'HASH') { + if ($settings->{'postsubmit'}->{'client'} eq 'off') { + $postsubmitclient = 0; + foreach my $type (@types) { + $deftimeout{$type} = $staticdefaults{'postsubmit'}; + } + } else { + foreach my $type (@types) { + if (ref($settings->{'postsubmit'}->{'timeout'}) eq 'HASH') { + if ($settings->{'postsubmit'}->{'timeout'}->{$type} =~ /^\d+$/) { + $deftimeout{$type} = $settings->{'postsubmit'}->{'timeout'}->{$type}; + } else { + $deftimeout{$type} = $staticdefaults{'postsubmit'}; + } + } else { + $deftimeout{$type} = $staticdefaults{'postsubmit'}; + } + } + } + } else { + foreach my $type (@types) { + $deftimeout{$type} = $staticdefaults{'postsubmit'}; + } + } + } else { + foreach my $type (@types) { + $deftimeout{$type} = $staticdefaults{'postsubmit'}; + } + } + if (!$currdefresponder) { + $currdefresponder = $staticdefaults{'anonsurvey_threshold'}; + } elsif ($currdefresponder < 1) { + $currdefresponder = 1; + } + foreach my $type (@types) { + if ($curruploadquota{$type} eq '') { + $curruploadquota{$type} = $staticdefaults{'uploadquota'}; + } + } + $datatable .= + ''. + $choices{'anonsurvey_threshold'}. + ''. + ''. + ''. + ''."\n"; + $itemcount ++; + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ''. + $choices{'uploadquota'}. + ''. + ''. + ''; + foreach my $type (@types) { + $datatable .= ''; + } + $datatable .= '
'.&mt($type).'
'. + '
'."\n"; + $itemcount ++; + my $onclick = "toggleDisplay(this.form,'credits');"; + my $display = 'none'; + if ($currusecredits) { + $display = 'block'; + } + my $additional = '
'. + ''.&mt('Default credits').'
'; + foreach my $type (@types) { + next if ($type eq 'community'); + $additional .= ''; + } + $additional .= '
'.&mt($type).'
'. + '
'."\n"; + %defaultchecked = ('coursecredits' => 'off'); + @toggles = ('coursecredits'); + my $current = { + 'coursecredits' => $currusecredits, + }; + (my $table,$itemcount) = + &radiobutton_prefs($current,\@toggles,\%defaultchecked, + \%choices,$itemcount,$onclick,$additional,'left'); + $datatable .= $table; + $onclick = "toggleDisplay(this.form,'studentsubmission');"; + my $display = 'none'; + if ($postsubmitclient) { + $display = 'block'; + } + $additional = '
'. + &mt('Number of seconds submit is disabled').'
'. + ''.&mt('Enter 0 to remain disabled until page reload.').'
'. + ''; + foreach my $type (@types) { + $additional .= ''; + } + $additional .= '
'.&mt($type).'
'. + '
'."\n"; + %defaultchecked = ('postsubmit' => 'on'); + @toggles = ('postsubmit'); + my $current = { + 'postsubmit' => $postsubmitclient, + }; + ($table,$itemcount) = + &radiobutton_prefs($current,\@toggles,\%defaultchecked, + \%choices,$itemcount,$onclick,$additional,'left'); + $datatable .= $table; + } + $$rowtotal += $itemcount; return $datatable; } +sub print_selfenrollment { + my ($position,$dom,$settings,$rowtotal) = @_; + my ($css_class,$datatable); + my $itemcount = 1; + my @types = ('official','unofficial','community','textbook'); + if (($position eq 'top') || ($position eq 'middle')) { + my ($rowsref,$titlesref) = &Apache::lonuserutils::get_selfenroll_titles(); + my %descs = &Apache::lonuserutils::selfenroll_default_descs(); + my @rows; + my $key; + if ($position eq 'top') { + $key = 'admin'; + if (ref($rowsref) eq 'ARRAY') { + @rows = @{$rowsref}; + } + } elsif ($position eq 'middle') { + $key = 'default'; + @rows = ('types','registered','approval','limit'); + } + foreach my $row (@rows) { + if (defined($titlesref->{$row})) { + $itemcount ++; + $css_class = $itemcount%2?' class="LC_odd_row"':''; + $datatable .= ''. + ''.$titlesref->{$row}.''. + ''. + ''; + my (%current,%currentcap); + if (ref($settings) eq 'HASH') { + if (ref($settings->{$key}) eq 'HASH') { + foreach my $type (@types) { + if (ref($settings->{$key}->{$type}) eq 'HASH') { + $current{$type} = $settings->{$key}->{$type}->{$row}; + } + if (($row eq 'limit') && ($key eq 'default')) { + if (ref($settings->{$key}->{$type}) eq 'HASH') { + $currentcap{$type} = $settings->{$key}->{$type}->{'cap'}; + } + } + } + } + } + my %roles = ( + '0' => &Apache::lonnet::plaintext('dc'), + ); + + foreach my $type (@types) { + unless (($row eq 'registered') && ($key eq 'default')) { + $datatable .= ''; + } + } + unless (($row eq 'registered') && ($key eq 'default')) { + $datatable .= ''; + } + foreach my $type (@types) { + if ($type eq 'community') { + $roles{'1'} = &mt('Community personnel'); + } else { + $roles{'1'} = &mt('Course personnel'); + } + $datatable .= ''; + } + $datatable .= ''; + } + $datatable .= '
'.&mt($type).'
'; + if ($position eq 'top') { + my %checked; + if ($current{$type} eq '0') { + $checked{'0'} = ' checked="checked"'; + } else { + $checked{'1'} = ' checked="checked"'; + } + foreach my $role ('1','0') { + $datatable .= ' '; + } + } else { + if ($row eq 'types') { + my %checked; + if ($current{$type} =~ /^(all|dom)$/) { + $checked{$1} = ' checked="checked"'; + } else { + $checked{''} = ' checked="checked"'; + } + foreach my $val ('','dom','all') { + $datatable .= ' '; + } + } elsif ($row eq 'registered') { + my %checked; + if ($current{$type} eq '1') { + $checked{'1'} = ' checked="checked"'; + } else { + $checked{'0'} = ' checked="checked"'; + } + foreach my $val ('0','1') { + $datatable .= ' '; + } + } elsif ($row eq 'approval') { + my %checked; + if ($current{$type} =~ /^([12])$/) { + $checked{$1} = ' checked="checked"'; + } else { + $checked{'0'} = ' checked="checked"'; + } + for my $val (0..2) { + $datatable .= ' '; + } + } elsif ($row eq 'limit') { + my %checked; + if ($current{$type} =~ /^(allstudents|selfenrolled)$/) { + $checked{$1} = ' checked="checked"'; + } else { + $checked{'none'} = ' checked="checked"'; + } + my $cap; + if ($currentcap{$type} =~ /^\d+$/) { + $cap = $currentcap{$type}; + } + foreach my $val ('none','allstudents','selfenrolled') { + $datatable .= ' '; + } + $datatable .= '
'. + ''.&mt('Maximum allowed: '). + ''. + ''; + } + } + $datatable .= '
'; + } + } elsif ($position eq 'bottom') { + $datatable .= &print_validation_rows('selfenroll',$dom,$settings,\$itemcount); + } + $$rowtotal += $itemcount; + return $datatable; +} + +sub print_validation_rows { + my ($caller,$dom,$settings,$rowtotal) = @_; + my ($itemsref,$namesref,$fieldsref); + if ($caller eq 'selfenroll') { + ($itemsref,$namesref,$fieldsref) = &Apache::lonuserutils::selfenroll_validation_types(); + } elsif ($caller eq 'requestcourses') { + ($itemsref,$namesref,$fieldsref) = &Apache::loncoursequeueadmin::requestcourses_validation_types(); + } + my %currvalidation; + if (ref($settings) eq 'HASH') { + if (ref($settings->{'validation'}) eq 'HASH') { + %currvalidation = %{$settings->{'validation'}}; + } + } + my $datatable; + my $itemcount = 0; + foreach my $item (@{$itemsref}) { + my $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ''. + $namesref->{$item}. + ''. + ''; + if (($item eq 'url') || ($item eq 'button')) { + $datatable .= ''. + ''; + } elsif ($item eq 'fields') { + my @currfields; + if (ref($currvalidation{$item}) eq 'ARRAY') { + @currfields = @{$currvalidation{$item}}; + } + foreach my $field (@{$fieldsref}) { + my $check = ''; + if (grep(/^\Q$field\E$/,@currfields)) { + $check = ' checked="checked"'; + } + $datatable .= ' '; + } + } elsif ($item eq 'markup') { + $datatable .= ''; + } + $datatable .= ''."\n"; + if (ref($rowtotal)) { + $itemcount ++; + } + } + if ($caller eq 'requestcourses') { + my %currhash; + if (ref($settings) eq 'HASH') { + if (ref($settings->{'validation'}) eq 'HASH') { + if ($settings->{'validation'}{'dc'} ne '') { + $currhash{$settings->{'validation'}{'dc'}} = 1; + } + } + } + my $numinrow = 2; + my ($numdc,$dctable,$rows) = &active_dc_picker($dom,$numinrow,'radio', + 'validationdc',%currhash); + my $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ''; + if ($numdc > 1) { + $datatable .= &mt('Course creation processed as: (choose Dom. Coord.)'); + } else { + $datatable .= &mt('Course creation processed as: '); + } + $datatable .= ''.$dctable.''; + $itemcount ++; + } + if (ref($rowtotal)) { + $$rowtotal += $itemcount; + } + 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); + my $curroffloadnow; + if (ref($settings) eq 'HASH') { + if (ref($settings->{'offloadnow'}) eq 'HASH') { + $curroffloadnow = $settings->{'offloadnow'}; + } + } + $datatable .= &spares_row($dom,\%servers,\%spareid,\%serverhomes,\%altids,$curroffloadnow,$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,$curroffloadnow,$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'); + my $checkednow; + if (ref($curroffloadnow) eq 'HASH') { + if ($curroffloadnow->{$server}) { + $checkednow = ' checked="checked"'; + } + } + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ' + + '. + &mt('[_1] when busy, offloads to:' + ,''.$server.'').'
'. + ''."\n". + ''. + "\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,%existing); + if (ref($settings) eq 'HASH') { + %existing = %{$settings}; + } + if ((keys(%servers) > 1) || (keys(%existing) > 0)) { + &get_loadbalancers_config(\%servers,\%existing,\%currbalancer, + \%currtargets,\%currrules); + } else { + return; + } + my ($othertitle,$usertypes,$types) = + &Apache::loncommon::sorted_inst_types($dom); + my $rownum = 8; + if (ref($types) eq 'ARRAY') { + $rownum += scalar(@{$types}); + } + my @css_class = ('LC_odd_row','LC_even_row'); + my $balnum = 0; + my $islast; + my (@toshow,$disabledtext); + if (keys(%currbalancer) > 0) { + @toshow = sort(keys(%currbalancer)); + if (scalar(@toshow) < scalar(keys(%servers)) + 1) { + push(@toshow,''); + } + } else { + @toshow = (''); + $disabledtext = &mt('No existing load balancer'); + } + foreach my $lonhost (@toshow) { + if ($balnum == scalar(@toshow)-1) { + $islast = 1; + } else { + $islast = 0; + } + my $cssidx = $balnum%2; + my $targets_div_style = 'display: none'; + my $disabled_div_style = 'display: block'; + my $homedom_div_style = 'display: none'; + $datatable .= ''. + ''. + '

'; + if ($lonhost eq '') { + $datatable .= ''; + if (keys(%currbalancer) > 0) { + $datatable .= &mt('Add balancer:'); + } else { + $datatable .= &mt('Enable balancer:'); + } + $datatable .= ' '. + ''."\n". + ' '."\n"; + } else { + $datatable .= ''.$lonhost.'
'. + ''. + ''; + $targets_div_style = 'display: block'; + $disabled_div_style = 'display: none'; + if ($dom eq &Apache::lonnet::host_domain($lonhost)) { + $homedom_div_style = 'display: block'; + } + } + $datatable .= '

'. + '
'.$disabledtext.'
'."\n". + '
'.&mt('Offloads to:').'
'; + my ($numspares,@spares) = &count_servers($lonhost,%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{$lonhost}) eq 'HASH') { + if (ref($currtargets{$lonhost}{$sparetype}) eq 'ARRAY') { + if (grep(/^\Q$spares[$i]\E$/,@{$currtargets{$lonhost}{$sparetype}})) { + $checked = ' checked="checked"'; + } + } + } + my ($chkboxval,$disabled); + if (($lonhost ne '') && (exists($servers{$lonhost}))) { + $chkboxval = $spares[$i]; + } + if (exists($currbalancer{$spares[$i]})) { + $disabled = ' disabled="disabled"'; + } + $targettable .= + ''; + my $rem = $i%($numinrow); + if ($rem == 0) { + if (($i > 0) && ($i < $numspares-1)) { + $targettable .= ''; + } + if ($i < $numspares-1) { + $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{$lonhost}, + $othertitle,$usertypes,$types,\%servers, + \%currbalancer,$lonhost, + $targets_div_style,$homedom_div_style, + $css_class[$cssidx],$balnum,$islast); + $$rowtotal += $rownum; + $balnum ++; + } + $datatable .= ''; + return $datatable; +} + +sub get_loadbalancers_config { + my ($servers,$existing,$currbalancer,$currtargets,$currrules) = @_; + return unless ((ref($servers) eq 'HASH') && + (ref($existing) eq 'HASH') && (ref($currbalancer) eq 'HASH') && + (ref($currtargets) eq 'HASH') && (ref($currrules) eq 'HASH')); + if (keys(%{$existing}) > 0) { + my $oldlonhost; + foreach my $key (sort(keys(%{$existing}))) { + if ($key eq 'lonhost') { + $oldlonhost = $existing->{'lonhost'}; + $currbalancer->{$oldlonhost} = 1; + } elsif ($key eq 'targets') { + if ($oldlonhost) { + $currtargets->{$oldlonhost} = $existing->{'targets'}; + } + } elsif ($key eq 'rules') { + if ($oldlonhost) { + $currrules->{$oldlonhost} = $existing->{'rules'}; + } + } elsif (ref($existing->{$key}) eq 'HASH') { + $currbalancer->{$key} = 1; + $currtargets->{$key} = $existing->{$key}{'targets'}; + $currrules->{$key} = $existing->{$key}{'rules'}; + } + } + } else { + my ($balancerref,$targetsref) = + &Apache::lonnet::get_lonbalancer_config($servers); + if ((ref($balancerref) eq 'HASH') && (ref($targetsref) eq 'HASH')) { + foreach my $server (sort(keys(%{$balancerref}))) { + $currbalancer->{$server} = 1; + $currtargets->{$server} = $targetsref->{$server}; + } + } + } + return; +} + +sub loadbalancing_rules { + my ($dom,$intdom,$currrules,$othertitle,$usertypes,$types,$servers, + $currbalancer,$lonhost,$targets_div_style,$homedom_div_style, + $css_class,$balnum,$islast) = @_; + my $output; + my $num = 0; + my ($alltypes,$othertypes,$titles) = + &loadbalancing_titles($dom,$intdom,$usertypes,$types); + if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH')) { + foreach my $type (@{$alltypes}) { + $num ++; + 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($lonhost)) { + $current = ''; + } + } + $output .= &loadbalance_rule_row($type,$titles->{$type},$current, + $servers,$currbalancer,$lonhost,$dom, + $targets_div_style,$homedom_div_style, + $css_class,$balnum,$num,$islast); + } + } + 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), + '_LC_ipchangesso' => &mt('SSO users from [_1], with IP mismatch',$dom), + '_LC_ipchange' => &mt('Non-SSO users with IP mismatch'), + ); + my @alltypes = ('_LC_adv','_LC_author','_LC_internetdom','_LC_external','_LC_ipchangesso','_LC_ipchange'); + 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,$lonhost,$dom, + $targets_div_style,$homedom_div_style,$css_class,$balnum,$num,$islast) = @_; + my @rulenames; + my %ruletitles = &offloadtype_text(); + if (($type eq '_LC_ipchangesso') || ($type eq '_LC_ipchange')) { + @rulenames = ('balancer','offloadedto','specific'); + } else { + @rulenames = ('default','homeserver'); + if ($type eq '_LC_external') { + push(@rulenames,'externalbalancer'); + } else { + push(@rulenames,'specific'); + } + push(@rulenames,'none'); + } + my $style = $targets_div_style; + if (($type eq '_LC_external') || ($type eq '_LC_internetdom')) { + $style = $homedom_div_style; + } + my $space; + if ($islast && $num == 1) { + $space = '
 
'; + } + my $output = + ''.$space. + '
'.$title.'
'."\n". + ''.$space. + '
'."\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', + 'none' => 'No offload', + 'balancer' => 'Session hosted on Load Balancer, after re-authentication', + 'offloadedto' => 'Session hosted on offload server, after re-authentication', + 'particular' => 'Session hosted (after re-auth) on 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', + 'updatesmail' => 'E-mail from nightly check of LON-CAPA module integrity/updates', + 'idconflictsmail' => 'E-mail from bi-nightly check for multiple users sharing same student/employee ID', + ); + 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 web page', + blog => 'Blog', + webdav => 'WebDAV', + portfolio => 'Portfolio', + official => 'Official courses (with institutional codes)', + unofficial => 'Unofficial courses', + community => 'Communities', + textbook => 'Textbook courses', + ); + return %titles; +} + +sub courserequest_titles { + my %titles = &Apache::lonlocal::texthash ( + official => 'Official', + unofficial => 'Unofficial', + community => 'Communities', + textbook => 'Textbook', + norequest => 'Not allowed', + approval => 'Approval by Dom. Coord.', + validate => 'With validation', + autolimit => 'Numerical limit', + unlimited => '(blank for unlimited)', + ); + return %titles; +} + +sub authorrequest_titles { + my %titles = &Apache::lonlocal::texthash ( + norequest => 'Not allowed', + approval => 'Approval by Dom. Coord.', + automatic => 'Automatic approval', + ); + 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 institutional 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 ++; + } + } + 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'); + my ($rules,$ruleorder) = + &Apache::lonnet::inst_userrules($dom,'username'); + my %lt = &usercreation_types(); + my %checked; + if (ref($settings) eq 'HASH') { + if (ref($settings->{'cancreate'}) eq 'HASH') { + foreach my $item (@creators) { + $checked{$item} = $settings->{'cancreate'}{$item}; + } + } 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 ($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 = ('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 ($checked{$item} eq $option) { + $check = ' checked="checked" '; + } + $datatable .= '  '; + } + $datatable .= ''; + } + } 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 print_selfcreation { + my ($position,$dom,$settings,$rowtotal) = @_; + my (@selfcreate,$createsettings,$processing,$datatable); + if (ref($settings) eq 'HASH') { + if (ref($settings->{'cancreate'}) eq 'HASH') { + $createsettings = $settings->{'cancreate'}; + if (ref($createsettings) eq 'HASH') { + if (ref($createsettings->{'selfcreate'}) eq 'ARRAY') { + @selfcreate = @{$createsettings->{'selfcreate'}}; + } elsif ($createsettings->{'selfcreate'} ne '') { + if ($settings->{'cancreate'}{'selfcreate'} eq 'any') { + @selfcreate = ('email','login','sso'); + } elsif ($createsettings->{'selfcreate'} ne 'none') { + @selfcreate = ($createsettings->{'selfcreate'}); + } + } + if (ref($createsettings->{'selfcreateprocessing'}) eq 'HASH') { + $processing = $createsettings->{'selfcreateprocessing'}; + } + } + } + } + my %radiohash; + my $numinrow = 4; + map { $radiohash{'cancreate_'.$_} = 1; } @selfcreate; + if ($position eq 'top') { + my %choices = &Apache::lonlocal::texthash ( + cancreate_login => 'Institutional Login', + cancreate_sso => 'Institutional Single Sign On', + ); + my @toggles = sort(keys(%choices)); + my %defaultchecked = ( + 'cancreate_login' => 'off', + 'cancreate_sso' => 'off', + ); + my ($onclick,$itemcount); + ($datatable,$itemcount) = &radiobutton_prefs(\%radiohash,\@toggles,\%defaultchecked, + \%choices,$itemcount,$onclick); + $$rowtotal += $itemcount; + + my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); + + if (ref($usertypes) eq 'HASH') { + if (keys(%{$usertypes}) > 0) { + $datatable .= &insttypes_row($createsettings,$types,$usertypes, + $dom,$numinrow,$othertitle, + 'statustocreate',$$rowtotal); + $$rowtotal ++; + } + } + my @fields = ('lastname','firstname','middlename','permanentemail','id','inststatus'); + my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); + $fieldtitles{'inststatus'} = &mt('Institutional status'); + my $rem; + my $numperrow = 2; + my $css_class = $$rowtotal%2?' class="LC_odd_row"':''; + $datatable .= ''. + ''.&mt('Mapping of Shibboleth environment variable names to user data fields (SSO auth)').''. + ''."\n". + ''; + } + $datatable .= ''; + } + my $currval; + if (ref($createsettings) eq 'HASH') { + if (ref($createsettings->{'shibenv'}) eq 'HASH') { + $currval = $createsettings->{'shibenv'}{$fields[$i]}; + } + } + $datatable .= ''; + } + my $colsleft = $numperrow - $rem; + if ($colsleft > 1 ) { + $datatable .= ''; + } elsif ($colsleft == 1) { + $datatable .= ''; + } + $datatable .= '
'."\n"; + for (my $i=0; $i<@fields; $i++) { + $rem = $i%($numperrow); + if ($rem == 0) { + if ($i > 0) { + $datatable .= '
'. + ''. + ' '. + $fieldtitles{$fields[$i]}.''. + '  
'; + $$rowtotal ++; + } elsif ($position eq 'middle') { + my %domconf = &Apache::lonnet::get_dom('configuration',['usermodification'],$dom); + 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('selfcreate',$status,$domconf{'usermodification'}, + $numinrow,$$rowtotal,$usertypes); + $$rowtotal ++; + } + } + } else { + my %choices = &Apache::lonlocal::texthash ( + cancreate_email => 'E-mail address as username', + ); + my @toggles = sort(keys(%choices)); + my %defaultchecked = ( + 'cancreate_email' => 'off', + ); + my $itemcount = 0; + my $display = 'none'; + if (grep(/^\Qemail\E$/,@selfcreate)) { + $display = 'block'; + } + my $onclick = "toggleDisplay(this.form,'emailoptions');"; + my $additional = '
'; + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); + my $usertypes = {}; + my $order = []; + if ((ref($domdefaults{'inststatustypes'}) eq 'HASH') && (ref($domdefaults{'inststatusguest'}) eq 'ARRAY')) { + $usertypes = $domdefaults{'inststatustypes'}; + $order = $domdefaults{'inststatusguest'}; + } + if (ref($order) eq 'ARRAY') { + push(@{$order},'default'); + if (@{$order} > 1) { + $usertypes->{'default'} = &mt('Other users'); + $additional .= ''; + foreach my $status (@{$order}) { + $additional .= ''; + } + $additional .= ''; + foreach my $status (@{$order}) { + $additional .= ''; + } + $additional .= '
'.$usertypes->{$status}.'
'.&email_as_username($rowtotal,$processing,$status).'
'; + } else { + $usertypes->{'default'} = &mt('All users'); + $additional .= &email_as_username($rowtotal,$processing); + } + } + $additional .= '
'."\n"; + + ($datatable,$itemcount) = &radiobutton_prefs(\%radiohash,\@toggles,\%defaultchecked, + \%choices,$$rowtotal,$onclick,$additional); + $$rowtotal ++; + $datatable .= &print_requestmail($dom,'selfcreation',$createsettings,$rowtotal); + $$rowtotal ++; + my ($infofields,$infotitles) = &Apache::loncommon::emailusername_info(); + $numinrow = 1; + if (ref($order) eq 'ARRAY') { + foreach my $status (@{$order}) { + $datatable .= &modifiable_userdata_row('cancreate','emailusername_'.$status,$settings, + $numinrow,$$rowtotal,$usertypes,$infofields,$infotitles); + $$rowtotal ++; + } + } + 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,$$rowtotal); + $$rowtotal ++; + } + } + $datatable .= &captcha_choice('cancreate',$createsettings,$$rowtotal); + } + return $datatable; +} + +sub email_as_username { + my ($rowtotal,$processing,$type) = @_; + my %choices = + &Apache::lonlocal::texthash ( + automatic => 'Automatic approval', + approval => 'Queued for approval', + ); + my $output; + foreach my $option ('automatic','approval') { + my $checked; + if (ref($processing) eq 'HASH') { + if ($type eq '') { + if (!exists($processing->{'default'})) { + if ($option eq 'automatic') { + $checked = ' checked="checked"'; + } + } else { + if ($processing->{'default'} eq $option) { + $checked = ' checked="checked"'; + } + } + } else { + if (!exists($processing->{$type})) { + if ($option eq 'automatic') { + $checked = ' checked="checked"'; + } + } else { + if ($processing->{$type} eq $option) { + $checked = ' checked="checked"'; + } + } + } + } elsif ($option eq 'automatic') { + $checked = ' checked="checked"'; + } + my $name = 'cancreate_emailprocess'; + if (($type ne '') && ($type ne 'default')) { + $name .= '_'.$type; + } + $output .= ''; + if ($type eq '') { + $output .= ' '; + } else { + $output .= '
'; + } + } + $$rowtotal ++; + return $output; +} + +sub captcha_choice { + my ($context,$settings,$itemcount) = @_; + my ($keyentry,$currpub,$currpriv,%checked,$rowname,$pubtext,$privtext); + my %lt = &captcha_phrases(); + $keyentry = 'hidden'; + if ($context eq 'cancreate') { + $rowname = &mt('CAPTCHA validation'); + } elsif ($context eq 'login') { + $rowname = &mt('"Contact helpdesk" CAPTCHA validation'); + } + if (ref($settings) eq 'HASH') { + if ($settings->{'captcha'}) { + $checked{$settings->{'captcha'}} = ' checked="checked"'; + } else { + $checked{'original'} = ' checked="checked"'; + } + if ($settings->{'captcha'} eq 'recaptcha') { + $pubtext = $lt{'pub'}; + $privtext = $lt{'priv'}; + $keyentry = 'text'; + } + if (ref($settings->{'recaptchakeys'}) eq 'HASH') { + $currpub = $settings->{'recaptchakeys'}{'public'}; + $currpriv = $settings->{'recaptchakeys'}{'private'}; + } + } else { + $checked{'original'} = ' checked="checked"'; + } + my $css_class = $itemcount%2?' class="LC_odd_row"':''; + my $output = ''. + ''.$rowname.''."\n". + ''."\n". + '
'."\n"; + foreach my $option ('original','recaptcha','notused') { + $output .= ''; + unless ($option eq 'notused') { + $output .= (' 'x2)."\n"; + } + } +# +# Note: If reCAPTCHA is to be used for LON-CAPA servers in a domain, a domain coordinator should visit: +# https://www.google.com/recaptcha and generate a Public and Private key. For domains with multiple +# servers a single key pair will be used for all servers, so the internet domain (e.g., yourcollege.edu) +# specified for use with the key should be broad enough to accommodate all servers in the LON-CAPA domain. +# + $output .= '
'."\n". + ''.$pubtext.' '."\n". + '
'."\n". + ''.$privtext.' '."\n". + '
'."\n". + ''; + return $output; +} + +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', + any => 'Any', + official => 'Institutional only ', + unofficial => 'Non-institutional only', + none => 'None', + ); + return %lt; +} + +sub selfcreation_types { + my %lt = &Apache::lonlocal::texthash ( + selfcreate => 'User creates own account', + any => 'Any', + official => 'Institutional only ', + unofficial => 'Non-institutional only', + email => 'E-mail address', + login => 'Institutional Login', + sso => 'SSO', + ); +} + +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 'bottom') { + $context = 'course'; + $rowcount = 0; + foreach my $role ('st','ep','ta','in','cr') { + $datatable .= &modifiable_userdata_row($context,$role,$settings, + $numinrow,$rowcount); + $$rowtotal ++; + $rowcount ++; + } + } + return $datatable; +} + +sub print_defaults { + my ($position,$dom,$settings,$rowtotal) = @_; + my $rownum = 0; + my ($datatable,$css_class); + if ($position eq 'top') { + my @items = ('auth_def','auth_arg_def','lang_def','timezone_def', + 'datelocale_def','portal_def'); + my %defaults; + if (ref($settings) eq 'HASH') { + %defaults = %{$settings}; + } else { + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); + foreach my $item (@items) { + $defaults{$item} = $domdefaults{$item}; + } + } + my $titles = &defaults_titles($dom); + 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 ($defaults{$item} eq $auth) { + $checked = ' checked="checked" '; + } + $datatable .= '  '; + } + } elsif ($item eq 'timezone_def') { + my $includeempty = 1; + $datatable .= &Apache::loncommon::select_timezone($item,$defaults{$item},undef,$includeempty); + } elsif ($item eq 'datelocale_def') { + my $includeempty = 1; + $datatable .= &Apache::loncommon::select_datelocale($item,$defaults{$item},undef,$includeempty); + } elsif ($item eq 'lang_def') { + my $includeempty = 1; + $datatable .= &Apache::loncommon::select_language($item,$defaults{$item},$includeempty); + } else { + my $size; + if ($item eq 'portal_def') { + $size = ' size="25"'; + } + $datatable .= ''; + } + $datatable .= ''; + $rownum ++; + } + } else { + my (%defaults); + if (ref($settings) eq 'HASH') { + if ((ref($settings->{'inststatusorder'}) eq 'ARRAY') && (ref($settings->{'inststatustypes'}) eq 'HASH') && + (ref($settings->{'inststatusguest'}) eq 'ARRAY')) { + my $maxnum = @{$settings->{'inststatusorder'}}; + for (my $i=0; $i<$maxnum; $i++) { + $css_class = $rownum%2?' class="LC_odd_row"':''; + my $item = $settings->{'inststatusorder'}->[$i]; + my $title = $settings->{'inststatustypes'}->{$item}; + my $guestok; + if (grep(/^\Q$item\E$/,@{$settings->{'inststatusguest'}})) { + $guestok = 1; + } + my $chgstr = ' onchange="javascript:reorderTypes(this.form,'."'$item'".');"'; + $datatable .= ''. + ''. + ' '.&mt('Internal ID:').' '.$item.' '. + ''. + &mt('delete').''. + ''.&mt('Name displayed:'). + ''. + ''. + ''. + ''.(' 'x2). + ''; + } + $css_class = $rownum%2?' class="LC_odd_row"':''; + my $chgstr = ' onchange="javascript:reorderTypes(this.form,'."'addinststatus_pos'".');"'; + $datatable .= ''. + ' '.&mt('Internal ID:'). + ''. + ' '.&mt('(new)'). + ''. + &mt('Name displayed:'). + ''. + ''. + ''.(' 'x2). + ''; + ''."\n"; + $rownum ++; + } + } + } + $$rowtotal += $rownum; + return $datatable; +} + +sub get_languages_hash { + my %langchoices; + foreach my $id (&Apache::loncommon::languageids()) { + my $code = &Apache::loncommon::supportedlanguagecode($id); + if ($code ne '') { + $langchoices{$code} = &Apache::loncommon::plainlanguagedescription($id); + } + } + return %langchoices; +} + +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 .= &Apache::loncommon::modal_link($scantronurl,&mt('Default bubblesheet format file'),600,500, + undef,undef,undef,undef,'background-color:#ffffff'); + } 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) { + my $link = &Apache::loncommon::modal_link($scantronurl,&mt('Custom bubblesheet format file'),600,500, + undef,undef,undef,undef,'background-color:#ffffff'); + $datatable .= ''. + $link. + ''. + ' '. + &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 (%checked); + my @catitems = ('unauth','auth'); + my @cattypes = ('std','domonly','codesrch','none'); + $checked{'unauth'} = 'std'; + $checked{'auth'} = 'std'; + if (ref($settings) eq 'HASH') { + foreach my $type (@cattypes) { + if ($type eq $settings->{'unauth'}) { + $checked{'unauth'} = $type; + } + if ($type eq $settings->{'auth'}) { + $checked{'auth'} = $type; + } + } + } + my %lt = &Apache::lonlocal::texthash ( + unauth => 'Catalog type for unauthenticated users', + auth => 'Catalog type for authenticated users', + none => 'No catalog', + std => 'Standard catalog', + domonly => 'Domain-only catalog', + codesrch => "Code search form", + ); + my $itemcount = 0; + foreach my $item (@catitems) { + my $css_class = $itemcount%2? ' class="LC_odd_row"':''; + $datatable .= ''. + ''.$lt{$item}.''. + ''; + foreach my $type (@cattypes) { + my $ischecked; + if ($checked{$item} eq $type) { + $ischecked=' checked="checked"'; + } + $datatable .= ' '; + } + $datatable .= ''; + $itemcount ++; + } + $$rowtotal += $itemcount; + } elsif ($position eq 'middle') { + 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'}->[1]->{'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', + 'checksums','clusterstatus','metadata_keywords','metadata_harvest', + 'takeoffline','takeonline','showenv','toggledebug','ping','domconf', + 'uniquecodes','diskusage','coursecatalog'); +} + +sub defaults_javascript { + my ($settings) = @_; + return unless (ref($settings) eq 'HASH'); + if ((ref($settings->{'inststatusorder'}) eq 'ARRAY') && (ref($settings->{'inststatustypes'}) eq 'HASH')) { + my $maxnum = scalar(@{$settings->{'inststatusorder'}}); + if ($maxnum eq '') { + $maxnum = 0; + } + $maxnum ++; + my $jstext = ' var inststatuses = Array('."'".join("','",@{$settings->{'inststatusorder'}})."'".');'; + return <<"ENDSCRIPT"; + + +ENDSCRIPT + } +} + +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: [_1] is a reserved category.','"instcode"'); + my $communities_reserved = &mt('The name: [_1] is a reserved category.','"communities"'); + 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,$item,$settings,$numinrow,$rowcount,$usertypes,$fieldsref,$titlesref) = @_; + my ($role,$rolename,$statustype); + $role = $item; + if ($context eq 'cancreate') { + if ($item =~ /^emailusername_(.+)$/) { + $statustype = $1; + $role = 'emailusername'; + if (ref($usertypes) eq 'HASH') { + if ($usertypes->{$statustype}) { + $rolename = &mt('Data provided by [_1]',$usertypes->{$statustype}); + } else { + $rolename = &mt('Data provided by user'); + } + } + } + } elsif ($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,%fieldtitles); + if (ref($fieldsref) eq 'ARRAY') { + @fields = @{$fieldsref}; + } else { + @fields = ('lastname','firstname','middlename','generation', + 'permanentemail','id'); + } + if ((ref($titlesref) eq 'HASH')) { + %fieldtitles = %{$titlesref}; + } else { + %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') { + my $hashref = $settings->{$context}->{$role}; + if ($role eq 'emailusername') { + if ($statustype) { + if (ref($settings->{$context}->{$role}->{$statustype}) eq 'HASH') { + $hashref = $settings->{$context}->{$role}->{$statustype}; + if (ref($hashref) eq 'HASH') { + foreach my $field (@fields) { + if ($hashref->{$field}) { + $checks{$field} = $hashref->{$field}; + } + } + } + } + } + } else { + if (ref($hashref) eq 'HASH') { + foreach my $field (@fields) { + if ($hashref->{$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 = ' '; + unless ($role eq 'emailusername') { + 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 .= '
'. + ''; + if ($role eq 'emailusername') { + unless ($checks{$fields[$i]} =~ /^(required|optional)$/) { + $checks{$fields[$i]} = 'omit'; + } + foreach my $option ('required','optional','omit') { + my $checked=''; + if ($checks{$fields[$i]} eq $option) { + $checked='checked="checked" '; + } + $output .= ''.(' ' x2); + } + $output .= ''.$fieldtitles{$fields[$i]}.''; + } else { + $output .= ''; + } + $output .= ''. + '  
'; + return $output; +} + +sub insttypes_row { + my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle,$context,$rownum) = @_; + 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 $class = 'LC_left_item'; + if ($context eq 'statustocreate') { + $class = 'LC_right_item'; + } + my $css_class = ' class="LC_odd_row"'; + if ($rownum ne '') { + $css_class = ($rownum%2? ' class="LC_odd_row"':''); + } + 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; @@ -466,10 +5867,12 @@ sub usertype_update_row { $datatable .= ''; } my $check = ' '; - 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 (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" '; + } } } } @@ -484,10 +5887,10 @@ sub usertype_update_row { } else { $datatable .= ''; } - $datatable .= ''. - $fieldtitles->{$fields->[$i]}.''; + $datatable .= ''; } $datatable .= ''; } @@ -496,102 +5899,1907 @@ sub usertype_update_row { } sub modify_login { - my ($dom,%domconfig) = @_; - my ($resulttext,%changes); - my %title = ( coursecatalog => 'Display course catalog', - adminmail => 'Display administrator E-mail address'); - my @offon = ('off','on'); - my %loginhash = ( - login => { coursecatalog => $env{'form.coursecatalog'}, - adminmail => $env{'form.adminmail'}, - } - ); + my ($r,$dom,$confname,$lastactref,%domconfig) = @_; + my ($resulttext,$errors,$colchgtext,%changes,%colchanges,%newfile,%newurl, + %curr_loginvia,%loginhash,@currlangs,@newlangs,$addedfile,%title,@offon); + %title = ( coursecatalog => 'Display course catalog', + adminmail => 'Display administrator E-mail address', + helpdesk => 'Display "Contact Helpdesk" link', + newuser => 'Link for visitors to create a user account', + loginheader => 'Log-in box header'); + @offon = ('off','on'); + 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}; + } + } + } + ($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'], + \%domconfig,\%loginhash); + my @toggles = ('coursecatalog','adminmail','helpdesk','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 %domservers = &Apache::lonnet::get_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 = &check_exempt_addresses($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 $servadm = $r->dir_config('lonAdmEMail'); + my %langchoices = &Apache::lonlocal::texthash(&get_languages_hash()); + if (ref($domconfig{'login'}) eq 'HASH') { + if (ref($domconfig{'login'}{'helpurl'}) eq 'HASH') { + foreach my $lang (sort(keys(%{$domconfig{'login'}{'helpurl'}}))) { + if ($lang eq 'nolang') { + push(@currlangs,$lang); + } elsif (defined($langchoices{$lang})) { + push(@currlangs,$lang); + } else { + next; + } + } + } + } + my @delurls = &Apache::loncommon::get_env_multiple('form.loginhelpurl_del'); + if (@currlangs > 0) { + foreach my $lang (@currlangs) { + if (grep(/^\Q$lang\E$/,@delurls)) { + $changes{'helpurl'}{$lang} = 1; + } elsif ($env{'form.loginhelpurl_'.$lang.'.filename'}) { + $changes{'helpurl'}{$lang} = 1; + $newfile{$lang} = $env{'form.loginhelpurl_'.$lang.'.filename'}; + push(@newlangs,$lang); + } else { + $loginhash{'login'}{'helpurl'}{$lang} = $domconfig{'login'}{'helpurl'}{$lang}; + } + } + } + unless (grep(/^nolang$/,@currlangs)) { + if ($env{'form.loginhelpurl_nolang.filename'}) { + $changes{'helpurl'}{'nolang'} = 1; + $newfile{'nolang'} = $env{'form.loginhelpurl_nolang.filename'}; + push(@newlangs,'nolang'); + } + } + if ($env{'form.loginhelpurl_add_lang'}) { + if ((defined($langchoices{$env{'form.loginhelpurl_add_lang'}})) && + ($env{'form.loginhelpurl_add_file.filename'})) { + $newfile{$env{'form.loginhelpurl_add_lang'}} = $env{'form.loginhelpurl_add_file.filename'}; + $addedfile = $env{'form.loginhelpurl_add_lang'}; + } + } + if ((@newlangs > 0) || ($addedfile)) { + my $error; + my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm); + if ($configuserok eq 'ok') { + if ($switchserver) { + $error = &mt("Upload of custom help file is not permitted to this server: [_1]",$switchserver); + } elsif ($author_ok eq 'ok') { + my @allnew = @newlangs; + if ($addedfile ne '') { + push(@allnew,$addedfile); + } + foreach my $lang (@allnew) { + my $formelem = 'loginhelpurl_'.$lang; + if ($lang eq $env{'form.loginhelpurl_add_lang'}) { + $formelem = 'loginhelpurl_add_file'; + } + (my $result,$newurl{$lang}) = &publishlogo($r,'upload',$formelem,$dom,$confname, + "help/$lang",'','',$newfile{$lang}); + if ($result eq 'ok') { + $loginhash{'login'}{'helpurl'}{$lang} = $newurl{$lang}; + $changes{'helpurl'}{$lang} = 1; + } else { + my $puberror = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$newfile{$lang},$result); + $errors .= '
  • '.$puberror.'
    • '; + if ((grep(/^\Q$lang\E$/,@currlangs)) && + (!grep(/^\Q$lang\E$/,@delurls))) { + $loginhash{'login'}{'helpurl'}{$lang} = $domconfig{'login'}{'helpurl'}{$lang}; + } + } + } + } else { + $error = &mt("Upload of custom log-in help file(s) failed because an author role could not be assigned to a Domain Configuration user ([_1]) in domain: [_2]. Error was: [_3].",$confname,$dom,$author_ok); + } + } else { + $error = &mt("Upload of custom log-in help file(s) failed because a Domain Configuration user ([_1]) could not be created in domain: [_2]. Error was: [_3].",$confname,$dom,$configuserok); + } + if ($error) { + &Apache::lonnet::logthis($error); + $errors .= '
  • '.$error.'
    • '; + } + } + + my (%currheadtagurls,%currexempt,@newhosts,%newheadtagurls,%possexempt); + if (ref($domconfig{'login'}) eq 'HASH') { + if (ref($domconfig{'login'}{'headtag'}) eq 'HASH') { + foreach my $lonhost (keys(%{$domconfig{'login'}{'headtag'}})) { + if ($domservers{$lonhost}) { + if (ref($domconfig{'login'}{'headtag'}{$lonhost}) eq 'HASH') { + $currheadtagurls{$lonhost} = $domconfig{'login'}{'headtag'}{$lonhost}{'url'}; + $currexempt{$lonhost} = $domconfig{'login'}{'headtagexempt'}{$lonhost}{'exempt'} + } + } + } + } + } + my @delheadtagurls = &Apache::loncommon::get_env_multiple('form.loginheadtag_del'); + foreach my $lonhost (sort(keys(%domservers))) { + if (grep(/^\Q$lonhost\E$/,@delheadtagurls)) { + $changes{'headtag'}{$lonhost} = 1; + } else { + if ($env{'form.loginheadtagexempt_'.$lonhost}) { + $possexempt{$lonhost} = &check_exempt_addresses($env{'form.loginheadtagexempt_'.$lonhost}); + } + if ($env{'form.loginheadtag_'.$lonhost.'.filename'}) { + push(@newhosts,$lonhost); + } elsif ($currheadtagurls{$lonhost}) { + $loginhash{'login'}{'headtag'}{$lonhost}{'url'} = $currheadtagurls{$lonhost}; + if ($currexempt{$lonhost}) { + if ((!exists($possexempt{$lonhost})) || ($possexempt{$lonhost} ne $currexempt{$lonhost})) { + $changes{'headtag'}{$lonhost} = 1; + } + } elsif ($possexempt{$lonhost}) { + $changes{'headtag'}{$lonhost} = 1; + } + if ($possexempt{$lonhost}) { + $loginhash{'login'}{'headtag'}{$lonhost}{'exempt'} = $possexempt{$lonhost}; + } + } + } + } + if (@newhosts) { + my $error; + my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm); + if ($configuserok eq 'ok') { + if ($switchserver) { + $error = &mt("Upload of custom markup is not permitted to this server: [_1]",$switchserver); + } elsif ($author_ok eq 'ok') { + foreach my $lonhost (@newhosts) { + my $formelem = 'loginheadtag_'.$lonhost; + (my $result,$newheadtagurls{$lonhost}) = &publishlogo($r,'upload',$formelem,$dom,$confname, + "login/headtag/$lonhost",'','', + $env{'form.loginheadtag_'.$lonhost.'.filename'}); + if ($result eq 'ok') { + $loginhash{'login'}{'headtag'}{$lonhost}{'url'} = $newheadtagurls{$lonhost}; + $changes{'headtag'}{$lonhost} = 1; + if ($possexempt{$lonhost}) { + $loginhash{'login'}{'headtag'}{$lonhost}{'exempt'} = $possexempt{$lonhost}; + } + } else { + my $puberror = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].", + $newheadtagurls{$lonhost},$result); + $errors .= '
  • '.$puberror.'
    • '; + if ((grep(/^\Q$lonhost\E$/,keys(%currheadtagurls))) && + (!grep(/^\Q$lonhost\E$/,@delheadtagurls))) { + $loginhash{'login'}{'headtag'}{$lonhost} = $currheadtagurls{$lonhost}; + } + } + } + } else { + $error = &mt("Upload of custom markup file(s) failed because an author role could not be assigned to a Domain Configuration user ([_1]) in domain: [_2]. Error was: [_3].",$confname,$dom,$author_ok); + } + } else { + $error = &mt("Upload of custom markup file(s) failed because a Domain Configuration user ([_1]) could not be created in domain: [_2]. Error was: [_3].",$confname,$dom,$configuserok); + } + if ($error) { + &Apache::lonnet::logthis($error); + $errors .= '
  • '.$error.'
    • '; + } + } + &process_captcha('login',\%changes,$loginhash{'login'},$domconfig{'login'}); + + my $defaulthelpfile = '/adm/loginproblems.html'; + my $defaulttext = &mt('Default in use'); + my $putresult = &Apache::lonnet::put_dom('configuration',\%loginhash, $dom); if ($putresult eq 'ok') { - if (($domconfig{'login'}{'coursecatalog'} eq '0') && - ($env{'form.coursecatalog'} eq '1')) { - $changes{'coursecatalog'} = 1; - } elsif (($domconfig{'login'}{'coursecatalog'} eq '' || - $domconfig{'login'}{'coursecatalog'} eq '1') && - ($env{'form.coursecatalog'} eq '0')) { - $changes{'coursecatalog'} = 1; - } - if (($domconfig{'login'}{'adminmail'} eq '1') && - ($env{'form.adminmail'} eq '0')) { - $changes{'adminmail'} = 1; - } elsif (($domconfig{'login'}{'adminmail'} eq '' || - $domconfig{'login'}{'adminmail'} eq '0') && - ($env{'form.adminmail'} eq '1')) { - $changes{'adminmail'} = 1; + my @toggles = ('coursecatalog','adminmail','helpdesk','newuser'); + my %defaultchecked = ( + 'coursecatalog' => 'on', + 'helpdesk' => '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) { + if (keys(%changes) > 0 || $colchgtext) { + &Apache::loncommon::devalidate_domconfig_cache($dom); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domainconfig'} = 1; + } $resulttext = &mt('Changes made:').'
      '; foreach my $item (sort(keys(%changes))) { - $resulttext .= '
    • '.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'
      • '; + 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 .= '
      • '; + } + } elsif ($item eq 'helpurl') { + if (ref($changes{$item}) eq 'HASH') { + foreach my $lang (sort(keys(%{$changes{$item}}))) { + if (grep(/^\Q$lang\E$/,@delurls)) { + my ($chg,$link); + $link = &Apache::loncommon::modal_link($defaulthelpfile,$defaulttext,600,500); + if ($lang eq 'nolang') { + $chg = &mt('custom log-in help file removed for no preferred language; [_1]',$link); + } else { + $chg = &mt('custom log-in help file removed for specific language: [_1]; [_2]',$langchoices{$lang},$link); + } + $resulttext .= '
    • '.$chg.'
      • '; + } else { + my $chg; + if ($lang eq 'nolang') { + $chg = &mt('custom log-in help file for no preferred language'); + } else { + $chg = &mt('custom log-in help file for specific language: [_1]',$langchoices{$lang}); + } + $resulttext .= '
    • '.&Apache::loncommon::modal_link( + $loginhash{'login'}{'helpurl'}{$lang}. + '?inhibitmenu=yes',$chg,600,500). + '
      • '; + } + } + } + } elsif ($item eq 'headtag') { + if (ref($changes{$item}) eq 'HASH') { + foreach my $lonhost (sort(keys(%{$changes{$item}}))) { + if (grep(/^\Q$lonhost\E$/,@delheadtagurls)) { + $resulttext .= '
    • '.&mt('custom markup file removed for [_1]',$domservers{$lonhost}).'
      • '; + } elsif (ref($loginhash{'login'}{'headtag'}{$lonhost}) eq 'HASH') { + $resulttext .= '
    • '.&mt('custom markup').' '.&mt('(for [_1])',$servers{$lonhost}).' '; + if ($possexempt{$lonhost}) { + $resulttext .= &mt('not included for client IP(s): [_1]',$possexempt{$lonhost}); + } else { + $resulttext .= &mt('included for any client IP'); + } + $resulttext .= '
      • '; + } + } + } + } elsif ($item eq 'captcha') { + if (ref($loginhash{'login'}) eq 'HASH') { + my $chgtxt; + if ($loginhash{'login'}{$item} eq 'notused') { + $chgtxt .= &mt('No CAPTCHA validation in use for helpdesk form.'); + } else { + my %captchas = &captcha_phrases(); + if ($captchas{$loginhash{'login'}{$item}}) { + $chgtxt .= &mt("Validation for helpdesk form set to $captchas{$loginhash{'login'}{$item}}."); + } else { + $chgtxt .= &mt('Validation for helpdesk form set to unknown type.'); + } + } + $resulttext .= '
    • '.$chgtxt.'
      • '; + } + } elsif ($item eq 'recaptchakeys') { + if (ref($loginhash{'login'}) eq 'HASH') { + my ($privkey,$pubkey); + if (ref($loginhash{'login'}{$item}) eq 'HASH') { + $pubkey = $loginhash{'login'}{$item}{'public'}; + $privkey = $loginhash{'login'}{$item}{'private'}; + } + my $chgtxt .= &mt('ReCAPTCHA keys changes').'
        '; + if (!$pubkey) { + $chgtxt .= '
      • '.&mt('Public key deleted').'
        • '; + } else { + $chgtxt .= '
      • '.&mt('Public key set to [_1]',$pubkey).'
        • '; + } + if (!$privkey) { + $chgtxt .= '
      • '.&mt('Private key deleted').'
        • '; + } else { + $chgtxt .= '
      • '.&mt('Private key set to [_1]',$privkey).'
        • '; + } + $chgtxt .= '
      '; + $resulttext .= '
    • '.$chgtxt.'
      • '; + } + } else { + $resulttext .= '
    • '.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'
      • '; + } } - $resulttext .= '
    '; + $resulttext .= $colchgtext.''; } else { $resulttext = &mt('No changes made to log-in page settings'); } } else { - $resulttext = &mt('An error occurred: [_1]',$putresult); + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + if ($errors) { + $resulttext .= '
    '.&mt('The following errors occurred: ').'
      '. + $errors.'
    '; + } + return $resulttext; +} + + +sub check_exempt_addresses { + my ($iplist) = @_; + $iplist =~ s/^\s+//; + $iplist =~ s/\s+$//; + my @poss_ips = split(/\s*[,:]\s*/,$iplist); + my (@okips,$new); + 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 = ''; + } + return $new; +} + +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,$lastactref,%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); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domainconfig'} = 1; + } + $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; + my %defaults; + foreach my $role (@{$roles}) { + if ($role eq 'login') { + %choices = &login_choices(); + @logintext = ('textcol','bgcol'); + } else { + %choices = &color_font_choices(); + } + if ($role eq 'login') { + @images = ('img','logo','domlogo','login'); + @bgs = ('pgbg','mainbg','sidebg'); + } else { + @images = ('img'); + @bgs = ('pgbg','tabbg','sidebg'); + } + my %defaults = &role_defaults($role,\@bgs,\@links,\@images,\@logintext); + unless ($env{'form.'.$role.'_font'} eq $defaults{'font'}) { + $confhash->{$role}{'font'} = $env{'form.'.$role.'_font'}; + } + if ($role eq 'login') { + foreach my $item (@logintext) { + $env{'form.'.$role.'_'.$item} = lc($env{'form.'.$role.'_'.$item}); + if ($env{'form.'.$role.'_'.$item} =~ /^\w+/) { + $env{'form.'.$role.'_'.$item} = '#'.$env{'form.'.$role.'_'.$item}; + } + unless ($env{'form.'.$role.'_'.$item} eq lc($defaults{'logintext'}{$item})) { + $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item}; + } + } + } else { + $env{'form.'.$role.'_fontmenu'} = lc($env{'form.'.$role.'_fontmenu'}); + if ($env{'form.'.$role.'_fontmenu'} =~ /^\w+/) { + $env{'form.'.$role.'_fontmenu'} = '#'.$env{'form.'.$role.'_fontmenu'}; + } + unless($env{'form.'.$role.'_fontmenu'} eq lc($defaults{'fontmenu'})) { + $confhash->{$role}{'fontmenu'} = $env{'form.'.$role.'_fontmenu'}; + } + } + foreach my $item (@bgs) { + $env{'form.'.$role.'_'.$item} = lc($env{'form.'.$role.'_'.$item}); + if ($env{'form.'.$role.'_'.$item} =~ /^\w+/) { + $env{'form.'.$role.'_'.$item} = '#'.$env{'form.'.$role.'_'.$item}; + } + unless ($env{'form.'.$role.'_'.$item} eq lc($defaults{'bgs'}{$item})) { + $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item}; + } + } + foreach my $item (@links) { + $env{'form.'.$role.'_'.$item} = lc($env{'form.'.$role.'_'.$item}); + if ($env{'form.'.$role.'_'.$item} =~ /^\w+/) { + $env{'form.'.$role.'_'.$item} = '#'.$env{'form.'.$role.'_'.$item}; + } + unless ($env{'form.'.$role.'_'.$item} eq lc($defaults{'links'}{$item})) { + $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 $docroot=$r->dir_config('lonDocRoot'); + my $filepath="$docroot/priv"; + my $relpath = "$dom/$confname"; + my ($fnamepath,$file,$fetchthumb); + $file=$fname; + if ($fname=~m|/|) { + ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|); + } + my @parts=split(/\//,"$filepath/$relpath/$fnamepath"); + my $count; + for ($count=5;$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 internal 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('Filename 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('Filename 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 Authoring 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 $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,%domconfig) = @_; - my ($resulttext,%changes); - my ($usertypes,$order) = - &Apache::lonnet::retrieve_inst_usertypes($dom); - my %formhash; + my ($r,$dom,$action,$lastactref,%domconfig) = @_; + my ($context,@usertools,@options,%validations,%titles,%confhash,%toolshash, + %limithash,$toolregexp,%conditions,$resulttext,%changes,$confname,$configuserok, + $author_ok,$switchserver,$errors,$validationitemsref,$validationnamesref, + $validationfieldsref); + if ($action eq 'quotas') { + $context = 'tools'; + } else { + $context = $action; + } + if ($context eq 'requestcourses') { + @usertools = ('official','unofficial','community','textbook'); + @options =('norequest','approval','validate','autolimit'); + %validations = &Apache::lonnet::auto_courserequest_checks($dom); + %titles = &courserequest_titles(); + $toolregexp = join('|',@usertools); + %conditions = &courserequest_conditions(); + $confname = $dom.'-domainconfig'; + my $servadm = $r->dir_config('lonAdmEMail'); + ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm); + ($validationitemsref,$validationnamesref,$validationfieldsref) = + &Apache::loncoursequeueadmin::requestcourses_validation_types(); + } elsif ($context eq 'requestauthor') { + @usertools = ('author'); + %titles = &authorrequest_titles(); + } else { + @usertools = ('aboutme','blog','webdav','portfolio'); + %titles = &tool_titles(); + } + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); + my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); foreach my $key (keys(%env)) { - if ($key =~ /^form\.quota_(.+)$/) { - $formhash{$1} = $env{$key}; + 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}; + } + } + } elsif ($context eq 'requestauthor') { + if ($key =~ /^\Qform.authorreq_\E(.+)$/) { + $confhash{$1} = $env{$key}; + } + } else { + if ($key =~ /^form\.quota_(.+)$/) { + $confhash{'defaultquota'}{$1} = $env{$key}; + } elsif ($key =~ /^form\.authorquota_(.+)$/) { + $confhash{'authorquota'}{$1} = $env{$key}; + } elsif ($key =~ /^form\.\Q$context\E_(.+)$/) { + @{$toolshash{$1}} = &Apache::loncommon::get_env_multiple($key); + } } } - if (ref($domconfig{'quotas'}) eq 'HASH') { - foreach my $key (keys(%{$domconfig{'quotas'}})) { - if (exists($formhash{$key})) { - if ($formhash{$key} ne $domconfig{'quotas'}{$key}) { - $changes{$key} = 1; + if (($context eq 'requestcourses') || ($context eq 'requestauthor')) { + my @approvalnotify = &Apache::loncommon::get_env_multiple('form.'.$context.'notifyapproval'); + @approvalnotify = sort(@approvalnotify); + $confhash{'notify'}{'approval'} = join(',',@approvalnotify); + my @crstypes = ('official','unofficial','community','textbook'); + my @hasuniquecode = &Apache::loncommon::get_env_multiple('form.uniquecode'); + foreach my $type (@hasuniquecode) { + if (grep(/^\Q$type\E$/,@crstypes)) { + $confhash{'uniquecode'}{$type} = 1; + } + } + my (%newbook,%allpos); + if ($context eq 'requestcourses') { + foreach my $type ('textbooks','templates') { + @{$allpos{$type}} = (); + my $invalid; + if ($type eq 'textbooks') { + $invalid = &mt('Invalid LON-CAPA course for textbook'); + } else { + $invalid = &mt('Invalid LON-CAPA course for template'); + } + if ($env{'form.'.$type.'_addbook'}) { + if (($env{'form.'.$type.'_addbook_cnum'} =~ /^$match_courseid$/) && + ($env{'form.'.$type.'_addbook_cdom'} =~ /^$match_domain$/)) { + if (&Apache::lonnet::homeserver($env{'form.'.$type.'_addbook_cnum'}, + $env{'form.'.$type.'_addbook_cdom'}) eq 'no_host') { + $errors .= '
  • '.$invalid.'
    • '; + } else { + $newbook{$type} = $env{'form.'.$type.'_addbook_cdom'}.'_'.$env{'form.'.$type.'_addbook_cnum'}; + my $position = $env{'form.'.$type.'_addbook_pos'}; + $position =~ s/\D+//g; + if ($position ne '') { + $allpos{$type}[$position] = $newbook{$type}; + } + } + } else { + $errors .= '
  • '.$invalid.'
    • '; + } + } + } + } + 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; + } + } + if (ref($domconfig{$action}{'uniquecode'}) eq 'HASH') { + if (ref($confhash{'uniquecode'}) eq 'HASH') { + foreach my $crstype (keys(%{$domconfig{$action}{'uniquecode'}})) { + unless ($confhash{'uniquecode'}{$crstype}) { + $changes{'uniquecode'} = 1; + } + } + unless ($changes{'uniquecode'}) { + foreach my $crstype (keys(%{$confhash{'uniquecode'}})) { + unless ($domconfig{$action}{'uniquecode'}{$crstype}) { + $changes{'uniquecode'} = 1; + } + } + } + } else { + $changes{'uniquecode'} = 1; + } + } elsif (ref($confhash{'uniquecode'}) eq 'HASH') { + $changes{'uniquecode'} = 1; + } + if ($context eq 'requestcourses') { + foreach my $type ('textbooks','templates') { + if (ref($domconfig{$action}{$type}) eq 'HASH') { + my %deletions; + my @todelete = &Apache::loncommon::get_env_multiple('form.'.$type.'_del'); + if (@todelete) { + map { $deletions{$_} = 1; } @todelete; + } + my %imgdeletions; + my @todeleteimages = &Apache::loncommon::get_env_multiple('form.'.$type.'_image_del'); + if (@todeleteimages) { + map { $imgdeletions{$_} = 1; } @todeleteimages; + } + my $maxnum = $env{'form.'.$type.'_maxnum'}; + for (my $i=0; $i<=$maxnum; $i++) { + my $itemid = $env{'form.'.$type.'_id_'.$i}; + my ($key) = ($itemid =~ /^\Q$type\E_(\w+)$/); + if (ref($domconfig{$action}{$type}{$key}) eq 'HASH') { + if ($deletions{$key}) { + if ($domconfig{$action}{$type}{$key}{'image'}) { + #FIXME need to obsolete item in RES space + } + next; + } else { + my $newpos = $env{'form.'.$itemid}; + $newpos =~ s/\D+//g; + foreach my $item ('subject','title','publisher','author') { + next if ((($item eq 'author') || ($item eq 'publisher')) && + ($type eq 'templates')); + $confhash{$type}{$key}{$item} = $env{'form.'.$type.'_'.$item.'_'.$i}; + if ($domconfig{$action}{$type}{$key}{$item} ne $confhash{$type}{$key}{$item}) { + $changes{$type}{$key} = 1; + } + } + $allpos{$type}[$newpos] = $key; + } + if ($imgdeletions{$key}) { + $changes{$type}{$key} = 1; + #FIXME need to obsolete item in RES space + } elsif ($env{'form.'.$type.'_image_'.$i.'.filename'}) { + my ($cdom,$cnum) = split(/_/,$key); + my ($imgurl,$error) = &process_textbook_image($r,$dom,$confname,$type.'_image_'.$i, + $cdom,$cnum,$type,$configuserok, + $switchserver,$author_ok); + if ($imgurl) { + $confhash{$type}{$key}{'image'} = $imgurl; + $changes{$type}{$key} = 1; + } + if ($error) { + &Apache::lonnet::logthis($error); + $errors .= '
  • '.$error.'
    • '; + } + } elsif ($domconfig{$action}{$type}{$key}{'image'}) { + $confhash{$type}{$key}{'image'} = + $domconfig{$action}{$type}{$key}{'image'}; + } + } + } + } + } + } + } else { + if ($confhash{'notify'}{'approval'}) { + $changes{'notify'}{'approval'} = 1; + } + if (ref($confhash{'uniquecode'} eq 'HASH')) { + $changes{'uniquecode'} = 1; + } + } + if ($context eq 'requestcourses') { + foreach my $type ('textbooks','templates') { + if ($newbook{$type}) { + $changes{$type}{$newbook{$type}} = 1; + foreach my $item ('subject','title','publisher','author') { + next if ((($item eq 'author') || ($item eq 'publisher')) && + ($type eq 'template')); + $env{'form.'.$type.'_addbook_'.$item} =~ s/(`)/'/g; + if ($env{'form.'.$type.'_addbook_'.$item}) { + $confhash{$type}{$newbook{$type}}{$item} = $env{'form.'.$type.'_addbook_'.$item}; + } + } + if ($type eq 'textbooks') { + if ($env{'form.'.$type.'_addbook_image.filename'} ne '') { + my ($cdom,$cnum) = split(/_/,$newbook{$type}); + my ($imageurl,$error) = + &process_textbook_image($r,$dom,$confname,$type.'_addbook_image',$cdom,$cnum,$type, + $configuserok,$switchserver,$author_ok); + if ($imageurl) { + $confhash{$type}{$newbook{$type}}{'image'} = $imageurl; + } + if ($error) { + &Apache::lonnet::logthis($error); + $errors .= '
  • '.$error.'
    • '; + } + } + } + } + if (@{$allpos{$type}} > 0) { + my $idx = 0; + foreach my $item (@{$allpos{$type}}) { + if ($item ne '') { + $confhash{$type}{$item}{'order'} = $idx; + if (ref($domconfig{$action}) eq 'HASH') { + if (ref($domconfig{$action}{$type}) eq 'HASH') { + if (ref($domconfig{$action}{$type}{$item}) eq 'HASH') { + if ($domconfig{$action}{$type}{$item}{'order'} ne $idx) { + $changes{$type}{$item} = 1; + } + } + } + } + $idx ++; + } + } + } + } + if (ref($validationitemsref) eq 'ARRAY') { + foreach my $item (@{$validationitemsref}) { + if ($item eq 'fields') { + my @changed; + @{$confhash{'validation'}{$item}} = &Apache::loncommon::get_env_multiple('form.requestcourses_validation_'.$item); + if (@{$confhash{'validation'}{$item}} > 0) { + @{$confhash{'validation'}{$item}} = sort(@{$confhash{'validation'}{$item}}); + } + if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') { + if (ref($domconfig{'requestcourses'}{'validation'}{$item}) eq 'ARRAY') { + @changed = &Apache::loncommon::compare_arrays($confhash{'validation'}{$item}, + $domconfig{'requestcourses'}{'validation'}{$item}); + } else { + @changed = @{$confhash{'validation'}{$item}}; + } + } else { + @changed = @{$confhash{'validation'}{$item}}; + } + if (@changed) { + if ($confhash{'validation'}{$item}) { + $changes{'validation'}{$item} = join(', ',@{$confhash{'validation'}{$item}}); + } else { + $changes{'validation'}{$item} = &mt('None'); + } + } + } else { + $confhash{'validation'}{$item} = $env{'form.requestcourses_validation_'.$item}; + if ($item eq 'markup') { + if ($env{'form.requestcourses_validation_'.$item}) { + $env{'form.requestcourses_validation_'.$item} =~ s/[\n\r\f]+/\s/gs; + } + } + if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') { + if ($domconfig{'requestcourses'}{'validation'}{$item} ne $confhash{'validation'}{$item}) { + $changes{'validation'}{$item} = $confhash{'validation'}{$item}; + } + } else { + if ($confhash{'validation'}{$item} ne '') { + $changes{'validation'}{$item} = $confhash{'validation'}{$item}; + } + } + } + } + } + if ($env{'form.validationdc'}) { + my $newval = $env{'form.validationdc'}; + my %domcoords = &get_active_dcs($dom); + if (exists($domcoords{$newval})) { + $confhash{'validation'}{'dc'} = $newval; + } + } + if (ref($confhash{'validation'}) eq 'HASH') { + if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') { + if ($domconfig{'requestcourses'}{'validation'}{'dc'}) { + unless ($confhash{'validation'}{'dc'} eq $domconfig{'requestcourses'}{'validation'}{'dc'}) { + if ($confhash{'validation'}{'dc'} eq '') { + $changes{'validation'}{'dc'} = &mt('None'); + } else { + $changes{'validation'}{'dc'} = $confhash{'validation'}{'dc'}; + } + } + } elsif ($confhash{'validation'}{'dc'} ne '') { + $changes{'validation'}{'dc'} = $confhash{'validation'}{'dc'}; + } + } elsif ($confhash{'validation'}{'dc'} ne '') { + $changes{'validation'}{'dc'} = $confhash{'validation'}{'dc'}; + } + } elsif (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') { + if ($domconfig{'requestcourses'}{'validation'}{'dc'}) { + $changes{'validation'}{'dc'} = &mt('None'); + } + } + } + } else { + $confhash{'defaultquota'}{'default'} = $env{'form.defaultquota'}; + $confhash{'authorquota'}{'default'} = $env{'form.authorquota'}; + } + 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}; + } + } + } elsif ($context eq 'requestauthor') { + $unset = '0'; + if ($type eq '_LC_adv') { + $unset = ''; + } + } else { + if (grep(/^\Q$type\E$/,@{$toolshash{$item}})) { + $confhash{$item}{$type} = 1; + } else { + $confhash{$item}{$type} = 0; + } + } + if (ref($domconfig{$action}) eq 'HASH') { + if ($action eq 'requestauthor') { + if ($domconfig{$action}{$type} ne $confhash{$type}) { + $changes{$type} = 1; + } + } elsif (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; + } + } elsif ($context eq 'requestauthor') { + if ($confhash{$type} ne $unset) { + $changes{$type} = 1; + } + } else { + if (!$confhash{$item}{$type}) { + $changes{$item}{$type} = 1; + } + } + } + } + } + unless (($context eq 'requestcourses') || ($context eq 'requestauthor')) { + 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 { - $formhash{$key} = $domconfig{'quotas'}{$key}; + 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($domconfig{'quotas'}{'authorquota'}) eq 'HASH') { + foreach my $key (keys(%{$domconfig{'quotas'}{'authorquota'}})) { + if (exists($confhash{'authorquota'}{$key})) { + if ($confhash{'authorquota'}{$key} ne $domconfig{'quotas'}{'authorquota'}{$key}) { + $changes{'authorquota'}{$key} = 1; + } + } else { + $confhash{'authorquota'}{$key} = $domconfig{'quotas'}{'authorquota'}{$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; + } + } + } + if (ref($confhash{'authorquota'}) eq 'HASH') { + foreach my $key (keys(%{$confhash{'authorquota'}})) { + if (ref($domconfig{'quotas'}) eq 'HASH') { + if (ref($domconfig{'quotas'}{'authorquota'}) eq 'HASH') { + if (!exists($domconfig{'quotas'}{'authorquota'}{$key})) { + $changes{'authorquota'}{$key} = 1; + } + } else { + $changes{'authorquota'}{$key} = 1; + } + } else { + $changes{'authorquota'}{$key} = 1; + } } } } - foreach my $key (keys(%formhash)) { - if ($formhash{$key} ne '') { - if (!exists($domconfig{'quotas'}{$key})) { - $changes{$key} = 1; + + if ($context eq 'requestauthor') { + $domdefaults{'requestauthor'} = \%confhash; + } else { + foreach my $key (keys(%confhash)) { + unless (($context eq 'requestcourses') && (($key eq 'textbooks') || ($key eq 'templates'))) { + $domdefaults{$key} = $confhash{$key}; } } } + my %quotahash = ( - quotas => {%formhash}, + $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); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domdefaults'} = 1; + } $resulttext = &mt('Changes made:').'
      '; - foreach my $item (sort(keys(%changes))) { - $resulttext .= '
    • '.&mt('[_1] set to [_2] Mb',$usertypes->{$item},$formhash{$item}).'
      • '; + unless (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { + 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 .= '
      • '; + } + if (ref($changes{'authorquota'}) eq 'HASH') { + $resulttext .= '
    • '.&mt('Authoring Space default quotas').'
        '; + foreach my $type (@{$types},'default') { + if (defined($changes{'authorquota'}{$type})) { + my $typetitle = $usertypes->{$type}; + if ($type eq 'default') { + $typetitle = $othertitle; + } + $resulttext .= '
      • '.&mt('[_1] set to [_2] MB',$typetitle,$confhash{'authorquota'}{$type}).'
        • '; + } + } + $resulttext .= '
      • '; + } + } + my %newenv; + foreach my $item (@usertools) { + my (%haschgs,%inconf); + if ($context eq 'requestauthor') { + %haschgs = %changes; + %inconf = %confhash; + } else { + if (ref($changes{$item}) eq 'HASH') { + %haschgs = %{$changes{$item}}; + } + if (ref($confhash{$item}) eq 'HASH') { + %inconf = %{$confhash{$item}}; + } + } + if (keys(%haschgs) > 0) { + my $newacc = + &Apache::lonnet::usertools_access($env{'user.name'}, + $env{'user.domain'}, + $item,'reload',$context); + if (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { + 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; + } + } + unless ($context eq 'requestauthor') { + $resulttext .= '
    • '.$titles{$item}.'
        '; + } + foreach my $type (@{$types},'default','_LC_adv') { + if ($haschgs{$type}) { + my $typetitle = $usertypes->{$type}; + if ($type eq 'default') { + $typetitle = $othertitle; + } elsif ($type eq '_LC_adv') { + $typetitle = 'LON-CAPA Advanced Users'; + } + if ($inconf{$type}) { + if ($context eq 'requestcourses') { + my $cond; + if ($inconf{$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{$inconf{$type}}; + } + $resulttext .= '
      • '.&mt('Set to be available to [_1].',$typetitle).' '.$cond.'
        • '; + } elsif ($context eq 'requestauthor') { + $resulttext .= '
      • '.&mt('Set to "[_1]" for "[_2]".', + $titles{$inconf{$type}},$typetitle); + + } else { + $resulttext .= '
      • '.&mt('Set to be available to [_1]',$typetitle).'
        • '; + } + } else { + if ($type eq '_LC_adv') { + if ($inconf{$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).'
        • '; + } + } + } + } + unless ($context eq 'requestauthor') { + $resulttext .= '
      • '; + } + } + } + if (($action eq 'requestcourses') || ($action eq 'requestauthor')) { + 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 requests requiring approval.').'
      • '; + } + } + } + } + } + if ($action eq 'requestcourses') { + my @offon = ('off','on'); + if ($changes{'uniquecode'}) { + if (ref($confhash{'uniquecode'}) eq 'HASH') { + my $codestr = join(' ',map{ &mt($_); } sort(keys(%{$confhash{'uniquecode'}}))); + $resulttext .= '
    • '. + &mt('Generation of six character code as course identifier for distribution to students set to on for: [_1].',''.$codestr.''). + '
      • '; + } else { + $resulttext .= '
    • '.&mt('Generation of six character code as course identifier for distribution to students set to off.'). + '
      • '; + } + } + foreach my $type ('textbooks','templates') { + if (ref($changes{$type}) eq 'HASH') { + $resulttext .= '
    • '.&mt("Available $type updated").'
        '; + foreach my $key (sort(keys(%{$changes{$type}}))) { + my %coursehash = &Apache::lonnet::coursedescription($key); + my $coursetitle = $coursehash{'description'}; + my $position = $confhash{$type}{$key}{'order'} + 1; + $resulttext .= '
      • '; + foreach my $item ('subject','title','publisher','author') { + next if ((($item eq 'author') || ($item eq 'publisher')) && + ($type eq 'templates')); + my $name = $item.':'; + $name =~ s/^(\w)/\U$1/; + $resulttext .= &mt($name).' '.$confhash{$type}{$key}{$item}.'
        '; + } + $resulttext .= ' '.&mt('Order: [_1]',$position).'
        '; + if ($type eq 'textbooks') { + if ($confhash{$type}{$key}{'image'}) { + $resulttext .= ' '.&mt('Image: [_1]', + 'Textbook cover').'
        '; + } + } + $resulttext .= ' '.&mt('LON-CAPA Course: [_1]',$coursetitle).'
        • '; + } + $resulttext .= '
      • '; + } + } + if (ref($changes{'validation'}) eq 'HASH') { + if ((ref($validationitemsref) eq 'ARRAY') && (ref($validationnamesref) eq 'HASH')) { + $resulttext .= '
    • '.&mt('Validation of courses/communities updated').'
        '; + foreach my $item (@{$validationitemsref}) { + if (exists($changes{'validation'}{$item})) { + if ($item eq 'markup') { + $resulttext .= '
      • '.&mt('[_1] set to: [_2]',$validationnamesref->{$item}, + '
        '.$changes{'validation'}{$item}.'
        ').'
        • '; + } else { + $resulttext .= '
      • '.&mt('[_1] set to: [_2]',$validationnamesref->{$item}, + ''.$changes{'validation'}{$item}.'').'
        • '; + } + } + } + if (exists($changes{'validation'}{'dc'})) { + $resulttext .= '
      • '.&mt('Validated course requests identified as processed by: [_1]', + ''.$changes{'validation'}{'dc'}.'').'
        • '; + } + } + } } $resulttext .= '
      '; + if (keys(%newenv)) { + &Apache::lonnet::appenv(\%newenv); + } } else { - $resulttext = &mt('No changes made to default quotas'); + if ($context eq 'requestcourses') { + $resulttext = &mt('No changes made to rights to request creation of courses.'); + } elsif ($context eq 'requestauthor') { + $resulttext = &mt('No changes made to rights to request author space.'); + } 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); + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + if ($errors) { + $resulttext .= '

      '.&mt('The following errors occurred when modifying Textbook settings.'). + '

        '.$errors.'

      '; } return $resulttext; } +sub process_textbook_image { + my ($r,$dom,$confname,$caller,$cdom,$cnum,$type,$configuserok,$switchserver,$author_ok) = @_; + my $filename = $env{'form.'.$caller.'.filename'}; + my ($error,$url); + my ($width,$height) = (50,50); + if ($configuserok eq 'ok') { + if ($switchserver) { + $error = &mt('Upload of textbook image is not permitted to this server: [_1]', + $switchserver); + } elsif ($author_ok eq 'ok') { + my ($result,$imageurl) = + &publishlogo($r,'upload',$caller,$dom,$confname, + "$type/$dom/$cnum/cover",$width,$height); + if ($result eq 'ok') { + $url = $imageurl; + } else { + $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$filename,$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].",$filename,$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].",$filename,$confname,$dom,$configuserok); + } + return ($url,$error); +} + sub modify_autoenroll { - my ($dom,%domconfig) = @_; + my ($dom,$lastactref,%domconfig) = @_; my ($resulttext,%changes); my %currautoenroll; if (ref($domconfig{'autoenroll'}) eq 'HASH') { @@ -601,13 +7809,22 @@ sub modify_autoenroll { } my $autorun = &Apache::lonnet::auto_run(undef,$dom), my %title = ( run => 'Auto-enrollment active', - sender => 'Sender for notification messages'); + 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 => $env{'form.sender_uname'}, - sender_domain => $env{'form.sender_domain'}, - + 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, @@ -619,37 +7836,48 @@ sub modify_autoenroll { } } elsif ($autorun) { if ($env{'form.autoenroll_run'} ne '1') { - $changes{'run'} = 1; + $changes{'run'} = 1; } } - if (exists($currautoenroll{sender_uname})) { - if ($currautoenroll{'sender_uname'} ne $env{'form.sender_uname'}) { - $changes{'sender'} = 1; - } - } else { + if ($currautoenroll{'sender_uname'} ne $sender_uname) { $changes{'sender'} = 1; } - if (exists($currautoenroll{sender_domain})) { - if ($currautoenroll{'sender_domain'} ne $env{'form.sender_domain'}) { - $changes{'sender'} = 1; - } - } else { + 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'}) { - $resulttext .= '
      • '.&mt("$title{'sender'} set to [_1]",$env{'form.sender_uname'}.':'.$env{'form.sender_domain'}).'
        • '; + 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); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domainconfig'} = 1; + } } $resulttext .= '
      '; } else { $resulttext = &mt('No changes made to auto-enrollment settings'); } } else { - $resulttext = &mt('An error occurred: [_1]',$putresult); + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } @@ -667,28 +7895,50 @@ sub modify_autoupdate { run => 'Auto-update:', classlists => 'Updates to user information in classlists?' ); - my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); + my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); my %fieldtitles = &Apache::lonlocal::texthash ( id => 'Student/Employee ID', - email => 'E-mail address', + permanentemail => 'E-mail address', lastname => 'Last Name', firstname => 'First Name', middlename => 'Middle Name', - gen => 'Generation', + generation => 'Generation', ); - my $othertitle = &mt('All users'); + $othertitle = &mt('All users'); if (keys(%{$usertypes}) > 0) { - $othertitle = "Other users"; + $othertitle = &mt('Other users'); } foreach my $key (keys(%env)) { if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) { - push(@{$fields{$1}},$2); + 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)) { @@ -700,33 +7950,66 @@ sub modify_autoupdate { } } elsif ($key eq 'fields') { if (ref($currautoupdate{$key}) eq 'HASH') { - foreach my $item (keys(%{$currautoupdate{$key}})) { + foreach my $item (@{$types},'default') { if (ref($currautoupdate{$key}{$item}) eq 'ARRAY') { my $change = 0; foreach my $type (@{$currautoupdate{$key}{$item}}) { if (!exists($fields{$item})) { $change = 1; + last; } elsif (ref($fields{$item}) eq 'ARRAY') { - if (!grep/^\Q$type\E$/,@{$fields{$item}}) { + 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; } } } } - foreach my $key (keys(%fields)) { - if (ref($currautoupdate{'fields'}) eq 'HASH') { - if (!exists($currautoupdate{'fields'}{$key})) { - push(@{$changes{'fields'}},$key); + 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); } - } else { - push(@{$changes{'fields'}},$key); } } my $putresult = &Apache::lonnet::put_dom('configuration',\%updatehash, @@ -735,7 +8018,17 @@ sub modify_autoupdate { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
        '; foreach my $key (sort(keys(%changes))) { - if (ref($changes{$key}) eq 'ARRAY') { + 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}}) { @@ -746,11 +8039,11 @@ sub modify_autoupdate { $newvaluestr = join(', ',@newvalues); } else { $newvaluestr = &mt('none'); - } + } if ($item eq 'default') { - $resulttext .= '
      • '.&mt("Updates for $othertitle set to: [_1]",$newvaluestr).'
        • '; + $resulttext .= '
      • '.&mt("Updates for '[_1]' set to: '[_2]'",$othertitle,$newvaluestr).'
        • '; } else { - $resulttext .= '
      • '.&mt("Updates for [_1] set to: [_2]",$usertypes->{$item},$newvaluestr).'
        • '; + $resulttext .= '
      • '.&mt("Updates for '[_1]' set to: '[_2]'",$usertypes->{$item},$newvaluestr).'
        • '; } } } else { @@ -768,10 +8061,4043 @@ sub modify_autoupdate { $resulttext = &mt('No changes made to autoupdates'); } } else { - $resulttext = &mt('An error occurred: [_1]',$putresult); + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } -1; +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.'').'
          • '; + } + $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,$lastactref,%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','updatesmail','idconflictsmail'); + my @toggles = ('reporterrors','reportupdates'); + 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}; + } + foreach my $item (@toggles) { + if ($env{'form.'.$item} =~ /^(0|1)$/) { + $contacts_hash{'contacts'}{$item} = $env{'form.'.$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'; + $default{'updatesmail'} = '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'); + } + } + } + } + foreach my $item (@toggles) { + if (($env{'form.'.$item} == 1) && ($currsetting{$item} == 0)) { + $changes{$item} = 1; + } elsif ((!$env{'form.'.$item}) && + (($currsetting{$item} eq '') || ($currsetting{$item} == 1))) { + $changes{$item} = 1; + } + } + my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash, + $dom); + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + &Apache::loncommon::devalidate_domconfig_cache($dom); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domainconfig'} = 1; + } + 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 .= '
          • '; + } + } + my @offon = ('off','on'); + if ($changes{'reporterrors'}) { + $resulttext .= '
        • '. + &mt('E-mail error reports to [_1] set to "'. + $offon[$env{'form.reporterrors'}].'".', + &Apache::loncommon::modal_link('http://loncapa.org/core.html', + &mt('LON-CAPA core group - MSU'),600,500)). + '
          • '; + } + if ($changes{'reportupdates'}) { + $resulttext .= '
        • '. + &mt('E-mail record of completed LON-CAPA updates to [_1] set to "'. + $offon[$env{'form.reportupdates'}].'".', + &Apache::loncommon::modal_link('http://loncapa.org/core.html', + &mt('LON-CAPA core group - MSU'),600,500)). + '
          • '; + } + $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,%save_usercreate); + my $warningmsg; + if (ref($domconfig{'usercreation'}) eq 'HASH') { + foreach my $key (keys(%{$domconfig{'usercreation'}})) { + if ($key eq 'cancreate') { + if (ref($domconfig{'usercreation'}{$key}) eq 'HASH') { + foreach my $item (keys(%{$domconfig{'usercreation'}{$key}})) { + if (($item eq 'selfcreate') || ($item eq 'statustocreate') || + ($item eq 'captcha') || ($item eq 'recaptchakeys')) { + $save_usercreate{$key}{$item} = $domconfig{'usercreation'}{$key}{$item}; + } else { + $curr_usercreation{$key}{$item} = $domconfig{'usercreation'}{$key}{$item}; + } + } + } + } elsif ($key eq 'email_rule') { + $save_usercreate{$key} = $domconfig{'usercreation'}{$key}; + } else { + $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 @contexts = ('author','course','requestcrs'); + foreach my $item(@contexts) { + $cancreate{$item} = $env{'form.can_createuser_'.$item}; + } + if (ref($curr_usercreation{'cancreate'}) eq 'HASH') { + foreach my $item (@contexts) { + 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); + } + + 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); + } + } + + $save_usercreate{'cancreate'}{'course'} = $cancreate{'course'}; + $save_usercreate{'cancreate'}{'author'} = $cancreate{'author'}; + $save_usercreate{'cancreate'}{'requestcrs'} = $cancreate{'requestcrs'}; + $save_usercreate{'id_rule'} = \@id_rule; + $save_usercreate{'username_rule'} = \@username_rule, + $save_usercreate{'authtypes'} = \%authhash; + + my %usercreation_hash = ( + usercreation => \%save_usercreate, + ); + + my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash, + $dom); + + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + $resulttext = &mt('Changes made:').'
          '; + if (ref($changes{'cancreate'}) eq 'ARRAY') { + my %lt = &usercreation_types(); + foreach my $type (@{$changes{'cancreate'}}) { + my $chgtext = $lt{$type}.', '; + 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.').'
          • '; + } + } + 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_selfcreation { + my ($dom,%domconfig) = @_; + my ($resulttext,$warningmsg,%curr_usercreation,%curr_usermodify,%changes,%cancreate); + my (%save_usercreate,%save_usermodify); + my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); + if (ref($types) eq 'ARRAY') { + $usertypes->{'default'} = $othertitle; + push(@{$types},'default'); + } +# +# Retrieve current domain configuration for self-creation of usernames from $domconfig{'usercreation'}. +# + if (ref($domconfig{'usercreation'}) eq 'HASH') { + foreach my $key (keys(%{$domconfig{'usercreation'}})) { + if ($key eq 'cancreate') { + if (ref($domconfig{'usercreation'}{$key}) eq 'HASH') { + foreach my $item (keys(%{$domconfig{'usercreation'}{$key}})) { + if (($item eq 'selfcreate') || ($item eq 'statustocreate') || + ($item eq 'captcha') || ($item eq 'recaptchakeys') || + ($item eq 'emailusername') || ($item eq 'notify') || + ($item eq 'selfcreateprocessing') || ($item eq 'shibenv')) { + $curr_usercreation{$key}{$item} = $domconfig{'usercreation'}{$key}{$item}; + } else { + $save_usercreate{$key}{$item} = $domconfig{'usercreation'}{$key}{$item}; + } + } + } + } elsif ($key eq 'email_rule') { + $curr_usercreation{$key} = $domconfig{'usercreation'}{$key}; + } else { + $save_usercreate{$key} = $domconfig{'usercreation'}{$key}; + } + } + } +# +# Retrieve current domain configuration for self-creation of usernames from $domconfig{'usermodification'}. +# + if (ref($domconfig{'usermodification'}) eq 'HASH') { + foreach my $key (keys(%{$domconfig{'usermodification'}})) { + if ($key eq 'selfcreate') { + $curr_usermodify{$key} = $domconfig{'usermodification'}{$key}; + } else { + $save_usermodify{$key} = $domconfig{'usermodification'}{$key}; + } + } + } + + my @contexts = ('selfcreate'); + @{$cancreate{'selfcreate'}} = (); + %{$cancreate{'emailusername'}} = (); + @{$cancreate{'statustocreate'}} = (); + %{$cancreate{'selfcreateprocessing'}} = (); + %{$cancreate{'shibenv'}} = (); + 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 username', + ); +# +# Populate $cancreate{'selfcreate'} array reference with types of user, for which self-creation of user accounts +# is permitted. +# + + my @statuses; + if (ref($domconfig{'inststatus'}) eq 'HASH') { + if (ref($domconfig{'inststatus'}{'inststatusguest'}) eq 'ARRAY') { + @statuses = @{$domconfig{'inststatus'}{'inststatusguest'}}; + } + } + push(@statuses,'default'); + + foreach my $item ('login','sso','email') { + if ($item eq 'email') { + if ($env{'form.cancreate_email'}) { + push(@{$cancreate{'selfcreate'}},'email'); + push(@contexts,'selfcreateprocessing'); + foreach my $type (@statuses) { + if ($type eq 'default') { + $cancreate{'selfcreateprocessing'}{$type} = $env{'form.cancreate_emailprocess'}; + } else { + $cancreate{'selfcreateprocessing'}{$type} = $env{'form.cancreate_emailprocess_'.$type}; + } + } + } + } else { + if ($env{'form.cancreate_'.$item}) { + push(@{$cancreate{'selfcreate'}},$item); + } + } + } + my (@email_rule,%userinfo,%savecaptcha); + my ($infofields,$infotitles) = &Apache::loncommon::emailusername_info(); +# +# Populate $cancreate{'emailusername'}{$type} hash ref with information fields (if new user will provide data +# value set to one), if self-creation with e-mail address permitted, where $type is user type: faculty, staff, student etc. +# + + if ($env{'form.cancreate_email'}) { + push(@contexts,'emailusername'); + if (ref($types) eq 'ARRAY') { + foreach my $type (@{$types}) { + if (ref($infofields) eq 'ARRAY') { + foreach my $field (@{$infofields}) { + if ($env{'form.canmodify_emailusername_'.$type.'_'.$field} =~ /^(required|optional)$/) { + $cancreate{'emailusername'}{$type}{$field} = $1; + } + } + } + } + } +# +# Populate $cancreate{'notify'} hash ref with names of Domain Coordinators who are to be notified of +# queued requests for self-creation of account using e-mail address as username +# + + my @approvalnotify = &Apache::loncommon::get_env_multiple('form.selfcreationnotifyapproval'); + @approvalnotify = sort(@approvalnotify); + $cancreate{'notify'}{'approval'} = join(',',@approvalnotify); + if (ref($curr_usercreation{'cancreate'}) eq 'HASH') { + if (ref($curr_usercreation{'cancreate'}{'notify'}) eq 'HASH') { + if ($curr_usercreation{'cancreate'}{'notify'}{'approval'} ne $cancreate{'notify'}{'approval'}) { + push(@{$changes{'cancreate'}},'notify'); + } + } else { + if ($cancreate{'notify'}{'approval'}) { + push(@{$changes{'cancreate'}},'notify'); + } + } + } elsif ($cancreate{'notify'}{'approval'}) { + push(@{$changes{'cancreate'}},'notify'); + } + +# +# Retrieve rules (if any) governing types of e-mail address which may be used as a username +# + @email_rule = &Apache::loncommon::get_env_multiple('form.email_rule'); + &process_captcha('cancreate',\%changes,\%savecaptcha,$curr_usercreation{'cancreate'}); + if (ref($curr_usercreation{'email_rule'}) eq 'ARRAY') { + if (@{$curr_usercreation{'email_rule'}} > 0) { + foreach my $type (@{$curr_usercreation{'email_rule'}}) { + if (!grep(/^\Q$type\E$/,@email_rule)) { + push(@{$changes{'email_rule'}},$type); + } + } + } + if (@email_rule > 0) { + foreach my $type (@email_rule) { + if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'email_rule'}})) { + push(@{$changes{'email_rule'}},$type); + } + } + } + } elsif (@email_rule > 0) { + push(@{$changes{'email_rule'}},@email_rule); + } + } +# +# Check if domain default is set appropriately, if self-creation of accounts is to be available for +# institutional log-in. +# + if (grep(/^login$/,@{$cancreate{'selfcreate'}})) { + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); + if (!((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || + ($domdefaults{'auth_def'} eq 'localauth'))) { + $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.'); + } + } + my @fields = ('lastname','firstname','middlename','generation', + 'permanentemail','id'); + my @shibfields = (@fields,'inststatus'); + my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); +# +# Where usernames may created for institutional log-in and/or institutional single sign on: +# (a) populate $cancreate{'statustocreate'} array reference with institutional status types who +# may self-create accounts +# (b) populate $save_usermodify{'selfcreate'} hash reference with status types, and information fields +# which the user may supply, if institutional data is unavailable. +# + if (($env{'form.cancreate_login'}) || ($env{'form.cancreate_sso'})) { + if (ref($types) eq 'ARRAY') { + if (@{$types} > 1) { + @{$cancreate{'statustocreate'}} = &Apache::loncommon::get_env_multiple('form.statustocreate'); + push(@contexts,'statustocreate'); + } else { + undef($cancreate{'statustocreate'}); + } + foreach my $type (@{$types}) { + my @modifiable = &Apache::loncommon::get_env_multiple('form.canmodify_'.$type); + foreach my $field (@fields) { + if (grep(/^\Q$field\E$/,@modifiable)) { + $save_usermodify{'selfcreate'}{$type}{$field} = 1; + } else { + $save_usermodify{'selfcreate'}{$type}{$field} = 0; + } + } + } + if (ref($curr_usermodify{'selfcreate'}) eq 'HASH') { + foreach my $type (@{$types}) { + if (ref($curr_usermodify{'selfcreate'}{$type}) eq 'HASH') { + foreach my $field (@fields) { + if ($save_usermodify{'selfcreate'}{$type}{$field} ne + $curr_usermodify{'selfcreate'}{$type}{$field}) { + push(@{$changes{'selfcreate'}},$type); + last; + } + } + } + } + } else { + foreach my $type (@{$types}) { + push(@{$changes{'selfcreate'}},$type); + } + } + } + foreach my $field (@shibfields) { + if ($env{'form.shibenv_'.$field} ne '') { + $cancreate{'shibenv'}{$field} = $env{'form.shibenv_'.$field}; + } + } + if (ref($curr_usercreation{'cancreate'}) eq 'HASH') { + if (ref($curr_usercreation{'cancreate'}{'shibenv'}) eq 'HASH') { + foreach my $field (@shibfields) { + if ($env{'form.shibenv_'.$field} ne $curr_usercreation{'cancreate'}{'shibenv'}{$field}) { + push(@{$changes{'cancreate'}},'shibenv'); + } + } + } else { + foreach my $field (@shibfields) { + if ($env{'form.shibenv_'.$field}) { + push(@{$changes{'cancreate'}},'shibenv'); + last; + } + } + } + } + } + foreach my $item (@contexts) { + 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); + } + } + } + } + if (ref($cancreate{$item}) eq 'ARRAY') { + foreach my $type (@{$cancreate{$item}}) { + if (!grep(/^$type$/,@{$curr_usercreation{'cancreate'}{$item}})) { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + } + } + } + } elsif (ref($curr_usercreation{'cancreate'}{$item}) eq 'HASH') { + if (ref($cancreate{$item}) eq 'HASH') { + foreach my $curr (keys(%{$curr_usercreation{'cancreate'}{$item}})) { + if (ref($curr_usercreation{'cancreate'}{$item}{$curr}) eq 'HASH') { + foreach my $field (keys(%{$curr_usercreation{'cancreate'}{$item}{$curr}})) { + unless ($curr_usercreation{'cancreate'}{$item}{$curr}{$field} eq $cancreate{$item}{$curr}{$field}) { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + } + } + } elsif ($item eq 'selfcreateprocessing') { + if ($cancreate{$item}{$curr} ne $curr_usercreation{'cancreate'}{$item}{$curr}) { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + } + } else { + if (!$cancreate{$item}{$curr}) { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + } + } + } + foreach my $field (keys(%{$cancreate{$item}})) { + if (ref($cancreate{$item}{$field}) eq 'HASH') { + foreach my $inner (keys(%{$cancreate{$item}{$field}})) { + if (ref($curr_usercreation{'cancreate'}{$item}{$field}) eq 'HASH') { + unless ($curr_usercreation{'cancreate'}{$item}{$field}{$inner} eq $cancreate{$item}{$field}{$inner}) { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + } + } else { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + } + } + } elsif ($item eq 'selfcreateprocessing') { + if ($cancreate{$item}{$field} ne $curr_usercreation{'cancreate'}{$item}{$field}) { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + } + } else { + if (!$curr_usercreation{'cancreate'}{$item}{$field}) { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + } + } + } + } + } elsif ($curr_usercreation{'cancreate'}{$item}) { + if (ref($cancreate{$item}) eq 'ARRAY') { + if (!grep(/^\Q$curr_usercreation{'cancreate'}{$item}\E$/,@{$cancreate{$item}})) { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + } + } elsif (ref($cancreate{$item}) eq 'HASH') { + if (!$cancreate{$item}{$curr_usercreation{'cancreate'}{$item}}) { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + } + } + } elsif ($item eq 'emailusername') { + if (ref($cancreate{$item}) eq 'HASH') { + foreach my $type (keys(%{$cancreate{$item}})) { + if (ref($cancreate{$item}{$type}) eq 'HASH') { + foreach my $field (keys(%{$cancreate{$item}{$type}})) { + if ($cancreate{$item}{$type}{$field}) { + if (!grep(/^$item$/,@{$changes{'cancreate'}})) { + push(@{$changes{'cancreate'}},$item); + } + last; + } + } + } + } + } + } + } +# +# Populate %save_usercreate hash with updates to self-creation configuration. +# + $save_usercreate{'cancreate'}{'captcha'} = $savecaptcha{'captcha'}; + $save_usercreate{'cancreate'}{'recaptchakeys'} = $savecaptcha{'recaptchakeys'}; + $save_usercreate{'cancreate'}{'selfcreate'} = $cancreate{'selfcreate'}; + if (ref($cancreate{'notify'}) eq 'HASH') { + $save_usercreate{'cancreate'}{'notify'} = $cancreate{'notify'}; + } + if (ref($cancreate{'selfcreateprocessing'}) eq 'HASH') { + $save_usercreate{'cancreate'}{'selfcreateprocessing'} = $cancreate{'selfcreateprocessing'}; + } + if (ref($cancreate{'statustocreate'}) eq 'ARRAY') { + $save_usercreate{'cancreate'}{'statustocreate'} = $cancreate{'statustocreate'}; + } + if (ref($cancreate{'shibenv'}) eq 'HASH') { + $save_usercreate{'cancreate'}{'shibenv'} = $cancreate{'shibenv'}; + } + $save_usercreate{'cancreate'}{'emailusername'} = $cancreate{'emailusername'}; + $save_usercreate{'emailrule'} = \@email_rule; + + my %userconfig_hash = ( + usercreation => \%save_usercreate, + usermodification => \%save_usermodify, + ); + my $putresult = &Apache::lonnet::put_dom('configuration',\%userconfig_hash, + $dom); +# +# Accumulate details of changes to domain cofiguration for self-creation of usernames in $resulttext +# + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + $resulttext = &mt('Changes made:').'
          '; + if (ref($changes{'cancreate'}) eq 'ARRAY') { + my %lt = &selfcreation_types(); + foreach my $type (@{$changes{'cancreate'}}) { + my $chgtext; + if ($type eq 'selfcreate') { + if (@{$cancreate{$type}} == 0) { + $chgtext .= &mt('Self creation of a new user account is not permitted.'); + } else { + $chgtext .= &mt('Self-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 'shibenv') { + if (keys(%{$cancreate{$type}}) == 0) { + $chgtext .= &mt('Shibboleth-autheticated user does not use environment variables to set user information'); + } else { + $chgtext .= &mt('Shibboleth-autheticated user information set from environment variables, as follows:'). + '
            '; + foreach my $field (@shibfields) { + next if ($cancreate{$type}{$field} eq ''); + if ($field eq 'inststatus') { + $chgtext .= '
          • '.&mt('Institutional status').' -- '.$cancreate{$type}{$field}.'
            • '; + } else { + $chgtext .= '
          • '.$fieldtitles{$field}.' -- '.$cancreate{$type}{$field}.'
            • '; + } + } + $chgtext .= '
          '; + } + } 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.'); + } + } + } + } elsif ($type eq 'selfcreateprocessing') { + my %choices = &Apache::lonlocal::texthash ( + automatic => 'Automatic approval', + approval => 'Queued for approval', + ); + if (@statuses > 1) { + $chgtext .= &mt('Processing of requests to create account with e-mail address as username set as follows:'). + '
            '; + foreach my $type (@statuses) { + if ($type eq 'default') { + $chgtext .= '
          • '.$othertitle.' -- '.$choices{$cancreate{'selfcreateprocessing'}{$type}}.'
            • '; + } else { + $chgtext .= '
          • '.$usertypes->{$type}.' -- '.$choices{$cancreate{'selfcreateprocessing'}{$type}}.'
            • '; + } + } + $chgtext .= '
          '; + } else { + $chgtext .= &mt('Processing of requests to create account with e-mail address as username set to: "[_1]"', + $choices{$cancreate{'selfcreateprocessing'}{'default'}}); + } + } elsif ($type eq 'captcha') { + if ($savecaptcha{$type} eq 'notused') { + $chgtext .= &mt('No CAPTCHA validation in use for self-creation screen.'); + } else { + my %captchas = &captcha_phrases(); + if ($captchas{$savecaptcha{$type}}) { + $chgtext .= &mt("Validation for self-creation screen set to $captchas{$savecaptcha{$type}}."); + } else { + $chgtext .= &mt('Validation for self-creation screen set to unknown type.'); + } + } + } elsif ($type eq 'recaptchakeys') { + my ($privkey,$pubkey); + if (ref($savecaptcha{$type}) eq 'HASH') { + $pubkey = $savecaptcha{$type}{'public'}; + $privkey = $savecaptcha{$type}{'private'}; + } + $chgtext .= &mt('ReCAPTCHA keys changes').'
            '; + if (!$pubkey) { + $chgtext .= '
          • '.&mt('Public key deleted').'
            • '; + } else { + $chgtext .= '
          • '.&mt('Public key set to [_1]',$pubkey).'
            • '; + } + if (!$privkey) { + $chgtext .= '
          • '.&mt('Private key deleted').'
            • '; + } else { + $chgtext .= '
          • '.&mt('Private key set to [_1]',$pubkey).'
            • '; + } + $chgtext .= '
          '; + } elsif ($type eq 'emailusername') { + if (ref($cancreate{'emailusername'}) eq 'HASH') { + if (ref($types) eq 'ARRAY') { + foreach my $type (@{$types}) { + if (ref($cancreate{'emailusername'}{$type}) eq 'HASH') { + if (keys(%{$cancreate{'emailusername'}{$type}}) > 0) { + $chgtext .= &mt('When self-creating account with e-mail as username, the following information will be provided by [_1]:',"'$usertypes->{$type}'"). + '
            '; + foreach my $field (@{$infofields}) { + if ($cancreate{'emailusername'}{$type}{$field}) { + $chgtext .= '
          • '.$infotitles->{$field}.'
            • '; + } + } + $chgtext .= '
          '; + } else { + $chgtext .= &mt('When self creating account with e-mail as username, no information besides e-mail address will be provided by [_1].',"'$usertypes->{$type}'").'
          '; + } + } else { + $chgtext .= &mt('When self creating account with e-mail as username, no information besides e-mail address will be provided by [_1].',"'$usertypes->{$type}'").'
          '; + } + } + } + } + } elsif ($type eq 'notify') { + $chgtext = &mt('No Domain Coordinators will receive notification of username requests requiring approval.'); + if (ref($changes{'cancreate'}) eq 'ARRAY') { + if ((grep(/^notify$/,@{$changes{'cancreate'}})) && (ref($cancreate{'notify'}) eq 'HASH')) { + if ($cancreate{'notify'}{'approval'}) { + $chgtext = &mt('Notification of username requests requiring approval will be sent to: ').$cancreate{'notify'}{'approval'}; + } + } + } + } + if ($chgtext) { + $resulttext .= '
        • '.$chgtext.'
          • '; + } + } + } + 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.'). + '
          • '; + } + } + if (ref($changes{'selfcreate'}) eq 'ARRAY') { + $resulttext .= '
        • '.&mt('When self-creating institutional account:').'
            '; + my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); + foreach my $type (@{$changes{'selfcreate'}}) { + my $typename = $type; + if (ref($usertypes) eq 'HASH') { + if ($usertypes->{$type} ne '') { + $typename = $usertypes->{$type}; + } + } + my @modifiable; + $resulttext .= '
          • '. + &mt('Self-creation of account by users with status: [_1]', + ''.$typename.''). + ' - '.&mt('modifiable fields (if institutional data blank): '); + foreach my $field (@fields) { + if ($save_usermodify{'selfcreate'}{$type}{$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 self-creation settings'); + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + if ($warningmsg ne '') { + $resulttext .= '
        '.$warningmsg.'
        '; + } + return $resulttext; +} + +sub process_captcha { + my ($container,$changes,$newsettings,$current) = @_; + return unless ((ref($changes) eq 'HASH') && (ref($newsettings) eq 'HASH') || (ref($current) eq 'HASH')); + $newsettings->{'captcha'} = $env{'form.'.$container.'_captcha'}; + unless ($newsettings->{'captcha'} eq 'recaptcha' || $newsettings->{'captcha'} eq 'notused') { + $newsettings->{'captcha'} = 'original'; + } + if ($current->{'captcha'} ne $newsettings->{'captcha'}) { + if ($container eq 'cancreate') { + if (ref($changes->{'cancreate'}) eq 'ARRAY') { + push(@{$changes->{'cancreate'}},'captcha'); + } elsif (!defined($changes->{'cancreate'})) { + $changes->{'cancreate'} = ['captcha']; + } + } else { + $changes->{'captcha'} = 1; + } + } + my ($newpub,$newpriv,$currpub,$currpriv); + if ($newsettings->{'captcha'} eq 'recaptcha') { + $newpub = $env{'form.'.$container.'_recaptchapub'}; + $newpriv = $env{'form.'.$container.'_recaptchapriv'}; + $newpub =~ s/[^\w\-]//g; + $newpriv =~ s/[^\w\-]//g; + $newsettings->{'recaptchakeys'} = { + public => $newpub, + private => $newpriv, + }; + } + if (ref($current->{'recaptchakeys'}) eq 'HASH') { + $currpub = $current->{'recaptchakeys'}{'public'}; + $currpriv = $current->{'recaptchakeys'}{'private'}; + unless ($newsettings->{'captcha'} eq 'recaptcha') { + $newsettings->{'recaptchakeys'} = { + public => '', + private => '', + } + } + } + if (($newpub ne $currpub) || ($newpriv ne $currpriv)) { + if ($container eq 'cancreate') { + if (ref($changes->{'cancreate'}) eq 'ARRAY') { + push(@{$changes->{'cancreate'}},'recaptchakeys'); + } elsif (!defined($changes->{'cancreate'})) { + $changes->{'cancreate'} = ['recaptchakeys']; + } + } else { + $changes->{'recaptchakeys'} = 1; + } + } + return; +} + +sub modify_usermodification { + my ($dom,%domconfig) = @_; + my ($resulttext,%curr_usermodification,%changes,%modifyhash); + if (ref($domconfig{'usermodification'}) eq 'HASH') { + foreach my $key (keys(%{$domconfig{'usermodification'}})) { + if ($key eq 'selfcreate') { + $modifyhash{$key} = $domconfig{'usermodification'}{$key}; + } else { + $curr_usermodification{$key} = $domconfig{'usermodification'}{$key}; + } + } + } + my @contexts = ('author','course'); + my %context_title = ( + author => 'In author context', + course => 'In course context', + ); + my @fields = ('lastname','firstname','middlename','generation', + 'permanentemail','id'); + my %roles = ( + author => ['ca','aa'], + course => ['st','ep','ta','in','cr'], + ); + my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); + 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 ($role eq 'cr') { + $rolename = &mt('Custom'); + } else { + $rolename = &Apache::lonnet::plaintext($role); + } + my @modifiable; + $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,$lastactref,%domconfig) = @_; + my ($resulttext,$mailmsgtxt,%newvalues,%changes,@errors); + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); + 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 $currinststatus; + if (ref($domconfig{'inststatus'}) eq 'HASH') { + $currinststatus = $domconfig{'inststatus'}; + } else { + my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); + $currinststatus = { + inststatustypes => $usertypes, + inststatusorder => $types, + inststatusguest => [], + }; + } + my @todelete = &Apache::loncommon::get_env_multiple('form.inststatus_delete'); + my @allpos; + my %guests; + my %alltypes; + my ($currtitles,$currguests,$currorder); + if (ref($currinststatus) eq 'HASH') { + if (ref($currinststatus->{'inststatusorder'}) eq 'ARRAY') { + foreach my $type (@{$currinststatus->{'inststatusorder'}}) { + if (ref($currinststatus->{inststatustypes}) eq 'HASH') { + if ($currinststatus->{inststatustypes}->{$type} ne '') { + $currtitles .= $currinststatus->{inststatustypes}->{$type}.','; + } + } + unless (grep(/^\Q$type\E$/,@todelete)) { + my $position = $env{'form.inststatus_pos_'.$type}; + $position =~ s/\D+//g; + $allpos[$position] = $type; + $alltypes{$type} = $env{'form.inststatus_title_'.$type}; + $alltypes{$type} =~ s/`//g; + if ($env{'form.inststatus_guest_'.$type}) { + $guests{$type} = 1; + } + } + } + if (ref($currinststatus->{'inststatusguest'}) eq 'ARRAY') { + $currguests = join(',',@{$currinststatus->{'inststatusguest'}}); + } + $currorder = join(',',@{$currinststatus->{'inststatusorder'}}); + $currtitles =~ s/,$//; + } + } + if ($env{'form.addinststatus'}) { + my $newtype = $env{'form.addinststatus'}; + $newtype =~ s/\W//g; + unless (exists($alltypes{$newtype})) { + if ($env{'form.addinststatus_guest'}) { + $guests{$newtype} = 1; + } + $alltypes{$newtype} = $env{'form.addinststatus_title'}; + $alltypes{$newtype} =~ s/`//g; + my $position = $env{'form.addinststatus_pos'}; + $position =~ s/\D+//g; + if ($position ne '') { + $allpos[$position] = $newtype; + } + } + } + my (@orderedstatus,@orderedguests); + foreach my $type (@allpos) { + unless (($type eq '') || (grep(/^\Q$type\E$/,@orderedstatus))) { + push(@orderedstatus,$type); + if ($guests{$type}) { + push(@orderedguests,$type); + } + } + } + foreach my $type (keys(%alltypes)) { + unless (grep(/^\Q$type\E$/,@orderedstatus)) { + delete($alltypes{$type}); + } + } + $defaults_hash{'inststatus'} = { + inststatustypes => \%alltypes, + inststatusorder => \@orderedstatus, + inststatusguest => \@orderedguests, + }; + if (ref($defaults_hash{'inststatus'}) eq 'HASH') { + foreach my $item ('inststatustypes','inststatusorder','inststatusguest') { + $domdefaults{$item} = $defaults_hash{'inststatus'}{$item}; + } + } + if ($currorder ne join(',',@orderedstatus)) { + $changes{'inststatus'}{'inststatusorder'} = 1; + } + if ($currguests ne join(',',@orderedguests)) { + $changes{'inststatus'}{'inststatusguest'} = 1; + } + my $newtitles; + foreach my $item (@orderedstatus) { + $newtitles .= $alltypes{$item}.','; + } + $newtitles =~ s/,$//; + if ($currtitles ne $newtitles) { + $changes{'inststatus'}{'inststatustypes'} = 1; + } + my $putresult = &Apache::lonnet::put_dom('configuration',\%defaults_hash, + $dom); + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + $resulttext = &mt('Changes made:').'
          '; + my $version = &Apache::lonnet::get_server_loncaparev($dom); + 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))) { + if ($item eq 'inststatus') { + if (ref($changes{'inststatus'}) eq 'HASH') { + if (($changes{'inststatus'}{'inststatustypes'}) || $changes{'inststatus'}{'inststatusorder'}) { + $resulttext .= '
        • '.&mt('Institutional user status types set to:').' '; + foreach my $type (@orderedstatus) { + $resulttext .= $alltypes{$type}.', '; + } + $resulttext =~ s/, $//; + $resulttext .= '
          • '; + } + if ($changes{'inststatus'}{'inststatusguest'}) { + $resulttext .= '
        • '; + if (@orderedguests) { + $resulttext .= &mt('Types assignable to "non-institutional" usernames set to:').' '; + foreach my $type (@orderedguests) { + $resulttext .= $alltypes{$type}.', '; + } + $resulttext =~ s/, $//; + } else { + $resulttext .= &mt('Types assignable to "non-institutional" usernames set to none.'); + } + $resulttext .= '
          • '; + } + } + } else { + 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 (ref($lastactref) eq 'HASH') { + $lastactref->{'domdefaults'} = 1; + } + if ($changes{'auth_def'} || $changes{'auth_arg_def'} || $changes{'lang_def'} || $changes{'datelocale_def'}) { + my $notify = 1; + if (ref($domconfig{'contacts'}) eq 'HASH') { + if ($domconfig{'contacts'}{'reportupdates'} == 0) { + $notify = 0; + } + } + if ($notify) { + &Apache::lonmsg::sendemail('installrecord@loncapa.org', + "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,$lastactref,%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); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domainconfig'} = 1; + } + } 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,$lastactref,%domconfig) = @_; + my ($resulttext,%deletions,%reorderings,%needreordering,%adds,%changes,$errors, + $cathash); + my @deletecategory = &Apache::loncommon::get_env_multiple('form.deletecategory'); + my @catitems = ('unauth','auth'); + my @cattypes = ('std','domonly','codesrch','none'); + 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'}; + } + foreach my $item (@catitems) { + if (grep(/^\Q$env{'form.coursecat_'.$item}\E$/,@cattypes)) { + if ($domconfig{'coursecategories'}{$item} ne $env{'form.coursecat_'.$item}) { + $changes{$item} = 1; + $domconfig{'coursecategories'}{$item} = $env{'form.coursecat_'.$item}; + } + } + } + } 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'}, + }; + foreach my $item (@catitems) { + if ($env{'form.coursecat_'.$item} ne 'std') { + $changes{$item} = 1; + } + if (grep(/^\Q$env{'form.coursecat_'.$item}\E$/,@cattypes)) { + $domconfig{'coursecategories'}{$item} = $env{'form.coursecat_'.$item}; + } + } + } + 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")', + none => 'No catalog', + std => 'Standard catalog', + domonly => 'Domain-only catalog', + codesrch => 'Code search form', + ); + $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 ($changes{'unauth'}) { + $resulttext .= '
      • '.&mt('Catalog type for unauthenticated users set to "'.$level{$env{'form.coursecat_unauth'}}.'"').'
        • '; + } + if ($changes{'auth'}) { + $resulttext .= '
      • '.&mt('Catalog type for authenticated users set to "'.$level{$env{'form.coursecat_auth'}}.'"').'
        • '; + } + 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 .= '
      '; + if ($changes{'unauth'} || $changes{'auth'}) { + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); + if ($changes{'auth'}) { + $domdefaults{'catauth'} = $domconfig{'coursecategories'}{'auth'}; + } + if ($changes{'unauth'}) { + $domdefaults{'catunauth'} = $domconfig{'coursecategories'}{'unauth'}; + } + my $cachetime = 24*60*60; + &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domdefaults'} = 1; + } + } + } 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 %defaultchecked = ('submitbugs' => 'on'); + my @offon = ('off','on'); + my @toggles = ('submitbugs'); + if (ref($domconfig{'helpsettings'}) eq 'HASH') { + foreach my $item (@toggles) { + if ($defaultchecked{$item} eq 'on') { + if ($domconfig{'helpsettings'}{$item} eq '') { + if ($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 '') { + if ($env{'form.'.$item} eq '1') { + $changes{$item} = 1; + } + } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) { + $changes{$item} = 1; + } + } + if (($env{'form.'.$item} eq '0') || ($env{'form.'.$item} eq '1')) { + $helphash{'helpsettings'}{$item} = $env{'form.'.$item}; + } + } + } + my $putresult; + if (keys(%changes) > 0) { + $putresult = &Apache::lonnet::put_dom('configuration',\%helphash,$dom); + if ($putresult eq 'ok') { + $resulttext = &mt('Changes made:').'
        '; + foreach my $item (sort(keys(%changes))) { + if ($item eq 'submitbugs') { + $resulttext .= '
      • '.&mt('Display link to: [_1] set to "'.$offon[$env{'form.'.$item}].'".', + &Apache::loncommon::modal_link('http://bugs.loncapa.org', + &mt('LON-CAPA bug tracker'),600,500)).'
        • '; + } + } + $resulttext .= '
      '; + } else { + $resulttext = &mt('No changes made to help settings'); + $errors .= '
    • '. + &mt('An error occurred storing the settings: [_1]', + $putresult).'
      • '; + } + } + if ($errors) { + $resulttext .= '
      '.&mt('The following errors occurred: ').'
        '. + $errors.'
      '; + } + return $resulttext; +} + +sub modify_coursedefaults { + my ($dom,$lastactref,%domconfig) = @_; + my ($resulttext,$errors,%changes,%defaultshash); + my %defaultchecked = ( + 'canuse_pdfforms' => 'off', + 'uselcmath' => 'on', + 'usejsme' => 'on' + ); + my @toggles = ('canuse_pdfforms','uselcmath','usejsme'); + my @numbers = ('anonsurvey_threshold','uploadquota_official','uploadquota_unofficial', + 'uploadquota_community','uploadquota_textbook'); + my @types = ('official','unofficial','community','textbook'); + my %staticdefaults = ( + anonsurvey_threshold => 10, + uploadquota => 500, + postsubmit => 60, + ); + + $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{'coursedefaults'}{$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}; + } + foreach my $item (@numbers) { + my ($currdef,$newdef); + $newdef = $env{'form.'.$item}; + if ($item eq 'anonsurvey_threshold') { + $currdef = $domconfig{'coursedefaults'}{$item}; + $newdef =~ s/\D//g; + if ($newdef eq '' || $newdef < 1) { + $newdef = 1; + } + $defaultshash{'coursedefaults'}{$item} = $newdef; + } else { + my ($type) = ($item =~ /^\Quploadquota_\E(\w+)$/); + if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') { + $currdef = $domconfig{'coursedefaults'}{'uploadquota'}{$type}; + } + $newdef =~ s/[^\w.\-]//g; + $defaultshash{'coursedefaults'}{'uploadquota'}{$type} = $newdef; + } + if ($currdef ne $newdef) { + my $staticdef; + if ($item eq 'anonsurvey_threshold') { + unless (($currdef eq '') && ($newdef == $staticdefaults{$item})) { + $changes{$item} = 1; + } + } else { + unless (($currdef eq '') && ($newdef == $staticdefaults{'uploadquota'})) { + $changes{'uploadquota'} = 1; + } + } + } + } + + my %credits; + foreach my $type (@types) { + unless ($type eq 'community') { + $credits{$type} = $env{'form.'.$type.'_credits'}; + $credits{$type} =~ s/[^\d.]+//g; + } + } + if ((ref($domconfig{'coursedefaults'}{'coursecredits'}) ne 'HASH') && + ($env{'form.coursecredits'} eq '1')) { + $changes{'coursecredits'} = 1; + foreach my $type (keys(%credits)) { + $defaultshash{'coursedefaults'}{'coursecredits'}{$type} = $credits{$type}; + } + } else { + if ($env{'form.coursecredits'} eq '1') { + foreach my $type (@types) { + unless ($type eq 'community') { + if ($domconfig{'coursedefaults'}{'coursecredits'}{$type} ne $credits{$type}) { + $changes{'coursecredits'} = 1; + } + $defaultshash{'coursedefaults'}{'coursecredits'}{$type} = $credits{$type}; + } + } + } elsif (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') { + foreach my $type (@types) { + unless ($type eq 'community') { + if ($domconfig{'coursedefaults'}{'coursecredits'}{$type}) { + $changes{'coursecredits'} = 1; + last; + } + } + } + } + } + if ($env{'form.postsubmit'} eq '1') { + $defaultshash{'coursedefaults'}{'postsubmit'}{'client'} = 'on'; + my %currtimeout; + if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') { + if ($domconfig{'coursedefaults'}{'postsubmit'}{'client'} eq 'off') { + $changes{'postsubmit'} = 1; + } + if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') { + %currtimeout = %{$domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}}; + } + } else { + $changes{'postsubmit'} = 1; + } + foreach my $type (@types) { + my $timeout = $env{'form.'.$type.'_timeout'}; + $timeout =~ s/\D//g; + if ($timeout == $staticdefaults{'postsubmit'}) { + $timeout = ''; + } elsif (($timeout eq '') || ($timeout =~ /^0+$/)) { + $timeout = '0'; + } + unless ($timeout eq '') { + $defaultshash{'coursedefaults'}{'postsubmit'}{'timeout'}{$type} = $timeout; + } + if (exists($currtimeout{$type})) { + if ($timeout ne $currtimeout{$type}) { + $changes{'postsubmit'} = 1; + } + } elsif ($timeout ne '') { + $changes{'postsubmit'} = 1; + } + } + } else { + $defaultshash{'coursedefaults'}{'postsubmit'}{'client'} = 'off'; + if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') { + if ($domconfig{'coursedefaults'}{'postsubmit'}{'client'} eq 'on') { + $changes{'postsubmit'} = 1; + } + } else { + $changes{'postsubmit'} = 1; + } + } + } + my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash, + $dom); + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); + if (($changes{'canuse_pdfforms'}) || ($changes{'uploadquota'}) || ($changes{'postsubmit'}) || + ($changes{'coursecredits'}) || ($changes{'uselcmath'}) || ($changes{'usejsme'})) { + foreach my $item ('canuse_pdfforms','uselcmath','usejsme') { + if ($changes{$item}) { + $domdefaults{$item}=$defaultshash{'coursedefaults'}{$item}; + } + } + if ($changes{'coursecredits'}) { + if (ref($defaultshash{'coursedefaults'}{'coursecredits'}) eq 'HASH') { + foreach my $type (keys(%{$defaultshash{'coursedefaults'}{'coursecredits'}})) { + $domdefaults{$type.'credits'} = + $defaultshash{'coursedefaults'}{'coursecredits'}{$type}; + } + } + } + if ($changes{'postsubmit'}) { + if (ref($defaultshash{'coursedefaults'}{'postsubmit'}) eq 'HASH') { + $domdefaults{'postsubmit'} = $defaultshash{'coursedefaults'}{'postsubmit'}{'client'}; + if (ref($defaultshash{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') { + foreach my $type (keys(%{$defaultshash{'coursedefaults'}{'postsubmit'}{'timeout'}})) { + $domdefaults{$type.'postsubtimeout'} = + $defaultshash{'coursedefaults'}{'postsubmit'}{'timeout'}{$type}; + } + } + } + } + if ($changes{'uploadquota'}) { + if (ref($defaultshash{'coursedefaults'}{'uploadquota'}) eq 'HASH') { + foreach my $type (@types) { + $domdefaults{$type.'quota'}=$defaultshash{'coursedefaults'}{'uploadquota'}{$type}; + } + } + } + my $cachetime = 24*60*60; + &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domdefaults'} = 1; + } + } + $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 'uselcmath') { + if ($env{'form.'.$item} eq '1') { + $resulttext .= '
      • '.&mt('Math preview uses LON-CAPA previewer (javascript), if supported by browser.').'
        • '; + } else { + $resulttext .= '
      • '.&mt('Math preview uses DragMath (Java), if supported by client OS.').'
        • '; + } + } elsif ($item eq 'usejsme') { + if ($env{'form.'.$item} eq '1') { + $resulttext .= '
      • '.&mt('Molecule editor uses JSME (HTML5), if supported by browser.').'
        • '; + } else { + $resulttext .= '
      • '.&mt('Molecule editor uses JME (Java), if supported by client OS.').'
        • '; + } + } elsif ($item eq 'anonsurvey_threshold') { + $resulttext .= '
      • '.&mt('Responder count required for display of anonymous survey submissions set to [_1].',$defaultshash{'coursedefaults'}{'anonsurvey_threshold'}).'
        • '; + } elsif ($item eq 'uploadquota') { + if (ref($defaultshash{'coursedefaults'}{'uploadquota'}) eq 'HASH') { + $resulttext .= '
      • '.&mt('Default quota for content uploaded to a course/community via Course Editor set as follows:').'
          '. + '
        • '.&mt('Official courses: [_1] MB',''.$defaultshash{'coursedefaults'}{'uploadquota'}{'official'}.'').'
          • '. + '
        • '.&mt('Unofficial courses: [_1] MB',''.$defaultshash{'coursedefaults'}{'uploadquota'}{'unofficial'}.'').'
          • '. + '
        • '.&mt('Textbook courses: [_1] MB',''.$defaultshash{'coursedefaults'}{'uploadquota'}{'textbook'}.'').'
          • '. + + '
        • '.&mt('Communities: [_1] MB',''.$defaultshash{'coursedefaults'}{'uploadquota'}{'community'}.'').'
          • '. + '
        '. + '
        • '; + } else { + $resulttext .= '
      • '.&mt('Default quota for content uploaded via Course Editor remains default: [_1] MB',$staticdefaults{'uploadquota'}).'
        • '; + } + } elsif ($item eq 'postsubmit') { + if ($domdefaults{'postsubmit'} eq 'off') { + $resulttext .= '
      • '.&mt('Submit button(s) remain enabled on page after student makes submission.'); + } else { + $resulttext .= '
      • '.&mt('Submit button(s) disabled on page after student makes submission').'; '; + if (ref($defaultshash{'coursedefaults'}{'postsubmit'}) eq 'HASH') { + $resulttext .= &mt('durations:').'
          '; + foreach my $type (@types) { + $resulttext .= '
        • '; + my $timeout; + if (ref($defaultshash{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') { + $timeout = $defaultshash{'coursedefaults'}{'postsubmit'}{'timeout'}{$type}; + } + my $display; + if ($timeout eq '0') { + $display = &mt('unlimited'); + } elsif ($timeout eq '') { + $display = &mt('[quant,_1,second] (default)',$staticdefaults{'postsubmit'}); + } else { + $display = &mt('[quant,_1,second]',$timeout); + } + if ($type eq 'community') { + $resulttext .= &mt('Communities'); + } elsif ($type eq 'official') { + $resulttext .= &mt('Official courses'); + } elsif ($type eq 'unofficial') { + $resulttext .= &mt('Unofficial courses'); + } elsif ($type eq 'textbook') { + $resulttext .= &mt('Textbook courses'); + } + $resulttext .= ' -- '.$display.'
          • '; + } + $resulttext .= '
        '; + } + $resulttext .= '
        • '; + } + } elsif ($item eq 'coursecredits') { + if (ref($defaultshash{'coursedefaults'}{'coursecredits'}) eq 'HASH') { + if (($domdefaults{'officialcredits'} eq '') && + ($domdefaults{'unofficialcredits'} eq '') && + ($domdefaults{'textbookcredits'} eq '')) { + $resulttext .= '
      • '.&mt('Student credits not in use for courses in this domain').'
        • '; + } else { + $resulttext .= '
      • '.&mt('Student credits can be set per course by a Domain Coordinator, with the following defaults applying:').'
          '. + '
        • '.&mt('Official courses: [_1]',$defaultshash{'coursedefaults'}{'coursecredits'}{'official'}).'
          • '. + '
        • '.&mt('Unofficial courses: [_1]',$defaultshash{'coursedefaults'}{'coursecredits'}{'unofficial'}).'
          • '. + '
        • '.&mt('Textbook courses: [_1]',$defaultshash{'coursedefaults'}{'coursecredits'}{'textbook'}).'
          • '. + '
        '. + '
        • '; + } + } else { + $resulttext .= '
      • '.&mt('Student credits not in use for courses in this domain').'
        • '; + } + } + } + $resulttext .= '
      '; + } else { + $resulttext = &mt('No changes made to course defaults'); + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + return $resulttext; +} + +sub modify_selfenrollment { + my ($dom,$lastactref,%domconfig) = @_; + my ($resulttext,$errors,%changes,%selfenrollhash,%ordered); + my @types = ('official','unofficial','community','textbook'); + my %titles = &tool_titles(); + my %descs = &Apache::lonuserutils::selfenroll_default_descs(); + ($ordered{'admin'},my $titlesref) = &Apache::lonuserutils::get_selfenroll_titles(); + $ordered{'default'} = ['types','registered','approval','limit']; + + my (%roles,%shown,%toplevel); + $roles{'0'} = &Apache::lonnet::plaintext('dc'); + + if (ref($domconfig{'selfenrollment'}) ne 'HASH') { + if ($domconfig{'selfenrollment'} eq '') { + $domconfig{'selfenrollment'} = {}; + } + } + %toplevel = ( + admin => 'Configuration Rights', + default => 'Default settings', + validation => 'Validation of self-enrollment requests', + ); + my ($itemsref,$namesref,$fieldsref) = &Apache::lonuserutils::selfenroll_validation_types(); + + if (ref($ordered{'admin'}) eq 'ARRAY') { + foreach my $item (@{$ordered{'admin'}}) { + foreach my $type (@types) { + if ($env{'form.selfenrolladmin_'.$item.'_'.$type}) { + $selfenrollhash{'admin'}{$type}{$item} = 1; + } else { + $selfenrollhash{'admin'}{$type}{$item} = 0; + } + if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') { + if (ref($domconfig{'selfenrollment'}{'admin'}{$type}) eq 'HASH') { + if ($selfenrollhash{'admin'}{$type}{$item} ne + $domconfig{'selfenrollment'}{'admin'}{$type}{$item}) { + push(@{$changes{'admin'}{$type}},$item); + } + } else { + if (!$selfenrollhash{'admin'}{$type}{$item}) { + push(@{$changes{'admin'}{$type}},$item); + } + } + } elsif (!$selfenrollhash{'admin'}{$type}{$item}) { + push(@{$changes{'admin'}{$type}},$item); + } + } + } + } + + foreach my $item (@{$ordered{'default'}}) { + foreach my $type (@types) { + my $value = $env{'form.selfenrolldefault_'.$item.'_'.$type}; + if ($item eq 'types') { + unless (($value eq 'all') || ($value eq 'dom')) { + $value = ''; + } + } elsif ($item eq 'registered') { + unless ($value eq '1') { + $value = 0; + } + } elsif ($item eq 'approval') { + unless ($value =~ /^[012]$/) { + $value = 0; + } + } else { + unless (($value eq 'allstudents') || ($value eq 'selfenrolled')) { + $value = 'none'; + } + } + $selfenrollhash{'default'}{$type}{$item} = $value; + if (ref($domconfig{'selfenrollment'}{'default'}) eq 'HASH') { + if (ref($domconfig{'selfenrollment'}{'default'}{$type}) eq 'HASH') { + if ($selfenrollhash{'default'}{$type}{$item} ne + $domconfig{'selfenrollment'}{'default'}{$type}{$item}) { + push(@{$changes{'default'}{$type}},$item); + } + } else { + push(@{$changes{'default'}{$type}},$item); + } + } else { + push(@{$changes{'default'}{$type}},$item); + } + if ($item eq 'limit') { + if (($value eq 'allstudents') || ($value eq 'selfenrolled')) { + $env{'form.selfenrolldefault_cap_'.$type} =~ s/\D//g; + if ($env{'form.selfenrolldefault_cap_'.$type} ne '') { + $selfenrollhash{'default'}{$type}{'cap'} = $env{'form.selfenrolldefault_cap_'.$type}; + } + } else { + $selfenrollhash{'default'}{$type}{'cap'} = ''; + } + if (ref($domconfig{'selfenrollment'}{'default'}{$type}) eq 'HASH') { + if ($selfenrollhash{'default'}{$type}{'cap'} ne + $domconfig{'selfenrollment'}{'admin'}{$type}{'cap'}) { + push(@{$changes{'default'}{$type}},'cap'); + } + } elsif ($selfenrollhash{'default'}{$type}{'cap'} ne '') { + push(@{$changes{'default'}{$type}},'cap'); + } + } + } + } + + foreach my $item (@{$itemsref}) { + if ($item eq 'fields') { + my @changed; + @{$selfenrollhash{'validation'}{$item}} = &Apache::loncommon::get_env_multiple('form.selfenroll_validation_'.$item); + if (@{$selfenrollhash{'validation'}{$item}} > 0) { + @{$selfenrollhash{'validation'}{$item}} = sort(@{$selfenrollhash{'validation'}{$item}}); + } + if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') { + if (ref($domconfig{'selfenrollment'}{'validation'}{$item}) eq 'ARRAY') { + @changed = &Apache::loncommon::compare_arrays($selfenrollhash{'validation'}{$item}, + $domconfig{'selfenrollment'}{'validation'}{$item}); + } else { + @changed = @{$selfenrollhash{'validation'}{$item}}; + } + } else { + @changed = @{$selfenrollhash{'validation'}{$item}}; + } + if (@changed) { + if ($selfenrollhash{'validation'}{$item}) { + $changes{'validation'}{$item} = join(', ',@{$selfenrollhash{'validation'}{$item}}); + } else { + $changes{'validation'}{$item} = &mt('None'); + } + } + } else { + $selfenrollhash{'validation'}{$item} = $env{'form.selfenroll_validation_'.$item}; + if ($item eq 'markup') { + if ($env{'form.selfenroll_validation_'.$item}) { + $env{'form.selfenroll_validation_'.$item} =~ s/[\n\r\f]+/\s/gs; + } + } + if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') { + if ($domconfig{'selfenrollment'}{'validation'}{$item} ne $selfenrollhash{'validation'}{$item}) { + $changes{'validation'}{$item} = $selfenrollhash{'validation'}{$item}; + } + } + } + } + + my $putresult = &Apache::lonnet::put_dom('configuration',{'selfenrollment' => \%selfenrollhash}, + $dom); + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); + $resulttext = &mt('Changes made:').'
        '; + foreach my $key ('admin','default','validation') { + if (ref($changes{$key}) eq 'HASH') { + $resulttext .= '
      • '.$toplevel{$key}.'
          '; + if ($key eq 'validation') { + foreach my $item (@{$itemsref}) { + if (exists($changes{$key}{$item})) { + if ($item eq 'markup') { + $resulttext .= '
        • '.&mt('[_1] set to: [_2]',$namesref->{$item}, + '
          '.$changes{$key}{$item}.'
          ').'
          • '; + } else { + $resulttext .= '
        • '.&mt('[_1] set to: [_2]',$namesref->{$item}, + ''.$changes{$key}{$item}.'').'
          • '; + } + } + } + } else { + foreach my $type (@types) { + if ($type eq 'community') { + $roles{'1'} = &mt('Community personnel'); + } else { + $roles{'1'} = &mt('Course personnel'); + } + if (ref($changes{$key}{$type}) eq 'ARRAY') { + if (ref($selfenrollhash{$key}{$type}) eq 'HASH') { + if ($key eq 'admin') { + my @mgrdc = (); + if (ref($ordered{$key}) eq 'ARRAY') { + foreach my $item (@{$ordered{'admin'}}) { + if (ref($selfenrollhash{$key}{$type}) eq 'HASH') { + if ($selfenrollhash{$key}{$type}{$item} eq '0') { + push(@mgrdc,$item); + } + } + } + if (@mgrdc) { + $domdefaults{$type.'selfenrolladmdc'} = join(',',@mgrdc); + } else { + delete($domdefaults{$type.'selfenrolladmdc'}); + } + } + } else { + if (ref($ordered{$key}) eq 'ARRAY') { + foreach my $item (@{$ordered{$key}}) { + if (grep(/^\Q$item\E$/,@{$changes{$key}{$type}})) { + $domdefaults{$type.'selfenroll'.$item} = + $selfenrollhash{$key}{$type}{$item}; + } + } + } + } + } + $resulttext .= '
        • '.$titles{$type}.'
            '; + foreach my $item (@{$ordered{$key}}) { + if (grep(/^\Q$item\E$/,@{$changes{$key}{$type}})) { + $resulttext .= '
          • '; + if ($key eq 'admin') { + $resulttext .= &mt('[_1] -- management by: [_2]',$titlesref->{$item}, + ''.$roles{$selfenrollhash{'admin'}{$type}{$item}}.''); + } else { + $resulttext .= &mt('[_1] set to: [_2]',$titlesref->{$item}, + ''.$descs{$item}{$selfenrollhash{'default'}{$type}{$item}}.''); + } + $resulttext .= '
            • '; + } + } + $resulttext .= '
          • '; + } + } + $resulttext .= '
        • '; + } + } + if ((exists($changes{'admin'})) || (exists($changes{'default'}))) { + my $cachetime = 24*60*60; + &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domdefaults'} = 1; + } + } + } + $resulttext .= '
      '; + } else { + $resulttext = &mt('No changes made to self-enrollment settings'); + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + return $resulttext; +} + +sub modify_usersessions { + my ($dom,$lastactref,%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,1); + 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; + } + } + $defaultshash{'usersessions'}{'offloadnow'} = {}; + my @offloadnow = &Apache::loncommon::get_env_multiple('form.offloadnow'); + my @okoffload; + if (@offloadnow) { + foreach my $server (@offloadnow) { + if (&Apache::lonnet::hostname($server) ne '') { + unless (grep(/^\Q$server\E$/,@okoffload)) { + push(@okoffload,$server); + } + } + } + if (@okoffload) { + foreach my $lonhost (@okoffload) { + $defaultshash{'usersessions'}{'offloadnow'}{$lonhost} = 1; + } + } + } + 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; + } + if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') { + foreach my $lonhost (keys(%{$domconfig{'usersessions'}{'offloadnow'}})) { + unless ($defaultshash{'usersessions'}{'offloadnow'}{$lonhost}) { + $changes{'offloadnow'} = 1; + last; + } + } + unless ($changes{'offloadnow'}) { + foreach my $lonhost (keys(%{$defaultshash{'usersessions'}{'offloadnow'}})) { + unless ($domconfig{'usersessions'}{'offloadnow'}{$lonhost}) { + $changes{'offloadnow'} = 1; + last; + } + } + } + } elsif (@okoffload) { + $changes{'offloadnow'} = 1; + } + } elsif (@okoffload) { + $changes{'offloadnow'} = 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'}; + } + if (ref($defaultshash{'usersessions'}{'offloadnow'}) eq 'HASH') { + $domdefaults{'offloadnow'} = $defaultshash{'usersessions'}{'offloadnow'}; + } + } + my $cachetime = 24*60*60; + &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domdefaults'} = 1; + } + 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); + my $cachekey = &escape('spares').':'.&escape($lonhostdom); + &Apache::lonnet::remote_devalidate_cache($lonhost,[$cachekey]); + 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 .= '
        '; + } + } + if ($changes{'offloadnow'}) { + if (ref($defaultshash{'usersessions'}{'offloadnow'}) eq 'HASH') { + if (keys(%{$defaultshash{'usersessions'}{'offloadnow'}}) > 0) { + $resulttext .= '
      • '.&mt('Switch active users on next access, for server(s):').'
          '; + foreach my $lonhost (sort(keys(%{$defaultshash{'usersessions'}{'offloadnow'}}))) { + $resulttext .= '
        • '.$lonhost.'
          • '; + } + $resulttext .= '
        '; + } else { + $resulttext .= '
      • '.&mt('No servers now set to switch active users on next access.'); + } + } else { + $resulttext .= '
      • '.&mt('No servers now set to switch active users on next access.').'
        • '; + } + } + $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 %libraryservers = &Apache::lonnet::get_servers($dom,'library'); + my @sparestypes = ('primary','default'); + my %typetitles = &sparestype_titles(); + my $resulttext; + my (%currbalancer,%currtargets,%currrules,%existing); + if (ref($domconfig{'loadbalancing'}) eq 'HASH') { + %existing = %{$domconfig{'loadbalancing'}}; + } + &get_loadbalancers_config(\%servers,\%existing,\%currbalancer, + \%currtargets,\%currrules); + my ($saveloadbalancing,%defaultshash,%changes); + my ($alltypes,$othertypes,$titles) = + &loadbalancing_titles($dom,$intdom,$usertypes,$types); + my %ruletitles = &offloadtype_text(); + my @deletions = &Apache::loncommon::get_env_multiple('form.loadbalancing_delete'); + for (my $i=0; $i<$env{'form.loadbalancing_total'}; $i++) { + my $balancer = $env{'form.loadbalancing_lonhost_'.$i}; + if ($balancer eq '') { + next; + } + if (!exists($servers{$balancer})) { + if (exists($currbalancer{$balancer})) { + push(@{$changes{'delete'}},$balancer); + } + next; + } + if ((@deletions > 0) && (grep(/^\Q$i\E$/,@deletions))) { + push(@{$changes{'delete'}},$balancer); + next; + } + if (!exists($currbalancer{$balancer})) { + push(@{$changes{'add'}},$balancer); + } + $defaultshash{'loadbalancing'}{$balancer}{'targets'}{'primary'} = []; + $defaultshash{'loadbalancing'}{$balancer}{'targets'}{'default'} = []; + $defaultshash{'loadbalancing'}{$balancer}{'rules'} = {}; + unless (ref($domconfig{'loadbalancing'}) eq 'HASH') { + $saveloadbalancing = 1; + } + foreach my $sparetype (@sparestypes) { + my @targets = &Apache::loncommon::get_env_multiple('form.loadbalancing_target_'.$i.'_'.$sparetype); + my @offloadto; + foreach my $target (@targets) { + if (($servers{$target}) && ($target ne $balancer)) { + if ($sparetype eq 'default') { + if (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{'primary'}) eq 'ARRAY') { + next if (grep(/^\Q$target\E$/,@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{'primary'}})); + } + } + unless(grep(/^\Q$target\E$/,@offloadto)) { + push(@offloadto,$target); + } + } + $defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype} = \@offloadto; + } + } + if (ref($currtargets{$balancer}) eq 'HASH') { + foreach my $sparetype (@sparestypes) { + if (ref($currtargets{$balancer}{$sparetype}) eq 'ARRAY') { + my @targetdiffs = &Apache::loncommon::compare_arrays($currtargets{$balancer}{$sparetype},$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}); + if (@targetdiffs > 0) { + $changes{'curr'}{$balancer}{'targets'} = 1; + } + } elsif (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}) eq 'ARRAY') { + if (@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}} > 0) { + $changes{'curr'}{$balancer}{'targets'} = 1; + } + } + } + } else { + if (ref($defaultshash{'loadbalancing'}{$balancer}) eq 'HASH') { + foreach my $sparetype (@sparestypes) { + if (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}) eq 'ARRAY') { + if (@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}} > 0) { + $changes{'curr'}{$balancer}{'targets'} = 1; + } + } + } + } + } + my $ishomedom; + if (&Apache::lonnet::host_domain($balancer) eq $dom) { + $ishomedom = 1; + } + if (ref($alltypes) eq 'ARRAY') { + foreach my $type (@{$alltypes}) { + my $rule; + unless ((($type eq '_LC_external') || ($type eq '_LC_internetdom')) && + (!$ishomedom)) { + $rule = $env{'form.loadbalancing_rules_'.$i.'_'.$type}; + } + if ($rule eq 'specific') { + my $specifiedhost = $env{'form.loadbalancing_singleserver_'.$i.'_'.$type}; + if (exists($servers{$specifiedhost})) { + $rule = $specifiedhost; + } + } + $defaultshash{'loadbalancing'}{$balancer}{'rules'}{$type} = $rule; + if (ref($currrules{$balancer}) eq 'HASH') { + if ($rule ne $currrules{$balancer}{$type}) { + $changes{'curr'}{$balancer}{'rules'}{$type} = 1; + } + } elsif ($rule ne '') { + $changes{'curr'}{$balancer}{'rules'}{$type} = 1; + } + } + } + } + my $nochgmsg = &mt('No changes made to Load Balancer settings.'); + if ((keys(%changes) > 0) || ($saveloadbalancing)) { + unless (ref($defaultshash{'loadbalancing'}) eq 'HASH') { + $defaultshash{'loadbalancing'} = {}; + } + my $putresult = &Apache::lonnet::put_dom('configuration', + \%defaultshash,$dom); + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + my %toupdate; + if (ref($changes{'delete'}) eq 'ARRAY') { + foreach my $balancer (sort(@{$changes{'delete'}})) { + $resulttext .= '
    • '.&mt('Load Balancing discontinued for: [_1]',$balancer).'
      • '; + $toupdate{$balancer} = 1; + } + } + if (ref($changes{'add'}) eq 'ARRAY') { + foreach my $balancer (sort(@{$changes{'add'}})) { + $resulttext .= '
    • '.&mt('Load Balancing enabled for: [_1]',$balancer); + $toupdate{$balancer} = 1; + } + } + if (ref($changes{'curr'}) eq 'HASH') { + foreach my $balancer (sort(keys(%{$changes{'curr'}}))) { + $toupdate{$balancer} = 1; + if (ref($changes{'curr'}{$balancer}) eq 'HASH') { + if ($changes{'curr'}{$balancer}{'targets'}) { + my %offloadstr; + foreach my $sparetype (@sparestypes) { + if (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}) eq 'ARRAY') { + if (@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}} > 0) { + $offloadstr{$sparetype} = join(', ',@{$defaultshash{'loadbalancing'}{$balancer}{'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: [_1] set to offload to - [_2]',$balancer,$showoffload).'
      • '; + } + } + } + if (ref($changes{'curr'}{$balancer}{'rules'}) eq 'HASH') { + if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH')) { + foreach my $type (@{$alltypes}) { + if ($changes{'curr'}{$balancer}{'rules'}{$type}) { + my $rule = $defaultshash{'loadbalancing'}{$balancer}{'rules'}{$type}; + my $balancetext; + if ($rule eq '') { + $balancetext = $ruletitles{'default'}; + } elsif (($rule eq 'homeserver') || ($rule eq 'externalbalancer') || + ($type eq '_LC_ipchange') || ($type eq '_LC_ipchangesso')) { + if (($type eq '_LC_ipchange') || ($type eq '_LC_ipchangesso')) { + foreach my $sparetype (@sparestypes) { + if (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}) eq 'ARRAY') { + map { $toupdate{$_} = 1; } (@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}}); + } + } + foreach my $item (@{$alltypes}) { + next if ($item =~ /^_LC_ipchange/); + my $hasrule = $defaultshash{'loadbalancing'}{$balancer}{'rules'}{$item}; + if ($hasrule eq 'homeserver') { + map { $toupdate{$_} = 1; } (keys(%libraryservers)); + } else { + unless (($hasrule eq 'default') || ($hasrule eq 'none') || ($hasrule eq 'externalbalancer')) { + if ($servers{$hasrule}) { + $toupdate{$hasrule} = 1; + } + } + } + } + if (($rule eq 'balancer') || ($rule eq 'offloadedto')) { + $balancetext = $ruletitles{$rule}; + } else { + my $receiver = $defaultshash{'loadbalancing'}{$balancer}{'rules'}{$type}; + $balancetext = $ruletitles{'particular'}.' '.$receiver; + if ($receiver) { + $toupdate{$receiver}; + } + } + } else { + $balancetext = $ruletitles{$rule}; + } + } else { + $balancetext = &mt('offload to [_1]',$defaultshash{'loadbalancing'}{$balancer}{'rules'}{$type}); + } + $resulttext .= '
    • '.&mt('Load Balancer: [_1] -- balancing for [_2] set to - "[_3]"',$balancer,$titles->{$type},$balancetext).'
      • '; + } + } + } + } + if (keys(%toupdate)) { + my %thismachine; + my $updatedhere; + my $cachetime = 60*60*24; + map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids(); + foreach my $lonhost (keys(%toupdate)) { + if ($thismachine{$lonhost}) { + unless ($updatedhere) { + &Apache::lonnet::do_cache_new('loadbalancing',$dom, + $defaultshash{'loadbalancing'}, + $cachetime); + $updatedhere = 1; + } + } else { + my $cachekey = &escape('loadbalancing').':'.&escape($dom); + &Apache::lonnet::remote_devalidate_cache($lonhost,[$cachekey]); + } + } + } + } + } + if ($resulttext ne '') { + $resulttext = &mt('Changes made:').'
        '.$resulttext.'
      '; + } else { + $resulttext = $nochgmsg; + } + } else { + $resulttext = $nochgmsg; + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + } else { + $resulttext = $nochgmsg; + } + 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 $now = time; + my %dompersonnel = &Apache::lonnet::get_domain_roles($dom,['dc'],$now,$now); + my %domcoords; + my $numdcs = 0; + foreach my $server (keys(%dompersonnel)) { + foreach my $user (sort(keys(%{$dompersonnel{$server}}))) { + my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user); + $domcoords{$uname.':'.$udom} = $dompersonnel{$server}{$user}; + } + } + return %domcoords; +} + +sub active_dc_picker { + my ($dom,$numinrow,$inputtype,$name,%currhash) = @_; + my %domcoords = &get_active_dcs($dom); + my @domcoord = keys(%domcoords); + if (keys(%currhash)) { + foreach my $dc (keys(%currhash)) { + unless (exists($domcoords{$dc})) { + push(@domcoord,$dc); + } + } + } + @domcoord = sort(@domcoord); + my $numdcs = scalar(@domcoord); + my $rows = 0; + my $table; + if ($numdcs > 1) { + $table = ''; + for (my $i=0; $i<@domcoord; $i++) { + my $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $table .= ''; + } + $table .= ''; + $rows ++; + } + my $check = ''; + if ($inputtype eq 'radio') { + if (keys(%currhash) == 0) { + if (!$i) { + $check = ' checked="checked"'; + } + } elsif (exists($currhash{$domcoord[$i]})) { + $check = ' checked="checked"'; + } + } else { + if (exists($currhash{$domcoord[$i]})) { + $check = ' checked="checked"'; + } + } + if ($i == @domcoord - 1) { + my $colsleft = $numinrow - $rem; + if ($colsleft > 1) { + $table .= ''; + } + $table .= '
      '; + } else { + $table .= ''; + } + } else { + $table .= ''; + } + my ($dcname,$dcdom) = split(':',$domcoord[$i]); + my $user = &Apache::loncommon::plainname($dcname,$dcdom); + $table .= '
      '; + } elsif ($numdcs == 1) { + my ($dcname,$dcdom) = split(':',$domcoord[0]); + my $user = &Apache::loncommon::plainname($dcname,$dcdom); + if ($inputtype eq 'radio') { + $table = ''.$user; + if ($user ne $dcname.':'.$dcdom) { + $table .= ' ('.$dcname.':'.$dcdom.')'; + } + } else { + my $check; + if (exists($currhash{$domcoord[0]})) { + $check = ' checked="checked"'; + } + $table = ''; + $rows ++; + } + } + return ($numdcs,$table,$rows); +} + +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,$settings) = @_; + 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); + my (%currbalancer,%currtargets,%currrules,%existing); + if (ref($settings) eq 'HASH') { + %existing = %{$settings}; + } + &get_loadbalancers_config($servers,\%existing,\%currbalancer, + \%currtargets,\%currrules); + my $balancers = join("','",sort(keys(%currbalancer))); + 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 + +} + +sub recaptcha_js { + my %lt = &captcha_phrases(); + return <<"END"; + + + +END + +} + +sub toggle_display_js { + return <<"END"; + + + +END + +} + +sub captcha_phrases { + return &Apache::lonlocal::texthash ( + priv => 'Private key', + pub => 'Public key', + original => 'original (CAPTCHA)', + recaptcha => 'successor (ReCAPTCHA)', + notused => 'unused', + ); +} + +sub devalidate_remote_domconfs { + my ($dom,$cachekeys) = @_; + return unless (ref($cachekeys) eq 'HASH'); + my %servers = &Apache::lonnet::internet_dom_servers($dom); + my %thismachine; + map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids(); + my @posscached = ('domainconfig','domdefaults'); + if (keys(%servers)) { + foreach my $server (keys(%servers)) { + next if ($thismachine{$server}); + my @cached; + foreach my $name (@posscached) { + if ($cachekeys->{$name}) { + push(@cached,&escape($name).':'.&escape($dom)); + } + } + if (@cached) { + &Apache::lonnet::remote_devalidate_cache($server,\@cached); + } + } + } + return; +} + +1;