Annotation of loncom/interface/domainprefs.pm, revision 1.160.6.26

1.1       raeburn     1: # The LearningOnline Network with CAPA
                      2: # Handler to set domain-wide configuration settings
                      3: #
1.160.6.26! raeburn     4: # $Id: domainprefs.pm,v 1.160.6.25 2013/09/22 01:54:13 raeburn Exp $
1.2       albertel    5: #
1.1       raeburn     6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA#
                     23: # /home/httpd/html/adm/gpl.txt
                     24: #
                     25: # http://www.lon-capa.org/
                     26: #
                     27: #
                     28: ###############################################################
                     29: ##############################################################
                     30: 
1.101     raeburn    31: =pod
                     32: 
                     33: =head1 NAME
                     34: 
                     35: Apache::domainprefs.pm
                     36: 
                     37: =head1 SYNOPSIS
                     38: 
                     39: Handles configuration of a LON-CAPA domain.  
                     40: 
                     41: This is part of the LearningOnline Network with CAPA project
                     42: described at http://www.lon-capa.org.
                     43: 
                     44: 
                     45: =head1 OVERVIEW
                     46: 
                     47: Each institution using LON-CAPA will typically have a single domain designated 
1.160.6.13  raeburn    48: for use by individuals affiliated with the institution.  Accordingly, each domain
1.101     raeburn    49: may define a default set of logos and a color scheme which can be used to "brand"
                     50: the LON-CAPA instance. In addition, an institution will typically have a language
                     51: and timezone which are used for the majority of courses.
                     52: 
                     53: LON-CAPA provides a mechanism to display and modify these defaults, as well as a 
                     54: host of other domain-wide settings which determine the types of functionality
                     55: available to users and courses in the domain.
                     56: 
                     57: There is also a mechanism to configure cataloging of courses in the domain, and
                     58: controls on the operation of automated processes which govern such things as
                     59: roster updates, user directory updates and processing of course requests.
                     60: 
                     61: The domain coordination manual which is built dynamically on install/update of 
                     62: LON-CAPA from the relevant help items provides more information about domain 
                     63: configuration.
                     64: 
                     65: Most of the domain settings are stored in the configuration.db GDBM file which is
                     66: housed on the primary library server for the domain in /home/httpd/lonUsers/$dom,
                     67: where $dom is the domain.  The configuration.db stores settings in a number of 
                     68: frozen hashes of hashes.  In a few cases, domain information must be uploaded to
                     69: the domain as files (e.g., image files for logos etc., or plain text files for
                     70: bubblesheet formats).  In this case the domainprefs.pm must be running in a user
                     71: session hosted on the primary library server in the domain, as these files are 
                     72: stored in author space belonging to a special $dom-domainconfig user.   
                     73: 
                     74: domainprefs.pm in combination with lonconfigsettings.pm will retrieve and display
                     75: the current settings, and provides an interface to make modifications.
                     76: 
                     77: =head1 SUBROUTINES
                     78: 
                     79: =over
                     80: 
                     81: =item print_quotas()
                     82: 
                     83: Inputs: 4 
                     84: 
                     85: $dom,$settings,$rowtotal,$action.
                     86: 
                     87: $dom is the domain, $settings is a reference to a hash of current settings for
                     88: the current context, $rowtotal is a reference to the scalar used to record the 
1.160.6.5  raeburn    89: number of rows displayed on the page, and $action is the context (quotas,
                     90: requestcourses or requestauthor).
1.101     raeburn    91: 
                     92: The print_quotas routine was orginally created to display/store information
                     93: about default quota sizes for portfolio spaces for the different types of 
                     94: institutional affiliation in the domain (e.g., Faculty, Staff, Student etc.), 
                     95: but is now also used to manage availability of user tools: 
                     96: i.e., blogs, aboutme page, and portfolios, and the course request tool,
1.160.6.20  raeburn    97: used by course owners to request creation of a course, and to display/store
                     98: default quota sizes for authoring spaces.
                     99: 
1.101     raeburn   100: Outputs: 1
                    101: 
                    102: $datatable  - HTML containing form elements which allow settings to be changed. 
                    103: 
                    104: In the case of course requests, radio buttons are displayed for each institutional
                    105: affiliate type (and also default, and _LC_adv) for each of the course types 
                    106: (official, unofficial and community).  In each case the radio buttons allow the 
                    107: selection of one of four values:
                    108: 
1.104     raeburn   109: 0, approval, validate, autolimit=N (where N is blank, or a positive integer).
1.101     raeburn   110: which have the following effects:
                    111: 
                    112: 0
                    113: 
                    114: =over
                    115: 
                    116: - course requests are not allowed for this course types/affiliation
                    117: 
                    118: =back
                    119: 
1.104     raeburn   120: approval 
1.101     raeburn   121: 
                    122: =over 
                    123: 
                    124: - course requests must be approved by a Doman Coordinator in the 
                    125: course's domain
                    126: 
                    127: =back
                    128: 
                    129: validate 
                    130: 
                    131: =over
                    132: 
                    133: - an institutional validation (e.g., check requestor is instructor
                    134: of record) needs to be passed before the course will be created.  The required
                    135: validation is in localenroll.pm on the primary library server for the course 
                    136: domain.
                    137: 
                    138: =back
                    139: 
                    140: autolimit 
                    141: 
                    142: =over
                    143:  
1.143     raeburn   144: - course requests will be processed automatically up to a limit of
1.101     raeburn   145: N requests for the course type for the particular requestor.
                    146: If N is undefined, there is no limit to the number of course requests
                    147: which a course owner may submit and have processed automatically. 
                    148: 
                    149: =back
                    150: 
                    151: =item modify_quotas() 
                    152: 
                    153: =back
                    154: 
                    155: =cut
                    156: 
1.1       raeburn   157: package Apache::domainprefs;
                    158: 
                    159: use strict;
                    160: use Apache::Constants qw(:common :http);
                    161: use Apache::lonnet;
                    162: use Apache::loncommon();
                    163: use Apache::lonhtmlcommon();
                    164: use Apache::lonlocal;
1.43      raeburn   165: use Apache::lonmsg();
1.91      raeburn   166: use Apache::lonconfigsettings;
1.69      raeburn   167: use LONCAPA qw(:DEFAULT :match);
1.6       raeburn   168: use LONCAPA::Enrollment;
1.81      raeburn   169: use LONCAPA::lonauthcgi();
1.9       raeburn   170: use File::Copy;
1.43      raeburn   171: use Locale::Language;
1.62      raeburn   172: use DateTime::TimeZone;
1.68      raeburn   173: use DateTime::Locale;
1.1       raeburn   174: 
1.155     raeburn   175: my $registered_cleanup;
                    176: my $modified_urls;
                    177: 
1.1       raeburn   178: sub handler {
                    179:     my $r=shift;
                    180:     if ($r->header_only) {
                    181:         &Apache::loncommon::content_type($r,'text/html');
                    182:         $r->send_http_header;
                    183:         return OK;
                    184:     }
                    185: 
1.91      raeburn   186:     my $context = 'domain';
1.1       raeburn   187:     my $dom = $env{'request.role.domain'};
1.5       albertel  188:     my $domdesc = &Apache::lonnet::domain($dom,'description');
1.1       raeburn   189:     if (&Apache::lonnet::allowed('mau',$dom)) {
                    190:         &Apache::loncommon::content_type($r,'text/html');
                    191:         $r->send_http_header;
                    192:     } else {
                    193:         $env{'user.error.msg'}=
                    194:         "/adm/domainprefs:mau:0:0:Cannot modify domain settings";
                    195:         return HTTP_NOT_ACCEPTABLE;
                    196:     }
1.155     raeburn   197: 
                    198:     $registered_cleanup=0;
                    199:     @{$modified_urls}=();
                    200: 
1.1       raeburn   201:     &Apache::lonhtmlcommon::clear_breadcrumbs();
                    202:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.58      raeburn   203:                                             ['phase','actions']);
1.30      raeburn   204:     my $phase = 'pickactions';
1.3       raeburn   205:     if ( exists($env{'form.phase'}) ) {
                    206:         $phase = $env{'form.phase'};
                    207:     }
1.150     raeburn   208:     my %servers = &Apache::lonnet::internet_dom_servers($dom);
1.3       raeburn   209:     my %domconfig =
1.6       raeburn   210:       &Apache::lonnet::get_dom('configuration',['login','rolecolors',
1.125     raeburn   211:                 'quotas','autoenroll','autoupdate','autocreate',
                    212:                 'directorysrch','usercreation','usermodification',
                    213:                 'contacts','defaults','scantron','coursecategories',
1.160.6.16  raeburn   214:                 'serverstatuses','requestcourses','coursedefaults',
                    215:                 'usersessions','loadbalancing','requestauthor'],$dom);
1.43      raeburn   216:     my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll',
1.125     raeburn   217:                        'autoupdate','autocreate','directorysrch','contacts',
1.48      raeburn   218:                        'usercreation','usermodification','scantron',
1.160.6.5  raeburn   219:                        'requestcourses','requestauthor','coursecategories',
1.160.6.16  raeburn   220:                        'serverstatuses','coursedefaults','usersessions');
1.160.6.7  raeburn   221:     my %existing;
                    222:     if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
                    223:         %existing = %{$domconfig{'loadbalancing'}};
                    224:     }
                    225:     if ((keys(%servers) > 1) || (keys(%existing) > 0)) {
1.150     raeburn   226:         push(@prefs_order,'loadbalancing');
                    227:     }
1.30      raeburn   228:     my %prefs = (
                    229:         'rolecolors' =>
                    230:                    { text => 'Default color schemes',
1.67      raeburn   231:                      help => 'Domain_Configuration_Color_Schemes',
1.30      raeburn   232:                      header => [{col1 => 'Student Settings',
                    233:                                  col2 => '',},
                    234:                                 {col1 => 'Coordinator Settings',
                    235:                                  col2 => '',},
                    236:                                 {col1 => 'Author Settings',
                    237:                                  col2 => '',},
                    238:                                 {col1 => 'Administrator Settings',
                    239:                                  col2 => '',}],
                    240:                     },
1.110     raeburn   241:         'login' =>
1.30      raeburn   242:                     { text => 'Log-in page options',
1.67      raeburn   243:                       help => 'Domain_Configuration_Login_Page',
1.160.6.5  raeburn   244:                       header => [{col1 => 'Log-in Page Items',
                    245:                                   col2 => '',},
                    246:                                  {col1 => 'Log-in Help',
                    247:                                   col2 => 'Value'}],
1.30      raeburn   248:                     },
1.43      raeburn   249:         'defaults' => 
1.141     raeburn   250:                     { text => 'Default authentication/language/timezone/portal',
1.67      raeburn   251:                       help => 'Domain_Configuration_LangTZAuth',
1.43      raeburn   252:                       header => [{col1 => 'Setting',
                    253:                                   col2 => 'Value'}],
                    254:                     },
1.30      raeburn   255:         'quotas' => 
1.160.6.20  raeburn   256:                     { text => 'Blogs, personal web pages, webDAV/quotas, portfolios',
1.67      raeburn   257:                       help => 'Domain_Configuration_Quotas',
1.77      raeburn   258:                       header => [{col1 => 'User affiliation',
1.72      raeburn   259:                                   col2 => 'Available tools',
1.160.6.20  raeburn   260:                                   col3 => 'Quotas, Mb; (Authoring requires role)',}],
1.30      raeburn   261:                     },
                    262:         'autoenroll' =>
                    263:                    { text => 'Auto-enrollment settings',
1.67      raeburn   264:                      help => 'Domain_Configuration_Auto_Enrollment',
1.30      raeburn   265:                      header => [{col1 => 'Configuration setting',
                    266:                                  col2 => 'Value(s)'}],
                    267:                    },
                    268:         'autoupdate' => 
                    269:                    { text => 'Auto-update settings',
1.67      raeburn   270:                      help => 'Domain_Configuration_Auto_Updates',
1.30      raeburn   271:                      header => [{col1 => 'Setting',
                    272:                                  col2 => 'Value',},
1.131     raeburn   273:                                 {col1 => 'Setting',
                    274:                                  col2 => 'Affiliation'},
1.43      raeburn   275:                                 {col1 => 'User population',
1.131     raeburn   276:                                  col2 => 'Updateable user data'}],
1.30      raeburn   277:                   },
1.125     raeburn   278:         'autocreate' => 
                    279:                   { text => 'Auto-course creation settings',
                    280:                      help => 'Domain_Configuration_Auto_Creation',
                    281:                      header => [{col1 => 'Configuration Setting',
                    282:                                  col2 => 'Value',}],
                    283:                   },
1.30      raeburn   284:         'directorysrch' => 
                    285:                   { text => 'Institutional directory searches',
1.67      raeburn   286:                     help => 'Domain_Configuration_InstDirectory_Search',
1.30      raeburn   287:                     header => [{col1 => 'Setting',
                    288:                                 col2 => 'Value',}],
                    289:                   },
                    290:         'contacts' =>
                    291:                   { text => 'Contact Information',
1.67      raeburn   292:                     help => 'Domain_Configuration_Contact_Info',
1.30      raeburn   293:                     header => [{col1 => 'Setting',
                    294:                                 col2 => 'Value',}],
                    295:                   },
                    296: 
                    297:         'usercreation' => 
                    298:                   { text => 'User creation',
1.67      raeburn   299:                     help => 'Domain_Configuration_User_Creation',
1.43      raeburn   300:                     header => [{col1 => 'Format rule type',
                    301:                                 col2 => 'Format rules in force'},
1.34      raeburn   302:                                {col1 => 'User account creation',
                    303:                                 col2 => 'Usernames which may be created',},
1.30      raeburn   304:                                {col1 => 'Context',
1.43      raeburn   305:                                 col2 => 'Assignable authentication types'}],
1.30      raeburn   306:                   },
1.69      raeburn   307:         'usermodification' =>
1.33      raeburn   308:                   { text => 'User modification',
1.67      raeburn   309:                     help => 'Domain_Configuration_User_Modification',
1.33      raeburn   310:                     header => [{col1 => 'Target user has role',
                    311:                                 col2 => 'User information updateable in author context'},
                    312:                                {col1 => 'Target user has role',
1.63      raeburn   313:                                 col2 => 'User information updateable in course context'},
                    314:                                {col1 => "Status of user",
                    315:                                 col2 => 'Information settable when self-creating account (if directory data blank)'}],
1.33      raeburn   316:                   },
1.69      raeburn   317:         'scantron' =>
1.95      www       318:                   { text => 'Bubblesheet format file',
1.67      raeburn   319:                     help => 'Domain_Configuration_Scantron_Format',
1.46      raeburn   320:                     header => [ {col1 => 'Item',
                    321:                                  col2 => '',
                    322:                               }],
                    323:                   },
1.86      raeburn   324:         'requestcourses' => 
                    325:                  {text => 'Request creation of courses',
                    326:                   help => 'Domain_Configuration_Request_Courses',
                    327:                   header => [{col1 => 'User affiliation',
1.102     raeburn   328:                               col2 => 'Availability/Processing of requests',},
                    329:                              {col1 => 'Setting',
                    330:                               col2 => 'Value'}],
1.86      raeburn   331:                  },
1.160.6.5  raeburn   332:         'requestauthor' =>
                    333:                  {text => 'Request authoring space',
                    334:                   help => 'Domain_Configuration_Request_Author',
                    335:                   header => [{col1 => 'User affiliation',
                    336:                               col2 => 'Availability/Processing of requests',},
                    337:                              {col1 => 'Setting',
                    338:                               col2 => 'Value'}],
                    339:                  },
1.69      raeburn   340:         'coursecategories' =>
1.120     raeburn   341:                   { text => 'Cataloging of courses/communities',
1.67      raeburn   342:                     help => 'Domain_Configuration_Cataloging_Courses',
1.69      raeburn   343:                     header => [{col1 => 'Category settings',
1.57      raeburn   344:                                 col2 => '',},
                    345:                                {col1 => 'Categories',
                    346:                                 col2 => '',
                    347:                                }],
1.69      raeburn   348:                   },
                    349:         'serverstatuses' =>
1.77      raeburn   350:                  {text   => 'Access to server status pages',
1.69      raeburn   351:                   help   => 'Domain_Configuration_Server_Status',
                    352:                   header => [{col1 => 'Status Page',
                    353:                               col2 => 'Other named users',
                    354:                               col3 => 'Specific IPs',
                    355:                             }],
                    356:                  },
1.160.6.16  raeburn   357:         'coursedefaults' =>
                    358:                  {text => 'Course/Community defaults',
                    359:                   help => 'Domain_Configuration_Course_Defaults',
                    360:                   header => [{col1 => 'Defaults which can be overridden for each course by a DC',
                    361:                               col2 => 'Value',},],
                    362:                  },
1.141     raeburn   363:         'usersessions' =>
1.145     raeburn   364:                  {text  => 'User session hosting/offloading',
1.137     raeburn   365:                   help  => 'Domain_Configuration_User_Sessions',
1.145     raeburn   366:                   header => [{col1 => 'Domain server',
                    367:                               col2 => 'Servers to offload sessions to when busy'},
                    368:                              {col1 => 'Hosting of users from other domains',
1.137     raeburn   369:                               col2 => 'Rules'},
                    370:                              {col1 => "Hosting domain's own users elsewhere",
                    371:                               col2 => 'Rules'}],
                    372:                  },
1.150     raeburn   373:          'loadbalancing' =>
1.160.6.7  raeburn   374:                  {text  => 'Dedicated Load Balancer(s)',
1.150     raeburn   375:                   help  => 'Domain_Configuration_Load_Balancing',
1.160.6.7  raeburn   376:                   header => [{col1 => 'Balancers',
1.150     raeburn   377:                               col2 => 'Default destinations',
1.160.6.13  raeburn   378:                               col3 => 'User affiliation',
1.150     raeburn   379:                               col4 => 'Overrides'},
                    380:                             ],
                    381:                  },
1.3       raeburn   382:     );
1.110     raeburn   383:     if (keys(%servers) > 1) {
                    384:         $prefs{'login'}  = { text   => 'Log-in page options',
                    385:                              help   => 'Domain_Configuration_Login_Page',
                    386:                             header => [{col1 => 'Log-in Service',
                    387:                                         col2 => 'Server Setting',},
                    388:                                        {col1 => 'Log-in Page Items',
1.160.6.5  raeburn   389:                                         col2 => ''},
                    390:                                        {col1 => 'Log-in Help',
                    391:                                         col2 => 'Value'}],
1.110     raeburn   392:                            };
                    393:     }
1.160.6.13  raeburn   394: 
1.6       raeburn   395:     my @roles = ('student','coordinator','author','admin');
1.30      raeburn   396:     my @actions = &Apache::loncommon::get_env_multiple('form.actions');
1.3       raeburn   397:     &Apache::lonhtmlcommon::add_breadcrumb
1.30      raeburn   398:     ({href=>"javascript:changePage(document.$phase,'pickactions')",
1.133     raeburn   399:       text=>"Settings to display/modify"});
1.9       raeburn   400:     my $confname = $dom.'-domainconfig';
1.160.6.13  raeburn   401: 
1.3       raeburn   402:     if ($phase eq 'process') {
1.160.6.24  raeburn   403:         if (&Apache::lonconfigsettings::make_changes($r,$dom,$phase,$context,\@prefs_order,
                    404:                                                      \%prefs,\%domconfig,$confname,\@roles) eq 'update') {
                    405:             $r->rflush();
                    406:             &devalidate_remote_domconfs($dom);
                    407:         }
1.30      raeburn   408:     } elsif ($phase eq 'display') {
1.160.6.16  raeburn   409:         my $js = &recaptcha_js().
1.160.6.26! raeburn   410:                  &credits_js();
1.160.6.7  raeburn   411:         if ((keys(%servers) > 1) || (keys(%existing) > 0)) {
1.152     raeburn   412:             my ($othertitle,$usertypes,$types) =
                    413:                 &Apache::loncommon::sorted_inst_types($dom);
1.160.6.7  raeburn   414:             $js .= &lonbalance_targets_js($dom,$types,\%servers,
                    415:                                           $domconfig{'loadbalancing'}).
1.160.6.6  raeburn   416:                    &new_spares_js().
                    417:                    &common_domprefs_js().
                    418:                    &Apache::loncommon::javascript_array_indexof();
1.152     raeburn   419:         }
1.150     raeburn   420:         &Apache::lonconfigsettings::display_settings($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,$js);
1.1       raeburn   421:     } else {
1.160.6.11  raeburn   422: # check if domconfig user exists for the domain.
                    423:         my $servadm = $r->dir_config('lonAdmEMail');
1.160.6.26! raeburn   424:         my ($configuserok,$author_ok,$switchserver) =
1.160.6.11  raeburn   425:             &config_check($dom,$confname,$servadm);
                    426:         unless ($configuserok eq 'ok') {
                    427:             &Apache::lonconfigsettings::print_header($r,$phase,$context);
                    428:             $r->print(&mt('The domain configuration user "[_1]" has yet to be created.',
                    429:                           $confname).
                    430:                       '<br />'
                    431:             );
                    432:             if ($switchserver) {
                    433:                 $r->print(&mt('Ordinarily, that domain configuration user is created when the ./UPDATE script is run to install LON-CAPA for the first time.').
                    434:                           '<br />'.
                    435:                           &mt('However, that does not apply when new domains are added to a multi-domain server, and ./UPDATE has not been run recently.').
                    436:                           '<br />'.
                    437:                           &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).
                    438:                           '<br />'.
                    439:                           &mt('To do that now, use the following link: [_1]',$switchserver)
                    440:                 );
                    441:             } else {
                    442:                 $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.').
                    443:                           '<br />'.
                    444:                           &mt('Once that is done, you will be able to use the web-based "Set domain configuration" to configure the domain')
                    445:                 );
                    446:             }
                    447:             $r->print(&Apache::loncommon::end_page());
                    448:             return OK;
                    449:         }
1.21      raeburn   450:         if (keys(%domconfig) == 0) {
                    451:             my $primarylibserv = &Apache::lonnet::domain($dom,'primary');
1.29      raeburn   452:             my @ids=&Apache::lonnet::current_machine_ids();
                    453:             if (!grep(/^\Q$primarylibserv\E$/,@ids)) {
1.21      raeburn   454:                 my %designhash = &Apache::loncommon::get_domainconf($dom);
1.41      raeburn   455:                 my @loginimages = ('img','logo','domlogo','login');
1.21      raeburn   456:                 my $custom_img_count = 0;
                    457:                 foreach my $img (@loginimages) {
                    458:                     if ($designhash{$dom.'.login.'.$img} ne '') {
                    459:                         $custom_img_count ++;
                    460:                     }
                    461:                 }
                    462:                 foreach my $role (@roles) {
                    463:                     if ($designhash{$dom.'.'.$role.'.img'} ne '') {
                    464:                         $custom_img_count ++;
                    465:                     }
                    466:                 }
                    467:                 if ($custom_img_count > 0) {
1.94      raeburn   468:                     &Apache::lonconfigsettings::print_header($r,$phase,$context);
1.21      raeburn   469:                     my $switch_server = &check_switchserver($dom,$confname);
1.29      raeburn   470:                     $r->print(
                    471:     &mt('Domain configuration settings have yet to be saved for this domain via the web-based domain preferences interface.').'<br />'.
                    472:     &mt("While this remains so, you must switch to the domain's primary library server in order to update settings.").'<br /><br />'.
                    473:     &mt("Thereafter, (with a Domain Coordinator role selected in the domain) you will be able to update settings when logged in to any server in the LON-CAPA network.").'<br />'.
                    474:     &mt("However, you will still need to switch to the domain's primary library server to upload new images or logos.").'<br /><br />');
                    475:                     if ($switch_server) {
1.30      raeburn   476:                         $r->print($switch_server.' '.&mt('to primary library server for domain: [_1]',$dom));
1.29      raeburn   477:                     }
1.91      raeburn   478:                     $r->print(&Apache::loncommon::end_page());
1.21      raeburn   479:                     return OK;
                    480:                 }
                    481:             }
                    482:         }
1.91      raeburn   483:         &Apache::lonconfigsettings::display_choices($r,$phase,$context,\@prefs_order,\%prefs);
1.3       raeburn   484:     }
                    485:     return OK;
                    486: }
                    487: 
                    488: sub process_changes {
1.160.6.24  raeburn   489:     my ($r,$dom,$confname,$action,$roles,$values,$lastactref) = @_;
1.92      raeburn   490:     my %domconfig;
                    491:     if (ref($values) eq 'HASH') {
                    492:         %domconfig = %{$values};
                    493:     }
1.3       raeburn   494:     my $output;
                    495:     if ($action eq 'login') {
1.160.6.24  raeburn   496:         $output = &modify_login($r,$dom,$confname,$lastactref,%domconfig);
1.6       raeburn   497:     } elsif ($action eq 'rolecolors') {
1.9       raeburn   498:         $output = &modify_rolecolors($r,$dom,$confname,$roles,
1.160.6.24  raeburn   499:                                      $lastactref,%domconfig);
1.3       raeburn   500:     } elsif ($action eq 'quotas') {
1.86      raeburn   501:         $output = &modify_quotas($dom,$action,%domconfig);
1.3       raeburn   502:     } elsif ($action eq 'autoenroll') {
1.160.6.24  raeburn   503:         $output = &modify_autoenroll($dom,$lastactref,%domconfig);
1.3       raeburn   504:     } elsif ($action eq 'autoupdate') {
                    505:         $output = &modify_autoupdate($dom,%domconfig);
1.125     raeburn   506:     } elsif ($action eq 'autocreate') {
                    507:         $output = &modify_autocreate($dom,%domconfig);
1.23      raeburn   508:     } elsif ($action eq 'directorysrch') {
                    509:         $output = &modify_directorysrch($dom,%domconfig);
1.27      raeburn   510:     } elsif ($action eq 'usercreation') {
1.28      raeburn   511:         $output = &modify_usercreation($dom,%domconfig);
1.33      raeburn   512:     } elsif ($action eq 'usermodification') {
                    513:         $output = &modify_usermodification($dom,%domconfig);
1.28      raeburn   514:     } elsif ($action eq 'contacts') {
1.160.6.24  raeburn   515:         $output = &modify_contacts($dom,$lastactref,%domconfig);
1.43      raeburn   516:     } elsif ($action eq 'defaults') {
1.160.6.23  raeburn   517:         $output = &modify_defaults($dom,$r,%domconfig);
1.46      raeburn   518:     } elsif ($action eq 'scantron') {
1.160.6.24  raeburn   519:         $output = &modify_scantron($r,$dom,$confname,$lastactref,%domconfig);
1.48      raeburn   520:     } elsif ($action eq 'coursecategories') {
                    521:         $output = &modify_coursecategories($dom,%domconfig);
1.69      raeburn   522:     } elsif ($action eq 'serverstatuses') {
                    523:         $output = &modify_serverstatuses($dom,%domconfig);
1.86      raeburn   524:     } elsif ($action eq 'requestcourses') {
                    525:         $output = &modify_quotas($dom,$action,%domconfig);
1.160.6.5  raeburn   526:     } elsif ($action eq 'requestauthor') {
                    527:         $output = &modify_quotas($dom,$action,%domconfig);
1.160.6.16  raeburn   528:     } elsif ($action eq 'coursedefaults') {
                    529:         $output = &modify_coursedefaults($dom,%domconfig);
1.137     raeburn   530:     } elsif ($action eq 'usersessions') {
                    531:         $output = &modify_usersessions($dom,%domconfig);
1.150     raeburn   532:     } elsif ($action eq 'loadbalancing') {
                    533:         $output = &modify_loadbalancing($dom,%domconfig);
1.3       raeburn   534:     }
                    535:     return $output;
                    536: }
                    537: 
                    538: sub print_config_box {
1.9       raeburn   539:     my ($r,$dom,$confname,$phase,$action,$item,$settings) = @_;
1.30      raeburn   540:     my $rowtotal = 0;
1.49      raeburn   541:     my $output;
                    542:     if ($action eq 'coursecategories') {
                    543:         $output = &coursecategories_javascript($settings);
1.91      raeburn   544:     }
1.49      raeburn   545:     $output .= 
1.30      raeburn   546:          '<table class="LC_nested_outer">
1.3       raeburn   547:           <tr>
1.66      raeburn   548:            <th align="left" valign="middle"><span class="LC_nobreak">'.
                    549:            &mt($item->{text}).'&nbsp;'.
                    550:            &Apache::loncommon::help_open_topic($item->{'help'}).'</span></th>'."\n".
                    551:           '</tr>';
1.30      raeburn   552:     $rowtotal ++;
1.110     raeburn   553:     my $numheaders = 1;
                    554:     if (ref($item->{'header'}) eq 'ARRAY') {
                    555:         $numheaders = scalar(@{$item->{'header'}});
                    556:     }
                    557:     if ($numheaders > 1) {
1.64      raeburn   558:         my $colspan = '';
1.145     raeburn   559:         my $rightcolspan = '';
1.160.6.5  raeburn   560:         if (($action eq 'rolecolors') || ($action eq 'coursecategories') ||
                    561:             (($action eq 'login') && ($numheaders < 3))) {
1.64      raeburn   562:             $colspan = ' colspan="2"';
                    563:         }
1.145     raeburn   564:         if ($action eq 'usersessions') {
                    565:             $rightcolspan = ' colspan="3"'; 
                    566:         }
1.30      raeburn   567:         $output .= '
1.3       raeburn   568:           <tr>
                    569:            <td>
                    570:             <table class="LC_nested">
                    571:              <tr class="LC_info_row">
1.59      bisitz    572:               <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[0]->{'col1'}).'</td>
1.145     raeburn   573:               <td class="LC_right_item"'.$rightcolspan.'>'.&mt($item->{'header'}->[0]->{'col2'}).'</td>
1.30      raeburn   574:              </tr>';
1.69      raeburn   575:         $rowtotal ++;
1.6       raeburn   576:         if ($action eq 'autoupdate') {
1.30      raeburn   577:             $output .= &print_autoupdate('top',$dom,$settings,\$rowtotal);
1.28      raeburn   578:         } elsif ($action eq 'usercreation') {
1.33      raeburn   579:             $output .= &print_usercreation('top',$dom,$settings,\$rowtotal);
                    580:         } elsif ($action eq 'usermodification') {
                    581:             $output .= &print_usermodification('top',$dom,$settings,\$rowtotal);
1.57      raeburn   582:         } elsif ($action eq 'coursecategories') {
                    583:             $output .= &print_coursecategories('top',$dom,$item,$settings,\$rowtotal);
1.110     raeburn   584:         } elsif ($action eq 'login') {
1.160.6.5  raeburn   585:             if ($numheaders == 3) {
                    586:                 $colspan = ' colspan="2"';
                    587:                 $output .= &print_login('service',$dom,$confname,$phase,$settings,\$rowtotal);
                    588:             } else {
                    589:                 $output .= &print_login('page',$dom,$confname,$phase,$settings,\$rowtotal);
                    590:             }
1.102     raeburn   591:         } elsif ($action eq 'requestcourses') {
                    592:             $output .= &print_quotas($dom,$settings,\$rowtotal,$action);
1.160.6.5  raeburn   593:         } elsif ($action eq 'requestauthor') {
                    594:             $output .= &print_quotas($dom,$settings,\$rowtotal,$action);
1.137     raeburn   595:         } elsif ($action eq 'usersessions') {
                    596:             $output .= &print_usersessions('top',$dom,$settings,\$rowtotal); 
1.122     jms       597:         } elsif ($action eq 'rolecolors') {
1.30      raeburn   598:             $output .= &print_rolecolors($phase,'student',$dom,$confname,$settings,\$rowtotal);
1.160.6.2  raeburn   599:         }
1.30      raeburn   600:         $output .= '
1.6       raeburn   601:            </table>
                    602:           </td>
                    603:          </tr>
                    604:          <tr>
                    605:            <td>
                    606:             <table class="LC_nested">
                    607:              <tr class="LC_info_row">
1.59      bisitz    608:               <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[1]->{'col1'}).'</td>';
1.57      raeburn   609:         $output .= '
1.59      bisitz    610:               <td class="LC_right_item"'.$colspan.'>'.&mt($item->{'header'}->[1]->{'col2'}).'</td>
1.30      raeburn   611:              </tr>';
                    612:             $rowtotal ++;
1.6       raeburn   613:         if ($action eq 'autoupdate') {
1.131     raeburn   614:             $output .= &print_autoupdate('middle',$dom,$settings,\$rowtotal).'
                    615:            </table>
                    616:           </td>
                    617:          </tr>
                    618:          <tr>
                    619:            <td>
                    620:             <table class="LC_nested">
                    621:              <tr class="LC_info_row">
                    622:               <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[2]->{'col1'}).'</td>
                    623:               <td class="LC_right_item">'.&mt($item->{'header'}->[2]->{'col2'}).'</td>      </tr>'.
                    624:             &print_autoupdate('bottom',$dom,$settings,\$rowtotal);
                    625:             $rowtotal ++;
1.28      raeburn   626:         } elsif ($action eq 'usercreation') {
1.34      raeburn   627:             $output .= &print_usercreation('middle',$dom,$settings,\$rowtotal).'
                    628:            </table>
                    629:           </td>
                    630:          </tr>
                    631:          <tr>
                    632:            <td>
                    633:             <table class="LC_nested">
                    634:              <tr class="LC_info_row">
1.59      bisitz    635:               <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[2]->{'col1'}).'</td>
                    636:               <td class="LC_right_item">'.&mt($item->{'header'}->[2]->{'col2'}).'</td>             </tr>'.
1.34      raeburn   637:             &print_usercreation('bottom',$dom,$settings,\$rowtotal);
                    638:             $rowtotal ++;
1.33      raeburn   639:         } elsif ($action eq 'usermodification') {
1.63      raeburn   640:             $output .= &print_usermodification('middle',$dom,$settings,\$rowtotal).'
                    641:            </table>
                    642:           </td>
                    643:          </tr>
                    644:          <tr>
                    645:            <td>
                    646:             <table class="LC_nested">
                    647:              <tr class="LC_info_row">
                    648:               <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[2]->{'col1'}).'</td>
                    649:               <td class="LC_right_item">'.&mt($item->{'header'}->[2]->{'col2'}).'</td>      </tr>'.
                    650:                        &print_usermodification('bottom',$dom,$settings,\$rowtotal);
                    651:             $rowtotal ++;
1.57      raeburn   652:         } elsif ($action eq 'coursecategories') {
                    653:             $output .= &print_coursecategories('bottom',$dom,$item,$settings,\$rowtotal);
1.110     raeburn   654:         } elsif ($action eq 'login') {
1.160.6.5  raeburn   655:             if ($numheaders == 3) {
                    656:                 $output .= &print_login('page',$dom,$confname,$phase,$settings,\$rowtotal).'
                    657:            </table>
                    658:           </td>
                    659:          </tr>
                    660:          <tr>
                    661:            <td>
                    662:             <table class="LC_nested">
                    663:              <tr class="LC_info_row">
                    664:               <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[2]->{'col1'}).'</td>
                    665:               <td class="LC_right_item"'.$colspan.'>'.&mt($item->{'header'}->[2]->{'col2'}).'</td>      </tr>'.
                    666:                        &print_login('help',$dom,$confname,$phase,$settings,\$rowtotal);
                    667:                 $rowtotal ++;
                    668:             } else {
                    669:                 $output .= &print_login('help',$dom,$confname,$phase,$settings,\$rowtotal);
                    670:             }
1.102     raeburn   671:         } elsif ($action eq 'requestcourses') {
1.160.6.5  raeburn   672:             $output .= &print_requestmail($dom,$action,$settings,\$rowtotal);
                    673:         } elsif ($action eq 'requestauthor') {
                    674:             $output .= &print_requestmail($dom,$action,$settings,\$rowtotal);
1.137     raeburn   675:         } elsif ($action eq 'usersessions') {
1.145     raeburn   676:             $output .= &print_usersessions('middle',$dom,$settings,\$rowtotal).'
                    677:            </table>
                    678:           </td>
                    679:          </tr>
                    680:          <tr>
                    681:            <td>
                    682:             <table class="LC_nested">
                    683:              <tr class="LC_info_row">
                    684:               <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[2]->{'col1'}).'</td>
                    685:               <td class="LC_right_item">'.&mt($item->{'header'}->[2]->{'col2'}).'</td>      </tr>'.
                    686:                        &print_usersessions('bottom',$dom,$settings,\$rowtotal);
                    687:             $rowtotal ++;
1.122     jms       688:         } elsif ($action eq 'rolecolors') {
1.30      raeburn   689:             $output .= &print_rolecolors($phase,'coordinator',$dom,$confname,$settings,\$rowtotal).'
1.6       raeburn   690:            </table>
                    691:           </td>
                    692:          </tr>
                    693:          <tr>
                    694:            <td>
                    695:             <table class="LC_nested">
                    696:              <tr class="LC_info_row">
1.69      raeburn   697:               <td class="LC_left_item"'.$colspan.' valign="top">'.
                    698:                &mt($item->{'header'}->[2]->{'col1'}).'</td>
                    699:               <td class="LC_right_item" valign="top">'.
                    700:                &mt($item->{'header'}->[2]->{'col2'}).'</td>
1.3       raeburn   701:              </tr>'.
1.30      raeburn   702:             &print_rolecolors($phase,'author',$dom,$confname,$settings,\$rowtotal).'
1.3       raeburn   703:            </table>
                    704:           </td>
                    705:          </tr>
                    706:          <tr>
                    707:            <td>
                    708:             <table class="LC_nested">
                    709:              <tr class="LC_info_row">
1.59      bisitz    710:               <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[3]->{'col1'}).'</td>
                    711:               <td class="LC_right_item">'.&mt($item->{'header'}->[3]->{'col2'}).'</td>
1.3       raeburn   712:              </tr>'.
1.30      raeburn   713:             &print_rolecolors($phase,'admin',$dom,$confname,$settings,\$rowtotal);
                    714:             $rowtotal += 2;
1.6       raeburn   715:         }
1.3       raeburn   716:     } else {
1.30      raeburn   717:         $output .= '
1.3       raeburn   718:           <tr>
                    719:            <td>
                    720:             <table class="LC_nested">
1.30      raeburn   721:              <tr class="LC_info_row">';
1.24      raeburn   722:         if (($action eq 'login') || ($action eq 'directorysrch')) {
1.30      raeburn   723:             $output .= '  
1.59      bisitz    724:               <td class="LC_left_item" colspan="2">'.&mt($item->{'header'}->[0]->{'col1'}).'</td>';
1.69      raeburn   725:         } elsif ($action eq 'serverstatuses') {
                    726:             $output .= '
                    727:               <td class="LC_left_item" valign="top">'.&mt($item->{'header'}->[0]->{'col1'}).
                    728:               '<br />('.&mt('Automatic access for Dom. Coords.').')</td>';
                    729: 
1.6       raeburn   730:         } else {
1.30      raeburn   731:             $output .= '
1.69      raeburn   732:               <td class="LC_left_item" valign="top">'.&mt($item->{'header'}->[0]->{'col1'}).'</td>';
                    733:         }
1.72      raeburn   734:         if (defined($item->{'header'}->[0]->{'col3'})) {
                    735:             $output .= '<td class="LC_left_item" valign="top">'.
                    736:                        &mt($item->{'header'}->[0]->{'col2'});
                    737:             if ($action eq 'serverstatuses') {
                    738:                 $output .= '<br />(<tt>'.&mt('user1:domain1,user2:domain2 etc.').'</tt>)';
                    739:             } 
1.69      raeburn   740:         } else {
                    741:             $output .= '<td class="LC_right_item" valign="top">'.
                    742:                        &mt($item->{'header'}->[0]->{'col2'});
                    743:         }
                    744:         $output .= '</td>';
                    745:         if ($item->{'header'}->[0]->{'col3'}) {
1.150     raeburn   746:             if (defined($item->{'header'}->[0]->{'col4'})) {
                    747:                 $output .= '<td class="LC_left_item" valign="top">'.
                    748:                             &mt($item->{'header'}->[0]->{'col3'});
                    749:             } else {
                    750:                 $output .= '<td class="LC_right_item" valign="top">'.
                    751:                            &mt($item->{'header'}->[0]->{'col3'});
                    752:             }
1.69      raeburn   753:             if ($action eq 'serverstatuses') {
                    754:                 $output .= '<br />(<tt>'.&mt('IP1,IP2 etc.').'</tt>)';
                    755:             }
                    756:             $output .= '</td>';
1.6       raeburn   757:         }
1.150     raeburn   758:         if ($item->{'header'}->[0]->{'col4'}) {
                    759:             $output .= '<td class="LC_right_item" valign="top">'.
                    760:                        &mt($item->{'header'}->[0]->{'col4'});
                    761:         }
1.69      raeburn   762:         $output .= '</tr>';
1.48      raeburn   763:         $rowtotal ++;
1.160.6.5  raeburn   764:         if ($action eq 'quotas') {
1.86      raeburn   765:             $output .= &print_quotas($dom,$settings,\$rowtotal,$action);
1.3       raeburn   766:         } elsif ($action eq 'autoenroll') {
1.30      raeburn   767:             $output .= &print_autoenroll($dom,$settings,\$rowtotal);
1.125     raeburn   768:         } elsif ($action eq 'autocreate') {
                    769:             $output .= &print_autocreate($dom,$settings,\$rowtotal);
1.23      raeburn   770:         } elsif ($action eq 'directorysrch') {
1.30      raeburn   771:             $output .= &print_directorysrch($dom,$settings,\$rowtotal);
1.28      raeburn   772:         } elsif ($action eq 'contacts') {
1.30      raeburn   773:             $output .= &print_contacts($dom,$settings,\$rowtotal);
1.43      raeburn   774:         } elsif ($action eq 'defaults') {
                    775:             $output .= &print_defaults($dom,\$rowtotal);
1.46      raeburn   776:         } elsif ($action eq 'scantron') {
                    777:             $output .= &print_scantronformat($r,$dom,$confname,$settings,\$rowtotal);
1.69      raeburn   778:         } elsif ($action eq 'serverstatuses') {
                    779:             $output .= &print_serverstatuses($dom,$settings,\$rowtotal);
1.118     jms       780:         } elsif ($action eq 'helpsettings') {
1.160.6.5  raeburn   781:             $output .= &print_helpsettings($dom,$confname,$settings,\$rowtotal);
1.150     raeburn   782:         } elsif ($action eq 'loadbalancing') {
                    783:             $output .= &print_loadbalancing($dom,$settings,\$rowtotal);
1.160.6.16  raeburn   784:         } elsif ($action eq 'coursedefaults') {
                    785:             $output .= &print_coursedefaults('bottom',$dom,$settings,\$rowtotal);
1.121     raeburn   786:         }
1.3       raeburn   787:     }
1.30      raeburn   788:     $output .= '
1.3       raeburn   789:    </table>
                    790:   </td>
                    791:  </tr>
1.30      raeburn   792: </table><br />';
                    793:     return ($output,$rowtotal);
1.1       raeburn   794: }
                    795: 
1.3       raeburn   796: sub print_login {
1.160.6.5  raeburn   797:     my ($caller,$dom,$confname,$phase,$settings,$rowtotal) = @_;
1.110     raeburn   798:     my ($css_class,$datatable);
1.6       raeburn   799:     my %choices = &login_choices();
1.110     raeburn   800: 
1.160.6.5  raeburn   801:     if ($caller eq 'service') {
1.149     raeburn   802:         my %servers = &Apache::lonnet::internet_dom_servers($dom);
1.110     raeburn   803:         my $choice = $choices{'disallowlogin'};
                    804:         $css_class = ' class="LC_odd_row"';
1.128     raeburn   805:         $datatable .= '<tr'.$css_class.'><td>'.$choice.'</td>'.
1.110     raeburn   806:                       '<td align="right"><table><tr><th>'.$choices{'hostid'}.'</th>'.
1.128     raeburn   807:                       '<th>'.$choices{'server'}.'</th>'.
                    808:                       '<th>'.$choices{'serverpath'}.'</th>'.
                    809:                       '<th>'.$choices{'custompath'}.'</th>'.
                    810:                       '<th><span class="LC_nobreak">'.$choices{'exempt'}.'</span></th></tr>'."\n";
1.110     raeburn   811:         my %disallowed;
                    812:         if (ref($settings) eq 'HASH') {
                    813:             if (ref($settings->{'loginvia'}) eq 'HASH') {
                    814:                %disallowed = %{$settings->{'loginvia'}};
                    815:             }
                    816:         }
                    817:         foreach my $lonhost (sort(keys(%servers))) {
                    818:             my $direct = 'selected="selected"';
1.128     raeburn   819:             if (ref($disallowed{$lonhost}) eq 'HASH') {
                    820:                 if ($disallowed{$lonhost}{'server'} ne '') {
                    821:                     $direct = '';
                    822:                 }
1.110     raeburn   823:             }
1.115     raeburn   824:             $datatable .= '<tr><td>'.$servers{$lonhost}.'</td>'.
1.128     raeburn   825:                           '<td><select name="'.$lonhost.'_server">'.
1.110     raeburn   826:                           '<option value=""'.$direct.'>'.$choices{'directlogin'}.
                    827:                           '</option>';
1.160.6.13  raeburn   828:             foreach my $hostid (sort(keys(%servers))) {
1.115     raeburn   829:                 next if ($servers{$hostid} eq $servers{$lonhost});
1.110     raeburn   830:                 my $selected = '';
1.128     raeburn   831:                 if (ref($disallowed{$lonhost}) eq 'HASH') {
                    832:                     if ($hostid eq $disallowed{$lonhost}{'server'}) {
                    833:                         $selected = 'selected="selected"';
                    834:                     }
1.110     raeburn   835:                 }
                    836:                 $datatable .= '<option value="'.$hostid.'"'.$selected.'>'.
                    837:                               $servers{$hostid}.'</option>';
                    838:             }
1.128     raeburn   839:             $datatable .= '</select></td>'.
                    840:                           '<td><select name="'.$lonhost.'_serverpath">';
                    841:             foreach my $path ('','/','/adm/login','/adm/roles','custom') {
                    842:                 my $pathname = $path;
                    843:                 if ($path eq 'custom') {
                    844:                     $pathname = &mt('Custom Path').' ->';
                    845:                 }
                    846:                 my $selected = '';
                    847:                 if (ref($disallowed{$lonhost}) eq 'HASH') {
                    848:                     if ($path eq $disallowed{$lonhost}{'serverpath'}) {
                    849:                         $selected = 'selected="selected"';
                    850:                     }
                    851:                 } elsif ($path eq '') {
                    852:                     $selected = 'selected="selected"';
                    853:                 }
                    854:                 $datatable .= '<option value="'.$path.'"'.$selected.'>'.$pathname.'</option>';
                    855:             }
                    856:             $datatable .= '</select></td>';
                    857:             my ($custom,$exempt);
                    858:             if (ref($disallowed{$lonhost}) eq 'HASH') {
                    859:                 $custom = $disallowed{$lonhost}{'custompath'};
                    860:                 $exempt = $disallowed{$lonhost}{'exempt'};
                    861:             }
                    862:             $datatable .= '<td><input type="text" name="'.$lonhost.'_custompath" size="6" value="'.$custom.'" /></td>'.
                    863:                           '<td><input type="text" name="'.$lonhost.'_exempt" size="8" value="'.$exempt.'" /></td>'.
                    864:                           '</tr>';
1.110     raeburn   865:         }
                    866:         $datatable .= '</table></td></tr>';
                    867:         return $datatable;
1.160.6.5  raeburn   868:     } elsif ($caller eq 'page') {
                    869:         my %defaultchecked = ( 
                    870:                                'coursecatalog' => 'on',
1.160.6.14  raeburn   871:                                'helpdesk'      => 'on',
1.160.6.5  raeburn   872:                                'adminmail'     => 'off',
                    873:                                'newuser'       => 'off',
                    874:                              );
1.160.6.14  raeburn   875:         my @toggles = ('coursecatalog','adminmail','helpdesk','newuser');
1.160.6.5  raeburn   876:         my (%checkedon,%checkedoff);
1.42      raeburn   877:         foreach my $item (@toggles) {
1.160.6.5  raeburn   878:             if ($defaultchecked{$item} eq 'on') { 
                    879:                 $checkedon{$item} = ' checked="checked" ';
1.42      raeburn   880:                 $checkedoff{$item} = ' ';
1.160.6.5  raeburn   881:             } elsif ($defaultchecked{$item} eq 'off') {
                    882:                 $checkedoff{$item} = ' checked="checked" ';
1.42      raeburn   883:                 $checkedon{$item} = ' ';
                    884:             }
1.1       raeburn   885:         }
1.160.6.5  raeburn   886:         my @images = ('img','logo','domlogo','login');
                    887:         my @logintext = ('textcol','bgcol');
                    888:         my @bgs = ('pgbg','mainbg','sidebg');
                    889:         my @links = ('link','alink','vlink');
                    890:         my %designhash = &Apache::loncommon::get_domainconf($dom);
                    891:         my %defaultdesign = %Apache::loncommon::defaultdesign;
                    892:         my (%is_custom,%designs);
                    893:         my %defaults = (
                    894:                        font => $defaultdesign{'login.font'},
                    895:                        );
1.6       raeburn   896:         foreach my $item (@images) {
1.160.6.5  raeburn   897:             $defaults{$item} = $defaultdesign{'login.'.$item};
                    898:             $defaults{'showlogo'}{$item} = 1;
                    899:         }
                    900:         foreach my $item (@bgs) {
                    901:             $defaults{'bgs'}{$item} = $defaultdesign{'login.'.$item};
1.6       raeburn   902:         }
1.41      raeburn   903:         foreach my $item (@logintext) {
1.160.6.5  raeburn   904:             $defaults{'logintext'}{$item} = $defaultdesign{'login.'.$item};
1.41      raeburn   905:         }
1.160.6.5  raeburn   906:         foreach my $item (@links) {
                    907:             $defaults{'links'}{$item} = $defaultdesign{'login.'.$item};
1.6       raeburn   908:         }
1.160.6.5  raeburn   909:         if (ref($settings) eq 'HASH') {
                    910:             foreach my $item (@toggles) {
                    911:                 if ($settings->{$item} eq '1') {
                    912:                     $checkedon{$item} =  ' checked="checked" ';
                    913:                     $checkedoff{$item} = ' ';
                    914:                 } elsif ($settings->{$item} eq '0') {
                    915:                     $checkedoff{$item} =  ' checked="checked" ';
                    916:                     $checkedon{$item} = ' ';
                    917:                 }
1.6       raeburn   918:             }
1.160.6.5  raeburn   919:             foreach my $item (@images) {
                    920:                 if (defined($settings->{$item})) {
                    921:                     $designs{$item} = $settings->{$item};
                    922:                     $is_custom{$item} = 1;
                    923:                 }
                    924:                 if (defined($settings->{'showlogo'}{$item})) {
                    925:                     $designs{'showlogo'}{$item} = $settings->{'showlogo'}{$item};
                    926:                 }
                    927:             }
                    928:             foreach my $item (@logintext) {
                    929:                 if ($settings->{$item} ne '') {
                    930:                     $designs{'logintext'}{$item} = $settings->{$item};
                    931:                     $is_custom{$item} = 1;
                    932:                 }
                    933:             }
                    934:             if ($settings->{'font'} ne '') {
                    935:                 $designs{'font'} = $settings->{'font'};
                    936:                 $is_custom{'font'} = 1;
                    937:             }
                    938:             foreach my $item (@bgs) {
                    939:                 if ($settings->{$item} ne '') {
                    940:                     $designs{'bgs'}{$item} = $settings->{$item};
                    941:                     $is_custom{$item} = 1;
                    942:                 }
                    943:             }
                    944:             foreach my $item (@links) {
                    945:                 if ($settings->{$item} ne '') {
                    946:                     $designs{'links'}{$item} = $settings->{$item};
                    947:                     $is_custom{$item} = 1;
                    948:                 }
                    949:             }
                    950:         } else {
                    951:             if ($designhash{$dom.'.login.font'} ne '') {
                    952:                 $designs{'font'} = $designhash{$dom.'.login.font'};
                    953:                 $is_custom{'font'} = 1;
                    954:             }
                    955:             foreach my $item (@images) {
                    956:                 if ($designhash{$dom.'.login.'.$item} ne '') {
                    957:                     $designs{$item} = $designhash{$dom.'.login.'.$item};
                    958:                     $is_custom{$item} = 1;
                    959:                 }
                    960:             }
                    961:             foreach my $item (@bgs) {
                    962:                 if ($designhash{$dom.'.login.'.$item} ne '') {
                    963:                     $designs{'bgs'}{$item} = $designhash{$dom.'.login.'.$item};
                    964:                     $is_custom{$item} = 1;
                    965:                 }
                    966:             }
                    967:             foreach my $item (@links) {
                    968:                 if ($designhash{$dom.'.login.'.$item} ne '') {
                    969:                     $designs{'links'}{$item} = $designhash{$dom.'.login.'.$item};
                    970:                     $is_custom{$item} = 1;
                    971:                 }
1.6       raeburn   972:             }
                    973:         }
1.160.6.5  raeburn   974:         my %alt_text = &Apache::lonlocal::texthash  ( img => 'Log-in banner',
                    975:                                                       logo => 'Institution Logo',
                    976:                                                       domlogo => 'Domain Logo',
                    977:                                                       login => 'Login box');
                    978:         my $itemcount = 1;
                    979:         foreach my $item (@toggles) {
                    980:             $css_class = $itemcount%2?' class="LC_odd_row"':'';
                    981:             $datatable .=  
                    982:                 '<tr'.$css_class.'><td colspan="2">'.$choices{$item}.
                    983:                 '</td><td>'.
                    984:                 '<span class="LC_nobreak"><label><input type="radio" name="'.
                    985:                 $item.'"'.$checkedon{$item}.' value="1" />'.&mt('Yes').
                    986:                 '</label>&nbsp;<label><input type="radio" name="'.$item.'"'.
                    987:                 $checkedoff{$item}.' value="0" />'.&mt('No').'</label></span></td>'.
                    988:                 '</tr>';
                    989:             $itemcount ++;
1.6       raeburn   990:         }
1.160.6.5  raeburn   991:         $datatable .= &display_color_options($dom,$confname,$phase,'login',$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal,\@logintext);
                    992:         $datatable .= '</tr></table></td></tr>';
                    993:     } elsif ($caller eq 'help') {
                    994:         my ($defaulturl,$defaulttype,%url,%type,%lt,%langchoices);
                    995:         my $switchserver = &check_switchserver($dom,$confname);
                    996:         my $itemcount = 1;
                    997:         $defaulturl = '/adm/loginproblems.html';
                    998:         $defaulttype = 'default';
                    999:         %lt = &Apache::lonlocal::texthash (
                   1000:                      del     => 'Delete?',
                   1001:                      rep     => 'Replace:',
                   1002:                      upl     => 'Upload:',
                   1003:                      default => 'Default',
                   1004:                      custom  => 'Custom',
                   1005:                                              );
                   1006:         %langchoices = &Apache::lonlocal::texthash(&get_languages_hash());
                   1007:         my @currlangs;
                   1008:         if (ref($settings) eq 'HASH') {
                   1009:             if (ref($settings->{'helpurl'}) eq 'HASH') {
                   1010:                 foreach my $key (sort(keys(%{$settings->{'helpurl'}}))) {
                   1011:                     next if ($settings->{'helpurl'}{$key} eq '');
                   1012:                     $url{$key} = $settings->{'helpurl'}{$key}.'?inhibitmenu=yes';
                   1013:                     $type{$key} = 'custom';
                   1014:                     unless ($key eq 'nolang') {
                   1015:                         push(@currlangs,$key);
                   1016:                     }
                   1017:                 }
                   1018:             } elsif ($settings->{'helpurl'} ne '') {
                   1019:                 $type{'nolang'} = 'custom';
                   1020:                 $url{'nolang'} = $settings->{'helpurl'}.'?inhibitmenu=yes';
1.8       raeburn  1021:             }
                   1022:         }
1.160.6.5  raeburn  1023:         foreach my $lang ('nolang',sort(@currlangs)) {
                   1024:             $css_class = $itemcount%2 ? ' class="LC_odd_row"' : '';
                   1025:             $datatable .= '<tr'.$css_class.'>';
                   1026:             if ($url{$lang} eq '') {
                   1027:                 $url{$lang} = $defaulturl;
                   1028:             }
                   1029:             if ($type{$lang} eq '') {
                   1030:                 $type{$lang} = $defaulttype;
                   1031:             }
                   1032:             $datatable .= '<td colspan="2"><span class="LC_nobreak">';
                   1033:             if ($lang eq 'nolang') {
                   1034:                 $datatable .= &mt('Log-in help page if no specific language file: [_1]',
                   1035:                                   &Apache::loncommon::modal_link($url{$lang},$lt{$type{$lang}},600,500));
                   1036:             } else {
                   1037:                 $datatable .= &mt('Log-in help page for language: [_1] is [_2]',
                   1038:                                   $langchoices{$lang},
                   1039:                                   &Apache::loncommon::modal_link($url{$lang},$lt{$type{$lang}},600,500));
                   1040:             }
                   1041:             $datatable .= '</span></td>'."\n".
                   1042:                           '<td class="LC_left_item">';
                   1043:             if ($type{$lang} eq 'custom') {
                   1044:                 $datatable .= '<span class="LC_nobreak"><label>'.
                   1045:                               '<input type="checkbox" name="loginhelpurl_del" value="'.$lang.'" />'.
                   1046:                               $lt{'del'}.'</label>&nbsp;'.$lt{'rep'}.'</span>';
                   1047:             } else {
                   1048:                 $datatable .= $lt{'upl'};
                   1049:             }
                   1050:             $datatable .='<br />';
                   1051:             if ($switchserver) {
                   1052:                 $datatable .= &mt('Upload to library server: [_1]',$switchserver);
                   1053:             } else {
                   1054:                 $datatable .= '<input type="file" name="loginhelpurl_'.$lang.'" />';
1.6       raeburn  1055:             }
1.160.6.5  raeburn  1056:             $datatable .= '</td></tr>';
                   1057:             $itemcount ++;
1.6       raeburn  1058:         }
1.160.6.5  raeburn  1059:         my @addlangs;
                   1060:         foreach my $lang (sort(keys(%langchoices))) {
                   1061:             next if ((grep(/^\Q$lang\E$/,@currlangs)) || ($lang eq 'x_chef'));
                   1062:             push(@addlangs,$lang);
                   1063:         }
                   1064:         if (@addlangs > 0) {
                   1065:             my %toadd;
                   1066:             map { $toadd{$_} = $langchoices{$_} ; } @addlangs;
                   1067:             $toadd{''} = &mt('Select');
                   1068:             $css_class = $itemcount%2 ? ' class="LC_odd_row"' : '';
                   1069:             $datatable .= '<tr'.$css_class.'><td class="LC_left_item" colspan="2">'.
                   1070:                           &mt('Add log-in help page for a specific language:').'&nbsp;'.
                   1071:                           &Apache::loncommon::select_form('','loginhelpurl_add_lang',\%toadd).
                   1072:                           '</td><td class="LC_left_item">'.$lt{'upl'}.'<br />';
                   1073:             if ($switchserver) {
                   1074:                 $datatable .= &mt('Upload to library server: [_1]',$switchserver);
                   1075:             } else {
                   1076:                 $datatable .= '<input type="file" name="loginhelpurl_add_file" />';
1.6       raeburn  1077:             }
1.160.6.5  raeburn  1078:             $datatable .= '</td></tr>';
                   1079:             $itemcount ++;
1.6       raeburn  1080:         }
1.160.6.5  raeburn  1081:         $datatable .= &captcha_choice('login',$settings,$itemcount);
1.1       raeburn  1082:     }
1.6       raeburn  1083:     return $datatable;
                   1084: }
                   1085: 
                   1086: sub login_choices {
                   1087:     my %choices =
                   1088:         &Apache::lonlocal::texthash (
1.116     bisitz   1089:             coursecatalog => 'Display Course/Community Catalog link?',
1.110     raeburn  1090:             adminmail     => "Display Administrator's E-mail Address?",
1.160.6.14  raeburn  1091:             helpdesk      => 'Display "Contact Helpdesk" link',
1.110     raeburn  1092:             disallowlogin => "Login page requests redirected",
                   1093:             hostid        => "Server",
1.128     raeburn  1094:             server        => "Redirect to:",
                   1095:             serverpath    => "Path",
                   1096:             custompath    => "Custom", 
                   1097:             exempt        => "Exempt IP(s)",
1.110     raeburn  1098:             directlogin   => "No redirect",
                   1099:             newuser       => "Link to create a user account",
                   1100:             img           => "Header",
                   1101:             logo          => "Main Logo",
                   1102:             domlogo       => "Domain Logo",
                   1103:             login         => "Log-in Header", 
                   1104:             textcol       => "Text color",
                   1105:             bgcol         => "Box color",
                   1106:             bgs           => "Background colors",
                   1107:             links         => "Link colors",
                   1108:             font          => "Font color",
                   1109:             pgbg          => "Header",
                   1110:             mainbg        => "Page",
                   1111:             sidebg        => "Login box",
                   1112:             link          => "Link",
                   1113:             alink         => "Active link",
                   1114:             vlink         => "Visited link",
1.6       raeburn  1115:         );
                   1116:     return %choices;
                   1117: }
                   1118: 
                   1119: sub print_rolecolors {
1.30      raeburn  1120:     my ($phase,$role,$dom,$confname,$settings,$rowtotal) = @_;
1.6       raeburn  1121:     my %choices = &color_font_choices();
                   1122:     my @bgs = ('pgbg','tabbg','sidebg');
                   1123:     my @links = ('link','alink','vlink');
                   1124:     my @images = ('img');
                   1125:     my %alt_text = &Apache::lonlocal::texthash(img => "Banner for $role role");
1.7       albertel 1126:     my %designhash = &Apache::loncommon::get_domainconf($dom);
1.6       raeburn  1127:     my %defaultdesign = %Apache::loncommon::defaultdesign;
                   1128:     my (%is_custom,%designs);
1.160.6.22  raeburn  1129:     my %defaults = &role_defaults($role,\@bgs,\@links,\@images);
1.6       raeburn  1130:     if (ref($settings) eq 'HASH') {
                   1131:         if (ref($settings->{$role}) eq 'HASH') {
                   1132:             if ($settings->{$role}->{'img'} ne '') {
                   1133:                 $designs{'img'} = $settings->{$role}->{'img'};
                   1134:                 $is_custom{'img'} = 1;
                   1135:             }
                   1136:             if ($settings->{$role}->{'font'} ne '') {
                   1137:                 $designs{'font'} = $settings->{$role}->{'font'};
                   1138:                 $is_custom{'font'} = 1;
                   1139:             }
1.97      tempelho 1140:             if ($settings->{$role}->{'fontmenu'} ne '') {
                   1141:                 $designs{'fontmenu'} = $settings->{$role}->{'fontmenu'};
                   1142:                 $is_custom{'fontmenu'} = 1;
                   1143:             }
1.6       raeburn  1144:             foreach my $item (@bgs) {
                   1145:                 if ($settings->{$role}->{$item} ne '') {
                   1146:                     $designs{'bgs'}{$item} = $settings->{$role}->{$item};
                   1147:                     $is_custom{$item} = 1;
                   1148:                 }
                   1149:             }
                   1150:             foreach my $item (@links) {
                   1151:                 if ($settings->{$role}->{$item} ne '') {
                   1152:                     $designs{'links'}{$item} = $settings->{$role}->{$item};
                   1153:                     $is_custom{$item} = 1;
                   1154:                 }
                   1155:             }
                   1156:         }
                   1157:     } else {
                   1158:         if ($designhash{$dom.'.'.$role.'.img'} ne '') {
                   1159:             $designs{img} = $designhash{$dom.'.'.$role.'.img'};
                   1160:             $is_custom{'img'} = 1;
                   1161:         }
1.97      tempelho 1162:         if ($designhash{$dom.'.'.$role.'.fontmenu'} ne '') {
                   1163:             $designs{fontmenu} = $designhash{$dom.'.'.$role.'.fontmenu'};
                   1164:             $is_custom{'fontmenu'} = 1; 
                   1165:         }
1.6       raeburn  1166:         if ($designhash{$dom.'.'.$role.'.font'} ne '') {
                   1167:             $designs{font} = $designhash{$dom.'.'.$role.'.font'};
                   1168:             $is_custom{'font'} = 1;
                   1169:         }
                   1170:         foreach my $item (@bgs) {
                   1171:             if ($designhash{$dom.'.'.$role.'.'.$item} ne '') {
                   1172:                 $designs{'bgs'}{$item} = $designhash{$dom.'.'.$role.'.'.$item};
                   1173:                 $is_custom{$item} = 1;
                   1174:             
                   1175:             }
                   1176:         }
                   1177:         foreach my $item (@links) {
                   1178:             if ($designhash{$dom.'.'.$role.'.'.$item} ne '') {
                   1179:                 $designs{'links'}{$item} = $designhash{$dom.'.'.$role.'.'.$item};
                   1180:                 $is_custom{$item} = 1;
                   1181:             }
                   1182:         }
                   1183:     }
                   1184:     my $itemcount = 1;
1.30      raeburn  1185:     my $datatable = &display_color_options($dom,$confname,$phase,$role,$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal);
1.6       raeburn  1186:     $datatable .= '</tr></table></td></tr>';
                   1187:     return $datatable;
                   1188: }
                   1189: 
1.160.6.22  raeburn  1190: sub role_defaults {
                   1191:     my ($role,$bgs,$links,$images,$logintext) = @_;
                   1192:     my %defaults;
                   1193:     unless ((ref($bgs) eq 'ARRAY') && (ref($links) eq 'ARRAY') && (ref($images) eq 'ARRAY')) {
                   1194:         return %defaults;
                   1195:     }
                   1196:     my %defaultdesign = %Apache::loncommon::defaultdesign;
                   1197:     if ($role eq 'login') {
                   1198:         %defaults = (
                   1199:                        font => $defaultdesign{$role.'.font'},
                   1200:                     );
                   1201:         if (ref($logintext) eq 'ARRAY') {
                   1202:             foreach my $item (@{$logintext}) {
                   1203:                 $defaults{'logintext'}{$item} = $defaultdesign{$role.'.'.$item};
                   1204:             }
                   1205:         }
                   1206:         foreach my $item (@{$images}) {
                   1207:             $defaults{'showlogo'}{$item} = 1;
                   1208:         }
                   1209:     } else {
                   1210:         %defaults = (
                   1211:                        img => $defaultdesign{$role.'.img'},
                   1212:                        font => $defaultdesign{$role.'.font'},
                   1213:                        fontmenu => $defaultdesign{$role.'.fontmenu'},
                   1214:                     );
                   1215:     }
                   1216:     foreach my $item (@{$bgs}) {
                   1217:         $defaults{'bgs'}{$item} = $defaultdesign{$role.'.'.$item};
                   1218:     }
                   1219:     foreach my $item (@{$links}) {
                   1220:         $defaults{'links'}{$item} = $defaultdesign{$role.'.'.$item};
                   1221:     }
                   1222:     foreach my $item (@{$images}) {
                   1223:         $defaults{$item} = $defaultdesign{$role.'.'.$item};
                   1224:     }
                   1225:     return %defaults;
                   1226: }
                   1227: 
1.6       raeburn  1228: sub display_color_options {
1.9       raeburn  1229:     my ($dom,$confname,$phase,$role,$itemcount,$choices,$is_custom,$defaults,$designs,
1.135     bisitz   1230:         $images,$bgs,$links,$alt_text,$rowtotal,$logintext) = @_;
1.159     raeburn  1231:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.6       raeburn  1232:     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.134     raeburn  1233:     my $datatable = '<tr'.$css_class.'>'.
1.6       raeburn  1234:         '<td>'.$choices->{'font'}.'</td>';
                   1235:     if (!$is_custom->{'font'}) {
1.30      raeburn  1236:         $datatable .=  '<td>'.&mt('Default in use:').'&nbsp;<span id="css_default_'.$role.'_font" style="color: '.$defaults->{'font'}.';">'.$defaults->{'font'}.'</span></td>';
1.6       raeburn  1237:     } else {
                   1238:         $datatable .= '<td>&nbsp;</td>';
                   1239:     }
1.160.6.9  raeburn  1240:     my $current_color = $designs->{'font'} ? $designs->{'font'} : $defaults->{'font'};
                   1241: 
1.8       raeburn  1242:     $datatable .= '<td><span class="LC_nobreak">'.
1.160.6.9  raeburn  1243:                   '<input type="text" class="colorchooser" size="10" name="'.$role.'_font"'.
                   1244:                   ' value="'.$current_color.'" />&nbsp;'.
                   1245:                   '&nbsp;</td></tr>';
1.107     raeburn  1246:     unless ($role eq 'login') { 
                   1247:         $datatable .= '<tr'.$css_class.'>'.
                   1248:                       '<td>'.$choices->{'fontmenu'}.'</td>';
                   1249:         if (!$is_custom->{'fontmenu'}) {
                   1250:             $datatable .=  '<td>'.&mt('Default in use:').'&nbsp;<span id="css_default_'.$role.'_font" style="color: '.$defaults->{'fontmenu'}.';">'.$defaults->{'fontmenu'}.'</span></td>';
                   1251:         } else {
                   1252:             $datatable .= '<td>&nbsp;</td>';
                   1253:         }
1.160.6.22  raeburn  1254: 	$current_color = $designs->{'fontmenu'} ?
                   1255: 	    $designs->{'fontmenu'} : $defaults->{'fontmenu'};
1.107     raeburn  1256:         $datatable .= '<td><span class="LC_nobreak">'.
1.160.6.9  raeburn  1257:                       '<input class="colorchooser" type="text" size="10" name="'
1.160.6.22  raeburn  1258: 		      .$role.'_fontmenu"'.
1.160.6.9  raeburn  1259:                       ' value="'.$current_color.'" />&nbsp;'.
                   1260:                       '&nbsp;</td></tr>';
1.97      tempelho 1261:     }
1.9       raeburn  1262:     my $switchserver = &check_switchserver($dom,$confname);
1.6       raeburn  1263:     foreach my $img (@{$images}) {
1.18      albertel 1264: 	$itemcount ++;
1.6       raeburn  1265:         $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.8       raeburn  1266:         $datatable .= '<tr'.$css_class.'>'.
1.70      raeburn  1267:                       '<td>'.$choices->{$img};
1.41      raeburn  1268:         my ($imgfile,$img_import,$login_hdr_pick,$logincolors);
1.70      raeburn  1269:         if ($role eq 'login') {
                   1270:             if ($img eq 'login') {
                   1271:                 $login_hdr_pick =
1.135     bisitz   1272:                     &login_header_options($img,$role,$defaults,$is_custom,$choices);
1.70      raeburn  1273:                 $logincolors =
                   1274:                     &login_text_colors($img,$role,$logintext,$phase,$choices,
1.160.6.22  raeburn  1275:                                        $designs,$defaults);
1.70      raeburn  1276:             } elsif ($img ne 'domlogo') {
                   1277:                 $datatable.= &logo_display_options($img,$defaults,$designs);
                   1278:             }
                   1279:         }
                   1280:         $datatable .= '</td>';
1.6       raeburn  1281:         if ($designs->{$img} ne '') {
                   1282:             $imgfile = $designs->{$img};
1.18      albertel 1283: 	    $img_import = ($imgfile =~ m{^/adm/});
1.6       raeburn  1284:         } else {
                   1285:             $imgfile = $defaults->{$img};
                   1286:         }
                   1287:         if ($imgfile) {
1.9       raeburn  1288:             my ($showfile,$fullsize);
                   1289:             if ($imgfile =~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) {
1.6       raeburn  1290:                 my $urldir = $1;
                   1291:                 my $filename = $2;
                   1292:                 my @info = &Apache::lonnet::stat_file($designs->{$img});
                   1293:                 if (@info) {
                   1294:                     my $thumbfile = 'tn-'.$filename;
                   1295:                     my @thumb=&Apache::lonnet::stat_file($urldir.'/'.$thumbfile);
                   1296:                     if (@thumb) {
                   1297:                         $showfile = $urldir.'/'.$thumbfile;
                   1298:                     } else {
                   1299:                         $showfile = $imgfile;
                   1300:                     }
                   1301:                 } else {
                   1302:                     $showfile = '';
                   1303:                 }
                   1304:             } elsif ($imgfile =~ m-^/(adm/[^/]+)/([^/]+)$-) {
1.16      raeburn  1305:                 $showfile = $imgfile;
1.6       raeburn  1306:                 my $imgdir = $1;
                   1307:                 my $filename = $2;
1.159     raeburn  1308:                 if (-e "$londocroot/$imgdir/tn-".$filename) {
1.6       raeburn  1309:                     $showfile = "/$imgdir/tn-".$filename;
                   1310:                 } else {
1.159     raeburn  1311:                     my $input = $londocroot.$imgfile;
                   1312:                     my $output = "$londocroot/$imgdir/tn-".$filename;
1.6       raeburn  1313:                     if (!-e $output) {
1.9       raeburn  1314:                         my ($width,$height) = &thumb_dimensions();
1.16      raeburn  1315:                         my ($fullwidth,$fullheight) = &check_dimensions($input);
                   1316:                         if ($fullwidth ne '' && $fullheight ne '') {
                   1317:                             if ($fullwidth > $width && $fullheight > $height) { 
                   1318:                                 my $size = $width.'x'.$height;
                   1319:                                 system("convert -sample $size $input $output");
1.159     raeburn  1320:                                 $showfile = "/$imgdir/tn-".$filename;
1.16      raeburn  1321:                             }
                   1322:                         }
1.6       raeburn  1323:                     }
                   1324:                 }
1.16      raeburn  1325:             }
1.6       raeburn  1326:             if ($showfile) {
1.40      raeburn  1327:                 if ($showfile =~ m{^/(adm|res)/}) {
                   1328:                     if ($showfile =~ m{^/res/}) {
                   1329:                         my $local_showfile =
                   1330:                             &Apache::lonnet::filelocation('',$showfile);
                   1331:                         &Apache::lonnet::repcopy($local_showfile);
                   1332:                     }
                   1333:                     $showfile = &Apache::loncommon::lonhttpdurl($showfile);
                   1334:                 }
                   1335:                 if ($imgfile) {
                   1336:                     if ($imgfile  =~ m{^/(adm|res)/}) {
                   1337:                         if ($imgfile =~ m{^/res/}) {
                   1338:                             my $local_imgfile =
                   1339:                                 &Apache::lonnet::filelocation('',$imgfile);
                   1340:                             &Apache::lonnet::repcopy($local_imgfile);
                   1341:                         }
                   1342:                         $fullsize = &Apache::loncommon::lonhttpdurl($imgfile);
                   1343:                     } else {
                   1344:                         $fullsize = $imgfile;
                   1345:                     }
                   1346:                 }
1.41      raeburn  1347:                 $datatable .= '<td>';
                   1348:                 if ($img eq 'login') {
1.135     bisitz   1349:                     $datatable .= $login_hdr_pick;
                   1350:                 } 
1.41      raeburn  1351:                 $datatable .= &image_changes($is_custom->{$img},$alt_text->{$img},$img_import,
                   1352:                                              $showfile,$fullsize,$role,$img,$imgfile,$logincolors);
1.6       raeburn  1353:             } else {
1.160.6.22  raeburn  1354:                 $datatable .= '<td>&nbsp;</td><td class="LC_left_item">'.
                   1355:                               &mt('Upload:').'<br />';
1.6       raeburn  1356:             }
                   1357:         } else {
1.160.6.22  raeburn  1358:             $datatable .= '<td>&nbsp;</td><td class="LC_left_item">'.
                   1359:                           &mt('Upload:').'<br />';
1.6       raeburn  1360:         }
1.9       raeburn  1361:         if ($switchserver) {
                   1362:             $datatable .= &mt('Upload to library server: [_1]',$switchserver);
                   1363:         } else {
1.135     bisitz   1364:             if ($img ne 'login') { # suppress file selection for Log-in header
                   1365:                 $datatable .='&nbsp;<input type="file" name="'.$role.'_'.$img.'" />';
                   1366:             }
1.9       raeburn  1367:         }
                   1368:         $datatable .= '</td></tr>';
1.6       raeburn  1369:     }
                   1370:     $itemcount ++;
                   1371:     $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   1372:     $datatable .= '<tr'.$css_class.'>'.
                   1373:                   '<td>'.$choices->{'bgs'}.'</td>';
                   1374:     my $bgs_def;
                   1375:     foreach my $item (@{$bgs}) {
                   1376:         if (!$is_custom->{$item}) {
1.70      raeburn  1377:             $bgs_def .= '<td><span class="LC_nobreak">'.$choices->{$item}.'</span>&nbsp;<span id="css_default_'.$role.'_'.$item.'" style="background-color: '.$defaults->{'bgs'}{$item}.';">&nbsp;&nbsp;&nbsp;</span><br />'.$defaults->{'bgs'}{$item}.'</td>';
1.6       raeburn  1378:         }
                   1379:     }
                   1380:     if ($bgs_def) {
1.8       raeburn  1381:         $datatable .= '<td>'.&mt('Default(s) in use:').'<br /><table border="0"><tr>'.$bgs_def.'</tr></table></td>';
1.6       raeburn  1382:     } else {
                   1383:         $datatable .= '<td>&nbsp;</td>';
                   1384:     }
                   1385:     $datatable .= '<td class="LC_right_item">'.
                   1386:                   '<table border="0"><tr>';
1.160.6.13  raeburn  1387: 
1.6       raeburn  1388:     foreach my $item (@{$bgs}) {
1.160.6.22  raeburn  1389:         $datatable .= '<td align="center">'.$choices->{$item};
                   1390: 	my $color = $designs->{'bgs'}{$item} ? $designs->{'bgs'}{$item} : $defaults->{'bgs'}{$item};
1.6       raeburn  1391:         if ($designs->{'bgs'}{$item}) {
1.160.6.9  raeburn  1392:             $datatable .= '&nbsp;';
1.6       raeburn  1393:         }
1.160.6.9  raeburn  1394:         $datatable .= '<br /><input type="text" class="colorchooser" size="8" name="'.$role.'_'.$item.'" value="'.$color.
1.41      raeburn  1395:                       '" onblur = "javascript:colchg_span('."'css_".$role.'_'.$item."'".',this);" /></td>';
1.6       raeburn  1396:     }
                   1397:     $datatable .= '</tr></table></td></tr>';
                   1398:     $itemcount ++;
                   1399:     $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   1400:     $datatable .= '<tr'.$css_class.'>'.
                   1401:                   '<td>'.$choices->{'links'}.'</td>';
                   1402:     my $links_def;
                   1403:     foreach my $item (@{$links}) {
                   1404:         if (!$is_custom->{$item}) {
1.30      raeburn  1405:             $links_def .= '<td>'.$choices->{$item}.'<br /><span id="css_default_'.$role.'_'.$item.'" style="color: '.$defaults->{'links'}{$item}.';">'.$defaults->{'links'}{$item}.'</span></td>';
1.6       raeburn  1406:         }
                   1407:     }
                   1408:     if ($links_def) {
1.8       raeburn  1409:         $datatable .= '<td>'.&mt('Default(s) in use:').'<br /><table border="0"><tr>'.$links_def.'</tr></table></td>';
1.6       raeburn  1410:     } else {
                   1411:         $datatable .= '<td>&nbsp;</td>';
                   1412:     }
                   1413:     $datatable .= '<td class="LC_right_item">'.
                   1414:                   '<table border="0"><tr>';
                   1415:     foreach my $item (@{$links}) {
1.160.6.22  raeburn  1416: 	my $color = $designs->{'link'}{$item} ? $designs->{'link'}{$item} : $defaults->{'links'}{$item};
                   1417:         $datatable .= '<td align="center">'.$choices->{$item}."\n";
1.6       raeburn  1418:         if ($designs->{'links'}{$item}) {
1.160.6.9  raeburn  1419:             $datatable.='&nbsp;';
1.6       raeburn  1420:         }
1.160.6.9  raeburn  1421:         $datatable .= '<br /><input type="text" size="8" class="colorchooser" name="'.$role.'_'.$item.'" value="'.$color.
1.6       raeburn  1422:                       '" /></td>';
                   1423:     }
1.30      raeburn  1424:     $$rowtotal += $itemcount;
1.3       raeburn  1425:     return $datatable;
                   1426: }
                   1427: 
1.70      raeburn  1428: sub logo_display_options {
                   1429:     my ($img,$defaults,$designs) = @_;
                   1430:     my $checkedon;
                   1431:     if (ref($defaults) eq 'HASH') {
                   1432:         if (ref($defaults->{'showlogo'}) eq 'HASH') {
                   1433:             if ($defaults->{'showlogo'}{$img}) {
                   1434:                 $checkedon = 'checked="checked" ';     
                   1435:             }
                   1436:         } 
                   1437:     }
                   1438:     if (ref($designs) eq 'HASH') {
                   1439:         if (ref($designs->{'showlogo'}) eq 'HASH') {
                   1440:             if (defined($designs->{'showlogo'}{$img})) {
                   1441:                 if ($designs->{'showlogo'}{$img} == 0) {
                   1442:                     $checkedon = '';
                   1443:                 } elsif ($designs->{'showlogo'}{$img} == 1) {
                   1444:                     $checkedon = 'checked="checked" ';
                   1445:                 }
                   1446:             }
                   1447:         }
                   1448:     }
                   1449:     return '<br /><label>&nbsp;&nbsp;<input type="checkbox" name="'.
                   1450:            'login_showlogo_'.$img.'" value="1" '.$checkedon.'/>'.
                   1451:            &mt('show').'</label>'."\n";
                   1452: }
                   1453: 
1.41      raeburn  1454: sub login_header_options  {
1.135     bisitz   1455:     my ($img,$role,$defaults,$is_custom,$choices) = @_;
                   1456:     my $output = '';
1.41      raeburn  1457:     if ((!$is_custom->{'textcol'}) || (!$is_custom->{'bgcol'})) {
1.135     bisitz   1458:         $output .= &mt('Text default(s):').'<br />';
1.41      raeburn  1459:         if (!$is_custom->{'textcol'}) {
                   1460:             $output .= $choices->{'textcol'}.':&nbsp;'.$defaults->{'logintext'}{'textcol'}.
                   1461:                        '&nbsp;&nbsp;&nbsp;';
                   1462:         }
                   1463:         if (!$is_custom->{'bgcol'}) {
                   1464:             $output .= $choices->{'bgcol'}.':&nbsp;'.
                   1465:                        '<span id="css_'.$role.'_font" style="background-color: '.
                   1466:                        $defaults->{'logintext'}{'bgcol'}.';">&nbsp;&nbsp;&nbsp;</span>';
                   1467:         }
                   1468:         $output .= '<br />';
                   1469:     }
                   1470:     $output .='<br />';
                   1471:     return $output;
                   1472: }
                   1473: 
                   1474: sub login_text_colors {
1.160.6.22  raeburn  1475:     my ($img,$role,$logintext,$phase,$choices,$designs,$defaults) = @_;
1.41      raeburn  1476:     my $color_menu = '<table border="0"><tr>';
                   1477:     foreach my $item (@{$logintext}) {
1.160.6.22  raeburn  1478:         $color_menu .= '<td align="center">'.$choices->{$item};
                   1479:         my $color = $designs->{'logintext'}{$item} ? $designs->{'logintext'}{$item} : $defaults->{'logintext'}{$item};
                   1480:         $color_menu .= '<br /><input type="text" class="colorchooser" size="8" name="'.$role.'_'.$item.'" value="'.$color.
                   1481:                       '" onblur = "javascript:colchg_span('."'css_".$role.'_'.$item."'".',this);" /></td>';
1.41      raeburn  1482:     }
                   1483:     $color_menu .= '</tr></table><br />';
                   1484:     return $color_menu;
                   1485: }
                   1486: 
                   1487: sub image_changes {
                   1488:     my ($is_custom,$alt_text,$img_import,$showfile,$fullsize,$role,$img,$imgfile,$logincolors) = @_;
                   1489:     my $output;
1.135     bisitz   1490:     if ($img eq 'login') {
                   1491:             # suppress image for Log-in header
                   1492:     } elsif (!$is_custom) {
1.70      raeburn  1493:         if ($img ne 'domlogo') {
1.41      raeburn  1494:             $output .= &mt('Default image:').'<br />';
                   1495:         } else {
                   1496:             $output .= &mt('Default in use:').'<br />';
                   1497:         }
                   1498:     }
1.135     bisitz   1499:     if ($img eq 'login') { # suppress image for Log-in header
                   1500:         $output .= '<td>'.$logincolors;
1.41      raeburn  1501:     } else {
1.135     bisitz   1502:         if ($img_import) {
                   1503:             $output .= '<input type="hidden" name="'.$role.'_import_'.$img.'" value="'.$imgfile.'" />';
                   1504:         }
                   1505:         $output .= '<a href="'.$fullsize.'" target="_blank"><img src="'.
                   1506:                    $showfile.'" alt="'.$alt_text.'" border="0" /></a></td>';
                   1507:         if ($is_custom) {
                   1508:             $output .= '<td>'.$logincolors.'<span class="LC_nobreak"><label>'.
                   1509:                        '<input type="checkbox" name="'.
                   1510:                        $role.'_del_'.$img.'" value="1" />'.&mt('Delete?').
                   1511:                        '</label>&nbsp;'.&mt('Replace:').'</span><br />';
                   1512:         } else {
1.160.6.22  raeburn  1513:             $output .= '<td valign="middle">'.$logincolors.&mt('Upload:').'<br />';
1.135     bisitz   1514:         }
1.41      raeburn  1515:     }
                   1516:     return $output;
                   1517: }
                   1518: 
1.3       raeburn  1519: sub print_quotas {
1.86      raeburn  1520:     my ($dom,$settings,$rowtotal,$action) = @_;
                   1521:     my $context;
                   1522:     if ($action eq 'quotas') {
                   1523:         $context = 'tools';
                   1524:     } else {
                   1525:         $context = $action;
                   1526:     }
1.160.6.20  raeburn  1527:     my ($datatable,$defaultquota,$authorquota,@usertools,@options,%validations);
1.44      raeburn  1528:     my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
1.3       raeburn  1529:     my $typecount = 0;
1.101     raeburn  1530:     my ($css_class,%titles);
1.86      raeburn  1531:     if ($context eq 'requestcourses') {
1.98      raeburn  1532:         @usertools = ('official','unofficial','community');
1.106     raeburn  1533:         @options =('norequest','approval','validate','autolimit');
1.101     raeburn  1534:         %validations = &Apache::lonnet::auto_courserequest_checks($dom);
                   1535:         %titles = &courserequest_titles();
1.160.6.5  raeburn  1536:     } elsif ($context eq 'requestauthor') {
                   1537:         @usertools = ('author');
                   1538:         @options = ('norequest','approval','automatic');
                   1539:         %titles = &authorrequest_titles();
1.86      raeburn  1540:     } else {
1.160.6.4  raeburn  1541:         @usertools = ('aboutme','blog','webdav','portfolio');
1.101     raeburn  1542:         %titles = &tool_titles();
1.86      raeburn  1543:     }
1.26      raeburn  1544:     if (ref($types) eq 'ARRAY') {
1.23      raeburn  1545:         foreach my $type (@{$types}) {
1.160.6.20  raeburn  1546:             my ($currdefquota,$currauthorquota);
1.160.6.5  raeburn  1547:             unless (($context eq 'requestcourses') ||
                   1548:                     ($context eq 'requestauthor')) {
1.86      raeburn  1549:                 if (ref($settings) eq 'HASH') {
                   1550:                     if (ref($settings->{defaultquota}) eq 'HASH') {
1.160.6.20  raeburn  1551:                         $currdefquota = $settings->{defaultquota}->{$type};
1.86      raeburn  1552:                     } else {
                   1553:                         $currdefquota = $settings->{$type};
                   1554:                     }
1.160.6.20  raeburn  1555:                     if (ref($settings->{authorquota}) eq 'HASH') {
                   1556:                         $currauthorquota = $settings->{authorquota}->{$type};
                   1557:                     }
1.78      raeburn  1558:                 }
1.72      raeburn  1559:             }
1.3       raeburn  1560:             if (defined($usertypes->{$type})) {
                   1561:                 $typecount ++;
                   1562:                 $css_class = $typecount%2?' class="LC_odd_row"':'';
1.72      raeburn  1563:                 $datatable .= '<tr'.$css_class.'>'.
1.3       raeburn  1564:                               '<td>'.$usertypes->{$type}.'</td>'.
1.72      raeburn  1565:                               '<td class="LC_left_item">';
1.101     raeburn  1566:                 if ($context eq 'requestcourses') {
                   1567:                     $datatable .= '<table><tr>';
                   1568:                 }
                   1569:                 my %cell;  
1.72      raeburn  1570:                 foreach my $item (@usertools) {
1.101     raeburn  1571:                     if ($context eq 'requestcourses') {
                   1572:                         my ($curroption,$currlimit);
                   1573:                         if (ref($settings) eq 'HASH') {
                   1574:                             if (ref($settings->{$item}) eq 'HASH') {
                   1575:                                 $curroption = $settings->{$item}->{$type};
                   1576:                                 if ($curroption =~ /^autolimit=(\d*)$/) {
                   1577:                                     $currlimit = $1; 
                   1578:                                 }
                   1579:                             }
                   1580:                         }
                   1581:                         if (!$curroption) {
                   1582:                             $curroption = 'norequest';
                   1583:                         }
                   1584:                         $datatable .= '<th>'.$titles{$item}.'</th>';
                   1585:                         foreach my $option (@options) {
                   1586:                             my $val = $option;
                   1587:                             if ($option eq 'norequest') {
                   1588:                                 $val = 0;  
                   1589:                             }
                   1590:                             if ($option eq 'validate') {
                   1591:                                 my $canvalidate = 0;
                   1592:                                 if (ref($validations{$item}) eq 'HASH') { 
                   1593:                                     if ($validations{$item}{$type}) {
                   1594:                                         $canvalidate = 1;
                   1595:                                     }
                   1596:                                 }
                   1597:                                 next if (!$canvalidate);
                   1598:                             }
                   1599:                             my $checked = '';
                   1600:                             if ($option eq $curroption) {
                   1601:                                 $checked = ' checked="checked"';
                   1602:                             } elsif ($option eq 'autolimit') {
                   1603:                                 if ($curroption =~ /^autolimit/) {
                   1604:                                     $checked = ' checked="checked"';
                   1605:                                 }                       
                   1606:                             } 
                   1607:                             $cell{$item} .= '<span class="LC_nobreak"><label>'.
                   1608:                                   '<input type="radio" name="crsreq_'.$item.
                   1609:                                   '_'.$type.'" value="'.$val.'"'.$checked.' />'.
1.127     raeburn  1610:                                   $titles{$option}.'</label>';
1.101     raeburn  1611:                             if ($option eq 'autolimit') {
1.127     raeburn  1612:                                 $cell{$item} .= '&nbsp;<input type="text" name="crsreq_'.
1.101     raeburn  1613:                                                 $item.'_limit_'.$type.'" size="1" '.
1.103     raeburn  1614:                                                 'value="'.$currlimit.'" />';
1.101     raeburn  1615:                             }
1.127     raeburn  1616:                             $cell{$item} .= '</span> ';
1.103     raeburn  1617:                             if ($option eq 'autolimit') {
1.127     raeburn  1618:                                 $cell{$item} .= $titles{'unlimited'};
1.103     raeburn  1619:                             }
1.101     raeburn  1620:                         }
1.160.6.5  raeburn  1621:                     } elsif ($context eq 'requestauthor') {
                   1622:                         my $curroption;
                   1623:                         if (ref($settings) eq 'HASH') {
                   1624:                             $curroption = $settings->{$type};
                   1625:                         }
                   1626:                         if (!$curroption) {
                   1627:                             $curroption = 'norequest';
                   1628:                         }
                   1629:                         foreach my $option (@options) {
                   1630:                             my $val = $option;
                   1631:                             if ($option eq 'norequest') {
                   1632:                                 $val = 0;
                   1633:                             }
                   1634:                             my $checked = '';
                   1635:                             if ($option eq $curroption) {
                   1636:                                 $checked = ' checked="checked"';
                   1637:                             }
                   1638:                             $datatable .= '<span class="LC_nobreak"><label>'.
                   1639:                                   '<input type="radio" name="authorreq_'.$type.
                   1640:                                   '" value="'.$val.'"'.$checked.' />'.
                   1641:                                   $titles{$option}.'</label></span>&nbsp; ';
                   1642:                         }
1.101     raeburn  1643:                     } else {
                   1644:                         my $checked = 'checked="checked" ';
                   1645:                         if (ref($settings) eq 'HASH') {
                   1646:                             if (ref($settings->{$item}) eq 'HASH') {
                   1647:                                 if ($settings->{$item}->{$type} == 0) {
                   1648:                                     $checked = '';
                   1649:                                 } elsif ($settings->{$item}->{$type} == 1) {
                   1650:                                     $checked =  'checked="checked" ';
                   1651:                                 }
1.78      raeburn  1652:                             }
1.72      raeburn  1653:                         }
1.101     raeburn  1654:                         $datatable .= '<span class="LC_nobreak"><label>'.
                   1655:                                       '<input type="checkbox" name="'.$context.'_'.$item.
                   1656:                                       '" value="'.$type.'" '.$checked.'/>'.$titles{$item}.
                   1657:                                       '</label></span>&nbsp; ';
1.72      raeburn  1658:                     }
1.101     raeburn  1659:                 }
                   1660:                 if ($context eq 'requestcourses') {
                   1661:                     $datatable .= '</tr><tr>';
                   1662:                     foreach my $item (@usertools) {
1.106     raeburn  1663:                         $datatable .= '<td style="vertical-align: top">'.$cell{$item}.'</td>';  
1.101     raeburn  1664:                     }
                   1665:                     $datatable .= '</tr></table>';
1.72      raeburn  1666:                 }
1.86      raeburn  1667:                 $datatable .= '</td>';
1.160.6.5  raeburn  1668:                 unless (($context eq 'requestcourses') ||
                   1669:                         ($context eq 'requestauthor')) {
1.86      raeburn  1670:                     $datatable .= 
1.160.6.20  raeburn  1671:                               '<td class="LC_right_item">'.
                   1672:                               '<span class="LC_nobreak">'.&mt('Portfolio').':&nbsp;'.
1.3       raeburn  1673:                               '<input type="text" name="quota_'.$type.
1.72      raeburn  1674:                               '" value="'.$currdefquota.
1.160.6.20  raeburn  1675:                               '" size="5" /></span>'.('&nbsp;' x 2).
                   1676:                               '<span class="LC_nobreak">'.&mt('Authoring').':&nbsp;'.
                   1677:                               '<input type="text" name="authorquota_'.$type.
                   1678:                               '" value="'.$currauthorquota.
                   1679:                               '" size="5" /></span></td>';
1.86      raeburn  1680:                 }
                   1681:                 $datatable .= '</tr>';
1.3       raeburn  1682:             }
                   1683:         }
                   1684:     }
1.160.6.5  raeburn  1685:     unless (($context eq 'requestcourses') || ($context eq 'requestauthor')) {
1.86      raeburn  1686:         $defaultquota = '20';
1.160.6.20  raeburn  1687:         $authorquota = '500';
1.86      raeburn  1688:         if (ref($settings) eq 'HASH') {
                   1689:             if (ref($settings->{'defaultquota'}) eq 'HASH') {
                   1690:                 $defaultquota = $settings->{'defaultquota'}->{'default'};
                   1691:             } elsif (defined($settings->{'default'})) {
                   1692:                 $defaultquota = $settings->{'default'};
                   1693:             }
1.160.6.20  raeburn  1694:             if (ref($settings->{'authorquota'}) eq 'HASH') {
                   1695:                 $authorquota = $settings->{'authorquota'}->{'default'};
                   1696:             }
1.3       raeburn  1697:         }
                   1698:     }
                   1699:     $typecount ++;
                   1700:     $css_class = $typecount%2?' class="LC_odd_row"':'';
                   1701:     $datatable .= '<tr'.$css_class.'>'.
1.26      raeburn  1702:                   '<td>'.$othertitle.'</td>'.
1.72      raeburn  1703:                   '<td class="LC_left_item">';
1.101     raeburn  1704:     if ($context eq 'requestcourses') {
                   1705:         $datatable .= '<table><tr>';
                   1706:     }
                   1707:     my %defcell;
1.72      raeburn  1708:     foreach my $item (@usertools) {
1.101     raeburn  1709:         if ($context eq 'requestcourses') {
                   1710:             my ($curroption,$currlimit);
                   1711:             if (ref($settings) eq 'HASH') {
                   1712:                 if (ref($settings->{$item}) eq 'HASH') {
                   1713:                     $curroption = $settings->{$item}->{'default'};
                   1714:                     if ($curroption =~ /^autolimit=(\d*)$/) {
                   1715:                         $currlimit = $1;
                   1716:                     }
                   1717:                 }
                   1718:             }
                   1719:             if (!$curroption) {
                   1720:                 $curroption = 'norequest';
                   1721:             }
                   1722:             $datatable .= '<th>'.$titles{$item}.'</th>';
                   1723:             foreach my $option (@options) {
                   1724:                 my $val = $option;
                   1725:                 if ($option eq 'norequest') {
                   1726:                     $val = 0;
                   1727:                 }
                   1728:                 if ($option eq 'validate') {
                   1729:                     my $canvalidate = 0;
                   1730:                     if (ref($validations{$item}) eq 'HASH') {
                   1731:                         if ($validations{$item}{'default'}) {
                   1732:                             $canvalidate = 1;
                   1733:                         }
                   1734:                     }
                   1735:                     next if (!$canvalidate);
                   1736:                 }
                   1737:                 my $checked = '';
                   1738:                 if ($option eq $curroption) {
                   1739:                     $checked = ' checked="checked"';
                   1740:                 } elsif ($option eq 'autolimit') {
                   1741:                     if ($curroption =~ /^autolimit/) {
                   1742:                         $checked = ' checked="checked"';
                   1743:                     }
                   1744:                 }
                   1745:                 $defcell{$item} .= '<span class="LC_nobreak"><label>'.
                   1746:                                   '<input type="radio" name="crsreq_'.$item.
                   1747:                                   '_default" value="'.$val.'"'.$checked.' />'.
                   1748:                                   $titles{$option}.'</label>';
                   1749:                 if ($option eq 'autolimit') {
1.127     raeburn  1750:                     $defcell{$item} .= '&nbsp;<input type="text" name="crsreq_'.
1.101     raeburn  1751:                                        $item.'_limit_default" size="1" '.
                   1752:                                        'value="'.$currlimit.'" />';
                   1753:                 }
1.127     raeburn  1754:                 $defcell{$item} .= '</span> ';
1.104     raeburn  1755:                 if ($option eq 'autolimit') {
1.127     raeburn  1756:                     $defcell{$item} .= $titles{'unlimited'};
1.104     raeburn  1757:                 }
1.101     raeburn  1758:             }
1.160.6.5  raeburn  1759:         } elsif ($context eq 'requestauthor') {
                   1760:             my $curroption;
                   1761:             if (ref($settings) eq 'HASH') {
1.160.6.8  raeburn  1762:                 $curroption = $settings->{'default'};
1.160.6.5  raeburn  1763:             }
                   1764:             if (!$curroption) {
                   1765:                 $curroption = 'norequest';
                   1766:             }
                   1767:             foreach my $option (@options) {
                   1768:                 my $val = $option;
                   1769:                 if ($option eq 'norequest') {
                   1770:                     $val = 0;
                   1771:                 }
                   1772:                 my $checked = '';
                   1773:                 if ($option eq $curroption) {
                   1774:                     $checked = ' checked="checked"';
                   1775:                 }
                   1776:                 $datatable .= '<span class="LC_nobreak"><label>'.
                   1777:                               '<input type="radio" name="authorreq_default"'.
                   1778:                               ' value="'.$val.'"'.$checked.' />'.
                   1779:                               $titles{$option}.'</label></span>&nbsp; ';
                   1780:             }
1.101     raeburn  1781:         } else {
                   1782:             my $checked = 'checked="checked" ';
                   1783:             if (ref($settings) eq 'HASH') {
                   1784:                 if (ref($settings->{$item}) eq 'HASH') {
                   1785:                     if ($settings->{$item}->{'default'} == 0) {
                   1786:                         $checked = '';
                   1787:                     } elsif ($settings->{$item}->{'default'} == 1) {
                   1788:                         $checked = 'checked="checked" ';
                   1789:                     }
1.78      raeburn  1790:                 }
1.72      raeburn  1791:             }
1.101     raeburn  1792:             $datatable .= '<span class="LC_nobreak"><label>'.
                   1793:                           '<input type="checkbox" name="'.$context.'_'.$item.
                   1794:                           '" value="default" '.$checked.'/>'.$titles{$item}.
                   1795:                           '</label></span>&nbsp; ';
                   1796:         }
                   1797:     }
                   1798:     if ($context eq 'requestcourses') {
                   1799:         $datatable .= '</tr><tr>';
                   1800:         foreach my $item (@usertools) {
1.106     raeburn  1801:             $datatable .= '<td style="vertical-align: top">'.$defcell{$item}.'</td>';
1.72      raeburn  1802:         }
1.101     raeburn  1803:         $datatable .= '</tr></table>';
1.72      raeburn  1804:     }
1.86      raeburn  1805:     $datatable .= '</td>';
1.160.6.5  raeburn  1806:     unless (($context eq 'requestcourses') || ($context eq 'requestauthor')) {
1.160.6.20  raeburn  1807:         $datatable .= '<td class="LC_right_item">'.
                   1808:                       '<span class="LC_nobreak">'.&mt('Portfolio').':&nbsp;'.
1.86      raeburn  1809:                       '<input type="text" name="defaultquota" value="'.
1.160.6.20  raeburn  1810:                       $defaultquota.'" size="5" /></span>'.('&nbsp;' x2).
                   1811:                       '<span class="LC_nobreak">'.&mt('Authoring').':&nbsp;'.
                   1812:                       '<input type="text" name="authorquota" value="'.
                   1813:                       $authorquota.'" size="5" /></span></td>';
1.86      raeburn  1814:     }
                   1815:     $datatable .= '</tr>';
1.72      raeburn  1816:     $typecount ++;
                   1817:     $css_class = $typecount%2?' class="LC_odd_row"':'';
                   1818:     $datatable .= '<tr'.$css_class.'>'.
1.160.6.20  raeburn  1819:                   '<td>'.&mt('LON-CAPA Advanced Users').'<br />';
1.104     raeburn  1820:     if ($context eq 'requestcourses') {
1.109     raeburn  1821:         $datatable .= &mt('(overrides affiliation, if set)').
                   1822:                       '</td>'.
                   1823:                       '<td class="LC_left_item">'.
                   1824:                       '<table><tr>';
1.101     raeburn  1825:     } else {
1.109     raeburn  1826:         $datatable .= &mt('(overrides affiliation, if checked)').
                   1827:                       '</td>'.
                   1828:                       '<td class="LC_left_item" colspan="2">'.
                   1829:                       '<br />';
1.101     raeburn  1830:     }
                   1831:     my %advcell;
1.72      raeburn  1832:     foreach my $item (@usertools) {
1.101     raeburn  1833:         if ($context eq 'requestcourses') {
                   1834:             my ($curroption,$currlimit);
                   1835:             if (ref($settings) eq 'HASH') {
                   1836:                 if (ref($settings->{$item}) eq 'HASH') {
                   1837:                     $curroption = $settings->{$item}->{'_LC_adv'};
                   1838:                     if ($curroption =~ /^autolimit=(\d*)$/) {
                   1839:                         $currlimit = $1;
                   1840:                     }
                   1841:                 }
                   1842:             }
                   1843:             $datatable .= '<th>'.$titles{$item}.'</th>';
1.104     raeburn  1844:             my $checked = '';
                   1845:             if ($curroption eq '') {
                   1846:                 $checked = ' checked="checked"';
                   1847:             }
                   1848:             $advcell{$item} .= '<span class="LC_nobreak"><label>'.
                   1849:                                '<input type="radio" name="crsreq_'.$item.
                   1850:                                '__LC_adv" value=""'.$checked.' />'.
                   1851:                                &mt('No override set').'</label></span>&nbsp; ';
1.101     raeburn  1852:             foreach my $option (@options) {
                   1853:                 my $val = $option;
                   1854:                 if ($option eq 'norequest') {
                   1855:                     $val = 0;
                   1856:                 }
                   1857:                 if ($option eq 'validate') {
                   1858:                     my $canvalidate = 0;
                   1859:                     if (ref($validations{$item}) eq 'HASH') {
                   1860:                         if ($validations{$item}{'_LC_adv'}) {
                   1861:                             $canvalidate = 1;
                   1862:                         }
                   1863:                     }
                   1864:                     next if (!$canvalidate);
                   1865:                 }
                   1866:                 my $checked = '';
1.104     raeburn  1867:                 if ($val eq $curroption) {
1.101     raeburn  1868:                     $checked = ' checked="checked"';
                   1869:                 } elsif ($option eq 'autolimit') {
                   1870:                     if ($curroption =~ /^autolimit/) {
                   1871:                         $checked = ' checked="checked"';
                   1872:                     }
                   1873:                 }
                   1874:                 $advcell{$item} .= '<span class="LC_nobreak"><label>'.
                   1875:                                   '<input type="radio" name="crsreq_'.$item.
                   1876:                                   '__LC_adv" value="'.$val.'"'.$checked.' />'.
                   1877:                                   $titles{$option}.'</label>';
                   1878:                 if ($option eq 'autolimit') {
1.127     raeburn  1879:                     $advcell{$item} .= '&nbsp;<input type="text" name="crsreq_'.
1.101     raeburn  1880:                                        $item.'_limit__LC_adv" size="1" '.
                   1881:                                        'value="'.$currlimit.'" />';
                   1882:                 }
1.127     raeburn  1883:                 $advcell{$item} .= '</span> ';
1.104     raeburn  1884:                 if ($option eq 'autolimit') {
1.127     raeburn  1885:                     $advcell{$item} .= $titles{'unlimited'};
1.104     raeburn  1886:                 }
1.101     raeburn  1887:             }
1.160.6.5  raeburn  1888:         } elsif ($context eq 'requestauthor') {
                   1889:             my $curroption;
                   1890:             if (ref($settings) eq 'HASH') {
                   1891:                 $curroption = $settings->{'_LC_adv'};
                   1892:             }
                   1893:             my $checked = '';
                   1894:             if ($curroption eq '') {
                   1895:                 $checked = ' checked="checked"';
                   1896:             }
                   1897:             $datatable .= '<span class="LC_nobreak"><label>'.
                   1898:                           '<input type="radio" name="authorreq__LC_adv"'.
                   1899:                           ' value=""'.$checked.' />'.
                   1900:                           &mt('No override set').'</label></span>&nbsp; ';
                   1901:             foreach my $option (@options) {
                   1902:                 my $val = $option;
                   1903:                 if ($option eq 'norequest') {
                   1904:                     $val = 0;
                   1905:                 }
                   1906:                 my $checked = '';
                   1907:                 if ($val eq $curroption) {
                   1908:                     $checked = ' checked="checked"';
                   1909:                 }
                   1910:                 $datatable .= '<span class="LC_nobreak"><label>'.
1.160.6.8  raeburn  1911:                               '<input type="radio" name="authorreq__LC_adv"'.
                   1912:                               ' value="'.$val.'"'.$checked.' />'.
1.160.6.5  raeburn  1913:                               $titles{$option}.'</label></span>&nbsp; ';
                   1914:             }
1.101     raeburn  1915:         } else {
                   1916:             my $checked = 'checked="checked" ';
                   1917:             if (ref($settings) eq 'HASH') {
                   1918:                 if (ref($settings->{$item}) eq 'HASH') {
                   1919:                     if ($settings->{$item}->{'_LC_adv'} == 0) {
                   1920:                         $checked = '';
                   1921:                     } elsif ($settings->{$item}->{'_LC_adv'} == 1) {
                   1922:                         $checked = 'checked="checked" ';
                   1923:                     }
1.79      raeburn  1924:                 }
1.72      raeburn  1925:             }
1.101     raeburn  1926:             $datatable .= '<span class="LC_nobreak"><label>'.
                   1927:                           '<input type="checkbox" name="'.$context.'_'.$item.
                   1928:                           '" value="_LC_adv" '.$checked.'/>'.$titles{$item}.
                   1929:                           '</label></span>&nbsp; ';
                   1930:         }
                   1931:     }
                   1932:     if ($context eq 'requestcourses') {
                   1933:         $datatable .= '</tr><tr>';
                   1934:         foreach my $item (@usertools) {
1.106     raeburn  1935:             $datatable .= '<td style="vertical-align: top">'.$advcell{$item}.'</td>';
1.72      raeburn  1936:         }
1.101     raeburn  1937:         $datatable .= '</tr></table>';
1.72      raeburn  1938:     }
1.98      raeburn  1939:     $datatable .= '</td></tr>';
1.30      raeburn  1940:     $$rowtotal += $typecount;
1.3       raeburn  1941:     return $datatable;
                   1942: }
                   1943: 
1.160.6.5  raeburn  1944: sub print_requestmail {
                   1945:     my ($dom,$action,$settings,$rowtotal) = @_;
1.160.6.25  raeburn  1946:     my ($now,$datatable,%currapp);
1.102     raeburn  1947:     $now = time;
                   1948:     if (ref($settings) eq 'HASH') {
                   1949:         if (ref($settings->{'notify'}) eq 'HASH') {
                   1950:             if ($settings->{'notify'}{'approval'} ne '') {
1.160.6.16  raeburn  1951:                map {$currapp{$_}=1;} split(/,/,$settings->{'notify'}{'approval'});
1.102     raeburn  1952:             }
                   1953:         }
                   1954:     }
1.160.6.16  raeburn  1955:     my $numinrow = 2;
1.102     raeburn  1956:     my $css_class = 'class="LC_odd_row"';
1.160.6.5  raeburn  1957:     my $text;
                   1958:     if ($action eq 'requestcourses') {
                   1959:         $text = &mt('Receive notification of course requests requiring approval');
                   1960:     } else {
                   1961:         $text = &mt('Receive notification of authoring space requests requiring approval')
                   1962:     }
                   1963:     $datatable = '<tr '.$css_class.'>'.
                   1964:                  ' <td>'.$text.'</td>'.
1.102     raeburn  1965:                  ' <td class="LC_left_item">';
1.160.6.16  raeburn  1966:     my ($numdc,$table,$rows) = &active_dc_picker($dom,$numinrow,'checkbox',
                   1967:                                                  'reqapprovalnotify',%currapp);
                   1968:     if ($numdc > 0) {
                   1969:         $datatable .= $table;
1.102     raeburn  1970:     } else {
                   1971:         $datatable .= &mt('There are no active Domain Coordinators');
                   1972:     }
                   1973:     $datatable .='</td></tr>';
                   1974:     $$rowtotal += $rows;
                   1975:     return $datatable;
                   1976: }
                   1977: 
1.3       raeburn  1978: sub print_autoenroll {
1.30      raeburn  1979:     my ($dom,$settings,$rowtotal) = @_;
1.3       raeburn  1980:     my $autorun = &Apache::lonnet::auto_run(undef,$dom),
1.129     raeburn  1981:     my ($defdom,$runon,$runoff,$coownerson,$coownersoff);
1.3       raeburn  1982:     if (ref($settings) eq 'HASH') {
                   1983:         if (exists($settings->{'run'})) {
                   1984:             if ($settings->{'run'} eq '0') {
                   1985:                 $runoff = ' checked="checked" ';
                   1986:                 $runon = ' ';
                   1987:             } else {
                   1988:                 $runon = ' checked="checked" ';
                   1989:                 $runoff = ' ';
                   1990:             }
                   1991:         } else {
                   1992:             if ($autorun) {
                   1993:                 $runon = ' checked="checked" ';
                   1994:                 $runoff = ' ';
                   1995:             } else {
                   1996:                 $runoff = ' checked="checked" ';
                   1997:                 $runon = ' ';
                   1998:             }
                   1999:         }
1.129     raeburn  2000:         if (exists($settings->{'co-owners'})) {
                   2001:             if ($settings->{'co-owners'} eq '0') {
                   2002:                 $coownersoff = ' checked="checked" ';
                   2003:                 $coownerson = ' ';
                   2004:             } else {
                   2005:                 $coownerson = ' checked="checked" ';
                   2006:                 $coownersoff = ' ';
                   2007:             }
                   2008:         } else {
                   2009:             $coownersoff = ' checked="checked" ';
                   2010:             $coownerson = ' ';
                   2011:         }
1.3       raeburn  2012:         if (exists($settings->{'sender_domain'})) {
                   2013:             $defdom = $settings->{'sender_domain'};
                   2014:         }
1.14      raeburn  2015:     } else {
                   2016:         if ($autorun) {
                   2017:             $runon = ' checked="checked" ';
                   2018:             $runoff = ' ';
                   2019:         } else {
                   2020:             $runoff = ' checked="checked" ';
                   2021:             $runon = ' ';
                   2022:         }
1.3       raeburn  2023:     }
                   2024:     my $domform = &Apache::loncommon::select_dom_form($defdom,'sender_domain',1);
1.39      raeburn  2025:     my $notif_sender;
                   2026:     if (ref($settings) eq 'HASH') {
                   2027:         $notif_sender = $settings->{'sender_uname'};
                   2028:     }
1.3       raeburn  2029:     my $datatable='<tr class="LC_odd_row">'.
                   2030:                   '<td>'.&mt('Auto-enrollment active?').'</td>'.
1.8       raeburn  2031:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
1.3       raeburn  2032:                   '<input type="radio" name="autoenroll_run"'.
1.8       raeburn  2033:                   $runon.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
                   2034:                   '<label><input type="radio" name="autoenroll_run"'.
1.14      raeburn  2035:                   $runoff.' value="0" />'.&mt('No').'</label></span></td>'.
1.3       raeburn  2036:                   '</tr><tr>'.
                   2037:                   '<td>'.&mt('Notification messages - sender').
1.8       raeburn  2038:                   '</td><td class="LC_right_item"><span class="LC_nobreak">'.
1.3       raeburn  2039:                   &mt('username').':&nbsp;'.
                   2040:                   '<input type="text" name="sender_uname" value="'.
1.39      raeburn  2041:                   $notif_sender.'" size="10" />&nbsp;&nbsp;'.&mt('domain').
1.129     raeburn  2042:                   ':&nbsp;'.$domform.'</span></td></tr>'.
                   2043:                   '<tr class="LC_odd_row">'.
                   2044:                   '<td>'.&mt('Automatically assign co-ownership').'</td>'.
                   2045:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
                   2046:                   '<input type="radio" name="autoassign_coowners"'.
                   2047:                   $coownerson.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
                   2048:                   '<label><input type="radio" name="autoassign_coowners"'.
                   2049:                   $coownersoff.' value="0" />'.&mt('No').'</label></span></td>'.
                   2050:                   '</tr>';
                   2051:     $$rowtotal += 3;
1.3       raeburn  2052:     return $datatable;
                   2053: }
                   2054: 
                   2055: sub print_autoupdate {
1.30      raeburn  2056:     my ($position,$dom,$settings,$rowtotal) = @_;
1.3       raeburn  2057:     my $datatable;
                   2058:     if ($position eq 'top') {
                   2059:         my $updateon = ' ';
                   2060:         my $updateoff = ' checked="checked" ';
                   2061:         my $classlistson = ' ';
                   2062:         my $classlistsoff = ' checked="checked" ';
                   2063:         if (ref($settings) eq 'HASH') {
                   2064:             if ($settings->{'run'} eq '1') {
                   2065:                 $updateon = $updateoff;
                   2066:                 $updateoff = ' ';
                   2067:             }
                   2068:             if ($settings->{'classlists'} eq '1') {
                   2069:                 $classlistson = $classlistsoff;
                   2070:                 $classlistsoff = ' ';
                   2071:             }
                   2072:         }
                   2073:         my %title = (
                   2074:                    run => 'Auto-update active?',
                   2075:                    classlists => 'Update information in classlists?',
                   2076:                     );
                   2077:         $datatable = '<tr class="LC_odd_row">'. 
                   2078:                   '<td>'.&mt($title{'run'}).'</td>'.
1.8       raeburn  2079:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
1.3       raeburn  2080:                   '<input type="radio" name="autoupdate_run"'.
1.8       raeburn  2081:                   $updateon.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
                   2082:                   '<label><input type="radio" name="autoupdate_run"'.
                   2083:                   $updateoff.'value="0" />'.&mt('No').'</label></span></td>'.
1.3       raeburn  2084:                   '</tr><tr>'.
                   2085:                   '<td>'.&mt($title{'classlists'}).'</td>'.
1.8       raeburn  2086:                   '<td class="LC_right_item"><span class="LC_nobreak">'.
                   2087:                   '<label><input type="radio" name="classlists"'.
                   2088:                   $classlistson.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
                   2089:                   '<label><input type="radio" name="classlists"'.
                   2090:                   $classlistsoff.'value="0" />'.&mt('No').'</label></span></td>'.
1.3       raeburn  2091:                   '</tr>';
1.30      raeburn  2092:         $$rowtotal += 2;
1.131     raeburn  2093:     } elsif ($position eq 'middle') {
                   2094:         my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
                   2095:         my $numinrow = 3;
                   2096:         my $locknamesettings;
                   2097:         $datatable .= &insttypes_row($settings,$types,$usertypes,
                   2098:                                      $dom,$numinrow,$othertitle,
                   2099:                                     'lockablenames');
                   2100:         $$rowtotal ++;
1.3       raeburn  2101:     } else {
1.44      raeburn  2102:         my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
1.132     raeburn  2103:         my @fields = ('lastname','firstname','middlename','generation',
1.20      raeburn  2104:                       'permanentemail','id');
1.33      raeburn  2105:         my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
1.3       raeburn  2106:         my $numrows = 0;
1.26      raeburn  2107:         if (ref($types) eq 'ARRAY') {
                   2108:             if (@{$types} > 0) {
                   2109:                 $datatable = 
                   2110:                     &usertype_update_row($settings,$usertypes,\%fieldtitles,
                   2111:                                          \@fields,$types,\$numrows);
1.30      raeburn  2112:                     $$rowtotal += @{$types}; 
1.26      raeburn  2113:             }
1.3       raeburn  2114:         }
                   2115:         $datatable .= 
                   2116:             &usertype_update_row($settings,{'default' => $othertitle},
                   2117:                                  \%fieldtitles,\@fields,['default'],
                   2118:                                  \$numrows);
1.30      raeburn  2119:         $$rowtotal ++;     
1.3       raeburn  2120:     }
                   2121:     return $datatable;
                   2122: }
                   2123: 
1.125     raeburn  2124: sub print_autocreate {
                   2125:     my ($dom,$settings,$rowtotal) = @_;
1.160.6.16  raeburn  2126:     my (%createon,%createoff,%currhash);
1.125     raeburn  2127:     my @types = ('xml','req');
                   2128:     if (ref($settings) eq 'HASH') {
                   2129:         foreach my $item (@types) {
                   2130:             $createoff{$item} = ' checked="checked" ';
                   2131:             $createon{$item} = ' ';
                   2132:             if (exists($settings->{$item})) {
                   2133:                 if ($settings->{$item}) {
                   2134:                     $createon{$item} = ' checked="checked" ';
                   2135:                     $createoff{$item} = ' ';
                   2136:                 }
                   2137:             }
                   2138:         }
1.160.6.16  raeburn  2139:         if ($settings->{'xmldc'} ne '') {
                   2140:             $currhash{$settings->{'xmldc'}} = 1;
                   2141:         }
1.125     raeburn  2142:     } else {
                   2143:         foreach my $item (@types) {
                   2144:             $createoff{$item} = ' checked="checked" ';
                   2145:             $createon{$item} = ' ';
                   2146:         }
                   2147:     }
                   2148:     $$rowtotal += 2;
1.160.6.16  raeburn  2149:     my $numinrow = 2;
1.125     raeburn  2150:     my $datatable='<tr class="LC_odd_row">'.
                   2151:                   '<td>'.&mt('Create pending official courses from XML files').'</td>'.
                   2152:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
                   2153:                   '<input type="radio" name="autocreate_xml"'.
                   2154:                   $createon{'xml'}.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
                   2155:                   '<label><input type="radio" name="autocreate_xml"'.
1.143     raeburn  2156:                   $createoff{'xml'}.' value="0" />'.&mt('No').'</label></span>'.
                   2157:                   '</td></tr><tr>'.
                   2158:                   '<td>'.&mt('Create pending requests for official courses (if validated)').'</td>'.
                   2159:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
                   2160:                   '<input type="radio" name="autocreate_req"'.
                   2161:                   $createon{'req'}.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
                   2162:                   '<label><input type="radio" name="autocreate_req"'.
                   2163:                   $createoff{'req'}.' value="0" />'.&mt('No').'</label></span>';
1.160.6.16  raeburn  2164:     my ($numdc,$dctable,$rows) = &active_dc_picker($dom,$numinrow,'radio',
                   2165:                                                    'autocreate_xmldc',%currhash);
1.125     raeburn  2166:     if ($numdc > 1) {
1.143     raeburn  2167:         $datatable .= '</td></tr><tr class="LC_odd_row"><td>'.
                   2168:                       &mt('Course creation processed as: (choose Dom. Coord.)').
                   2169:                       '</td><td class="LC_left_item">'.$dctable.'</td></tr>';
1.125     raeburn  2170:     } else {
1.143     raeburn  2171:         $datatable .= $dctable.'</td></tr>';
1.125     raeburn  2172:     }
1.160.6.16  raeburn  2173:     $$rowtotal += $rows;
1.125     raeburn  2174:     return $datatable;
                   2175: }
                   2176: 
1.23      raeburn  2177: sub print_directorysrch {
1.30      raeburn  2178:     my ($dom,$settings,$rowtotal) = @_;
1.23      raeburn  2179:     my $srchon = ' ';
                   2180:     my $srchoff = ' checked="checked" ';
1.25      raeburn  2181:     my ($exacton,$containson,$beginson);
1.24      raeburn  2182:     my $localon = ' ';
                   2183:     my $localoff = ' checked="checked" ';
1.23      raeburn  2184:     if (ref($settings) eq 'HASH') {
                   2185:         if ($settings->{'available'} eq '1') {
                   2186:             $srchon = $srchoff;
                   2187:             $srchoff = ' ';
                   2188:         }
1.24      raeburn  2189:         if ($settings->{'localonly'} eq '1') {
                   2190:             $localon = $localoff;
                   2191:             $localoff = ' ';
                   2192:         }
1.25      raeburn  2193:         if (ref($settings->{'searchtypes'}) eq 'ARRAY') {
                   2194:             foreach my $type (@{$settings->{'searchtypes'}}) {
                   2195:                 if ($type eq 'exact') {
                   2196:                     $exacton = ' checked="checked" ';
                   2197:                 } elsif ($type eq 'contains') {
                   2198:                     $containson = ' checked="checked" ';
                   2199:                 } elsif ($type eq 'begins') {
                   2200:                     $beginson = ' checked="checked" ';
                   2201:                 }
                   2202:             }
                   2203:         } else {
                   2204:             if ($settings->{'searchtypes'} eq 'exact') {
                   2205:                 $exacton = ' checked="checked" ';
                   2206:             } elsif ($settings->{'searchtypes'} eq 'contains') {
                   2207:                 $containson = ' checked="checked" ';
                   2208:             } elsif ($settings->{'searchtypes'} eq 'specify') {
                   2209:                 $exacton = ' checked="checked" ';
                   2210:                 $containson = ' checked="checked" ';
                   2211:             }
1.23      raeburn  2212:         }
                   2213:     }
                   2214:     my ($searchtitles,$titleorder) = &sorted_searchtitles();
1.45      raeburn  2215:     my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
1.23      raeburn  2216: 
                   2217:     my $numinrow = 4;
1.26      raeburn  2218:     my $cansrchrow = 0;
1.23      raeburn  2219:     my $datatable='<tr class="LC_odd_row">'.
1.30      raeburn  2220:                   '<td colspan="2"><span class ="LC_nobreak">'.&mt('Directory search available?').'</span></td>'.
1.23      raeburn  2221:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
                   2222:                   '<input type="radio" name="dirsrch_available"'.
                   2223:                   $srchon.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
                   2224:                   '<label><input type="radio" name="dirsrch_available"'.
                   2225:                   $srchoff.' value="0" />'.&mt('No').'</label></span></td>'.
                   2226:                   '</tr><tr>'.
1.30      raeburn  2227:                   '<td colspan="2"><span class ="LC_nobreak">'.&mt('Other domains can search?').'</span></td>'.
1.24      raeburn  2228:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
                   2229:                   '<input type="radio" name="dirsrch_localonly"'.
                   2230:                   $localoff.' value="0" />'.&mt('Yes').'</label>&nbsp;'.
                   2231:                   '<label><input type="radio" name="dirsrch_localonly"'.
                   2232:                   $localon.' value="1" />'.&mt('No').'</label></span></td>'.
1.25      raeburn  2233:                   '</tr>';
1.30      raeburn  2234:     $$rowtotal += 2;
1.26      raeburn  2235:     if (ref($usertypes) eq 'HASH') {
                   2236:         if (keys(%{$usertypes}) > 0) {
1.93      raeburn  2237:             $datatable .= &insttypes_row($settings,$types,$usertypes,$dom,
                   2238:                                          $numinrow,$othertitle,'cansearch');
1.26      raeburn  2239:             $cansrchrow = 1;
                   2240:         }
                   2241:     }
                   2242:     if ($cansrchrow) {
1.30      raeburn  2243:         $$rowtotal ++;
1.26      raeburn  2244:         $datatable .= '<tr>';
                   2245:     } else {
                   2246:         $datatable .= '<tr class="LC_odd_row">';
                   2247:     }
1.30      raeburn  2248:     $datatable .= '<td><span class ="LC_nobreak">'.&mt('Supported search methods').
                   2249:                   '</span></td><td class="LC_left_item" colspan="2"><table><tr>';
1.25      raeburn  2250:     foreach my $title (@{$titleorder}) {
                   2251:         if (defined($searchtitles->{$title})) {
                   2252:             my $check = ' ';
1.93      raeburn  2253:             if (ref($settings) eq 'HASH') {
1.39      raeburn  2254:                 if (ref($settings->{'searchby'}) eq 'ARRAY') {
                   2255:                     if (grep(/^\Q$title\E$/,@{$settings->{'searchby'}})) {
                   2256:                         $check = ' checked="checked" ';
                   2257:                     }
1.25      raeburn  2258:                 }
                   2259:             }
                   2260:             $datatable .= '<td class="LC_left_item">'.
                   2261:                           '<span class="LC_nobreak"><label>'.
                   2262:                           '<input type="checkbox" name="searchby" '.
                   2263:                           'value="'.$title.'"'.$check.'/>'.
                   2264:                           $searchtitles->{$title}.'</label></span></td>';
                   2265:         }
                   2266:     }
1.26      raeburn  2267:     $datatable .= '</tr></table></td></tr>';
1.30      raeburn  2268:     $$rowtotal ++;
1.26      raeburn  2269:     if ($cansrchrow) {
                   2270:         $datatable .= '<tr class="LC_odd_row">';
                   2271:     } else {
                   2272:         $datatable .= '<tr>';
                   2273:     }
1.30      raeburn  2274:     $datatable .= '<td><span class ="LC_nobreak">'.&mt('Search latitude').'</span></td>'.   
1.26      raeburn  2275:                   '<td class="LC_left_item" colspan="2">'.
1.25      raeburn  2276:                   '<span class="LC_nobreak"><label>'.
                   2277:                   '<input type="checkbox" name="searchtypes" '.
                   2278:                   $exacton.' value="exact" />'.&mt('Exact match').
                   2279:                   '</label>&nbsp;'.
                   2280:                   '<label><input type="checkbox" name="searchtypes" '.
                   2281:                   $beginson.' value="begins" />'.&mt('Begins with').
                   2282:                   '</label>&nbsp;'.
                   2283:                   '<label><input type="checkbox" name="searchtypes" '.
                   2284:                   $containson.' value="contains" />'.&mt('Contains').
                   2285:                   '</label></span></td></tr>';
1.30      raeburn  2286:     $$rowtotal ++;
1.25      raeburn  2287:     return $datatable;
                   2288: }
                   2289: 
1.28      raeburn  2290: sub print_contacts {
1.30      raeburn  2291:     my ($dom,$settings,$rowtotal) = @_;
1.28      raeburn  2292:     my $datatable;
                   2293:     my @contacts = ('adminemail','supportemail');
1.134     raeburn  2294:     my (%checked,%to,%otheremails,%bccemails);
1.102     raeburn  2295:     my @mailings = ('errormail','packagesmail','lonstatusmail','helpdeskmail',
1.160.6.23  raeburn  2296:                     'requestsmail','updatesmail','idconflictsmail');
1.28      raeburn  2297:     foreach my $type (@mailings) {
                   2298:         $otheremails{$type} = '';
                   2299:     }
1.134     raeburn  2300:     $bccemails{'helpdeskmail'} = '';
1.28      raeburn  2301:     if (ref($settings) eq 'HASH') {
                   2302:         foreach my $item (@contacts) {
                   2303:             if (exists($settings->{$item})) {
                   2304:                 $to{$item} = $settings->{$item};
                   2305:             }
                   2306:         }
                   2307:         foreach my $type (@mailings) {
                   2308:             if (exists($settings->{$type})) {
                   2309:                 if (ref($settings->{$type}) eq 'HASH') {
                   2310:                     foreach my $item (@contacts) {
                   2311:                         if ($settings->{$type}{$item}) {
                   2312:                             $checked{$type}{$item} = ' checked="checked" ';
                   2313:                         }
                   2314:                     }
                   2315:                     $otheremails{$type} = $settings->{$type}{'others'};
1.134     raeburn  2316:                     if ($type eq 'helpdeskmail') {
                   2317:                         $bccemails{$type} = $settings->{$type}{'bcc'};
                   2318:                     }
1.28      raeburn  2319:                 }
1.89      raeburn  2320:             } elsif ($type eq 'lonstatusmail') {
                   2321:                 $checked{'lonstatusmail'}{'adminemail'} = ' checked="checked" ';
1.28      raeburn  2322:             }
                   2323:         }
                   2324:     } else {
                   2325:         $to{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'};
                   2326:         $to{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'};
                   2327:         $checked{'errormail'}{'adminemail'} = ' checked="checked" ';
                   2328:         $checked{'packagesmail'}{'adminemail'} = ' checked="checked" ';
1.89      raeburn  2329:         $checked{'helpdeskmail'}{'supportemail'} = ' checked="checked" ';
                   2330:         $checked{'lonstatusmail'}{'adminemail'} = ' checked="checked" '; 
1.102     raeburn  2331:         $checked{'requestsmail'}{'adminemail'} = ' checked="checked" ';
1.160.6.23  raeburn  2332:         $checked{'updatesmail'}{'adminemail'} = ' checked="checked" ';
                   2333:         $checked{'idconflictsmail'}{'adminemail'} = ' checked="checked" ';
1.28      raeburn  2334:     }
                   2335:     my ($titles,$short_titles) = &contact_titles();
                   2336:     my $rownum = 0;
                   2337:     my $css_class;
                   2338:     foreach my $item (@contacts) {
1.69      raeburn  2339:         $css_class = $rownum%2?' class="LC_odd_row"':'';
1.30      raeburn  2340:         $datatable .= '<tr'.$css_class.'>'. 
                   2341:                   '<td><span class="LC_nobreak">'.$titles->{$item}.
                   2342:                   '</span></td><td class="LC_right_item">'.
1.28      raeburn  2343:                   '<input type="text" name="'.$item.'" value="'.
                   2344:                   $to{$item}.'" /></td></tr>';
1.160.6.23  raeburn  2345:         $rownum ++;
1.28      raeburn  2346:     }
                   2347:     foreach my $type (@mailings) {
1.69      raeburn  2348:         $css_class = $rownum%2?' class="LC_odd_row"':'';
1.28      raeburn  2349:         $datatable .= '<tr'.$css_class.'>'.
1.30      raeburn  2350:                       '<td><span class="LC_nobreak">'.
                   2351:                       $titles->{$type}.': </span></td>'.
1.28      raeburn  2352:                       '<td class="LC_left_item">'.
                   2353:                       '<span class="LC_nobreak">';
                   2354:         foreach my $item (@contacts) {
                   2355:             $datatable .= '<label>'.
                   2356:                           '<input type="checkbox" name="'.$type.'"'.
                   2357:                           $checked{$type}{$item}.
                   2358:                           ' value="'.$item.'" />'.$short_titles->{$item}.
                   2359:                           '</label>&nbsp;';
                   2360:         }
                   2361:         $datatable .= '</span><br />'.&mt('Others').':&nbsp;&nbsp;'.
                   2362:                       '<input type="text" name="'.$type.'_others" '.
1.134     raeburn  2363:                       'value="'.$otheremails{$type}.'"  />';
                   2364:         if ($type eq 'helpdeskmail') {
1.136     raeburn  2365:             $datatable .= '<br />'.&mt('Bcc:').('&nbsp;'x6).
1.134     raeburn  2366:                           '<input type="text" name="'.$type.'_bcc" '.
                   2367:                           'value="'.$bccemails{$type}.'"  />';
                   2368:         }
                   2369:         $datatable .= '</td></tr>'."\n";
1.160.6.23  raeburn  2370:         $rownum ++;
1.28      raeburn  2371:     }
1.160.6.23  raeburn  2372:     my %choices;
                   2373:     $choices{'reporterrors'} = &mt('E-mail error reports to [_1]',
                   2374:                                    &Apache::loncommon::modal_link('http://loncapa.org/core.html',
                   2375:                                    &mt('LON-CAPA core group - MSU'),600,500));
                   2376:     $choices{'reportupdates'} = &mt('E-mail record of completed LON-CAPA updates to [_1]',
                   2377:                                     &Apache::loncommon::modal_link('http://loncapa.org/core.html',
                   2378:                                     &mt('LON-CAPA core group - MSU'),600,500));
                   2379:     my @toggles = ('reporterrors','reportupdates');
                   2380:     my %defaultchecked = ('reporterrors'  => 'on',
                   2381:                           'reportupdates' => 'on');
                   2382:     (my $reports,$rownum) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked,
                   2383:                                                \%choices,$rownum);
                   2384:     $datatable .= $reports;
1.30      raeburn  2385:     $$rowtotal += $rownum;
1.28      raeburn  2386:     return $datatable;
                   2387: }
                   2388: 
1.118     jms      2389: sub print_helpsettings {
1.160.6.5  raeburn  2390:     my ($dom,$confname,$settings,$rowtotal) = @_;
                   2391:     my ($datatable,$itemcount);
                   2392:     $itemcount = 1;
                   2393:     my (%choices,%defaultchecked,@toggles);
                   2394:     $choices{'submitbugs'} = &mt('Display link to: [_1]?',
                   2395:                                  &Apache::loncommon::modal_link('http://bugs.loncapa.org',
                   2396:                                  &mt('LON-CAPA bug tracker'),600,500));
                   2397:     %defaultchecked = ('submitbugs' => 'on');
                   2398:     @toggles = ('submitbugs',);
1.122     jms      2399: 
1.160.6.5  raeburn  2400:     ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked,
                   2401:                                                  \%choices,$itemcount);
                   2402:     return $datatable;
1.121     raeburn  2403: }
                   2404: 
                   2405: sub radiobutton_prefs {
1.160.6.16  raeburn  2406:     my ($settings,$toggles,$defaultchecked,$choices,$itemcount,$onclick,
                   2407:         $additional) = @_;
1.121     raeburn  2408:     return unless ((ref($toggles) eq 'ARRAY') && (ref($defaultchecked) eq 'HASH') &&
                   2409:                    (ref($choices) eq 'HASH'));
                   2410: 
                   2411:     my (%checkedon,%checkedoff,$datatable,$css_class);
                   2412: 
                   2413:     foreach my $item (@{$toggles}) {
                   2414:         if ($defaultchecked->{$item} eq 'on') {
1.118     jms      2415:             $checkedon{$item} = ' checked="checked" ';
                   2416:             $checkedoff{$item} = ' ';
1.121     raeburn  2417:         } elsif ($defaultchecked->{$item} eq 'off') {
1.118     jms      2418:             $checkedoff{$item} = ' checked="checked" ';
                   2419:             $checkedon{$item} = ' ';
                   2420:         }
                   2421:     }
                   2422:     if (ref($settings) eq 'HASH') {
1.121     raeburn  2423:         foreach my $item (@{$toggles}) {
1.118     jms      2424:             if ($settings->{$item} eq '1') {
                   2425:                 $checkedon{$item} =  ' checked="checked" ';
                   2426:                 $checkedoff{$item} = ' ';
                   2427:             } elsif ($settings->{$item} eq '0') {
                   2428:                 $checkedoff{$item} =  ' checked="checked" ';
                   2429:                 $checkedon{$item} = ' ';
                   2430:             }
                   2431:         }
1.121     raeburn  2432:     }
1.160.6.16  raeburn  2433:     if ($onclick) {
                   2434:         $onclick = ' onclick="'.$onclick.'"';
                   2435:     }
1.121     raeburn  2436:     foreach my $item (@{$toggles}) {
1.118     jms      2437:         $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.121     raeburn  2438:         $datatable .=
1.160.6.16  raeburn  2439:             '<tr'.$css_class.'><td valign="top">'.
                   2440:             '<span class="LC_nobreak">'.$choices->{$item}.
1.118     jms      2441:             '</span></td>'.
                   2442:             '<td class="LC_right_item"><span class="LC_nobreak">'.
                   2443:             '<label><input type="radio" name="'.
1.160.6.16  raeburn  2444:             $item.'" '.$checkedon{$item}.' value="1"'.$onclick.' />'.&mt('Yes').
1.118     jms      2445:             '</label>&nbsp;<label><input type="radio" name="'.$item.'" '.
1.160.6.16  raeburn  2446:             $checkedoff{$item}.' value="0"'.$onclick.' />'.&mt('No').'</label>'.
                   2447:             '</span>'.$additional.
                   2448:             '</td>'.
1.118     jms      2449:             '</tr>';
                   2450:         $itemcount ++;
1.121     raeburn  2451:     }
                   2452:     return ($datatable,$itemcount);
                   2453: }
                   2454: 
                   2455: sub print_coursedefaults {
1.139     raeburn  2456:     my ($position,$dom,$settings,$rowtotal) = @_;
1.160.6.16  raeburn  2457:     my ($css_class,$datatable,%checkedon,%checkedoff,%defaultchecked,@toggles);
1.121     raeburn  2458:     my $itemcount = 1;
1.160.6.16  raeburn  2459:     my %choices =  &Apache::lonlocal::texthash (
                   2460:         canuse_pdfforms      => 'Course/Community users can create/upload PDF forms',
1.160.6.21  raeburn  2461:         uploadquota          => 'Default quota for files uploaded directly to course/community using Course Editor (MB)',
1.160.6.16  raeburn  2462:         anonsurvey_threshold => 'Responder count needed before showing submissions for anonymous surveys',
                   2463:         coursecredits        => 'Credits can be specified for courses',
                   2464:     );
1.160.6.21  raeburn  2465:     my %staticdefaults = (
                   2466:                            anonsurvey_threshold => 10,
                   2467:                            uploadquota          => 500,
                   2468:                          );
1.139     raeburn  2469:     if ($position eq 'top') {
                   2470:         %defaultchecked = ('canuse_pdfforms' => 'off');
1.160.6.16  raeburn  2471:         @toggles = ('canuse_pdfforms');
1.139     raeburn  2472:         ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked,
1.121     raeburn  2473:                                                  \%choices,$itemcount);
1.139     raeburn  2474:     } else {
                   2475:         $css_class = $itemcount%2 ? ' class="LC_odd_row"' : '';
1.160.6.21  raeburn  2476:         my ($currdefresponder,$def_official_credits,$def_unofficial_credits,%curruploadquota);
1.160.6.16  raeburn  2477:         my $currusecredits = 0;
1.160.6.21  raeburn  2478:         my @types = ('official','unofficial','community');
1.139     raeburn  2479:         if (ref($settings) eq 'HASH') {
                   2480:             $currdefresponder = $settings->{'anonsurvey_threshold'};
1.160.6.21  raeburn  2481:             if (ref($settings->{'uploadquota'}) eq 'HASH') {
                   2482:                 foreach my $type (keys(%{$settings->{'uploadquota'}})) {
                   2483:                     $curruploadquota{$type} = $settings->{'uploadquota'}{$type};
                   2484:                 }
                   2485:             }
1.160.6.16  raeburn  2486:             if (ref($settings->{'coursecredits'}) eq 'HASH') {
                   2487:                 $def_official_credits = $settings->{'coursecredits'}->{'official'};
                   2488:                 $def_unofficial_credits = $settings->{'coursecredits'}->{'unofficial'};
                   2489:                 if (($def_official_credits ne '') || ($def_unofficial_credits ne '')) {
                   2490:                     $currusecredits = 1;
                   2491:                 }
                   2492:             }
1.139     raeburn  2493:         }
                   2494:         if (!$currdefresponder) {
1.160.6.21  raeburn  2495:             $currdefresponder = $staticdefaults{'anonsurvey_threshold'};
1.139     raeburn  2496:         } elsif ($currdefresponder < 1) {
                   2497:             $currdefresponder = 1;
                   2498:         }
1.160.6.21  raeburn  2499:         foreach my $type (@types) {
                   2500:             if ($curruploadquota{$type} eq '') {
                   2501:                 $curruploadquota{$type} = $staticdefaults{'uploadquota'};
                   2502:             }
                   2503:         }
1.139     raeburn  2504:         $datatable .=
1.160.6.16  raeburn  2505:                 '<tr'.$css_class.'><td><span class="LC_nobreak">'.
                   2506:                 $choices{'anonsurvey_threshold'}.
1.139     raeburn  2507:                 '</span></td>'.
                   2508:                 '<td class="LC_right_item"><span class="LC_nobreak">'.
                   2509:                 '<input type="text" name="anonsurvey_threshold"'.
                   2510:                 ' value="'.$currdefresponder.'" size="5" /></span>'.
1.160.6.21  raeburn  2511:                 '</td></tr>'."\n".
                   2512:                 '<tr><td><span class="LC_nobreak">'.
                   2513:                 $choices{'uploadquota'}.
                   2514:                 '</span></td>'.
                   2515:                 '<td align="right" class="LC_right_item">'.
                   2516:                 '<table><tr>';
                   2517:         foreach my $type (@types) {
                   2518:             $datatable .= '<td align="center">'.&mt($type).'<br />'.
                   2519:                            '<input type="text" name="uploadquota_'.$type.'"'.
                   2520:                            ' value="'.$curruploadquota{$type}.'" size="5" /></td>';
                   2521:         }
                   2522:         $datatable .= '</tr></table></td></tr>'."\n";
                   2523:         $itemcount += 2;
1.160.6.16  raeburn  2524:         my $onclick = 'toggleCredits(this.form);';
                   2525:         my $display = 'none';
                   2526:         if ($currusecredits) {
                   2527:             $display = 'block';
                   2528:         }
                   2529:         my $additional = '<div id="credits" style="display: '.$display.'">'.
                   2530:                          '<span class="LC_nobreak">'.
                   2531:                          &mt('Default credits for official courses [_1]',
                   2532:                          '<input type="text" name="official_credits" value="'.
                   2533:                          $def_official_credits.'" size="3" />').
                   2534:                          '</span><br />'.
                   2535:                          '<span class="LC_nobreak">'.
                   2536:                          &mt('Default credits for unofficial courses [_1]',
                   2537:                          '<input type="text" name="unofficial_credits" value="'.
                   2538:                          $def_unofficial_credits.'" size="3" />').
                   2539:                          '</span></div>'."\n";
                   2540:         %defaultchecked = ('coursecredits' => 'off');
                   2541:         @toggles = ('coursecredits');
                   2542:         my $current = {
                   2543:                         'coursecredits' => $currusecredits,
                   2544:                       };
                   2545:         (my $table,$itemcount) =
                   2546:             &radiobutton_prefs($current,\@toggles,\%defaultchecked,
                   2547:                                \%choices,$itemcount,$onclick,$additional);
                   2548:         $datatable .= $table;
1.139     raeburn  2549:     }
1.160.6.16  raeburn  2550:     $$rowtotal += $itemcount;
1.121     raeburn  2551:     return $datatable;
1.118     jms      2552: }
                   2553: 
1.137     raeburn  2554: sub print_usersessions {
                   2555:     my ($position,$dom,$settings,$rowtotal) = @_;
                   2556:     my ($css_class,$datatable,%checked,%choices);
1.140     raeburn  2557:     my (%by_ip,%by_location,@intdoms);
                   2558:     &build_location_hashes(\@intdoms,\%by_ip,\%by_location);
1.145     raeburn  2559: 
                   2560:     my @alldoms = &Apache::lonnet::all_domains();
1.152     raeburn  2561:     my %serverhomes = %Apache::lonnet::serverhomeIDs;
1.149     raeburn  2562:     my %servers = &Apache::lonnet::internet_dom_servers($dom);
1.152     raeburn  2563:     my %altids = &id_for_thisdom(%servers);
1.145     raeburn  2564:     my $itemcount = 1;
                   2565:     if ($position eq 'top') {
1.152     raeburn  2566:         if (keys(%serverhomes) > 1) {
1.145     raeburn  2567:             my %spareid = &current_offloads_to($dom,$settings,\%servers);
1.152     raeburn  2568:             $datatable .= &spares_row($dom,\%servers,\%spareid,\%serverhomes,\%altids,$rowtotal);
1.145     raeburn  2569:         } else {
1.140     raeburn  2570:             $datatable .= '<tr'.$css_class.'><td colspan="2">'.
1.150     raeburn  2571:                           &mt('Nothing to set here, as the cluster to which this domain belongs only contains one server.');
1.140     raeburn  2572:         }
1.137     raeburn  2573:     } else {
1.145     raeburn  2574:         if (keys(%by_location) == 0) {
                   2575:             $datatable .= '<tr'.$css_class.'><td colspan="2">'.
1.150     raeburn  2576:                           &mt('Nothing to set here, as the cluster to which this domain belongs only contains one institution.');
1.145     raeburn  2577:         } else {
                   2578:             my %lt = &usersession_titles();
                   2579:             my $numinrow = 5;
                   2580:             my $prefix;
                   2581:             my @types;
                   2582:             if ($position eq 'bottom') {
                   2583:                 $prefix = 'remote';
                   2584:                 @types = ('version','excludedomain','includedomain');
                   2585:             } else {
                   2586:                 $prefix = 'hosted';
                   2587:                 @types = ('excludedomain','includedomain');
                   2588:             }
                   2589:             my (%current,%checkedon,%checkedoff);
                   2590:             my @lcversions = &Apache::lonnet::all_loncaparevs();
                   2591:             my @locations = sort(keys(%by_location));
                   2592:             foreach my $type (@types) {
                   2593:                 $checkedon{$type} = '';
                   2594:                 $checkedoff{$type} = ' checked="checked"';
                   2595:             }
                   2596:             if (ref($settings) eq 'HASH') {
                   2597:                 if (ref($settings->{$prefix}) eq 'HASH') {
                   2598:                     foreach my $key (keys(%{$settings->{$prefix}})) {
                   2599:                         $current{$key} = $settings->{$prefix}{$key};
                   2600:                         if ($key eq 'version') {
                   2601:                             if ($current{$key} ne '') {
                   2602:                                 $checkedon{$key} = ' checked="checked"';
                   2603:                                 $checkedoff{$key} = '';
                   2604:                             }
                   2605:                         } elsif (ref($current{$key}) eq 'ARRAY') {
                   2606:                             $checkedon{$key} = ' checked="checked"';
                   2607:                             $checkedoff{$key} = '';
                   2608:                         }
1.137     raeburn  2609:                     }
                   2610:                 }
                   2611:             }
1.145     raeburn  2612:             foreach my $type (@types) {
                   2613:                 next if ($type ne 'version' && !@locations);
                   2614:                 $css_class = $itemcount%2 ? ' class="LC_odd_row"' : '';
                   2615:                 $datatable .= '<tr'.$css_class.'>
                   2616:                                <td><span class="LC_nobreak">'.$lt{$type}.'</span><br />
                   2617:                                <span class="LC_nobreak">&nbsp;
                   2618:                                <label><input type="radio" name="'.$prefix.'_'.$type.'_inuse" '.$checkedoff{$type}.' value="0" />'.&mt('Not in use').'</label>&nbsp;
                   2619:                                <label><input type="radio" name="'.$prefix.'_'.$type.'_inuse" '.$checkedon{$type}.' value="1" />'.&mt('In use').'</label></span></td><td>';
                   2620:                 if ($type eq 'version') {
                   2621:                     my $selector = '<select name="'.$prefix.'_version">';
                   2622:                     foreach my $version (@lcversions) {
                   2623:                         my $selected = '';
                   2624:                         if ($current{'version'} eq $version) {
                   2625:                             $selected = ' selected="selected"';
                   2626:                         }
                   2627:                         $selector .= ' <option value="'.$version.'"'.
                   2628:                                      $selected.'>'.$version.'</option>';
                   2629:                     }
                   2630:                     $selector .= '</select> ';
                   2631:                     $datatable .= &mt('remote server must be version: [_1] or later',$selector);
                   2632:                 } else {
                   2633:                     $datatable.= '<div><input type="button" value="'.&mt('check all').'" '.
                   2634:                                  'onclick="javascript:checkAll(document.display.'.$prefix.'_'.$type.')"'.
                   2635:                                  ' />'.('&nbsp;'x2).
                   2636:                                  '<input type="button" value="'.&mt('uncheck all').'" '.
                   2637:                                  'onclick="javascript:uncheckAll(document.display.'.$prefix.'_'.$type.')" />'.
                   2638:                                  "\n".
                   2639:                                  '</div><div><table>';
                   2640:                     my $rem;
                   2641:                     for (my $i=0; $i<@locations; $i++) {
                   2642:                         my ($showloc,$value,$checkedtype);
                   2643:                         if (ref($by_location{$locations[$i]}) eq 'ARRAY') {
                   2644:                             my $ip = $by_location{$locations[$i]}->[0];
                   2645:                             if (ref($by_ip{$ip}) eq 'ARRAY') {
                   2646:                                  $value = join(':',@{$by_ip{$ip}});
                   2647:                                 $showloc = join(', ',@{$by_ip{$ip}});
                   2648:                                 if (ref($current{$type}) eq 'ARRAY') {
                   2649:                                     foreach my $loc (@{$by_ip{$ip}}) {  
                   2650:                                         if (grep(/^\Q$loc\E$/,@{$current{$type}})) {
                   2651:                                             $checkedtype = ' checked="checked"';
                   2652:                                             last;
                   2653:                                         }
                   2654:                                     }
1.138     raeburn  2655:                                 }
                   2656:                             }
                   2657:                         }
1.145     raeburn  2658:                         $rem = $i%($numinrow);
                   2659:                         if ($rem == 0) {
                   2660:                             if ($i > 0) {
                   2661:                                 $datatable .= '</tr>';
                   2662:                             }
                   2663:                             $datatable .= '<tr>';
                   2664:                         }
                   2665:                         $datatable .= '<td class="LC_left_item">'.
                   2666:                                       '<span class="LC_nobreak"><label>'.
                   2667:                                       '<input type="checkbox" name="'.$prefix.'_'.$type.
                   2668:                                       '" value="'.$value.'"'.$checkedtype.' />'.$showloc.
                   2669:                                       '</label></span></td>';
1.137     raeburn  2670:                     }
1.145     raeburn  2671:                     $rem = @locations%($numinrow);
                   2672:                     my $colsleft = $numinrow - $rem;
                   2673:                     if ($colsleft > 1 ) {
                   2674:                         $datatable .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
                   2675:                                       '&nbsp;</td>';
                   2676:                     } elsif ($colsleft == 1) {
                   2677:                         $datatable .= '<td class="LC_left_item">&nbsp;</td>';
1.137     raeburn  2678:                     }
1.145     raeburn  2679:                     $datatable .= '</tr></table>';
1.137     raeburn  2680:                 }
1.145     raeburn  2681:                 $datatable .= '</td></tr>';
                   2682:                 $itemcount ++;
1.137     raeburn  2683:             }
                   2684:         }
                   2685:     }
                   2686:     $$rowtotal += $itemcount;
                   2687:     return $datatable;
                   2688: }
                   2689: 
1.138     raeburn  2690: sub build_location_hashes {
                   2691:     my ($intdoms,$by_ip,$by_location) = @_;
                   2692:     return unless((ref($intdoms) eq 'ARRAY') && (ref($by_ip) eq 'HASH') &&
                   2693:                   (ref($by_location) eq 'HASH')); 
                   2694:     my %iphost = &Apache::lonnet::get_iphost();
                   2695:     my $primary_id = &Apache::lonnet::domain($env{'request.role.domain'},'primary');
                   2696:     my $primary_ip = &Apache::lonnet::get_host_ip($primary_id);
                   2697:     if (ref($iphost{$primary_ip}) eq 'ARRAY') {
                   2698:         foreach my $id (@{$iphost{$primary_ip}}) {
                   2699:             my $intdom = &Apache::lonnet::internet_dom($id);
                   2700:             unless(grep(/^\Q$intdom\E$/,@{$intdoms})) {
                   2701:                 push(@{$intdoms},$intdom);
                   2702:             }
                   2703:         }
                   2704:     }
                   2705:     foreach my $ip (keys(%iphost)) {
                   2706:         if (ref($iphost{$ip}) eq 'ARRAY') {
                   2707:             foreach my $id (@{$iphost{$ip}}) {
                   2708:                 my $location = &Apache::lonnet::internet_dom($id);
                   2709:                 if ($location) {
                   2710:                     next if (grep(/^\Q$location\E$/,@{$intdoms}));
                   2711:                     if (ref($by_ip->{$ip}) eq 'ARRAY') {
                   2712:                         unless(grep(/^\Q$location\E$/,@{$by_ip->{$ip}})) {
                   2713:                             push(@{$by_ip->{$ip}},$location);
                   2714:                         }
                   2715:                     } else {
                   2716:                         $by_ip->{$ip} = [$location];
                   2717:                     }
                   2718:                 }
                   2719:             }
                   2720:         }
                   2721:     }
                   2722:     foreach my $ip (sort(keys(%{$by_ip}))) {
                   2723:         if (ref($by_ip->{$ip}) eq 'ARRAY') {
                   2724:             @{$by_ip->{$ip}} = sort(@{$by_ip->{$ip}});
                   2725:             my $first = $by_ip->{$ip}->[0];
                   2726:             if (ref($by_location->{$first}) eq 'ARRAY') {
                   2727:                 unless (grep(/^\Q$ip\E$/,@{$by_location->{$first}})) {
                   2728:                     push(@{$by_location->{$first}},$ip);
                   2729:                 }
                   2730:             } else {
                   2731:                 $by_location->{$first} = [$ip];
                   2732:             }
                   2733:         }
                   2734:     }
                   2735:     return;
                   2736: }
                   2737: 
1.145     raeburn  2738: sub current_offloads_to {
                   2739:     my ($dom,$settings,$servers) = @_;
                   2740:     my (%spareid,%otherdomconfigs);
1.152     raeburn  2741:     if (ref($servers) eq 'HASH') {
1.145     raeburn  2742:         foreach my $lonhost (sort(keys(%{$servers}))) {
                   2743:             my $gotspares;
1.152     raeburn  2744:             if (ref($settings) eq 'HASH') {
                   2745:                 if (ref($settings->{'spares'}) eq 'HASH') {
                   2746:                     if (ref($settings->{'spares'}{$lonhost}) eq 'HASH') {
                   2747:                         $spareid{$lonhost}{'primary'} = $settings->{'spares'}{$lonhost}{'primary'};
                   2748:                         $spareid{$lonhost}{'default'} = $settings->{'spares'}{$lonhost}{'default'};
                   2749:                         $gotspares = 1;
                   2750:                     }
1.145     raeburn  2751:                 }
                   2752:             }
                   2753:             unless ($gotspares) {
                   2754:                 my $gotspares;
                   2755:                 my $serverhomeID =
                   2756:                     &Apache::lonnet::get_server_homeID($servers->{$lonhost});
                   2757:                 my $serverhomedom =
                   2758:                     &Apache::lonnet::host_domain($serverhomeID);
                   2759:                 if ($serverhomedom ne $dom) {
                   2760:                     if (ref($otherdomconfigs{$serverhomedom} eq 'HASH')) {
                   2761:                         if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}) eq 'HASH') {
                   2762:                             if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}) eq 'HASH') {
                   2763:                                 $spareid{$lonhost}{'primary'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'primary'};
                   2764:                                 $spareid{$lonhost}{'default'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'default'};
                   2765:                                 $gotspares = 1;
                   2766:                             }
                   2767:                         }
                   2768:                     } else {
                   2769:                         $otherdomconfigs{$serverhomedom} =
                   2770:                             &Apache::lonnet::get_dom('configuration',['usersessions'],$serverhomedom);
                   2771:                         if (ref($otherdomconfigs{$serverhomedom}) eq 'HASH') {
                   2772:                             if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}) eq 'HASH') {
                   2773:                                 if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}) eq 'HASH') {
                   2774:                                     if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{$lonhost}) eq 'HASH') {
                   2775:                                         $spareid{$lonhost}{'primary'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'primary'};
                   2776:                                         $spareid{$lonhost}{'default'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'default'};
                   2777:                                         $gotspares = 1;
                   2778:                                     }
                   2779:                                 }
                   2780:                             }
                   2781:                         }
                   2782:                     }
                   2783:                 }
                   2784:             }
                   2785:             unless ($gotspares) {
                   2786:                 if ($lonhost eq $Apache::lonnet::perlvar{'lonHostID'}) {
                   2787:                     $spareid{$lonhost}{'primary'} = $Apache::lonnet::spareid{'primary'};
                   2788:                     $spareid{$lonhost}{'default'} = $Apache::lonnet::spareid{'default'};
                   2789:                } else {
                   2790:                     my $server_hostname = &Apache::lonnet::hostname($lonhost);
                   2791:                     my $server_homeID = &Apache::lonnet::get_server_homeID($server_hostname);
                   2792:                     if ($server_homeID eq $Apache::lonnet::perlvar{'lonHostID'}) {
                   2793:                         $spareid{$lonhost}{'primary'} = $Apache::lonnet::spareid{'primary'};
                   2794:                         $spareid{$lonhost}{'default'} = $Apache::lonnet::spareid{'default'};
                   2795:                     } else {
1.150     raeburn  2796:                         my %what = (
                   2797:                              spareid => 1,
                   2798:                         );
                   2799:                         my ($result,$returnhash) = 
                   2800:                             &Apache::lonnet::get_remote_globals($lonhost,\%what);
                   2801:                         if ($result eq 'ok') { 
                   2802:                             if (ref($returnhash) eq 'HASH') {
                   2803:                                 if (ref($returnhash->{'spareid'}) eq 'HASH') {
                   2804:                                     $spareid{$lonhost}{'primary'} = $returnhash->{'spareid'}->{'primary'};
                   2805:                                     $spareid{$lonhost}{'default'} = $returnhash->{'spareid'}->{'default'};
                   2806:                                 }
                   2807:                             }
1.145     raeburn  2808:                         }
                   2809:                     }
                   2810:                 }
                   2811:             }
                   2812:         }
                   2813:     }
                   2814:     return %spareid;
                   2815: }
                   2816: 
                   2817: sub spares_row {
1.152     raeburn  2818:     my ($dom,$servers,$spareid,$serverhomes,$altids,$rowtotal) = @_;
1.145     raeburn  2819:     my $css_class;
                   2820:     my $numinrow = 4;
                   2821:     my $itemcount = 1;
                   2822:     my $datatable;
1.152     raeburn  2823:     my %typetitles = &sparestype_titles();
                   2824:     if ((ref($servers) eq 'HASH') && (ref($spareid) eq 'HASH') && (ref($altids) eq 'HASH')) {
1.145     raeburn  2825:         foreach my $server (sort(keys(%{$servers}))) {
1.152     raeburn  2826:             my $serverhome = &Apache::lonnet::get_server_homeID($servers->{$server});
                   2827:             my ($othercontrol,$serverdom);
                   2828:             if ($serverhome ne $server) {
                   2829:                 $serverdom = &Apache::lonnet::host_domain($serverhome);
                   2830:                 $othercontrol = &mt('Session offloading controlled by domain: [_1]','<b>'.$serverdom.'</b>');
                   2831:             } else {
                   2832:                 $serverdom = &Apache::lonnet::host_domain($server);
                   2833:                 if ($serverdom ne $dom) {
                   2834:                     $othercontrol = &mt('Session offloading controlled by domain: [_1]','<b>'.$serverdom.'</b>');
                   2835:                 }
                   2836:             }
                   2837:             next unless (ref($spareid->{$server}) eq 'HASH');
1.145     raeburn  2838:             $css_class = $itemcount%2 ? ' class="LC_odd_row"' : '';
                   2839:             $datatable .= '<tr'.$css_class.'>
                   2840:                            <td rowspan="2">
1.160.6.13  raeburn  2841:                             <span class="LC_nobreak">'.
                   2842:                           &mt('[_1] when busy, offloads to:'
                   2843:                               ,'<b>'.$server.'</b>').
                   2844:                           "\n";
1.145     raeburn  2845:             my (%current,%canselect);
1.152     raeburn  2846:             my @choices = 
                   2847:                 &possible_newspares($server,$spareid->{$server},$serverhomes,$altids);
                   2848:             foreach my $type ('primary','default') {
                   2849:                 if (ref($spareid->{$server}) eq 'HASH') {
1.145     raeburn  2850:                     if (ref($spareid->{$server}{$type}) eq 'ARRAY') {
                   2851:                         my @spares = @{$spareid->{$server}{$type}};
                   2852:                         if (@spares > 0) {
1.152     raeburn  2853:                             if ($othercontrol) {
                   2854:                                 $current{$type} = join(', ',@spares);
                   2855:                             } else {
                   2856:                                 $current{$type} .= '<table>';
                   2857:                                 my $numspares = scalar(@spares);
                   2858:                                 for (my $i=0;  $i<@spares; $i++) {
                   2859:                                     my $rem = $i%($numinrow);
                   2860:                                     if ($rem == 0) {
                   2861:                                         if ($i > 0) {
                   2862:                                             $current{$type} .= '</tr>';
                   2863:                                         }
                   2864:                                         $current{$type} .= '<tr>';
1.145     raeburn  2865:                                     }
1.152     raeburn  2866:                                     $current{$type} .= '<td><label><input type="checkbox" name="spare_'.$type.'_'.$server.'" id="spare_'.$type.'_'.$server.'_'.$i.'" checked="checked" value="'.$spareid->{$server}{$type}[$i].'" onclick="updateNewSpares(this.form,'."'$server'".');" />&nbsp;'.
                   2867:                                                        $spareid->{$server}{$type}[$i].
                   2868:                                                        '</label></td>'."\n";
                   2869:                                 }
                   2870:                                 my $rem = @spares%($numinrow);
                   2871:                                 my $colsleft = $numinrow - $rem;
                   2872:                                 if ($colsleft > 1 ) {
                   2873:                                     $current{$type} .= '<td colspan="'.$colsleft.
                   2874:                                                        '" class="LC_left_item">'.
                   2875:                                                        '&nbsp;</td>';
                   2876:                                 } elsif ($colsleft == 1) {
                   2877:                                     $current{$type} .= '<td class="LC_left_item">&nbsp;</td>'."\n";
1.145     raeburn  2878:                                 }
1.152     raeburn  2879:                                 $current{$type} .= '</tr></table>';
1.150     raeburn  2880:                             }
1.145     raeburn  2881:                         }
                   2882:                     }
                   2883:                     if ($current{$type} eq '') {
                   2884:                         $current{$type} = &mt('None specified');
                   2885:                     }
1.152     raeburn  2886:                     if ($othercontrol) {
                   2887:                         if ($type eq 'primary') {
                   2888:                             $canselect{$type} = $othercontrol;
                   2889:                         }
                   2890:                     } else {
                   2891:                         $canselect{$type} = 
                   2892:                             &mt('Add new [_1]'.$type.'[_2]:','<i>','</i>').'&nbsp;'.
                   2893:                             '<select name="newspare_'.$type.'_'.$server.'" '.
                   2894:                             'id="newspare_'.$type.'_'.$server.'" onchange="checkNewSpares('."'$server','$type'".');">'."\n".
                   2895:                             '<option value="" selected ="selected">'.&mt('Select').'</option>'."\n";
                   2896:                         if (@choices > 0) {
                   2897:                             foreach my $lonhost (@choices) {
                   2898:                                 $canselect{$type} .= '<option value="'.$lonhost.'">'.$lonhost.'</option>'."\n";
                   2899:                             }
                   2900:                         }
                   2901:                         $canselect{$type} .= '</select>'."\n";
                   2902:                     }
                   2903:                 } else {
                   2904:                     $current{$type} = &mt('Could not be determined');
                   2905:                     if ($type eq 'primary') {
                   2906:                         $canselect{$type} =  $othercontrol;
                   2907:                     }
1.145     raeburn  2908:                 }
1.152     raeburn  2909:                 if ($type eq 'default') {
                   2910:                     $datatable .= '<tr'.$css_class.'>';
                   2911:                 }
                   2912:                 $datatable .= '<td><i>'.$typetitles{$type}.'</i></td>'."\n".
                   2913:                               '<td>'.$current{$type}.'</td>'."\n".
                   2914:                               '<td>'.$canselect{$type}.'</td></tr>'."\n";
1.145     raeburn  2915:             }
                   2916:             $itemcount ++;
                   2917:         }
                   2918:     }
                   2919:     $$rowtotal += $itemcount;
                   2920:     return $datatable;
                   2921: }
                   2922: 
1.152     raeburn  2923: sub possible_newspares {
                   2924:     my ($server,$currspares,$serverhomes,$altids) = @_;
                   2925:     my $serverhostname = &Apache::lonnet::hostname($server);
                   2926:     my %excluded;
                   2927:     if ($serverhostname ne '') {
                   2928:         %excluded = (
                   2929:                        $serverhostname => 1,
                   2930:                     );
                   2931:     }
                   2932:     if (ref($currspares) eq 'HASH') {
                   2933:         foreach my $type (keys(%{$currspares})) {
                   2934:             if (ref($currspares->{$type}) eq 'ARRAY') {
                   2935:                 if (@{$currspares->{$type}} > 0) {
                   2936:                     foreach my $curr (@{$currspares->{$type}}) {
                   2937:                         my $hostname = &Apache::lonnet::hostname($curr);
                   2938:                         $excluded{$hostname} = 1;
                   2939:                     }
                   2940:                 }
                   2941:             }
                   2942:         }
                   2943:     }
                   2944:     my @choices;
                   2945:     if ((ref($serverhomes) eq 'HASH') && (ref($altids) eq 'HASH')) {
                   2946:         if (keys(%{$serverhomes}) > 1) {
                   2947:             foreach my $name (sort(keys(%{$serverhomes}))) {
                   2948:                 unless ($excluded{$name}) {
                   2949:                     if (exists($altids->{$serverhomes->{$name}})) {
                   2950:                         push(@choices,$altids->{$serverhomes->{$name}});
                   2951:                     } else {
                   2952:                         push(@choices,$serverhomes->{$name});
1.145     raeburn  2953:                     }
                   2954:                 }
                   2955:             }
                   2956:         }
                   2957:     }
1.152     raeburn  2958:     return sort(@choices);
1.145     raeburn  2959: }
                   2960: 
1.150     raeburn  2961: sub print_loadbalancing {
                   2962:     my ($dom,$settings,$rowtotal) = @_;
                   2963:     my $primary_id = &Apache::lonnet::domain($dom,'primary');
                   2964:     my $intdom = &Apache::lonnet::internet_dom($primary_id);
                   2965:     my $numinrow = 1;
                   2966:     my $datatable;
                   2967:     my %servers = &Apache::lonnet::internet_dom_servers($dom);
1.160.6.7  raeburn  2968:     my (%currbalancer,%currtargets,%currrules,%existing);
                   2969:     if (ref($settings) eq 'HASH') {
                   2970:         %existing = %{$settings};
                   2971:     }
                   2972:     if ((keys(%servers) > 1) || (keys(%existing) > 0)) {
                   2973:         &get_loadbalancers_config(\%servers,\%existing,\%currbalancer,
                   2974:                                   \%currtargets,\%currrules);
1.150     raeburn  2975:     } else {
                   2976:         return;
                   2977:     }
                   2978:     my ($othertitle,$usertypes,$types) =
                   2979:         &Apache::loncommon::sorted_inst_types($dom);
1.160.6.26! raeburn  2980:     my $rownum = 8;
1.150     raeburn  2981:     if (ref($types) eq 'ARRAY') {
                   2982:         $rownum += scalar(@{$types});
                   2983:     }
1.160.6.7  raeburn  2984:     my @css_class = ('LC_odd_row','LC_even_row');
                   2985:     my $balnum = 0;
                   2986:     my $islast;
                   2987:     my (@toshow,$disabledtext);
                   2988:     if (keys(%currbalancer) > 0) {
                   2989:         @toshow = sort(keys(%currbalancer));
                   2990:         if (scalar(@toshow) < scalar(keys(%servers)) + 1) {
                   2991:             push(@toshow,'');
                   2992:         }
                   2993:     } else {
                   2994:         @toshow = ('');
                   2995:         $disabledtext = &mt('No existing load balancer');
                   2996:     }
                   2997:     foreach my $lonhost (@toshow) {
                   2998:         if ($balnum == scalar(@toshow)-1) {
                   2999:             $islast = 1;
                   3000:         } else {
                   3001:             $islast = 0;
                   3002:         }
                   3003:         my $cssidx = $balnum%2;
                   3004:         my $targets_div_style = 'display: none';
                   3005:         my $disabled_div_style = 'display: block';
                   3006:         my $homedom_div_style = 'display: none';
                   3007:         $datatable .= '<tr class="'.$css_class[$cssidx].'">'.
                   3008:                       '<td rowspan="'.$rownum.'" valign="top">'.
                   3009:                       '<p>';
                   3010:         if ($lonhost eq '') {
                   3011:             $datatable .= '<span class="LC_nobreak">';
                   3012:             if (keys(%currbalancer) > 0) {
                   3013:                 $datatable .= &mt('Add balancer:');
                   3014:             } else {
                   3015:                 $datatable .= &mt('Enable balancer:');
                   3016:             }
                   3017:             $datatable .= '&nbsp;'.
                   3018:                           '<select name="loadbalancing_lonhost_'.$balnum.'"'.
                   3019:                           ' id="loadbalancing_lonhost_'.$balnum.'"'.
                   3020:                           ' onchange="toggleTargets('."'$balnum'".');">'."\n".
                   3021:                           '<option value="" selected="selected">'.&mt('None').
                   3022:                           '</option>'."\n";
                   3023:             foreach my $server (sort(keys(%servers))) {
                   3024:                 next if ($currbalancer{$server});
                   3025:                 $datatable .= '<option value="'.$server.'">'.$server.'</option>'."\n";
                   3026:             }
                   3027:             $datatable .=
                   3028:                 '</select>'."\n".
                   3029:                 '<input type="hidden" name="loadbalancing_prevlonhost_'.$balnum.'" id="loadbalancing_prevlonhost_'.$balnum.'" value="" />&nbsp;</span>'."\n";
                   3030:         } else {
                   3031:             $datatable .= '<i>'.$lonhost.'</i><br /><span class="LC_nobreak">'.
                   3032:                           '<label><input type="checkbox" name="loadbalancing_delete" value="'.$balnum.'" id="loadbalancing_delete_'.$balnum.'" onclick="javascript:balancerDeleteChange('."'$balnum'".');" />&nbsp;'.
                   3033:                            &mt('Stop balancing').'</label>'.
                   3034:                            '<input type="hidden" name="loadbalancing_lonhost_'.$balnum.'" value="'.$lonhost.'" id="loadbalancing_lonhost_'.$balnum.'" /></span>';
                   3035:             $targets_div_style = 'display: block';
                   3036:             $disabled_div_style = 'display: none';
                   3037:             if ($dom eq &Apache::lonnet::host_domain($lonhost)) {
                   3038:                 $homedom_div_style = 'display: block';
                   3039:             }
                   3040:         }
                   3041:         $datatable .= '</p></td><td rowspan="'.$rownum.'" valign="top">'.
                   3042:                   '<div id="loadbalancing_disabled_'.$balnum.'" style="'.
                   3043:                   $disabled_div_style.'">'.$disabledtext.'</div>'."\n".
                   3044:                   '<div id="loadbalancing_targets_'.$balnum.'" style="'.$targets_div_style.'">'.&mt('Offloads to:').'<br />';
                   3045:         my ($numspares,@spares) = &count_servers($lonhost,%servers);
                   3046:         my @sparestypes = ('primary','default');
                   3047:         my %typetitles = &sparestype_titles();
                   3048:         foreach my $sparetype (@sparestypes) {
                   3049:             my $targettable;
                   3050:             for (my $i=0; $i<$numspares; $i++) {
                   3051:                 my $checked;
                   3052:                 if (ref($currtargets{$lonhost}) eq 'HASH') {
                   3053:                     if (ref($currtargets{$lonhost}{$sparetype}) eq 'ARRAY') {
                   3054:                         if (grep(/^\Q$spares[$i]\E$/,@{$currtargets{$lonhost}{$sparetype}})) {
                   3055:                             $checked = ' checked="checked"';
                   3056:                         }
                   3057:                     }
                   3058:                 }
                   3059:                 my ($chkboxval,$disabled);
                   3060:                 if (($lonhost ne '') && (exists($servers{$lonhost}))) {
                   3061:                     $chkboxval = $spares[$i];
                   3062:                 }
                   3063:                 if (exists($currbalancer{$spares[$i]})) {
                   3064:                     $disabled = ' disabled="disabled"';
                   3065:                 }
                   3066:                 $targettable .=
                   3067:                     '<td><label><input type="checkbox" name="loadbalancing_target_'.$balnum.'_'.$sparetype.'"'.
                   3068:                     $checked.$disabled.' value="'.$chkboxval.'" id="loadbalancing_target_'.$balnum.'_'.$sparetype.'_'.$i.'" onclick="checkOffloads('."this,'$balnum','$sparetype'".');" /><span id="loadbalancing_targettxt_'.$balnum.'_'.$sparetype.'_'.$i.'">&nbsp;'.$chkboxval.
                   3069:                     '</span></label></td>';
                   3070:                 my $rem = $i%($numinrow);
                   3071:                 if ($rem == 0) {
                   3072:                     if (($i > 0) && ($i < $numspares-1)) {
                   3073:                         $targettable .= '</tr>';
                   3074:                     }
                   3075:                     if ($i < $numspares-1) {
                   3076:                         $targettable .= '<tr>';
1.150     raeburn  3077:                     }
                   3078:                 }
                   3079:             }
1.160.6.7  raeburn  3080:             if ($targettable ne '') {
                   3081:                 my $rem = $numspares%($numinrow);
                   3082:                 my $colsleft = $numinrow - $rem;
                   3083:                 if ($colsleft > 1 ) {
                   3084:                     $targettable .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
                   3085:                                     '&nbsp;</td>';
                   3086:                 } elsif ($colsleft == 1) {
                   3087:                     $targettable .= '<td class="LC_left_item">&nbsp;</td>';
                   3088:                 }
                   3089:                 $datatable .=  '<i>'.$typetitles{$sparetype}.'</i><br />'.
                   3090:                                '<table><tr>'.$targettable.'</tr></table><br />';
                   3091:             }
                   3092:         }
                   3093:         $datatable .= '</div></td></tr>'.
                   3094:                       &loadbalancing_rules($dom,$intdom,$currrules{$lonhost},
                   3095:                                            $othertitle,$usertypes,$types,\%servers,
                   3096:                                            \%currbalancer,$lonhost,
                   3097:                                            $targets_div_style,$homedom_div_style,
                   3098:                                            $css_class[$cssidx],$balnum,$islast);
                   3099:         $$rowtotal += $rownum;
                   3100:         $balnum ++;
                   3101:     }
                   3102:     $datatable .= '<input type="hidden" name="loadbalancing_total" id="loadbalancing_total" value="'.$balnum.'" />';
                   3103:     return $datatable;
                   3104: }
                   3105: 
                   3106: sub get_loadbalancers_config {
                   3107:     my ($servers,$existing,$currbalancer,$currtargets,$currrules) = @_;
                   3108:     return unless ((ref($servers) eq 'HASH') &&
                   3109:                    (ref($existing) eq 'HASH') && (ref($currbalancer) eq 'HASH') &&
                   3110:                    (ref($currtargets) eq 'HASH') && (ref($currrules) eq 'HASH'));
                   3111:     if (keys(%{$existing}) > 0) {
                   3112:         my $oldlonhost;
                   3113:         foreach my $key (sort(keys(%{$existing}))) {
                   3114:             if ($key eq 'lonhost') {
                   3115:                 $oldlonhost = $existing->{'lonhost'};
                   3116:                 $currbalancer->{$oldlonhost} = 1;
                   3117:             } elsif ($key eq 'targets') {
                   3118:                 if ($oldlonhost) {
                   3119:                     $currtargets->{$oldlonhost} = $existing->{'targets'};
                   3120:                 }
                   3121:             } elsif ($key eq 'rules') {
                   3122:                 if ($oldlonhost) {
                   3123:                     $currrules->{$oldlonhost} = $existing->{'rules'};
                   3124:                 }
                   3125:             } elsif (ref($existing->{$key}) eq 'HASH') {
                   3126:                 $currbalancer->{$key} = 1;
                   3127:                 $currtargets->{$key} = $existing->{$key}{'targets'};
                   3128:                 $currrules->{$key} = $existing->{$key}{'rules'};
1.150     raeburn  3129:             }
                   3130:         }
1.160.6.7  raeburn  3131:     } else {
                   3132:         my ($balancerref,$targetsref) =
                   3133:                 &Apache::lonnet::get_lonbalancer_config($servers);
                   3134:         if ((ref($balancerref) eq 'HASH') && (ref($targetsref) eq 'HASH')) {
                   3135:             foreach my $server (sort(keys(%{$balancerref}))) {
                   3136:                 $currbalancer->{$server} = 1;
                   3137:                 $currtargets->{$server} = $targetsref->{$server};
1.150     raeburn  3138:             }
                   3139:         }
                   3140:     }
1.160.6.7  raeburn  3141:     return;
1.150     raeburn  3142: }
                   3143: 
                   3144: sub loadbalancing_rules {
                   3145:     my ($dom,$intdom,$currrules,$othertitle,$usertypes,$types,$servers,
1.160.6.7  raeburn  3146:         $currbalancer,$lonhost,$targets_div_style,$homedom_div_style,
                   3147:         $css_class,$balnum,$islast) = @_;
1.150     raeburn  3148:     my $output;
1.160.6.7  raeburn  3149:     my $num = 0;
                   3150:     my ($alltypes,$othertypes,$titles) =
1.150     raeburn  3151:         &loadbalancing_titles($dom,$intdom,$usertypes,$types);
                   3152:     if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH'))  {
                   3153:         foreach my $type (@{$alltypes}) {
1.160.6.7  raeburn  3154:             $num ++;
1.150     raeburn  3155:             my $current;
                   3156:             if (ref($currrules) eq 'HASH') {
                   3157:                 $current = $currrules->{$type};
                   3158:             }
1.160.6.26! raeburn  3159:             if (($type eq '_LC_external') || ($type eq '_LC_internetdom') || ($type eq '_LC_ipchange')) {
1.160.6.7  raeburn  3160:                 if ($dom ne &Apache::lonnet::host_domain($lonhost)) {
1.150     raeburn  3161:                     $current = '';
                   3162:                 }
                   3163:             }
                   3164:             $output .= &loadbalance_rule_row($type,$titles->{$type},$current,
1.160.6.7  raeburn  3165:                                              $servers,$currbalancer,$lonhost,$dom,
                   3166:                                              $targets_div_style,$homedom_div_style,
                   3167:                                              $css_class,$balnum,$num,$islast);
1.150     raeburn  3168:         }
                   3169:     }
                   3170:     return $output;
                   3171: }
                   3172: 
                   3173: sub loadbalancing_titles {
                   3174:     my ($dom,$intdom,$usertypes,$types) = @_;
                   3175:     my %othertypes = (
                   3176:            '_LC_adv'         => &mt('Advanced users from [_1]',$dom),
                   3177:            '_LC_author'      => &mt('Users from [_1] with author role',$dom),
                   3178:            '_LC_internetdom' => &mt('Users not from [_1], but from [_2]',$dom,$intdom),
                   3179:            '_LC_external'    => &mt('Users not from [_1]',$intdom),
1.160.6.26! raeburn  3180:            '_LC_ipchangesso' => &mt('SSO users from [_1], with IP mismatch',$dom),
        !          3181:            '_LC_ipchange'    => &mt('Non-SSO users with IP mismatch'),
1.150     raeburn  3182:                      );
1.160.6.26! raeburn  3183:     my @alltypes = ('_LC_adv','_LC_author','_LC_internetdom','_LC_external','_LC_ipchangesso','_LC_ipchange');
1.150     raeburn  3184:     if (ref($types) eq 'ARRAY') {
                   3185:         unshift(@alltypes,@{$types},'default');
                   3186:     }
                   3187:     my %titles;
                   3188:     foreach my $type (@alltypes) {
                   3189:         if ($type =~ /^_LC_/) {
                   3190:             $titles{$type} = $othertypes{$type};
                   3191:         } elsif ($type eq 'default') {
                   3192:             $titles{$type} = &mt('All users from [_1]',$dom);
                   3193:             if (ref($types) eq 'ARRAY') {
                   3194:                 if (@{$types} > 0) {
                   3195:                     $titles{$type} = &mt('Other users from [_1]',$dom);
                   3196:                 }
                   3197:             }
                   3198:         } elsif (ref($usertypes) eq 'HASH') {
                   3199:             $titles{$type} = $usertypes->{$type};
                   3200:         }
                   3201:     }
                   3202:     return (\@alltypes,\%othertypes,\%titles);
                   3203: }
                   3204: 
                   3205: sub loadbalance_rule_row {
1.160.6.7  raeburn  3206:     my ($type,$title,$current,$servers,$currbalancer,$lonhost,$dom,
                   3207:         $targets_div_style,$homedom_div_style,$css_class,$balnum,$num,$islast) = @_;
1.160.6.26! raeburn  3208:     my @rulenames;
1.150     raeburn  3209:     my %ruletitles = &offloadtype_text();
1.160.6.26! raeburn  3210:     if (($type eq '_LC_ipchangesso') || ($type eq '_LC_ipchange')) {
        !          3211:         @rulenames = ('balancer','offloadedto');
1.150     raeburn  3212:     } else {
1.160.6.26! raeburn  3213:         @rulenames = ('default','homeserver');
        !          3214:         if ($type eq '_LC_external') {
        !          3215:             push(@rulenames,'externalbalancer');
        !          3216:         } else {
        !          3217:             push(@rulenames,'specific');
        !          3218:         }
        !          3219:         push(@rulenames,'none');
1.150     raeburn  3220:     }
                   3221:     my $style = $targets_div_style;
1.160.6.26! raeburn  3222:     if (($type eq '_LC_external') || ($type eq '_LC_internetdom') || ($type eq '_LC_ipchange')) {
1.150     raeburn  3223:         $style = $homedom_div_style;
                   3224:     }
1.160.6.7  raeburn  3225:     my $space;
                   3226:     if ($islast && $num == 1) {
                   3227:         $space = '<div display="inline-block">&nbsp;</div>';
                   3228:     }
                   3229:     my $output =
                   3230:         '<tr class="'.$css_class.'" id="balanceruletr_'.$balnum.'_'.$num.'"><td valign="top">'.$space.
                   3231:         '<div id="balanceruletitle_'.$balnum.'_'.$type.'" style="'.$style.'">'.$title.'</div></td>'."\n".
                   3232:         '<td valaign="top">'.$space.
                   3233:         '<div id="balancerule_'.$balnum.'_'.$type.'" style="'.$style.'">'."\n";
1.150     raeburn  3234:     for (my $i=0; $i<@rulenames; $i++) {
                   3235:         my $rule = $rulenames[$i];
                   3236:         my ($checked,$extra);
                   3237:         if ($rulenames[$i] eq 'default') {
                   3238:             $rule = '';
                   3239:         }
                   3240:         if ($rulenames[$i] eq 'specific') {
                   3241:             if (ref($servers) eq 'HASH') {
                   3242:                 my $default;
                   3243:                 if (($current ne '') && (exists($servers->{$current}))) {
                   3244:                     $checked = ' checked="checked"';
                   3245:                 }
                   3246:                 unless ($checked) {
                   3247:                     $default = ' selected="selected"';
                   3248:                 }
1.160.6.7  raeburn  3249:                 $extra =
                   3250:                     ':&nbsp;<select name="loadbalancing_singleserver_'.$balnum.'_'.$type.
                   3251:                     '" id="loadbalancing_singleserver_'.$balnum.'_'.$type.
                   3252:                     '" onchange="singleServerToggle('."'$balnum','$type'".')">'."\n".
                   3253:                     '<option value=""'.$default.'></option>'."\n";
                   3254:                 foreach my $server (sort(keys(%{$servers}))) {
                   3255:                     if (ref($currbalancer) eq 'HASH') {
                   3256:                         next if (exists($currbalancer->{$server}));
                   3257:                     }
1.150     raeburn  3258:                     my $selected;
1.160.6.7  raeburn  3259:                     if ($server eq $current) {
1.150     raeburn  3260:                         $selected = ' selected="selected"';
                   3261:                     }
1.160.6.7  raeburn  3262:                     $extra .= '<option value="'.$server.'"'.$selected.'>'.$server.'</option>';
1.150     raeburn  3263:                 }
                   3264:                 $extra .= '</select>';
                   3265:             }
                   3266:         } elsif ($rule eq $current) {
                   3267:             $checked = ' checked="checked"';
                   3268:         }
                   3269:         $output .= '<span class="LC_nobreak"><label>'.
1.160.6.7  raeburn  3270:                    '<input type="radio" name="loadbalancing_rules_'.$balnum.'_'.$type.
                   3271:                    '" id="loadbalancing_rules_'.$balnum.'_'.$type.'_'.$i.'" value="'.
                   3272:                    $rule.'" onclick="balanceruleChange('."this.form,'$balnum','$type'".
1.150     raeburn  3273:                    ')"'.$checked.' />&nbsp;'.$ruletitles{$rulenames[$i]}.
                   3274:                    '</label>'.$extra.'</span><br />'."\n";
                   3275:     }
                   3276:     $output .= '</div></td></tr>'."\n";
                   3277:     return $output;
                   3278: }
                   3279: 
                   3280: sub offloadtype_text {
                   3281:     my %ruletitles = &Apache::lonlocal::texthash (
                   3282:            'default'          => 'Offloads to default destinations',
                   3283:            'homeserver'       => "Offloads to user's home server",
                   3284:            'externalbalancer' => "Offloads to Load Balancer in user's domain",
                   3285:            'specific'         => 'Offloads to specific server',
1.160.6.3  raeburn  3286:            'none'             => 'No offload',
1.160.6.26! raeburn  3287:            'balancer'         => 'Session hosted on Load Balancer, after re-authentication',
        !          3288:            'offloadedto'      => 'Session hosted on offload server, after re-authentication',
1.150     raeburn  3289:     );
                   3290:     return %ruletitles;
                   3291: }
                   3292: 
                   3293: sub sparestype_titles {
                   3294:     my %typestitles = &Apache::lonlocal::texthash (
                   3295:                           'primary' => 'primary',
                   3296:                           'default' => 'default',
                   3297:                       );
                   3298:     return %typestitles;
                   3299: }
                   3300: 
1.28      raeburn  3301: sub contact_titles {
                   3302:     my %titles = &Apache::lonlocal::texthash (
                   3303:                    'supportemail' => 'Support E-mail address',
1.69      raeburn  3304:                    'adminemail'   => 'Default Server Admin E-mail address',
1.28      raeburn  3305:                    'errormail'    => 'Error reports to be e-mailed to',
                   3306:                    'packagesmail' => 'Package update alerts to be e-mailed to',
1.89      raeburn  3307:                    'helpdeskmail' => 'Helpdesk requests to be e-mailed to',
                   3308:                    'lonstatusmail' => 'E-mail from nightly status check (warnings/errors)',
1.102     raeburn  3309:                    'requestsmail' => 'E-mail from course requests requiring approval',
1.160.6.15  raeburn  3310:                    'updatesmail'  => 'E-mail from nightly check of LON-CAPA module integrity/updates',
1.160.6.23  raeburn  3311:                    'idconflictsmail' => 'E-mail from bi-nightly check for multiple users sharing same student/employee ID',
1.28      raeburn  3312:                  );
                   3313:     my %short_titles = &Apache::lonlocal::texthash (
                   3314:                            adminemail   => 'Admin E-mail address',
                   3315:                            supportemail => 'Support E-mail',
                   3316:                        );   
                   3317:     return (\%titles,\%short_titles);
                   3318: }
                   3319: 
1.72      raeburn  3320: sub tool_titles {
                   3321:     my %titles = &Apache::lonlocal::texthash (
1.160.6.4  raeburn  3322:                      aboutme    => 'Personal web page',
1.86      raeburn  3323:                      blog       => 'Blog',
1.160.6.4  raeburn  3324:                      webdav     => 'WebDAV',
1.86      raeburn  3325:                      portfolio  => 'Portfolio',
1.88      bisitz   3326:                      official   => 'Official courses (with institutional codes)',
                   3327:                      unofficial => 'Unofficial courses',
1.98      raeburn  3328:                      community  => 'Communities',
1.86      raeburn  3329:                  );
1.72      raeburn  3330:     return %titles;
                   3331: }
                   3332: 
1.101     raeburn  3333: sub courserequest_titles {
                   3334:     my %titles = &Apache::lonlocal::texthash (
                   3335:                                    official   => 'Official',
                   3336:                                    unofficial => 'Unofficial',
                   3337:                                    community  => 'Communities',
                   3338:                                    norequest  => 'Not allowed',
1.104     raeburn  3339:                                    approval   => 'Approval by Dom. Coord.',
1.101     raeburn  3340:                                    validate   => 'With validation',
                   3341:                                    autolimit  => 'Numerical limit',
1.103     raeburn  3342:                                    unlimited  => '(blank for unlimited)',
1.101     raeburn  3343:                  );
                   3344:     return %titles;
                   3345: }
                   3346: 
1.160.6.5  raeburn  3347: sub authorrequest_titles {
                   3348:     my %titles = &Apache::lonlocal::texthash (
                   3349:                                    norequest  => 'Not allowed',
                   3350:                                    approval   => 'Approval by Dom. Coord.',
                   3351:                                    automatic  => 'Automatic approval',
                   3352:                  );
                   3353:     return %titles;
                   3354: }
                   3355: 
1.101     raeburn  3356: sub courserequest_conditions {
                   3357:     my %conditions = &Apache::lonlocal::texthash (
1.104     raeburn  3358:        approval    => '(Processing of request subject to approval by Domain Coordinator).',
1.160.6.17  raeburn  3359:        validate   => '(Processing of request subject to institutional validation).',
1.101     raeburn  3360:                  );
                   3361:     return %conditions;
                   3362: }
                   3363: 
                   3364: 
1.27      raeburn  3365: sub print_usercreation {
1.30      raeburn  3366:     my ($position,$dom,$settings,$rowtotal) = @_;
1.27      raeburn  3367:     my $numinrow = 4;
1.28      raeburn  3368:     my $datatable;
                   3369:     if ($position eq 'top') {
1.30      raeburn  3370:         $$rowtotal ++;
1.34      raeburn  3371:         my $rowcount = 0;
1.32      raeburn  3372:         my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom,'username');
1.28      raeburn  3373:         if (ref($rules) eq 'HASH') {
                   3374:             if (keys(%{$rules}) > 0) {
1.32      raeburn  3375:                 $datatable .= &user_formats_row('username',$settings,$rules,
                   3376:                                                 $ruleorder,$numinrow,$rowcount);
1.30      raeburn  3377:                 $$rowtotal ++;
1.32      raeburn  3378:                 $rowcount ++;
                   3379:             }
                   3380:         }
                   3381:         my ($idrules,$idruleorder) = &Apache::lonnet::inst_userrules($dom,'id');
                   3382:         if (ref($idrules) eq 'HASH') {
                   3383:             if (keys(%{$idrules}) > 0) {
                   3384:                 $datatable .= &user_formats_row('id',$settings,$idrules,
                   3385:                                                 $idruleorder,$numinrow,$rowcount);
                   3386:                 $$rowtotal ++;
                   3387:                 $rowcount ++;
1.28      raeburn  3388:             }
                   3389:         }
1.43      raeburn  3390:         my ($emailrules,$emailruleorder) = 
                   3391:             &Apache::lonnet::inst_userrules($dom,'email');
                   3392:         if (ref($emailrules) eq 'HASH') {
                   3393:             if (keys(%{$emailrules}) > 0) {
                   3394:                 $datatable .= &user_formats_row('email',$settings,$emailrules,
                   3395:                                                 $emailruleorder,$numinrow,$rowcount);
                   3396:                 $$rowtotal ++;
                   3397:                 $rowcount ++;
                   3398:             }
                   3399:         }
1.39      raeburn  3400:         if ($rowcount == 0) {
                   3401:             $datatable .= '<tr><td colspan="2">'.&mt('No format rules have been defined for usernames or IDs in this domain.').'</td></tr>';  
                   3402:             $$rowtotal ++;
                   3403:             $rowcount ++;
                   3404:         }
1.34      raeburn  3405:     } elsif ($position eq 'middle') {
1.100     raeburn  3406:         my @creators = ('author','course','requestcrs','selfcreate');
1.37      raeburn  3407:         my ($rules,$ruleorder) =
                   3408:             &Apache::lonnet::inst_userrules($dom,'username');
1.34      raeburn  3409:         my %lt = &usercreation_types();
                   3410:         my %checked;
1.50      raeburn  3411:         my @selfcreate; 
1.34      raeburn  3412:         if (ref($settings) eq 'HASH') {
                   3413:             if (ref($settings->{'cancreate'}) eq 'HASH') {
                   3414:                 foreach my $item (@creators) {
                   3415:                     $checked{$item} = $settings->{'cancreate'}{$item};
                   3416:                 }
1.50      raeburn  3417:                 if (ref($settings->{'cancreate'}{'selfcreate'}) eq 'ARRAY') {
                   3418:                     @selfcreate = @{$settings->{'cancreate'}{'selfcreate'}};
                   3419:                 } elsif ($settings->{'cancreate'}{'selfcreate'} ne '') {
                   3420:                     if ($settings->{'cancreate'}{'selfcreate'} eq 'any') {
                   3421:                         @selfcreate = ('email','login','sso');
                   3422:                     } elsif ($settings->{'cancreate'}{'selfcreate'} ne 'none') {
                   3423:                         @selfcreate = ($settings->{'cancreate'}{'selfcreate'});
                   3424:                     }
                   3425:                 }
1.34      raeburn  3426:             } elsif (ref($settings->{'cancreate'}) eq 'ARRAY') {
                   3427:                 foreach my $item (@creators) {
                   3428:                     if (grep(/^\Q$item\E$/,@{$settings->{'cancreate'}})) {
                   3429:                         $checked{$item} = 'none';
                   3430:                     }
                   3431:                 }
                   3432:             }
                   3433:         }
                   3434:         my $rownum = 0;
                   3435:         foreach my $item (@creators) {
                   3436:             $rownum ++;
1.50      raeburn  3437:             if ($item ne 'selfcreate') {  
                   3438:                 if ($checked{$item} eq '') {
1.43      raeburn  3439:                     $checked{$item} = 'any';
                   3440:                 }
1.34      raeburn  3441:             }
                   3442:             my $css_class;
                   3443:             if ($rownum%2) {
                   3444:                 $css_class = '';
                   3445:             } else {
                   3446:                 $css_class = ' class="LC_odd_row" ';
                   3447:             }
                   3448:             $datatable .= '<tr'.$css_class.'>'.
                   3449:                          '<td><span class="LC_nobreak">'.$lt{$item}.
                   3450:                          '</span></td><td align="right">';
1.50      raeburn  3451:             my @options;
1.45      raeburn  3452:             if ($item eq 'selfcreate') {
1.43      raeburn  3453:                 push(@options,('email','login','sso'));
                   3454:             } else {
1.50      raeburn  3455:                 @options = ('any');
1.43      raeburn  3456:                 if (ref($rules) eq 'HASH') {
                   3457:                     if (keys(%{$rules}) > 0) {
                   3458:                         push(@options,('official','unofficial'));
                   3459:                     }
1.37      raeburn  3460:                 }
1.50      raeburn  3461:                 push(@options,'none');
1.37      raeburn  3462:             }
                   3463:             foreach my $option (@options) {
1.50      raeburn  3464:                 my $type = 'radio';
1.34      raeburn  3465:                 my $check = ' ';
1.50      raeburn  3466:                 if ($item eq 'selfcreate') {
                   3467:                     $type = 'checkbox';
                   3468:                     if (grep(/^\Q$option\E$/,@selfcreate)) {
                   3469:                         $check = ' checked="checked" ';
                   3470:                     }
                   3471:                 } else {
                   3472:                     if ($checked{$item} eq $option) {
                   3473:                         $check = ' checked="checked" ';
                   3474:                     }
1.34      raeburn  3475:                 } 
                   3476:                 $datatable .= '<span class="LC_nobreak"><label>'.
1.50      raeburn  3477:                               '<input type="'.$type.'" name="can_createuser_'.
1.34      raeburn  3478:                               $item.'" value="'.$option.'"'.$check.'/>&nbsp;'.
                   3479:                               $lt{$option}.'</label>&nbsp;&nbsp;</span>';
                   3480:             }
                   3481:             $datatable .= '</td></tr>';
                   3482:         }
1.93      raeburn  3483:         my ($othertitle,$usertypes,$types) =
                   3484:             &Apache::loncommon::sorted_inst_types($dom);
1.160.6.5  raeburn  3485:         my $createsettings;
                   3486:         if (ref($settings) eq 'HASH') {
                   3487:             $createsettings = $settings->{cancreate};
                   3488:         }
1.93      raeburn  3489:         if (ref($usertypes) eq 'HASH') {
                   3490:             if (keys(%{$usertypes}) > 0) {
1.99      raeburn  3491:                 $datatable .= &insttypes_row($createsettings,$types,$usertypes,
1.93      raeburn  3492:                                              $dom,$numinrow,$othertitle,
                   3493:                                              'statustocreate');
                   3494:                 $$rowtotal ++;
1.160.6.5  raeburn  3495:                 $rownum ++;
1.93      raeburn  3496:             }
                   3497:         }
1.160.6.5  raeburn  3498:         $datatable .= &captcha_choice('cancreate',$createsettings,$rownum);
1.28      raeburn  3499:     } else {
                   3500:         my @contexts = ('author','course','domain');
                   3501:         my @authtypes = ('int','krb4','krb5','loc');
                   3502:         my %checked;
                   3503:         if (ref($settings) eq 'HASH') {
                   3504:             if (ref($settings->{'authtypes'}) eq 'HASH') {
                   3505:                 foreach my $item (@contexts) {
                   3506:                     if (ref($settings->{'authtypes'}{$item}) eq 'HASH') {
                   3507:                         foreach my $auth (@authtypes) {
                   3508:                             if ($settings->{'authtypes'}{$item}{$auth}) {
                   3509:                                 $checked{$item}{$auth} = ' checked="checked" ';
                   3510:                             }
                   3511:                         }
                   3512:                     }
                   3513:                 }
1.27      raeburn  3514:             }
1.35      raeburn  3515:         } else {
                   3516:             foreach my $item (@contexts) {
1.36      raeburn  3517:                 foreach my $auth (@authtypes) {
1.35      raeburn  3518:                     $checked{$item}{$auth} = ' checked="checked" ';
                   3519:                 }
                   3520:             }
1.27      raeburn  3521:         }
1.28      raeburn  3522:         my %title = &context_names();
                   3523:         my %authname = &authtype_names();
                   3524:         my $rownum = 0;
                   3525:         my $css_class; 
                   3526:         foreach my $item (@contexts) {
                   3527:             if ($rownum%2) {
                   3528:                 $css_class = '';
                   3529:             } else {
                   3530:                 $css_class = ' class="LC_odd_row" ';
                   3531:             }
1.30      raeburn  3532:             $datatable .=   '<tr'.$css_class.'>'.
1.28      raeburn  3533:                             '<td>'.$title{$item}.
                   3534:                             '</td><td class="LC_left_item">'.
                   3535:                             '<span class="LC_nobreak">';
                   3536:             foreach my $auth (@authtypes) {
                   3537:                 $datatable .= '<label>'. 
                   3538:                               '<input type="checkbox" name="'.$item.'_auth" '.
                   3539:                               $checked{$item}{$auth}.' value="'.$auth.'" />'.
                   3540:                               $authname{$auth}.'</label>&nbsp;';
                   3541:             }
                   3542:             $datatable .= '</span></td></tr>';
                   3543:             $rownum ++;
1.27      raeburn  3544:         }
1.30      raeburn  3545:         $$rowtotal += $rownum;
1.27      raeburn  3546:     }
                   3547:     return $datatable;
                   3548: }
                   3549: 
1.160.6.5  raeburn  3550: sub captcha_choice {
                   3551:     my ($context,$settings,$itemcount) = @_;
                   3552:     my ($keyentry,$currpub,$currpriv,%checked,$rowname,$pubtext,$privtext);
                   3553:     my %lt = &captcha_phrases();
                   3554:     $keyentry = 'hidden';
                   3555:     if ($context eq 'cancreate') {
                   3556:         $rowname = &mt('CAPTCHA validation (e-mail as username)');
                   3557:     } elsif ($context eq 'login') {
                   3558:         $rowname =  &mt('"Contact helpdesk" CAPTCHA validation');
                   3559:     }
                   3560:     if (ref($settings) eq 'HASH') {
                   3561:         if ($settings->{'captcha'}) {
                   3562:             $checked{$settings->{'captcha'}} = ' checked="checked"';
                   3563:         } else {
                   3564:             $checked{'original'} = ' checked="checked"';
                   3565:         }
                   3566:         if ($settings->{'captcha'} eq 'recaptcha') {
                   3567:             $pubtext = $lt{'pub'};
                   3568:             $privtext = $lt{'priv'};
                   3569:             $keyentry = 'text';
                   3570:         }
                   3571:         if (ref($settings->{'recaptchakeys'}) eq 'HASH') {
                   3572:             $currpub = $settings->{'recaptchakeys'}{'public'};
                   3573:             $currpriv = $settings->{'recaptchakeys'}{'private'};
                   3574:         }
                   3575:     } else {
                   3576:         $checked{'original'} = ' checked="checked"';
                   3577:     }
                   3578:     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   3579:     my $output = '<tr'.$css_class.'>'.
                   3580:                  '<td class="LC_left_item">'.$rowname.'</td><td class="LC_left_item" colspan="2">'."\n".
                   3581:                  '<table><tr><td>'."\n";
                   3582:     foreach my $option ('original','recaptcha','notused') {
                   3583:         $output .= '<span class="LC_nobreak"><label><input type="radio" name="'.$context.'_captcha" value="'.
                   3584:                    $option.'" '.$checked{$option}.' onchange="javascript:updateCaptcha('."this,'$context'".');" />'.
                   3585:                    $lt{$option}.'</label></span>';
                   3586:         unless ($option eq 'notused') {
                   3587:             $output .= ('&nbsp;'x2)."\n";
                   3588:         }
                   3589:     }
                   3590: #
                   3591: # Note: If reCAPTCHA is to be used for LON-CAPA servers in a domain, a domain coordinator should visit:
                   3592: # https://www.google.com/recaptcha and generate a Public and Private key. For domains with multiple
                   3593: # servers a single key pair will be used for all servers, so the internet domain (e.g., yourcollege.edu)
                   3594: # specified for use with the key should be broad enough to accommodate all servers in the LON-CAPA domain.
                   3595: #
                   3596:     $output .= '</td></tr>'."\n".
                   3597:                '<tr><td>'."\n".
                   3598:                '<span class="LC_nobreak"><span id="'.$context.'_recaptchapubtxt">'.$pubtext.'</span>&nbsp;'."\n".
                   3599:                '<input type="'.$keyentry.'" id="'.$context.'_recaptchapub" name="'.$context.'_recaptchapub" value="'.
                   3600:                $currpub.'" size="40" /></span><br />'."\n".
                   3601:                '<span class="LC_nobreak"><span id="'.$context.'_recaptchaprivtxt">'.$privtext.'</span>&nbsp;'."\n".
                   3602:                '<input type="'.$keyentry.'" id="'.$context.'_recaptchapriv" name="'.$context.'_recaptchapriv" value="'.
                   3603:                $currpriv.'" size="40" /></span></td></tr></table>'."\n".
                   3604:                '</td></tr>';
                   3605:     return $output;
                   3606: }
                   3607: 
1.32      raeburn  3608: sub user_formats_row {
                   3609:     my ($type,$settings,$rules,$ruleorder,$numinrow,$rowcount) = @_;
                   3610:     my $output;
                   3611:     my %text = (
                   3612:                    'username' => 'new usernames',
                   3613:                    'id'       => 'IDs',
1.45      raeburn  3614:                    'email'    => 'self-created accounts (e-mail)',
1.32      raeburn  3615:                );
                   3616:     my $css_class = $rowcount%2?' class="LC_odd_row"':'';
                   3617:     $output = '<tr '.$css_class.'>'.
1.63      raeburn  3618:               '<td><span class="LC_nobreak">';
                   3619:     if ($type eq 'email') {
                   3620:         $output .= &mt("Formats disallowed for $text{$type}: ");
                   3621:     } else {
                   3622:         $output .= &mt("Format rules to check for $text{$type}: ");
                   3623:     }
                   3624:     $output .= '</span></td>'.
                   3625:                '<td class="LC_left_item" colspan="2"><table>';
1.27      raeburn  3626:     my $rem;
                   3627:     if (ref($ruleorder) eq 'ARRAY') {
                   3628:         for (my $i=0; $i<@{$ruleorder}; $i++) {
                   3629:             if (ref($rules->{$ruleorder->[$i]}) eq 'HASH') {
                   3630:                 my $rem = $i%($numinrow);
                   3631:                 if ($rem == 0) {
                   3632:                     if ($i > 0) {
                   3633:                         $output .= '</tr>';
                   3634:                     }
                   3635:                     $output .= '<tr>';
                   3636:                 }
                   3637:                 my $check = ' ';
1.39      raeburn  3638:                 if (ref($settings) eq 'HASH') {
                   3639:                     if (ref($settings->{$type.'_rule'}) eq 'ARRAY') {
                   3640:                         if (grep(/^\Q$ruleorder->[$i]\E$/,@{$settings->{$type.'_rule'}})) {
                   3641:                             $check = ' checked="checked" ';
                   3642:                         }
1.27      raeburn  3643:                     }
                   3644:                 }
                   3645:                 $output .= '<td class="LC_left_item">'.
                   3646:                            '<span class="LC_nobreak"><label>'.
1.32      raeburn  3647:                            '<input type="checkbox" name="'.$type.'_rule" '.
1.27      raeburn  3648:                            'value="'.$ruleorder->[$i].'"'.$check.'/>'.
                   3649:                            $rules->{$ruleorder->[$i]}{'name'}.'</label></span></td>';
                   3650:             }
                   3651:         }
                   3652:         $rem = @{$ruleorder}%($numinrow);
                   3653:     }
                   3654:     my $colsleft = $numinrow - $rem;
                   3655:     if ($colsleft > 1 ) {
                   3656:         $output .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
                   3657:                    '&nbsp;</td>';
                   3658:     } elsif ($colsleft == 1) {
                   3659:         $output .= '<td class="LC_left_item">&nbsp;</td>';
                   3660:     }
                   3661:     $output .= '</tr></table></td></tr>';
                   3662:     return $output;
                   3663: }
                   3664: 
1.34      raeburn  3665: sub usercreation_types {
                   3666:     my %lt = &Apache::lonlocal::texthash (
                   3667:                     author     => 'When adding a co-author',
                   3668:                     course     => 'When adding a user to a course',
1.100     raeburn  3669:                     requestcrs => 'When requesting a course',
1.45      raeburn  3670:                     selfcreate => 'User creates own account', 
1.34      raeburn  3671:                     any        => 'Any',
                   3672:                     official   => 'Institutional only ',
                   3673:                     unofficial => 'Non-institutional only',
1.85      schafran 3674:                     email      => 'E-mail address',
1.43      raeburn  3675:                     login      => 'Institutional Login',
                   3676:                     sso        => 'SSO', 
1.34      raeburn  3677:                     none       => 'None',
                   3678:     );
                   3679:     return %lt;
1.48      raeburn  3680: }
1.34      raeburn  3681: 
1.28      raeburn  3682: sub authtype_names {
                   3683:     my %lt = &Apache::lonlocal::texthash(
                   3684:                       int    => 'Internal',
                   3685:                       krb4   => 'Kerberos 4',
                   3686:                       krb5   => 'Kerberos 5',
                   3687:                       loc    => 'Local',
                   3688:                   );
                   3689:     return %lt;
                   3690: }
                   3691: 
                   3692: sub context_names {
                   3693:     my %context_title = &Apache::lonlocal::texthash(
                   3694:        author => 'Creating users when an Author',
                   3695:        course => 'Creating users when in a course',
                   3696:        domain => 'Creating users when a Domain Coordinator',
                   3697:     );
                   3698:     return %context_title;
                   3699: }
                   3700: 
1.33      raeburn  3701: sub print_usermodification {
                   3702:     my ($position,$dom,$settings,$rowtotal) = @_;
                   3703:     my $numinrow = 4;
                   3704:     my ($context,$datatable,$rowcount);
                   3705:     if ($position eq 'top') {
                   3706:         $rowcount = 0;
                   3707:         $context = 'author'; 
                   3708:         foreach my $role ('ca','aa') {
                   3709:             $datatable .= &modifiable_userdata_row($context,$role,$settings,
                   3710:                                                    $numinrow,$rowcount);
                   3711:             $$rowtotal ++;
                   3712:             $rowcount ++;
                   3713:         }
1.63      raeburn  3714:     } elsif ($position eq 'middle') {
1.33      raeburn  3715:         $context = 'course';
                   3716:         $rowcount = 0;
                   3717:         foreach my $role ('st','ep','ta','in','cr') {
                   3718:             $datatable .= &modifiable_userdata_row($context,$role,$settings,
                   3719:                                                    $numinrow,$rowcount);
                   3720:             $$rowtotal ++;
                   3721:             $rowcount ++;
                   3722:         }
1.63      raeburn  3723:     } elsif ($position eq 'bottom') {
                   3724:         $context = 'selfcreate';
                   3725:         my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
                   3726:         $usertypes->{'default'} = $othertitle;
                   3727:         if (ref($types) eq 'ARRAY') {
                   3728:             push(@{$types},'default');
                   3729:             $usertypes->{'default'} = $othertitle;
                   3730:             foreach my $status (@{$types}) {
                   3731:                 $datatable .= &modifiable_userdata_row($context,$status,$settings,
                   3732:                                                        $numinrow,$rowcount,$usertypes);
                   3733:                 $$rowtotal ++;
                   3734:                 $rowcount ++;
                   3735:             }
                   3736:         }
1.33      raeburn  3737:     }
                   3738:     return $datatable;
                   3739: }
                   3740: 
1.43      raeburn  3741: sub print_defaults {
                   3742:     my ($dom,$rowtotal) = @_;
1.68      raeburn  3743:     my @items = ('auth_def','auth_arg_def','lang_def','timezone_def',
1.141     raeburn  3744:                  'datelocale_def','portal_def');
1.43      raeburn  3745:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
1.141     raeburn  3746:     my $titles = &defaults_titles($dom);
1.43      raeburn  3747:     my $rownum = 0;
                   3748:     my ($datatable,$css_class);
                   3749:     foreach my $item (@items) {
                   3750:         if ($rownum%2) {
                   3751:             $css_class = '';
                   3752:         } else {
                   3753:             $css_class = ' class="LC_odd_row" ';
                   3754:         }
                   3755:         $datatable .= '<tr'.$css_class.'>'.
                   3756:                   '<td><span class="LC_nobreak">'.$titles->{$item}.
                   3757:                   '</span></td><td class="LC_right_item">';
                   3758:         if ($item eq 'auth_def') {
                   3759:             my @authtypes = ('internal','krb4','krb5','localauth');
                   3760:             my %shortauth = (
                   3761:                              internal => 'int',
                   3762:                              krb4 => 'krb4',
                   3763:                              krb5 => 'krb5',
                   3764:                              localauth  => 'loc'
                   3765:                            );
                   3766:             my %authnames = &authtype_names();
                   3767:             foreach my $auth (@authtypes) {
                   3768:                 my $checked = ' ';
                   3769:                 if ($domdefaults{$item} eq $auth) {
                   3770:                     $checked = ' checked="checked" ';
                   3771:                 }
                   3772:                 $datatable .= '<label><input type="radio" name="'.$item.
                   3773:                               '" value="'.$auth.'"'.$checked.'/>'.
                   3774:                               $authnames{$shortauth{$auth}}.'</label>&nbsp;&nbsp;';
                   3775:             }
1.54      raeburn  3776:         } elsif ($item eq 'timezone_def') {
                   3777:             my $includeempty = 1;
                   3778:             $datatable .= &Apache::loncommon::select_timezone($item,$domdefaults{$item},undef,$includeempty);
1.68      raeburn  3779:         } elsif ($item eq 'datelocale_def') {
                   3780:             my $includeempty = 1;
                   3781:             $datatable .= &Apache::loncommon::select_datelocale($item,$domdefaults{$item},undef,$includeempty);
1.160.6.5  raeburn  3782:         } elsif ($item eq 'lang_def') {
                   3783:             my %langchoices = &get_languages_hash();
                   3784:             $langchoices{''} = 'No language preference';
                   3785:             %langchoices = &Apache::lonlocal::texthash(%langchoices);
                   3786:             $datatable .= &Apache::loncommon::select_form($domdefaults{$item},$item,
                   3787:                                                           \%langchoices);
1.43      raeburn  3788:         } else {
1.141     raeburn  3789:             my $size;
                   3790:             if ($item eq 'portal_def') {
                   3791:                 $size = ' size="25"';
                   3792:             }
1.43      raeburn  3793:             $datatable .= '<input type="text" name="'.$item.'" value="'.
1.141     raeburn  3794:                           $domdefaults{$item}.'"'.$size.' />';
1.43      raeburn  3795:         }
                   3796:         $datatable .= '</td></tr>';
                   3797:         $rownum ++;
                   3798:     }
                   3799:     $$rowtotal += $rownum;
                   3800:     return $datatable;
                   3801: }
                   3802: 
1.160.6.5  raeburn  3803: sub get_languages_hash {
                   3804:     my %langchoices;
                   3805:     foreach my $id (&Apache::loncommon::languageids()) {
                   3806:         my $code = &Apache::loncommon::supportedlanguagecode($id);
                   3807:         if ($code ne '') {
                   3808:             $langchoices{$code} =  &Apache::loncommon::plainlanguagedescription($id);
                   3809:         }
                   3810:     }
                   3811:     return %langchoices;
                   3812: }
                   3813: 
1.43      raeburn  3814: sub defaults_titles {
1.141     raeburn  3815:     my ($dom) = @_;
1.43      raeburn  3816:     my %titles = &Apache::lonlocal::texthash (
                   3817:                    'auth_def'      => 'Default authentication type',
                   3818:                    'auth_arg_def'  => 'Default authentication argument',
                   3819:                    'lang_def'      => 'Default language',
1.54      raeburn  3820:                    'timezone_def'  => 'Default timezone',
1.68      raeburn  3821:                    'datelocale_def' => 'Default locale for dates',
1.141     raeburn  3822:                    'portal_def'     => 'Portal/Default URL',
1.43      raeburn  3823:                  );
1.141     raeburn  3824:     if ($dom) {
                   3825:         my $uprimary_id = &Apache::lonnet::domain($dom,'primary');
                   3826:         my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
                   3827:         my $protocol = $Apache::lonnet::protocol{$uprimary_id};
                   3828:         $protocol = 'http' if ($protocol ne 'https');
                   3829:         if ($uint_dom) {
                   3830:             $titles{'portal_def'} .= ' '.&mt('(for example: [_1])',$protocol.'://loncapa.'.
                   3831:                                          $uint_dom);
                   3832:         }
                   3833:     }
1.43      raeburn  3834:     return (\%titles);
                   3835: }
                   3836: 
1.46      raeburn  3837: sub print_scantronformat {
                   3838:     my ($r,$dom,$confname,$settings,$rowtotal) = @_;
                   3839:     my $itemcount = 1;
1.60      raeburn  3840:     my ($datatable,$css_class,$scantronurl,$is_custom,%error,%scantronurls,
                   3841:         %confhash);
1.46      raeburn  3842:     my $switchserver = &check_switchserver($dom,$confname);
                   3843:     my %lt = &Apache::lonlocal::texthash (
1.95      www      3844:                 default => 'Default bubblesheet format file error',
                   3845:                 custom  => 'Custom bubblesheet format file error',
1.46      raeburn  3846:              );
                   3847:     my %scantronfiles = (
                   3848:         default => 'default.tab',
                   3849:         custom => 'custom.tab',
                   3850:     );
                   3851:     foreach my $key (keys(%scantronfiles)) {
                   3852:         $scantronurls{$key} = '/res/'.$dom.'/'.$confname.'/scantron/'
                   3853:                               .$scantronfiles{$key};
                   3854:     }
                   3855:     my @defaultinfo = &Apache::lonnet::stat_file($scantronurls{'default'});
                   3856:     if ((!@defaultinfo) || ($defaultinfo[0] eq 'no_such_dir')) {
                   3857:         if (!$switchserver) {
                   3858:             my $servadm = $r->dir_config('lonAdmEMail');
                   3859:             my ($configuserok,$author_ok) = &config_check($dom,$confname,$servadm);
                   3860:             if ($configuserok eq 'ok') {
                   3861:                 if ($author_ok eq 'ok') {
                   3862:                     my %legacyfile = (
                   3863:  default => $Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab', 
                   3864:  custom  => $Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab', 
                   3865:                     );
                   3866:                     my %md5chk;
                   3867:                     foreach my $type (keys(%legacyfile)) {
1.60      raeburn  3868:                         ($md5chk{$type}) = split(/ /,`md5sum $legacyfile{$type}`);
                   3869:                         chomp($md5chk{$type});
1.46      raeburn  3870:                     }
                   3871:                     if ($md5chk{'default'} ne $md5chk{'custom'}) {
                   3872:                         foreach my $type (keys(%legacyfile)) {
1.60      raeburn  3873:                             ($scantronurls{$type},my $error) = 
1.46      raeburn  3874:                                 &legacy_scantronformat($r,$dom,$confname,
                   3875:                                                  $type,$legacyfile{$type},
                   3876:                                                  $scantronurls{$type},
                   3877:                                                  $scantronfiles{$type});
1.60      raeburn  3878:                             if ($error ne '') {
                   3879:                                 $error{$type} = $error;
                   3880:                             }
                   3881:                         }
                   3882:                         if (keys(%error) == 0) {
                   3883:                             $is_custom = 1;
                   3884:                             $confhash{'scantron'}{'scantronformat'} = 
                   3885:                                 $scantronurls{'custom'};
                   3886:                             my $putresult = 
                   3887:                                 &Apache::lonnet::put_dom('configuration',
                   3888:                                                          \%confhash,$dom);
                   3889:                             if ($putresult ne 'ok') {
                   3890:                                 $error{'custom'} = 
                   3891:                                     '<span class="LC_error">'.
                   3892:                                     &mt('An error occurred updating the domain configuration: [_1]',$putresult).'</span>';
                   3893:                             }
1.46      raeburn  3894:                         }
                   3895:                     } else {
1.60      raeburn  3896:                         ($scantronurls{'default'},my $error) =
1.46      raeburn  3897:                             &legacy_scantronformat($r,$dom,$confname,
                   3898:                                           'default',$legacyfile{'default'},
                   3899:                                           $scantronurls{'default'},
                   3900:                                           $scantronfiles{'default'});
1.60      raeburn  3901:                         if ($error eq '') {
                   3902:                             $confhash{'scantron'}{'scantronformat'} = ''; 
                   3903:                             my $putresult =
                   3904:                                 &Apache::lonnet::put_dom('configuration',
                   3905:                                                          \%confhash,$dom);
                   3906:                             if ($putresult ne 'ok') {
                   3907:                                 $error{'default'} =
                   3908:                                     '<span class="LC_error">'.
                   3909:                                     &mt('An error occurred updating the domain configuration: [_1]',$putresult).'</span>';
                   3910:                             }
                   3911:                         } else {
                   3912:                             $error{'default'} = $error;
                   3913:                         }
1.46      raeburn  3914:                     }
                   3915:                 }
                   3916:             }
                   3917:         } else {
1.95      www      3918:             $error{'default'} = &mt("Unable to copy default bubblesheet formatfile to domain's RES space: [_1]",$switchserver);
1.46      raeburn  3919:         }
                   3920:     }
                   3921:     if (ref($settings) eq 'HASH') {
                   3922:         if ($settings->{'scantronformat'} eq "/res/$dom/$confname/scantron/custom.tab") {
                   3923:             my @info = &Apache::lonnet::stat_file($settings->{'scantronformat'});
                   3924:             if ((!@info) || ($info[0] eq 'no_such_dir')) {
                   3925:                 $scantronurl = '';
                   3926:             } else {
                   3927:                 $scantronurl = $settings->{'scantronformat'};
                   3928:             }
                   3929:             $is_custom = 1;
                   3930:         } else {
                   3931:             $scantronurl = $scantronurls{'default'};
                   3932:         }
                   3933:     } else {
1.60      raeburn  3934:         if ($is_custom) {
                   3935:             $scantronurl = $scantronurls{'custom'};
                   3936:         } else {
                   3937:             $scantronurl = $scantronurls{'default'};
                   3938:         }
1.46      raeburn  3939:     }
                   3940:     $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   3941:     $datatable .= '<tr'.$css_class.'>';
                   3942:     if (!$is_custom) {
1.65      raeburn  3943:         $datatable .= '<td>'.&mt('Default in use:').'<br />'.
                   3944:                       '<span class="LC_nobreak">';
1.46      raeburn  3945:         if ($scantronurl) {
1.160.6.21  raeburn  3946:             $datatable .= &Apache::loncommon::modal_link($scantronurl,&mt('Default bubblesheet format file'),600,500,
                   3947:                                                          undef,undef,undef,undef,'background-color:#ffffff');
1.46      raeburn  3948:         } else {
                   3949:             $datatable = &mt('File unavailable for display');
                   3950:         }
1.65      raeburn  3951:         $datatable .= '</span></td>';
1.60      raeburn  3952:         if (keys(%error) == 0) { 
                   3953:             $datatable .= '<td valign="bottom">';
                   3954:             if (!$switchserver) {
                   3955:                 $datatable .= &mt('Upload:').'<br />';
                   3956:             }
                   3957:         } else {
                   3958:             my $errorstr;
                   3959:             foreach my $key (sort(keys(%error))) {
                   3960:                 $errorstr .= $lt{$key}.': '.$error{$key}.'<br />';
                   3961:             }
                   3962:             $datatable .= '<td>'.$errorstr;
                   3963:         }
1.46      raeburn  3964:     } else {
                   3965:         if (keys(%error) > 0) {
                   3966:             my $errorstr;
                   3967:             foreach my $key (sort(keys(%error))) {
                   3968:                 $errorstr .= $lt{$key}.': '.$error{$key}.'<br />';
                   3969:             } 
1.60      raeburn  3970:             $datatable .= '<td>'.$errorstr.'</td><td>&nbsp;';
1.46      raeburn  3971:         } elsif ($scantronurl) {
1.160.6.26! raeburn  3972:             my $link =  &Apache::loncommon::modal_link($scantronurl,&mt('Custom bubblesheet format file'),600,500,
1.160.6.21  raeburn  3973:                                                        undef,undef,undef,undef,'background-color:#ffffff');
1.65      raeburn  3974:             $datatable .= '<td><span class="LC_nobreak">'.
1.160.6.21  raeburn  3975:                           $link.
                   3976:                           '<label><input type="checkbox" name="scantronformat_del"'.
                   3977:                           ' value="1" />'.&mt('Delete?').'</label></span></td>'.
1.65      raeburn  3978:                           '<td><span class="LC_nobreak">&nbsp;'.
                   3979:                           &mt('Replace:').'</span><br />';
1.46      raeburn  3980:         }
                   3981:     }
                   3982:     if (keys(%error) == 0) {
                   3983:         if ($switchserver) {
                   3984:             $datatable .= &mt('Upload to library server: [_1]',$switchserver);
                   3985:         } else {
1.65      raeburn  3986:             $datatable .='<span class="LC_nobreak">&nbsp;'.
                   3987:                          '<input type="file" name="scantronformat" /></span>';
1.46      raeburn  3988:         }
                   3989:     }
                   3990:     $datatable .= '</td></tr>';
                   3991:     $$rowtotal ++;
                   3992:     return $datatable;
                   3993: }
                   3994: 
                   3995: sub legacy_scantronformat {
                   3996:     my ($r,$dom,$confname,$file,$legacyfile,$newurl,$newfile) = @_;
                   3997:     my ($url,$error);
                   3998:     my @statinfo = &Apache::lonnet::stat_file($newurl);
                   3999:     if ((!@statinfo) || ($statinfo[0] eq 'no_such_dir')) {
                   4000:         (my $result,$url) =
                   4001:             &publishlogo($r,'copy',$legacyfile,$dom,$confname,'scantron',
                   4002:                          '','',$newfile);
                   4003:         if ($result ne 'ok') {
1.130     raeburn  4004:             $error = &mt("An error occurred publishing the [_1] bubblesheet format file in RES space. Error was: [_2].",$newfile,$result);
1.46      raeburn  4005:         }
                   4006:     }
                   4007:     return ($url,$error);
                   4008: }
1.43      raeburn  4009: 
1.49      raeburn  4010: sub print_coursecategories {
1.57      raeburn  4011:     my ($position,$dom,$hdritem,$settings,$rowtotal) = @_;
                   4012:     my $datatable;
                   4013:     if ($position eq 'top') {
                   4014:         my $toggle_cats_crs = ' ';
                   4015:         my $toggle_cats_dom = ' checked="checked" ';
                   4016:         my $can_cat_crs = ' ';
                   4017:         my $can_cat_dom = ' checked="checked" ';
1.120     raeburn  4018:         my $toggle_catscomm_comm = ' ';
                   4019:         my $toggle_catscomm_dom = ' checked="checked" ';
                   4020:         my $can_catcomm_comm = ' ';
                   4021:         my $can_catcomm_dom = ' checked="checked" ';
                   4022: 
1.57      raeburn  4023:         if (ref($settings) eq 'HASH') {
                   4024:             if ($settings->{'togglecats'} eq 'crs') {
                   4025:                 $toggle_cats_crs = $toggle_cats_dom;
                   4026:                 $toggle_cats_dom = ' ';
                   4027:             }
                   4028:             if ($settings->{'categorize'} eq 'crs') {
                   4029:                 $can_cat_crs = $can_cat_dom;
                   4030:                 $can_cat_dom = ' ';
                   4031:             }
1.120     raeburn  4032:             if ($settings->{'togglecatscomm'} eq 'comm') {
                   4033:                 $toggle_catscomm_comm = $toggle_catscomm_dom;
                   4034:                 $toggle_catscomm_dom = ' ';
                   4035:             }
                   4036:             if ($settings->{'categorizecomm'} eq 'comm') {
                   4037:                 $can_catcomm_comm = $can_catcomm_dom;
                   4038:                 $can_catcomm_dom = ' ';
                   4039:             }
1.57      raeburn  4040:         }
                   4041:         my %title = &Apache::lonlocal::texthash (
1.120     raeburn  4042:                      togglecats     => 'Show/Hide a course in catalog',
                   4043:                      togglecatscomm => 'Show/Hide a community in catalog',
                   4044:                      categorize     => 'Assign a category to a course',
                   4045:                      categorizecomm => 'Assign a category to a community',
1.57      raeburn  4046:                     );
                   4047:         my %level = &Apache::lonlocal::texthash (
1.120     raeburn  4048:                      dom  => 'Set in Domain',
                   4049:                      crs  => 'Set in Course',
                   4050:                      comm => 'Set in Community',
1.57      raeburn  4051:                     );
                   4052:         $datatable = '<tr class="LC_odd_row">'.
                   4053:                   '<td>'.$title{'togglecats'}.'</td>'.
                   4054:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
                   4055:                   '<input type="radio" name="togglecats"'.
                   4056:                   $toggle_cats_dom.' value="dom" />'.$level{'dom'}.'</label>&nbsp;'.
                   4057:                   '<label><input type="radio" name="togglecats"'.
                   4058:                   $toggle_cats_crs.' value="crs" />'.$level{'crs'}.'</label></span></td>'.
                   4059:                   '</tr><tr>'.
                   4060:                   '<td>'.$title{'categorize'}.'</td>'.
                   4061:                   '<td class="LC_right_item"><span class="LC_nobreak">'.
                   4062:                   '<label><input type="radio" name="categorize"'.
                   4063:                   $can_cat_dom.' value="dom" />'.$level{'dom'}.'</label>&nbsp;'.
                   4064:                   '<label><input type="radio" name="categorize"'.
                   4065:                   $can_cat_crs.'value="crs" />'.$level{'crs'}.'</label></span></td>'.
1.120     raeburn  4066:                   '</tr><tr class="LC_odd_row">'.
                   4067:                   '<td>'.$title{'togglecatscomm'}.'</td>'.
                   4068:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
                   4069:                   '<input type="radio" name="togglecatscomm"'.
                   4070:                   $toggle_catscomm_dom.' value="dom" />'.$level{'dom'}.'</label>&nbsp;'.
                   4071:                   '<label><input type="radio" name="togglecatscomm"'.
                   4072:                   $toggle_catscomm_comm.' value="comm" />'.$level{'comm'}.'</label></span></td>'.
                   4073:                   '</tr><tr>'.
                   4074:                   '<td>'.$title{'categorizecomm'}.'</td>'.
                   4075:                   '<td class="LC_right_item"><span class="LC_nobreak">'.
                   4076:                   '<label><input type="radio" name="categorizecomm"'.
                   4077:                   $can_catcomm_dom.' value="dom" />'.$level{'dom'}.'</label>&nbsp;'.
                   4078:                   '<label><input type="radio" name="categorizecomm"'.
                   4079:                   $can_catcomm_comm.'value="comm" />'.$level{'comm'}.'</label></span></td>'.
1.57      raeburn  4080:                   '</tr>';
1.120     raeburn  4081:         $$rowtotal += 4;
1.57      raeburn  4082:     } else {
                   4083:         my $css_class;
                   4084:         my $itemcount = 1;
                   4085:         my $cathash; 
                   4086:         if (ref($settings) eq 'HASH') {
                   4087:             $cathash = $settings->{'cats'};
                   4088:         }
                   4089:         if (ref($cathash) eq 'HASH') {
                   4090:             my (@cats,@trails,%allitems,%idx,@jsarray);
                   4091:             &Apache::loncommon::extract_categories($cathash,\@cats,\@trails,
                   4092:                                                    \%allitems,\%idx,\@jsarray);
                   4093:             my $maxdepth = scalar(@cats);
                   4094:             my $colattrib = '';
                   4095:             if ($maxdepth > 2) {
                   4096:                 $colattrib = ' colspan="2" ';
                   4097:             }
                   4098:             my @path;
                   4099:             if (@cats > 0) {
                   4100:                 if (ref($cats[0]) eq 'ARRAY') {
                   4101:                     my $numtop = @{$cats[0]};
                   4102:                     my $maxnum = $numtop;
1.120     raeburn  4103:                     my %default_names = (
                   4104:                           instcode    => &mt('Official courses'),
                   4105:                           communities => &mt('Communities'),
                   4106:                     );
                   4107: 
                   4108:                     if ((!grep(/^instcode$/,@{$cats[0]})) || 
                   4109:                         ($cathash->{'instcode::0'} eq '') ||
                   4110:                         (!grep(/^communities$/,@{$cats[0]})) || 
                   4111:                         ($cathash->{'communities::0'} eq '')) {
1.57      raeburn  4112:                         $maxnum ++;
                   4113:                     }
                   4114:                     my $lastidx;
                   4115:                     for (my $i=0; $i<$numtop; $i++) {
                   4116:                         my $parent = $cats[0][$i];
                   4117:                         $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   4118:                         my $item = &escape($parent).'::0';
                   4119:                         my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','$item','$idx{$item}'".');"';
                   4120:                         $lastidx = $idx{$item};
                   4121:                         $datatable .= '<tr '.$css_class.'><td><span class="LC_nobreak">'
                   4122:                                       .'<select name="'.$item.'"'.$chgstr.'>';
                   4123:                         for (my $k=0; $k<=$maxnum; $k++) {
                   4124:                             my $vpos = $k+1;
                   4125:                             my $selstr;
                   4126:                             if ($k == $i) {
                   4127:                                 $selstr = ' selected="selected" ';
                   4128:                             }
                   4129:                             $datatable .= '<option value="'.$k.'"'.$selstr.'>'.$vpos.'</option>';
                   4130:                         }
                   4131:                         $datatable .= '</select></td><td>';
1.120     raeburn  4132:                         if ($parent eq 'instcode' || $parent eq 'communities') {
                   4133:                             $datatable .=  '<span class="LC_nobreak">'
                   4134:                                            .$default_names{$parent}.'</span>';
                   4135:                             if ($parent eq 'instcode') {
                   4136:                                 $datatable .= '<br /><span class="LC_nobreak">('
                   4137:                                               .&mt('with institutional codes')
                   4138:                                               .')</span></td><td'.$colattrib.'>';
                   4139:                             } else {
                   4140:                                 $datatable .= '<table><tr><td>';
                   4141:                             }
                   4142:                             $datatable .= '<span class="LC_nobreak">'
                   4143:                                           .'<label><input type="radio" name="'
                   4144:                                           .$parent.'" value="1" checked="checked" />'
                   4145:                                           .&mt('Display').'</label>';
                   4146:                             if ($parent eq 'instcode') {
                   4147:                                 $datatable .= '&nbsp;';
                   4148:                             } else {
                   4149:                                 $datatable .= '</span></td></tr><tr><td>'
                   4150:                                               .'<span class="LC_nobreak">';
                   4151:                             }
                   4152:                             $datatable .= '<label><input type="radio" name="'
                   4153:                                           .$parent.'" value="0" />'
                   4154:                                           .&mt('Do not display').'</label></span>';
                   4155:                             if ($parent eq 'communities') {
                   4156:                                 $datatable .= '</td></tr></table>';
                   4157:                             }
                   4158:                             $datatable .= '</td>';
1.57      raeburn  4159:                         } else {
                   4160:                             $datatable .= $parent
                   4161:                                           .'&nbsp;<label><input type="checkbox" name="deletecategory" '
                   4162:                                           .'value="'.$item.'" />'.&mt('Delete').'</label></span></td>';
                   4163:                         }
                   4164:                         my $depth = 1;
                   4165:                         push(@path,$parent);
                   4166:                         $datatable .= &build_category_rows($itemcount,\@cats,$depth,$parent,\@path,\%idx);
                   4167:                         pop(@path);
                   4168:                         $datatable .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
                   4169:                         $itemcount ++;
                   4170:                     }
1.48      raeburn  4171:                     $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.57      raeburn  4172:                     my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','addcategory_pos','$lastidx'".');"';
                   4173:                     $datatable .= '<tr '.$css_class.'><td><span class="LC_nobreak"><select name="addcategory_pos"'.$chgstr.'>';
1.48      raeburn  4174:                     for (my $k=0; $k<=$maxnum; $k++) {
                   4175:                         my $vpos = $k+1;
                   4176:                         my $selstr;
1.57      raeburn  4177:                         if ($k == $numtop) {
1.48      raeburn  4178:                             $selstr = ' selected="selected" ';
                   4179:                         }
                   4180:                         $datatable .= '<option value="'.$k.'"'.$selstr.'>'.$vpos.'</option>';
                   4181:                     }
1.59      bisitz   4182:                     $datatable .= '</select></span></td><td colspan="2">'.&mt('Add category:').'&nbsp;'
1.57      raeburn  4183:                                   .'<input type="text" size="20" name="addcategory_name" value="" /></td>'
                   4184:                                   .'</tr>'."\n";
1.48      raeburn  4185:                     $itemcount ++;
1.120     raeburn  4186:                     foreach my $default ('instcode','communities') {
                   4187:                         if ((!grep(/^\Q$default\E$/,@{$cats[0]})) || ($cathash->{$default.'::0'} eq '')) {
                   4188:                             $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   4189:                             my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','$default"."_pos','$lastidx'".');"';
                   4190:                             $datatable .= '<tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr><tr '.$css_class.'><td>'.
                   4191:                                           '<span class="LC_nobreak"><select name="'.$default.'_pos"'.$chgstr.'>';
                   4192:                             for (my $k=0; $k<=$maxnum; $k++) {
                   4193:                                 my $vpos = $k+1;
                   4194:                                 my $selstr;
                   4195:                                 if ($k == $maxnum) {
                   4196:                                     $selstr = ' selected="selected" ';
                   4197:                                 }
                   4198:                                 $datatable .= '<option value="'.$k.'"'.$selstr.'>'.$vpos.'</option>';
1.57      raeburn  4199:                             }
1.120     raeburn  4200:                             $datatable .= '</select></span></td>'.
                   4201:                                           '<td><span class="LC_nobreak">'.
                   4202:                                           $default_names{$default}.'</span>';
                   4203:                             if ($default eq 'instcode') {
                   4204:                                 $datatable .= '<br /><span class="LC_nobreak">(' 
                   4205:                                               .&mt('with institutional codes').')</span>';
                   4206:                             }
                   4207:                             $datatable .= '</td>'
                   4208:                                           .'<td><span class="LC_nobreak"><label><input type="radio" name="'.$default.'" value="1" />'
                   4209:                                           .&mt('Display').'</label>&nbsp;'
                   4210:                                           .'<label><input type="radio" name="'.$default.'" value="0" checked="checked"/>'
                   4211:                                           .&mt('Do not display').'</label></span></td></tr>';
1.48      raeburn  4212:                         }
                   4213:                     }
                   4214:                 }
1.57      raeburn  4215:             } else {
                   4216:                 $datatable .= &initialize_categories($itemcount);
1.48      raeburn  4217:             }
                   4218:         } else {
1.57      raeburn  4219:             $datatable .= '<td class="LC_right_item">'.$hdritem->{'header'}->[0]->{'col2'}.'</td>'
                   4220:                           .&initialize_categories($itemcount);
1.48      raeburn  4221:         }
1.57      raeburn  4222:         $$rowtotal += $itemcount;
1.48      raeburn  4223:     }
                   4224:     return $datatable;
                   4225: }
                   4226: 
1.69      raeburn  4227: sub print_serverstatuses {
                   4228:     my ($dom,$settings,$rowtotal) = @_;
                   4229:     my $datatable;
                   4230:     my @pages = &serverstatus_pages();
                   4231:     my (%namedaccess,%machineaccess);
                   4232:     foreach my $type (@pages) {
                   4233:         $namedaccess{$type} = '';
                   4234:         $machineaccess{$type}= '';
                   4235:     }
                   4236:     if (ref($settings) eq 'HASH') {
                   4237:         foreach my $type (@pages) {
                   4238:             if (exists($settings->{$type})) {
                   4239:                 if (ref($settings->{$type}) eq 'HASH') {
                   4240:                     foreach my $key (keys(%{$settings->{$type}})) {
                   4241:                         if ($key eq 'namedusers') {
                   4242:                             $namedaccess{$type} = $settings->{$type}->{$key};
                   4243:                         } elsif ($key eq 'machines') {
                   4244:                             $machineaccess{$type} = $settings->{$type}->{$key};
                   4245:                         }
                   4246:                     }
                   4247:                 }
                   4248:             }
                   4249:         }
                   4250:     }
1.81      raeburn  4251:     my $titles= &LONCAPA::lonauthcgi::serverstatus_titles();
1.69      raeburn  4252:     my $rownum = 0;
                   4253:     my $css_class;
                   4254:     foreach my $type (@pages) {
                   4255:         $rownum ++;
                   4256:         $css_class = $rownum%2?' class="LC_odd_row"':'';
                   4257:         $datatable .= '<tr'.$css_class.'>'.
                   4258:                       '<td><span class="LC_nobreak">'.
                   4259:                       $titles->{$type}.'</span></td>'.
                   4260:                       '<td class="LC_left_item">'.
                   4261:                       '<input type="text" name="'.$type.'_namedusers" '.
                   4262:                       'value="'.$namedaccess{$type}.'" size="30" /></td>'.
                   4263:                       '<td class="LC_right_item">'.
                   4264:                       '<span class="LC_nobreak">'.
                   4265:                       '<input type="text" name="'.$type.'_machines" '.
                   4266:                       'value="'.$machineaccess{$type}.'" size="10" />'.
                   4267:                       '</td></tr>'."\n";
                   4268:     }
                   4269:     $$rowtotal += $rownum;
                   4270:     return $datatable;
                   4271: }
                   4272: 
                   4273: sub serverstatus_pages {
                   4274:     return ('userstatus','lonstatus','loncron','server-status','codeversions',
1.160.6.15  raeburn  4275:             'checksums','clusterstatus','metadata_keywords','metadata_harvest',
1.156     raeburn  4276:             'takeoffline','takeonline','showenv','toggledebug','ping','domconf');
1.69      raeburn  4277: }
                   4278: 
1.49      raeburn  4279: sub coursecategories_javascript {
                   4280:     my ($settings) = @_;
1.57      raeburn  4281:     my ($output,$jstext,$cathash);
1.49      raeburn  4282:     if (ref($settings) eq 'HASH') {
1.57      raeburn  4283:         $cathash = $settings->{'cats'};
                   4284:     }
                   4285:     if (ref($cathash) eq 'HASH') {
1.49      raeburn  4286:         my (@cats,@jsarray,%idx);
1.57      raeburn  4287:         &Apache::loncommon::gather_categories($cathash,\@cats,\%idx,\@jsarray);
1.49      raeburn  4288:         if (@jsarray > 0) {
                   4289:             $jstext = '    var categories = Array('.scalar(@jsarray).');'."\n";
                   4290:             for (my $i=0; $i<@jsarray; $i++) {
                   4291:                 if (ref($jsarray[$i]) eq 'ARRAY') {
                   4292:                     my $catstr = join('","',@{$jsarray[$i]});
                   4293:                     $jstext .= '    categories['.$i.'] = Array("'.$catstr.'");'."\n";
                   4294:                 }
                   4295:             }
                   4296:         }
                   4297:     } else {
                   4298:         $jstext  = '    var categories = Array(1);'."\n".
                   4299:                    '    categories[0] = Array("instcode_pos");'."\n"; 
                   4300:     }
1.120     raeburn  4301:     my $instcode_reserved = &mt('The name: "instcode" is a reserved category');
                   4302:     my $communities_reserved = &mt('The name: "communities" is a reserved category');
                   4303:     my $choose_again = '\\n'.&mt('Please use a different name for the new top level category'); 
1.49      raeburn  4304:     $output = <<"ENDSCRIPT";
                   4305: <script type="text/javascript">
1.109     raeburn  4306: // <![CDATA[
1.49      raeburn  4307: function reorderCats(form,parent,item,idx) {
                   4308:     var changedVal;
                   4309: $jstext
                   4310:     var newpos = 'addcategory_pos';
                   4311:     var current = new Array;
                   4312:     if (parent == '') {
                   4313:         var has_instcode = 0;
                   4314:         var maxtop = categories[idx].length;
                   4315:         for (var j=0; j<maxtop; j++) {
                   4316:             if (categories[idx][j] == 'instcode::0') {
                   4317:                 has_instcode == 1;
                   4318:             }
                   4319:         }
                   4320:         if (has_instcode == 0) {
                   4321:             categories[idx][maxtop] = 'instcode_pos';
                   4322:         }
                   4323:     } else {
                   4324:         newpos += '_'+parent;
                   4325:     }
                   4326:     var maxh = 1 + categories[idx].length;
                   4327:     var current = new Array;
                   4328:     var newitemVal = form.elements[newpos].options[form.elements[newpos].selectedIndex].value;
                   4329:     if (item == newpos) {
                   4330:         changedVal = newitemVal;
                   4331:     } else {
                   4332:         changedVal = form.elements[item].options[form.elements[item].selectedIndex].value;
                   4333:         current[newitemVal] = newpos;
                   4334:     }
                   4335:     for (var i=0; i<categories[idx].length; i++) {
                   4336:         var elementName = categories[idx][i];
                   4337:         if (elementName != item) {
                   4338:             if (form.elements[elementName]) {
                   4339:                 var currVal = form.elements[elementName].options[form.elements[elementName].selectedIndex].value;
                   4340:                 current[currVal] = elementName;
                   4341:             }
                   4342:         }
                   4343:     }
                   4344:     var oldVal;
                   4345:     for (var j=0; j<maxh; j++) {
                   4346:         if (current[j] == undefined) {
                   4347:             oldVal = j;
                   4348:         }
                   4349:     }
                   4350:     if (oldVal < changedVal) {
                   4351:         for (var k=oldVal+1; k<=changedVal ; k++) {
                   4352:            var elementName = current[k];
                   4353:            form.elements[elementName].selectedIndex = form.elements[elementName].selectedIndex - 1;
                   4354:         }
                   4355:     } else {
                   4356:         for (var k=changedVal; k<oldVal; k++) {
                   4357:             var elementName = current[k];
                   4358:             form.elements[elementName].selectedIndex = form.elements[elementName].selectedIndex + 1;
                   4359:         }
                   4360:     }
                   4361:     return;
                   4362: }
1.120     raeburn  4363: 
                   4364: function categoryCheck(form) {
                   4365:     if (form.elements['addcategory_name'].value == 'instcode') {
                   4366:         alert('$instcode_reserved\\n$choose_again');
                   4367:         return false;
                   4368:     }
                   4369:     if (form.elements['addcategory_name'].value == 'communities') {
                   4370:         alert('$communities_reserved\\n$choose_again');
                   4371:         return false;
                   4372:     }
                   4373:     return true;
                   4374: }
                   4375: 
1.109     raeburn  4376: // ]]>
1.49      raeburn  4377: </script>
                   4378: 
                   4379: ENDSCRIPT
                   4380:     return $output;
                   4381: }
                   4382: 
1.48      raeburn  4383: sub initialize_categories {
                   4384:     my ($itemcount) = @_;
1.120     raeburn  4385:     my ($datatable,$css_class,$chgstr);
                   4386:     my %default_names = (
                   4387:                       instcode    => 'Official courses (with institutional codes)',
                   4388:                       communities => 'Communities',
                   4389:                         );
                   4390:     my $select0 = ' selected="selected"';
                   4391:     my $select1 = '';
                   4392:     foreach my $default ('instcode','communities') {
                   4393:         $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   4394:         $chgstr = ' onchange="javascript:reorderCats(this.form,'."'',$default"."_pos','0'".');"';
                   4395:         if ($default eq 'communities') {
                   4396:             $select1 = $select0;
                   4397:             $select0 = '';
                   4398:         }
                   4399:         $datatable .= '<tr '.$css_class.'><td><span class="LC_nobreak">'
                   4400:                      .'<select name="'.$default.'_pos">'
                   4401:                      .'<option value="0"'.$select0.'>1</option>'
                   4402:                      .'<option value="1"'.$select1.'>2</option>'
                   4403:                      .'<option value="2">3</option></select>&nbsp;'
                   4404:                      .$default_names{$default}
                   4405:                      .'</span></td><td><span class="LC_nobreak">'
                   4406:                      .'<label><input type="radio" name="'.$default.'" value="1" checked="checked" />'
                   4407:                      .&mt('Display').'</label>&nbsp;<label>'
                   4408:                      .'<input type="radio" name="'.$default.'" value="0" />'.&mt('Do not display')
1.48      raeburn  4409:                  .'</label></span></td></tr>';
1.120     raeburn  4410:         $itemcount ++;
                   4411:     }
1.48      raeburn  4412:     $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.49      raeburn  4413:     $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','addcategory_pos','0'".');"';
1.48      raeburn  4414:     $datatable .= '<tr '.$css_class.'><td><span class="LC_nobreak">'
1.120     raeburn  4415:                   .'<select name="addcategory_pos"'.$chgstr.'>'
                   4416:                   .'<option value="0">1</option>'
                   4417:                   .'<option value="1">2</option>'
                   4418:                   .'<option value="2" selected="selected">3</option></select>&nbsp;'
1.48      raeburn  4419:                   .&mt('Add category').'</td><td>'.&mt('Name:')
                   4420:                   .'&nbsp;<input type="text" size="20" name="addcategory_name" value="" /></td></tr>';
                   4421:     return $datatable;
                   4422: }
                   4423: 
                   4424: sub build_category_rows {
1.49      raeburn  4425:     my ($itemcount,$cats,$depth,$parent,$path,$idx) = @_;
                   4426:     my ($text,$name,$item,$chgstr);
1.48      raeburn  4427:     if (ref($cats) eq 'ARRAY') {
                   4428:         my $maxdepth = scalar(@{$cats});
                   4429:         if (ref($cats->[$depth]) eq 'HASH') {
                   4430:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   4431:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   4432:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.160.6.23  raeburn  4433:                 $text .= '<td><table class="LC_data_table">';
1.49      raeburn  4434:                 my ($idxnum,$parent_name,$parent_item);
                   4435:                 my $higher = $depth - 1;
                   4436:                 if ($higher == 0) {
                   4437:                     $parent_name = &escape($parent).'::'.$higher;
                   4438:                 } else {
                   4439:                     if (ref($path) eq 'ARRAY') {
                   4440:                         $parent_name = &escape($parent).':'.&escape($path->[-2]).':'.$higher;
                   4441:                     }
                   4442:                 }
                   4443:                 $parent_item = 'addcategory_pos_'.$parent_name;
1.48      raeburn  4444:                 for (my $j=0; $j<=$numchildren; $j++) {
1.49      raeburn  4445:                     if ($j < $numchildren) {
1.48      raeburn  4446:                         $name = $cats->[$depth]{$parent}[$j];
                   4447:                         $item = &escape($name).':'.&escape($parent).':'.$depth;
1.49      raeburn  4448:                         $idxnum = $idx->{$item};
                   4449:                     } else {
                   4450:                         $name = $parent_name;
                   4451:                         $item = $parent_item;
1.48      raeburn  4452:                     }
1.49      raeburn  4453:                     $chgstr = ' onchange="javascript:reorderCats(this.form,'."'$parent_name','$item','$idxnum'".');"';
                   4454:                     $text .= '<tr '.$css_class.'><td><span class="LC_nobreak"><select name="'.$item.'"'.$chgstr.'>';
1.48      raeburn  4455:                     for (my $i=0; $i<=$numchildren; $i++) {
                   4456:                         my $vpos = $i+1;
                   4457:                         my $selstr;
                   4458:                         if ($j == $i) {
                   4459:                             $selstr = ' selected="selected" ';
                   4460:                         }
                   4461:                         $text .= '<option value="'.$i.'"'.$selstr.'>'.$vpos.'</option>';
                   4462:                     }
                   4463:                     $text .= '</select>&nbsp;';
                   4464:                     if ($j < $numchildren) {
                   4465:                         my $deeper = $depth+1;
                   4466:                         $text .= $name.'&nbsp;'
                   4467:                                  .'<label><input type="checkbox" name="deletecategory" value="'
                   4468:                                  .$item.'" />'.&mt('Delete').'</label></span></td><td>';
                   4469:                         if(ref($path) eq 'ARRAY') {
                   4470:                             push(@{$path},$name);
1.49      raeburn  4471:                             $text .= &build_category_rows($itemcount,$cats,$deeper,$name,$path,$idx);
1.48      raeburn  4472:                             pop(@{$path});
                   4473:                         }
                   4474:                     } else {
1.59      bisitz   4475:                         $text .= &mt('Add subcategory:').'&nbsp;</span><input type="textbox" size="20" name="addcategory_name_';
1.48      raeburn  4476:                         if ($j == $numchildren) {
                   4477:                             $text .= $name;
                   4478:                         } else {
                   4479:                             $text .= $item;
                   4480:                         }
                   4481:                         $text .= '" value="" />';
                   4482:                     }
                   4483:                     $text .= '</td></tr>';
                   4484:                 }
                   4485:                 $text .= '</table></td>';
                   4486:             } else {
                   4487:                 my $higher = $depth-1;
                   4488:                 if ($higher == 0) {
                   4489:                     $name = &escape($parent).'::'.$higher;
                   4490:                 } else {
                   4491:                     if (ref($path) eq 'ARRAY') {
                   4492:                         $name = &escape($parent).':'.&escape($path->[-2]).':'.$higher;
                   4493:                     }
                   4494:                 }
                   4495:                 my $colspan;
                   4496:                 if ($parent ne 'instcode') {
                   4497:                     $colspan = $maxdepth - $depth - 1;
                   4498:                     $text .= '<td colspan="'.$colspan.'">'.&mt('Add subcategory:').'<input type="textbox" size="20" name="subcat_'.$name.'" value="" /></td>';
                   4499:                 }
                   4500:             }
                   4501:         }
                   4502:     }
                   4503:     return $text;
                   4504: }
                   4505: 
1.33      raeburn  4506: sub modifiable_userdata_row {
1.63      raeburn  4507:     my ($context,$role,$settings,$numinrow,$rowcount,$usertypes) = @_;
1.33      raeburn  4508:     my $rolename;
1.63      raeburn  4509:     if ($context eq 'selfcreate') {
                   4510:         if (ref($usertypes) eq 'HASH') {
                   4511:             $rolename = $usertypes->{$role};
                   4512:         } else {
                   4513:             $rolename = $role;
                   4514:         }
1.33      raeburn  4515:     } else {
1.63      raeburn  4516:         if ($role eq 'cr') {
                   4517:             $rolename = &mt('Custom role');
                   4518:         } else {
                   4519:             $rolename = &Apache::lonnet::plaintext($role);
                   4520:         }
1.33      raeburn  4521:     }
                   4522:     my @fields = ('lastname','firstname','middlename','generation',
                   4523:                   'permanentemail','id');
                   4524:     my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
                   4525:     my $output;
                   4526:     my $css_class = $rowcount%2?' class="LC_odd_row"':'';
                   4527:     $output = '<tr '.$css_class.'>'.
                   4528:               '<td><span class="LC_nobreak">'.$rolename.'</span></td>'.
                   4529:               '<td class="LC_left_item" colspan="2"><table>';
                   4530:     my $rem;
                   4531:     my %checks;
                   4532:     if (ref($settings) eq 'HASH') {
                   4533:         if (ref($settings->{$context}) eq 'HASH') {
                   4534:             if (ref($settings->{$context}->{$role}) eq 'HASH') {
                   4535:                 foreach my $field (@fields) {
                   4536:                     if ($settings->{$context}->{$role}->{$field}) {
                   4537:                         $checks{$field} = ' checked="checked" ';
                   4538:                     }
                   4539:                 }
                   4540:             }
                   4541:         }
                   4542:     }
                   4543:     for (my $i=0; $i<@fields; $i++) {
                   4544:         my $rem = $i%($numinrow);
                   4545:         if ($rem == 0) {
                   4546:             if ($i > 0) {
                   4547:                 $output .= '</tr>';
                   4548:             }
                   4549:             $output .= '<tr>';
                   4550:         }
                   4551:         my $check = ' ';
                   4552:         if (exists($checks{$fields[$i]})) {
                   4553:             $check = $checks{$fields[$i]}
                   4554:         } else {
                   4555:             if ($role eq 'st') {
                   4556:                 if (ref($settings) ne 'HASH') {
                   4557:                     $check = ' checked="checked" '; 
                   4558:                 }
                   4559:             }
                   4560:         }
                   4561:         $output .= '<td class="LC_left_item">'.
                   4562:                    '<span class="LC_nobreak"><label>'.
                   4563:                    '<input type="checkbox" name="canmodify_'.$role.'" '.
                   4564:                    'value="'.$fields[$i].'"'.$check.'/>'.$fieldtitles{$fields[$i]}.
                   4565:                    '</label></span></td>';
                   4566:         $rem = @fields%($numinrow);
                   4567:     }
                   4568:     my $colsleft = $numinrow - $rem;
                   4569:     if ($colsleft > 1 ) {
                   4570:         $output .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
                   4571:                    '&nbsp;</td>';
                   4572:     } elsif ($colsleft == 1) {
                   4573:         $output .= '<td class="LC_left_item">&nbsp;</td>';
                   4574:     }
                   4575:     $output .= '</tr></table></td></tr>';
                   4576:     return $output;
                   4577: }
1.28      raeburn  4578: 
1.93      raeburn  4579: sub insttypes_row {
                   4580:     my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle,$context) = @_;
                   4581:     my %lt = &Apache::lonlocal::texthash (
                   4582:                       cansearch => 'Users allowed to search',
                   4583:                       statustocreate => 'Institutional affiliation(s) able to create own account (login/SSO)',
1.131     raeburn  4584:                       lockablenames => 'User preference to lock name',
1.93      raeburn  4585:              );
                   4586:     my $showdom;
                   4587:     if ($context eq 'cansearch') {
                   4588:         $showdom = ' ('.$dom.')';
                   4589:     }
1.160.6.5  raeburn  4590:     my $class = 'LC_left_item';
                   4591:     if ($context eq 'statustocreate') {
                   4592:         $class = 'LC_right_item';
                   4593:     }
1.25      raeburn  4594:     my $output =  '<tr class="LC_odd_row">'.
1.93      raeburn  4595:                   '<td>'.$lt{$context}.$showdom.
1.160.6.5  raeburn  4596:                   '</td><td class="'.$class.'" colspan="2"><table>';
1.26      raeburn  4597:     my $rem;
                   4598:     if (ref($types) eq 'ARRAY') {
                   4599:         for (my $i=0; $i<@{$types}; $i++) {
                   4600:             if (defined($usertypes->{$types->[$i]})) {
                   4601:                 my $rem = $i%($numinrow);
                   4602:                 if ($rem == 0) {
                   4603:                     if ($i > 0) {
                   4604:                         $output .= '</tr>';
                   4605:                     }
                   4606:                     $output .= '<tr>';
1.23      raeburn  4607:                 }
1.26      raeburn  4608:                 my $check = ' ';
1.99      raeburn  4609:                 if (ref($settings) eq 'HASH') {
                   4610:                     if (ref($settings->{$context}) eq 'ARRAY') {
                   4611:                         if (grep(/^\Q$types->[$i]\E$/,@{$settings->{$context}})) {
                   4612:                             $check = ' checked="checked" ';
                   4613:                         }
                   4614:                     } elsif ($context eq 'statustocreate') {
1.26      raeburn  4615:                         $check = ' checked="checked" ';
                   4616:                     }
1.23      raeburn  4617:                 }
1.26      raeburn  4618:                 $output .= '<td class="LC_left_item">'.
                   4619:                            '<span class="LC_nobreak"><label>'.
1.93      raeburn  4620:                            '<input type="checkbox" name="'.$context.'" '.
1.26      raeburn  4621:                            'value="'.$types->[$i].'"'.$check.'/>'.
                   4622:                            $usertypes->{$types->[$i]}.'</label></span></td>';
1.23      raeburn  4623:             }
                   4624:         }
1.26      raeburn  4625:         $rem = @{$types}%($numinrow);
1.23      raeburn  4626:     }
                   4627:     my $colsleft = $numinrow - $rem;
1.131     raeburn  4628:     if (($rem == 0) && (@{$types} > 0)) {
                   4629:         $output .= '<tr>';
                   4630:     }
1.23      raeburn  4631:     if ($colsleft > 1) {
1.25      raeburn  4632:         $output .= '<td colspan="'.$colsleft.'" class="LC_left_item">';
1.23      raeburn  4633:     } else {
1.25      raeburn  4634:         $output .= '<td class="LC_left_item">';
1.23      raeburn  4635:     }
                   4636:     my $defcheck = ' ';
1.99      raeburn  4637:     if (ref($settings) eq 'HASH') {  
                   4638:         if (ref($settings->{$context}) eq 'ARRAY') {
                   4639:             if (grep(/^default$/,@{$settings->{$context}})) {
                   4640:                 $defcheck = ' checked="checked" ';
                   4641:             }
                   4642:         } elsif ($context eq 'statustocreate') {
1.26      raeburn  4643:             $defcheck = ' checked="checked" ';
                   4644:         }
1.23      raeburn  4645:     }
1.25      raeburn  4646:     $output .= '<span class="LC_nobreak"><label>'.
1.93      raeburn  4647:                '<input type="checkbox" name="'.$context.'" '.
1.25      raeburn  4648:                'value="default"'.$defcheck.'/>'.
                   4649:                $othertitle.'</label></span></td>'.
                   4650:                '</tr></table></td></tr>';
                   4651:     return $output;
1.23      raeburn  4652: }
                   4653: 
                   4654: sub sorted_searchtitles {
                   4655:     my %searchtitles = &Apache::lonlocal::texthash(
                   4656:                          'uname' => 'username',
                   4657:                          'lastname' => 'last name',
                   4658:                          'lastfirst' => 'last name, first name',
                   4659:                      );
                   4660:     my @titleorder = ('uname','lastname','lastfirst');
                   4661:     return (\%searchtitles,\@titleorder);
                   4662: }
                   4663: 
1.25      raeburn  4664: sub sorted_searchtypes {
                   4665:     my %srchtypes_desc = (
                   4666:                            exact    => 'is exact match',
                   4667:                            contains => 'contains ..',
                   4668:                            begins   => 'begins with ..',
                   4669:                          );
                   4670:     my @srchtypeorder = ('exact','begins','contains');
                   4671:     return (\%srchtypes_desc,\@srchtypeorder);
                   4672: }
                   4673: 
1.3       raeburn  4674: sub usertype_update_row {
                   4675:     my ($settings,$usertypes,$fieldtitles,$fields,$types,$rownums) = @_;
                   4676:     my $datatable;
                   4677:     my $numinrow = 4;
                   4678:     foreach my $type (@{$types}) {
                   4679:         if (defined($usertypes->{$type})) {
                   4680:             $$rownums ++;
                   4681:             my $css_class = $$rownums%2?' class="LC_odd_row"':'';
                   4682:             $datatable .= '<tr'.$css_class.'><td>'.$usertypes->{$type}.
                   4683:                           '</td><td class="LC_left_item"><table>';
                   4684:             for (my $i=0; $i<@{$fields}; $i++) {
                   4685:                 my $rem = $i%($numinrow);
                   4686:                 if ($rem == 0) {
                   4687:                     if ($i > 0) {
                   4688:                         $datatable .= '</tr>';
                   4689:                     }
                   4690:                     $datatable .= '<tr>';
                   4691:                 }
                   4692:                 my $check = ' ';
1.39      raeburn  4693:                 if (ref($settings) eq 'HASH') {
                   4694:                     if (ref($settings->{'fields'}) eq 'HASH') {
                   4695:                         if (ref($settings->{'fields'}{$type}) eq 'ARRAY') {
                   4696:                             if (grep(/^\Q$fields->[$i]\E$/,@{$settings->{'fields'}{$type}})) {
                   4697:                                 $check = ' checked="checked" ';
                   4698:                             }
1.3       raeburn  4699:                         }
                   4700:                     }
                   4701:                 }
                   4702: 
                   4703:                 if ($i == @{$fields}-1) {
                   4704:                     my $colsleft = $numinrow - $rem;
                   4705:                     if ($colsleft > 1) {
                   4706:                         $datatable .= '<td colspan="'.$colsleft.'">';
                   4707:                     } else {
                   4708:                         $datatable .= '<td>';
                   4709:                     }
                   4710:                 } else {
                   4711:                     $datatable .= '<td>';
                   4712:                 }
1.8       raeburn  4713:                 $datatable .= '<span class="LC_nobreak"><label>'.
                   4714:                               '<input type="checkbox" name="updateable_'.$type.
                   4715:                               '_'.$fields->[$i].'" value="1"'.$check.'/>'.
                   4716:                               $fieldtitles->{$fields->[$i]}.'</label></span></td>';
1.3       raeburn  4717:             }
                   4718:             $datatable .= '</tr></table></td></tr>';
                   4719:         }
                   4720:     }
                   4721:     return $datatable;
1.1       raeburn  4722: }
                   4723: 
                   4724: sub modify_login {
1.160.6.24  raeburn  4725:     my ($r,$dom,$confname,$lastactref,%domconfig) = @_;
1.160.6.5  raeburn  4726:     my ($resulttext,$errors,$colchgtext,%changes,%colchanges,%newfile,%newurl,
                   4727:         %curr_loginvia,%loginhash,@currlangs,@newlangs,$addedfile,%title,@offon);
                   4728:     %title = ( coursecatalog => 'Display course catalog',
                   4729:                adminmail => 'Display administrator E-mail address',
1.160.6.14  raeburn  4730:                helpdesk  => 'Display "Contact Helpdesk" link',
1.160.6.5  raeburn  4731:                newuser => 'Link for visitors to create a user account',
                   4732:                loginheader => 'Log-in box header');
                   4733:     @offon = ('off','on');
1.112     raeburn  4734:     if (ref($domconfig{login}) eq 'HASH') {
                   4735:         if (ref($domconfig{login}{loginvia}) eq 'HASH') {
                   4736:             foreach my $lonhost (keys(%{$domconfig{login}{loginvia}})) {
                   4737:                 $curr_loginvia{$lonhost} = $domconfig{login}{loginvia}{$lonhost};
                   4738:             }
                   4739:         }
                   4740:     }
1.9       raeburn  4741:     ($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'],
                   4742:                                            \%domconfig,\%loginhash);
1.160.6.14  raeburn  4743:     my @toggles = ('coursecatalog','adminmail','helpdesk','newuser');
1.42      raeburn  4744:     foreach my $item (@toggles) {
                   4745:         $loginhash{login}{$item} = $env{'form.'.$item};
                   4746:     }
1.41      raeburn  4747:     $loginhash{login}{loginheader} = $env{'form.loginheader'};
1.6       raeburn  4748:     if (ref($colchanges{'login'}) eq 'HASH') {  
                   4749:         $colchgtext = &display_colorchgs($dom,\%colchanges,['login'],
                   4750:                                          \%loginhash);
                   4751:     }
1.110     raeburn  4752: 
1.149     raeburn  4753:     my %servers = &Apache::lonnet::internet_dom_servers($dom);
1.128     raeburn  4754:     my @loginvia_attribs = ('serverpath','custompath','exempt');
1.110     raeburn  4755:     if (keys(%servers) > 1) {
                   4756:         foreach my $lonhost (keys(%servers)) {
1.128     raeburn  4757:             next if ($env{'form.'.$lonhost.'_server'} eq $lonhost);
                   4758:             if (ref($curr_loginvia{$lonhost}) eq 'HASH') {
                   4759:                 if ($env{'form.'.$lonhost.'_server'} eq $curr_loginvia{$lonhost}{'server'}) {
                   4760:                     $loginhash{login}{loginvia}{$lonhost}{'server'} = $curr_loginvia{$lonhost}{'server'};
                   4761:                 } elsif ($curr_loginvia{$lonhost}{'server'} ne '') {
                   4762:                     if (defined($servers{$env{'form.'.$lonhost.'_server'}})) {
                   4763:                         $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'};
                   4764:                         $changes{'loginvia'}{$lonhost} = 1;
                   4765:                     } else {
                   4766:                         $loginhash{login}{loginvia}{$lonhost}{'server'} = '';
                   4767:                         $changes{'loginvia'}{$lonhost} = 1;
                   4768:                     }
                   4769:                 } else {
                   4770:                     if (defined($servers{$env{'form.'.$lonhost.'_server'}})) {
                   4771:                         $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'};
                   4772:                         $changes{'loginvia'}{$lonhost} = 1;
                   4773:                     }
                   4774:                 }
                   4775:                 if ($loginhash{login}{loginvia}{$lonhost}{'server'} eq '') {
                   4776:                     foreach my $item (@loginvia_attribs) {
                   4777:                         $loginhash{login}{loginvia}{$lonhost}{$item} = '';
                   4778:                     }
                   4779:                 } else {
                   4780:                     foreach my $item (@loginvia_attribs) {
                   4781:                         my $new = $env{'form.'.$lonhost.'_'.$item};
                   4782:                         if (($item eq 'serverpath') && ($new eq 'custom')) {
                   4783:                             $env{'form.'.$lonhost.'_custompath'} =~ s/\s+//g;
                   4784:                             if ($env{'form.'.$lonhost.'_custompath'} eq '') {
                   4785:                                 $new = '/';
                   4786:                             }
                   4787:                         }
                   4788:                         if (($item eq 'custompath') && 
                   4789:                             ($env{'form.'.$lonhost.'_serverpath'} ne 'custom')) {
                   4790:                             $new = '';
                   4791:                         }
                   4792:                         if ($new ne $curr_loginvia{$lonhost}{$item}) {
                   4793:                             $changes{'loginvia'}{$lonhost} = 1;
                   4794:                         }
                   4795:                         if ($item eq 'exempt') {
                   4796:                             $new =~ s/^\s+//;
                   4797:                             $new =~ s/\s+$//;
                   4798:                             my @poss_ips = split(/\s*[,:]\s*/,$new);
                   4799:                             my @okips;
                   4800:                             foreach my $ip (@poss_ips) {
                   4801:                                 if ($ip =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
                   4802:                                     if (($1 <= 255) && ($2 <= 255) && ($3 <= 255) && ($4 <= 255)) {
                   4803:                                         push(@okips,$ip); 
                   4804:                                     }
                   4805:                                 }
                   4806:                             }
                   4807:                             if (@okips > 0) {
                   4808:                                 $new = join(',',@okips); 
                   4809:                             } else {
                   4810:                                 $new = ''; 
                   4811:                             }
                   4812:                         }
                   4813:                         $loginhash{login}{loginvia}{$lonhost}{$item} = $new;
                   4814:                     }
                   4815:                 }
1.112     raeburn  4816:             } else {
1.128     raeburn  4817:                 if (defined($servers{$env{'form.'.$lonhost.'_server'}})) {
                   4818:                     $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'};
1.112     raeburn  4819:                     $changes{'loginvia'}{$lonhost} = 1;
1.128     raeburn  4820:                     foreach my $item (@loginvia_attribs) {
                   4821:                         my $new = $env{'form.'.$lonhost.'_'.$item};
                   4822:                         if (($item eq 'serverpath') && ($new eq 'custom')) {
                   4823:                             if ($env{'form.'.$lonhost.'_custompath'} eq '') {
                   4824:                                 $new = '/';
                   4825:                             }
                   4826:                         }
                   4827:                         if (($item eq 'custompath') && 
                   4828:                             ($env{'form.'.$lonhost.'_serverpath'} ne 'custom')) {
                   4829:                             $new = '';
                   4830:                         }
                   4831:                         $loginhash{login}{loginvia}{$lonhost}{$item} = $new;
                   4832:                     }
1.110     raeburn  4833:                 }
                   4834:             }
                   4835:         }
                   4836:     }
1.119     raeburn  4837: 
1.160.6.5  raeburn  4838:     my $servadm = $r->dir_config('lonAdmEMail');
                   4839:     my %langchoices = &Apache::lonlocal::texthash(&get_languages_hash());
                   4840:     if (ref($domconfig{'login'}) eq 'HASH') {
                   4841:         if (ref($domconfig{'login'}{'helpurl'}) eq 'HASH') {
                   4842:             foreach my $lang (sort(keys(%{$domconfig{'login'}{'helpurl'}}))) {
                   4843:                 if ($lang eq 'nolang') {
                   4844:                     push(@currlangs,$lang);
                   4845:                 } elsif (defined($langchoices{$lang})) {
                   4846:                     push(@currlangs,$lang);
                   4847:                 } else {
                   4848:                     next;
                   4849:                 }
                   4850:             }
                   4851:         }
                   4852:     }
                   4853:     my @delurls = &Apache::loncommon::get_env_multiple('form.loginhelpurl_del');
                   4854:     if (@currlangs > 0) {
                   4855:         foreach my $lang (@currlangs) {
                   4856:             if (grep(/^\Q$lang\E$/,@delurls)) {
                   4857:                 $changes{'helpurl'}{$lang} = 1;
                   4858:             } elsif ($env{'form.loginhelpurl_'.$lang.'.filename'}) {
                   4859:                 $changes{'helpurl'}{$lang} = 1;
                   4860:                 $newfile{$lang} = $env{'form.loginhelpurl_'.$lang.'.filename'};
                   4861:                 push(@newlangs,$lang);
                   4862:             } else {
                   4863:                 $loginhash{'login'}{'helpurl'}{$lang} = $domconfig{'login'}{'helpurl'}{$lang};
                   4864:             }
                   4865:         }
                   4866:     }
                   4867:     unless (grep(/^nolang$/,@currlangs)) {
                   4868:         if ($env{'form.loginhelpurl_nolang.filename'}) {
                   4869:             $changes{'helpurl'}{'nolang'} = 1;
                   4870:             $newfile{'nolang'} = $env{'form.loginhelpurl_nolang.filename'};
                   4871:             push(@newlangs,'nolang');
                   4872:         }
                   4873:     }
                   4874:     if ($env{'form.loginhelpurl_add_lang'}) {
                   4875:         if ((defined($langchoices{$env{'form.loginhelpurl_add_lang'}})) &&
                   4876:             ($env{'form.loginhelpurl_add_file.filename'})) {
                   4877:             $newfile{$env{'form.loginhelpurl_add_lang'}} = $env{'form.loginhelpurl_add_file.filename'};
                   4878:             $addedfile = $env{'form.loginhelpurl_add_lang'};
                   4879:         }
                   4880:     }
                   4881:     if ((@newlangs > 0) || ($addedfile)) {
                   4882:         my $error;
                   4883:         my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm);
                   4884:         if ($configuserok eq 'ok') {
                   4885:             if ($switchserver) {
                   4886:                 $error = &mt("Upload of custom help file is not permitted to this server: [_1]",$switchserver);
                   4887:             } elsif ($author_ok eq 'ok') {
                   4888:                 my @allnew = @newlangs;
                   4889:                 if ($addedfile ne '') {
                   4890:                     push(@allnew,$addedfile);
                   4891:                 }
                   4892:                 foreach my $lang (@allnew) {
                   4893:                     my $formelem = 'loginhelpurl_'.$lang;
                   4894:                     if ($lang eq $env{'form.loginhelpurl_add_lang'}) {
                   4895:                         $formelem = 'loginhelpurl_add_file';
                   4896:                     }
                   4897:                     (my $result,$newurl{$lang}) = &publishlogo($r,'upload',$formelem,$dom,$confname,
                   4898:                                                                "help/$lang",'','',$newfile{$lang});
                   4899:                     if ($result eq 'ok') {
                   4900:                         $loginhash{'login'}{'helpurl'}{$lang} = $newurl{$lang};
                   4901:                         $changes{'helpurl'}{$lang} = 1;
                   4902:                     } else {
                   4903:                         my $puberror = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$newfile{$lang},$result);
                   4904:                         $errors .= '<li><span class="LC_error">'.$puberror.'</span></li>';
                   4905:                         if ((grep(/^\Q$lang\E$/,@currlangs)) &&
                   4906:                             (!grep(/^\Q$lang\E$/,@delurls))) {
                   4907: 
                   4908:                             $loginhash{'login'}{'helpurl'}{$lang} = $domconfig{'login'}{'helpurl'}{$lang};
                   4909:                         }
                   4910:                     }
                   4911:                 }
                   4912:             } else {
                   4913:                 $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);
                   4914:             }
                   4915:         } else {
                   4916:             $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);
                   4917:         }
                   4918:         if ($error) {
                   4919:             &Apache::lonnet::logthis($error);
                   4920:             $errors .= '<li><span class="LC_error">'.$error.'</span></li>';
                   4921:         }
                   4922:     }
                   4923:     &process_captcha('login',\%changes,$loginhash{'login'},$domconfig{'login'});
                   4924: 
                   4925:     my $defaulthelpfile = '/adm/loginproblems.html';
                   4926:     my $defaulttext = &mt('Default in use');
                   4927: 
1.1       raeburn  4928:     my $putresult = &Apache::lonnet::put_dom('configuration',\%loginhash,
                   4929:                                              $dom);
                   4930:     if ($putresult eq 'ok') {
1.160.6.14  raeburn  4931:         my @toggles = ('coursecatalog','adminmail','helpdesk','newuser');
1.42      raeburn  4932:         my %defaultchecked = (
                   4933:                     'coursecatalog' => 'on',
1.160.6.14  raeburn  4934:                     'helpdesk'      => 'on',
1.42      raeburn  4935:                     'adminmail'     => 'off',
1.43      raeburn  4936:                     'newuser'       => 'off',
1.42      raeburn  4937:         );
1.55      raeburn  4938:         if (ref($domconfig{'login'}) eq 'HASH') {
                   4939:             foreach my $item (@toggles) {
                   4940:                 if ($defaultchecked{$item} eq 'on') { 
                   4941:                     if (($domconfig{'login'}{$item} eq '0') &&
                   4942:                         ($env{'form.'.$item} eq '1')) {
                   4943:                         $changes{$item} = 1;
                   4944:                     } elsif (($domconfig{'login'}{$item} eq '' ||
                   4945:                               $domconfig{'login'}{$item} eq '1') &&
                   4946:                              ($env{'form.'.$item} eq '0')) {
                   4947:                         $changes{$item} = 1;
                   4948:                     }
                   4949:                 } elsif ($defaultchecked{$item} eq 'off') {
                   4950:                     if (($domconfig{'login'}{$item} eq '1') &&
                   4951:                         ($env{'form.'.$item} eq '0')) {
                   4952:                         $changes{$item} = 1;
                   4953:                     } elsif (($domconfig{'login'}{$item} eq '' ||
                   4954:                               $domconfig{'login'}{$item} eq '0') &&
                   4955:                              ($env{'form.'.$item} eq '1')) {
                   4956:                         $changes{$item} = 1;
                   4957:                     }
1.42      raeburn  4958:                 }
                   4959:             }
1.41      raeburn  4960:         }
1.6       raeburn  4961:         if (keys(%changes) > 0 || $colchgtext) {
1.41      raeburn  4962:             &Apache::loncommon::devalidate_domconfig_cache($dom);
1.160.6.24  raeburn  4963:             $$lastactref = 'update';
1.1       raeburn  4964:             $resulttext = &mt('Changes made:').'<ul>';
                   4965:             foreach my $item (sort(keys(%changes))) {
1.135     bisitz   4966:                 if ($item eq 'loginvia') {
1.112     raeburn  4967:                     if (ref($changes{$item}) eq 'HASH') {
                   4968:                         $resulttext .= '<li>'.&mt('Log-in page availability:').'<ul>';
                   4969:                         foreach my $lonhost (sort(keys(%{$changes{$item}}))) {
1.128     raeburn  4970:                             if (defined($servers{$loginhash{login}{loginvia}{$lonhost}{'server'}})) {
                   4971:                                 if (ref($loginhash{login}{loginvia}{$lonhost}) eq 'HASH') {
                   4972:                                     my $protocol = $Apache::lonnet::protocol{$env{'form.'.$lonhost.'_server'}};
                   4973:                                     $protocol = 'http' if ($protocol ne 'https');
                   4974:                                     my $target = $protocol.'://'.$servers{$env{'form.'.$lonhost.'_server'}};
                   4975: 
                   4976:                                     if ($loginhash{login}{loginvia}{$lonhost}{'serverpath'} eq 'custom') {
                   4977:                                         $target .= $loginhash{login}{loginvia}{$lonhost}{'custompath'};
                   4978:                                     } else {
                   4979:                                         $target .= $loginhash{login}{loginvia}{$lonhost}{'serverpath'}; 
                   4980:                                     }
                   4981:                                     $resulttext .= '<li>'.&mt('Server: [_1] log-in page redirects to [_2].',$servers{$lonhost},'<a href="'.$target.'">'.$target.'</a>');
                   4982:                                     if ($loginhash{login}{loginvia}{$lonhost}{'exempt'} ne '') {
                   4983:                                         $resulttext .= '&nbsp;'.&mt('No redirection for clients from following IPs:').'&nbsp;'.$loginhash{login}{loginvia}{$lonhost}{'exempt'};
                   4984:                                     }
                   4985:                                     $resulttext .= '</li>';
                   4986:                                 } else {
                   4987:                                     $resulttext .= '<li>'.&mt('Server: [_1] has standard log-in page.',$lonhost).'</li>';
                   4988:                                 }
1.112     raeburn  4989:                             } else {
1.128     raeburn  4990:                                 $resulttext .= '<li>'.&mt('Server: [_1] has standard log-in page.',$servers{$lonhost}).'</li>';
1.112     raeburn  4991:                             }
                   4992:                         }
1.128     raeburn  4993:                         $resulttext .= '</ul></li>';
1.112     raeburn  4994:                     }
1.160.6.5  raeburn  4995:                 } elsif ($item eq 'helpurl') {
                   4996:                     if (ref($changes{$item}) eq 'HASH') {
                   4997:                         foreach my $lang (sort(keys(%{$changes{$item}}))) {
                   4998:                             if (grep(/^\Q$lang\E$/,@delurls)) {
                   4999:                                 my ($chg,$link);
                   5000:                                 $link = &Apache::loncommon::modal_link($defaulthelpfile,$defaulttext,600,500);
                   5001:                                 if ($lang eq 'nolang') {
                   5002:                                     $chg = &mt('custom log-in help file removed for no preferred language; [_1]',$link);
                   5003:                                 } else {
                   5004:                                     $chg = &mt('custom log-in help file removed for specific language: [_1]; [_2]',$langchoices{$lang},$link);
                   5005:                                 }
                   5006:                                 $resulttext .= '<li>'.$chg.'</li>';
                   5007:                             } else {
                   5008:                                 my $chg;
                   5009:                                 if ($lang eq 'nolang') {
                   5010:                                     $chg = &mt('custom log-in help file for no preferred language');
                   5011:                                 } else {
                   5012:                                     $chg = &mt('custom log-in help file for specific language: [_1]',$langchoices{$lang});
                   5013:                                 }
                   5014:                                 $resulttext .= '<li>'.&Apache::loncommon::modal_link(
                   5015:                                                       $loginhash{'login'}{'helpurl'}{$lang}.
                   5016:                                                       '?inhibitmenu=yes',$chg,600,500).
                   5017:                                                '</li>';
                   5018:                             }
                   5019:                         }
                   5020:                     }
                   5021:                 } elsif ($item eq 'captcha') {
                   5022:                     if (ref($loginhash{'login'}) eq 'HASH') {
                   5023:                         my $chgtxt;
                   5024:                         if ($loginhash{'login'}{$item} eq 'notused') {
                   5025:                             $chgtxt .= &mt('No CAPTCHA validation in use for helpdesk form.');
                   5026:                         } else {
                   5027:                             my %captchas = &captcha_phrases();
                   5028:                             if ($captchas{$loginhash{'login'}{$item}}) {
                   5029:                                 $chgtxt .= &mt("Validation for helpdesk form set to $captchas{$loginhash{'login'}{$item}}.");
                   5030:                             } else {
                   5031:                                 $chgtxt .= &mt('Validation for helpdesk form set to unknown type.');
                   5032:                             }
                   5033:                         }
                   5034:                         $resulttext .= '<li>'.$chgtxt.'</li>';
                   5035:                     }
                   5036:                 } elsif ($item eq 'recaptchakeys') {
                   5037:                     if (ref($loginhash{'login'}) eq 'HASH') {
                   5038:                         my ($privkey,$pubkey);
                   5039:                         if (ref($loginhash{'login'}{$item}) eq 'HASH') {
                   5040:                             $pubkey = $loginhash{'login'}{$item}{'public'};
                   5041:                             $privkey = $loginhash{'login'}{$item}{'private'};
                   5042:                         }
                   5043:                         my $chgtxt .= &mt('ReCAPTCHA keys changes').'<ul>';
                   5044:                         if (!$pubkey) {
                   5045:                             $chgtxt .= '<li>'.&mt('Public key deleted').'</li>';
                   5046:                         } else {
                   5047:                             $chgtxt .= '<li>'.&mt('Public key set to [_1]',$pubkey).'</li>';
                   5048:                         }
                   5049:                         if (!$privkey) {
                   5050:                             $chgtxt .= '<li>'.&mt('Private key deleted').'</li>';
                   5051:                         } else {
                   5052:                             $chgtxt .= '<li>'.&mt('Private key set to [_1]',$pubkey).'</li>';
                   5053:                         }
                   5054:                         $chgtxt .= '</ul>';
                   5055:                         $resulttext .= '<li>'.$chgtxt.'</li>';
                   5056:                     }
1.41      raeburn  5057:                 } else {
                   5058:                     $resulttext .= '<li>'.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'</li>';
                   5059:                 }
1.1       raeburn  5060:             }
1.6       raeburn  5061:             $resulttext .= $colchgtext.'</ul>';
1.1       raeburn  5062:         } else {
                   5063:             $resulttext = &mt('No changes made to log-in page settings');
                   5064:         }
                   5065:     } else {
1.11      albertel 5066:         $resulttext = '<span class="LC_error">'.
                   5067: 	    &mt('An error occurred: [_1]',$putresult).'</span>';
1.1       raeburn  5068:     }
1.6       raeburn  5069:     if ($errors) {
1.9       raeburn  5070:         $resulttext .= '<br />'.&mt('The following errors occurred: ').'<ul>'.
1.6       raeburn  5071:                        $errors.'</ul>';
                   5072:     }
                   5073:     return $resulttext;
                   5074: }
                   5075: 
                   5076: sub color_font_choices {
                   5077:     my %choices =
                   5078:         &Apache::lonlocal::texthash (
                   5079:             img => "Header",
                   5080:             bgs => "Background colors",
                   5081:             links => "Link colors",
1.55      raeburn  5082:             images => "Images",
1.6       raeburn  5083:             font => "Font color",
1.160.6.22  raeburn  5084:             fontmenu => "Font menu",
1.76      raeburn  5085:             pgbg => "Page",
1.6       raeburn  5086:             tabbg => "Header",
                   5087:             sidebg => "Border",
                   5088:             link => "Link",
                   5089:             alink => "Active link",
                   5090:             vlink => "Visited link",
                   5091:         );
                   5092:     return %choices;
                   5093: }
                   5094: 
                   5095: sub modify_rolecolors {
1.160.6.24  raeburn  5096:     my ($r,$dom,$confname,$roles,$lastactref,%domconfig) = @_;
1.6       raeburn  5097:     my ($resulttext,%rolehash);
                   5098:     $rolehash{'rolecolors'} = {};
1.55      raeburn  5099:     if (ref($domconfig{'rolecolors'}) ne 'HASH') {
                   5100:         if ($domconfig{'rolecolors'} eq '') {
                   5101:             $domconfig{'rolecolors'} = {};
                   5102:         }
                   5103:     }
1.9       raeburn  5104:     my ($errors,%changes) = &modify_colors($r,$dom,$confname,$roles,
1.6       raeburn  5105:                          $domconfig{'rolecolors'},$rolehash{'rolecolors'});
                   5106:     my $putresult = &Apache::lonnet::put_dom('configuration',\%rolehash,
                   5107:                                              $dom);
                   5108:     if ($putresult eq 'ok') {
                   5109:         if (keys(%changes) > 0) {
1.41      raeburn  5110:             &Apache::loncommon::devalidate_domconfig_cache($dom);
1.160.6.24  raeburn  5111:             $$lastactref = 'update';
1.6       raeburn  5112:             $resulttext = &display_colorchgs($dom,\%changes,$roles,
                   5113:                                              $rolehash{'rolecolors'});
                   5114:         } else {
                   5115:             $resulttext = &mt('No changes made to default color schemes');
                   5116:         }
                   5117:     } else {
1.11      albertel 5118:         $resulttext = '<span class="LC_error">'.
                   5119: 	    &mt('An error occurred: [_1]',$putresult).'</span>';
1.6       raeburn  5120:     }
                   5121:     if ($errors) {
                   5122:         $resulttext .= &mt('The following errors occurred: ').'<ul>'.
                   5123:                        $errors.'</ul>';
                   5124:     }
                   5125:     return $resulttext;
                   5126: }
                   5127: 
                   5128: sub modify_colors {
1.9       raeburn  5129:     my ($r,$dom,$confname,$roles,$domconfig,$confhash) = @_;
1.12      raeburn  5130:     my (%changes,%choices);
1.51      raeburn  5131:     my @bgs;
1.6       raeburn  5132:     my @links = ('link','alink','vlink');
1.41      raeburn  5133:     my @logintext;
1.6       raeburn  5134:     my @images;
                   5135:     my $servadm = $r->dir_config('lonAdmEMail');
                   5136:     my $errors;
1.160.6.22  raeburn  5137:     my %defaults;
1.6       raeburn  5138:     foreach my $role (@{$roles}) {
                   5139:         if ($role eq 'login') {
1.12      raeburn  5140:             %choices = &login_choices();
1.41      raeburn  5141:             @logintext = ('textcol','bgcol');
1.12      raeburn  5142:         } else {
                   5143:             %choices = &color_font_choices();
                   5144:         }
                   5145:         if ($role eq 'login') {
1.41      raeburn  5146:             @images = ('img','logo','domlogo','login');
1.51      raeburn  5147:             @bgs = ('pgbg','mainbg','sidebg');
1.6       raeburn  5148:         } else {
                   5149:             @images = ('img');
1.160.6.22  raeburn  5150:             @bgs = ('pgbg','tabbg','sidebg');
                   5151:         }
                   5152:         my %defaults = &role_defaults($role,\@bgs,\@links,\@images,\@logintext);
                   5153:         unless ($env{'form.'.$role.'_font'} eq $defaults{'font'}) {
                   5154:             $confhash->{$role}{'font'} = $env{'form.'.$role.'_font'};
                   5155:         }
                   5156:         if ($role eq 'login') {
                   5157:             foreach my $item (@logintext) {
                   5158:                 unless ($env{'form.'.$role.'_'.$item} eq  $defaults{'logintext'}{$item}) {
                   5159:                     $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item};
                   5160:                 }
                   5161:             }
                   5162:         } else {
                   5163:             unless($env{'form.'.$role.'_fontmenu'} eq $defaults{'fontmenu'}) {
                   5164:                 $confhash->{$role}{'fontmenu'} = $env{'form.'.$role.'_fontmenu'};
                   5165:             }
1.6       raeburn  5166:         }
1.160.6.22  raeburn  5167:         foreach my $item (@bgs) {
                   5168:             unless ($env{'form.'.$role.'_'.$item} eq $defaults{'bgs'}{$item} ) {
                   5169:                 $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item};
                   5170:             }
                   5171:         }
                   5172:         foreach my $item (@links) {
                   5173:             unless ($env{'form.'.$role.'_'.$item} eq  $defaults{'links'}{$item}) {
                   5174:                 $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item};
                   5175:             }
1.6       raeburn  5176:         }
1.46      raeburn  5177:         my ($configuserok,$author_ok,$switchserver) = 
                   5178:             &config_check($dom,$confname,$servadm);
1.9       raeburn  5179:         my ($width,$height) = &thumb_dimensions();
1.40      raeburn  5180:         if (ref($domconfig->{$role}) ne 'HASH') {
                   5181:             $domconfig->{$role} = {};
                   5182:         }
1.8       raeburn  5183:         foreach my $img (@images) {
1.70      raeburn  5184:             if (($role eq 'login') && (($img eq 'img') || ($img eq 'logo'))) {  
                   5185:                 if (defined($env{'form.login_showlogo_'.$img})) {
                   5186:                     $confhash->{$role}{'showlogo'}{$img} = 1;
                   5187:                 } else { 
                   5188:                     $confhash->{$role}{'showlogo'}{$img} = 0;
                   5189:                 }
                   5190:             } 
1.18      albertel 5191: 	    if ( ! $env{'form.'.$role.'_'.$img.'.filename'} 
                   5192: 		 && !defined($domconfig->{$role}{$img})
                   5193: 		 && !$env{'form.'.$role.'_del_'.$img}
                   5194: 		 && $env{'form.'.$role.'_import_'.$img}) {
                   5195: 		# import the old configured image from the .tab setting
                   5196: 		# if they haven't provided a new one 
                   5197: 		$domconfig->{$role}{$img} = 
                   5198: 		    $env{'form.'.$role.'_import_'.$img};
                   5199: 	    }
1.6       raeburn  5200:             if ($env{'form.'.$role.'_'.$img.'.filename'} ne '') {
1.9       raeburn  5201:                 my $error;
1.6       raeburn  5202:                 if ($configuserok eq 'ok') {
1.9       raeburn  5203:                     if ($switchserver) {
1.12      raeburn  5204:                         $error = &mt("Upload of [_1] image for $role page(s) is not permitted to this server: [_2]",$choices{$img},$switchserver);
1.9       raeburn  5205:                     } else {
                   5206:                         if ($author_ok eq 'ok') {
                   5207:                             my ($result,$logourl) = 
                   5208:                                 &publishlogo($r,'upload',$role.'_'.$img,
                   5209:                                            $dom,$confname,$img,$width,$height);
                   5210:                             if ($result eq 'ok') {
                   5211:                                 $confhash->{$role}{$img} = $logourl;
1.12      raeburn  5212:                                 $changes{$role}{'images'}{$img} = 1;
1.9       raeburn  5213:                             } else {
1.12      raeburn  5214:                                 $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);
1.9       raeburn  5215:                             }
                   5216:                         } else {
1.46      raeburn  5217:                             $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);
1.6       raeburn  5218:                         }
                   5219:                     }
                   5220:                 } else {
1.46      raeburn  5221:                     $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);
1.9       raeburn  5222:                 }
                   5223:                 if ($error) {
1.8       raeburn  5224:                     &Apache::lonnet::logthis($error);
1.11      albertel 5225:                     $errors .= '<li><span class="LC_error">'.$error.'</span></li>';
1.8       raeburn  5226:                 }
                   5227:             } elsif ($domconfig->{$role}{$img} ne '') {
1.9       raeburn  5228:                 if ($domconfig->{$role}{$img} !~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) {
                   5229:                     my $error;
                   5230:                     if ($configuserok eq 'ok') {
                   5231: # is confname an author?
                   5232:                         if ($switchserver eq '') {
                   5233:                             if ($author_ok eq 'ok') {
                   5234:                                 my ($result,$logourl) = 
                   5235:                                &publishlogo($r,'copy',$domconfig->{$role}{$img},
                   5236:                                             $dom,$confname,$img,$width,$height);
                   5237:                                 if ($result eq 'ok') {
                   5238:                                     $confhash->{$role}{$img} = $logourl;
1.18      albertel 5239: 				    $changes{$role}{'images'}{$img} = 1;
1.9       raeburn  5240:                                 }
                   5241:                             }
                   5242:                         }
                   5243:                     }
1.6       raeburn  5244:                 }
                   5245:             }
                   5246:         }
                   5247:         if (ref($domconfig) eq 'HASH') {
                   5248:             if (ref($domconfig->{$role}) eq 'HASH') {
                   5249:                 foreach my $img (@images) {
                   5250:                     if ($domconfig->{$role}{$img} ne '') {
                   5251:                         if ($env{'form.'.$role.'_del_'.$img}) {
                   5252:                             $confhash->{$role}{$img} = '';
1.12      raeburn  5253:                             $changes{$role}{'images'}{$img} = 1;
1.6       raeburn  5254:                         } else {
1.9       raeburn  5255:                             if ($confhash->{$role}{$img} eq '') {
                   5256:                                 $confhash->{$role}{$img} = $domconfig->{$role}{$img};
                   5257:                             }
1.6       raeburn  5258:                         }
                   5259:                     } else {
                   5260:                         if ($env{'form.'.$role.'_del_'.$img}) {
                   5261:                             $confhash->{$role}{$img} = '';
1.12      raeburn  5262:                             $changes{$role}{'images'}{$img} = 1;
1.6       raeburn  5263:                         } 
                   5264:                     }
1.70      raeburn  5265:                     if (($role eq 'login') && (($img eq 'logo') || ($img eq 'img'))) {
                   5266:                         if (ref($domconfig->{'login'}{'showlogo'}) eq 'HASH') {
                   5267:                             if ($confhash->{$role}{'showlogo'}{$img} ne 
                   5268:                                 $domconfig->{$role}{'showlogo'}{$img}) {
                   5269:                                 $changes{$role}{'showlogo'}{$img} = 1; 
                   5270:                             }
                   5271:                         } else {
                   5272:                             if ($confhash->{$role}{'showlogo'}{$img} == 0) {
                   5273:                                 $changes{$role}{'showlogo'}{$img} = 1;
                   5274:                             }
                   5275:                         }
                   5276:                     }
                   5277:                 }
1.6       raeburn  5278:                 if ($domconfig->{$role}{'font'} ne '') {
                   5279:                     if ($confhash->{$role}{'font'} ne $domconfig->{$role}{'font'}) {
                   5280:                         $changes{$role}{'font'} = 1;
                   5281:                     }
                   5282:                 } else {
                   5283:                     if ($confhash->{$role}{'font'}) {
                   5284:                         $changes{$role}{'font'} = 1;
                   5285:                     }
                   5286:                 }
1.107     raeburn  5287:                 if ($role ne 'login') {
                   5288:                     if ($domconfig->{$role}{'fontmenu'} ne '') {
                   5289:                         if ($confhash->{$role}{'fontmenu'} ne $domconfig->{$role}{'fontmenu'}) {
                   5290:                             $changes{$role}{'fontmenu'} = 1;
                   5291:                         }
                   5292:                     } else {
                   5293:                         if ($confhash->{$role}{'fontmenu'}) {
                   5294:                             $changes{$role}{'fontmenu'} = 1;
                   5295:                         }
1.97      tempelho 5296:                     }
                   5297:                 }
1.6       raeburn  5298:                 foreach my $item (@bgs) {
                   5299:                     if ($domconfig->{$role}{$item} ne '') {
                   5300:                         if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
                   5301:                             $changes{$role}{'bgs'}{$item} = 1;
                   5302:                         } 
                   5303:                     } else {
                   5304:                         if ($confhash->{$role}{$item}) {
                   5305:                             $changes{$role}{'bgs'}{$item} = 1;
                   5306:                         }
                   5307:                     }
                   5308:                 }
                   5309:                 foreach my $item (@links) {
                   5310:                     if ($domconfig->{$role}{$item} ne '') {
                   5311:                         if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
                   5312:                             $changes{$role}{'links'}{$item} = 1;
                   5313:                         }
                   5314:                     } else {
                   5315:                         if ($confhash->{$role}{$item}) {
                   5316:                             $changes{$role}{'links'}{$item} = 1;
                   5317:                         }
                   5318:                     }
                   5319:                 }
1.41      raeburn  5320:                 foreach my $item (@logintext) {
                   5321:                     if ($domconfig->{$role}{$item} ne '') {
                   5322:                         if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
                   5323:                             $changes{$role}{'logintext'}{$item} = 1;
                   5324:                         }
                   5325:                     } else {
                   5326:                         if ($confhash->{$role}{$item}) {
                   5327:                             $changes{$role}{'logintext'}{$item} = 1;
                   5328:                         }
                   5329:                     }
                   5330:                 }
1.6       raeburn  5331:             } else {
                   5332:                 &default_change_checker($role,\@images,\@links,\@bgs,
1.41      raeburn  5333:                                         \@logintext,$confhash,\%changes); 
1.6       raeburn  5334:             }
                   5335:         } else {
                   5336:             &default_change_checker($role,\@images,\@links,\@bgs,
1.41      raeburn  5337:                                     \@logintext,$confhash,\%changes); 
1.6       raeburn  5338:         }
                   5339:     }
                   5340:     return ($errors,%changes);
                   5341: }
                   5342: 
1.46      raeburn  5343: sub config_check {
                   5344:     my ($dom,$confname,$servadm) = @_;
                   5345:     my ($configuserok,$author_ok,$switchserver,%currroles);
                   5346:     my $uhome = &Apache::lonnet::homeserver($confname,$dom,1);
                   5347:     ($configuserok,%currroles) = &check_configuser($uhome,$dom,
                   5348:                                                    $confname,$servadm);
                   5349:     if ($configuserok eq 'ok') {
                   5350:         $switchserver = &check_switchserver($dom,$confname);
                   5351:         if ($switchserver eq '') {
                   5352:             $author_ok = &check_authorstatus($dom,$confname,%currroles);
                   5353:         }
                   5354:     }
                   5355:     return ($configuserok,$author_ok,$switchserver);
                   5356: }
                   5357: 
1.6       raeburn  5358: sub default_change_checker {
1.41      raeburn  5359:     my ($role,$images,$links,$bgs,$logintext,$confhash,$changes) = @_;
1.6       raeburn  5360:     foreach my $item (@{$links}) {
                   5361:         if ($confhash->{$role}{$item}) {
                   5362:             $changes->{$role}{'links'}{$item} = 1;
                   5363:         }
                   5364:     }
                   5365:     foreach my $item (@{$bgs}) {
                   5366:         if ($confhash->{$role}{$item}) {
                   5367:             $changes->{$role}{'bgs'}{$item} = 1;
                   5368:         }
                   5369:     }
1.41      raeburn  5370:     foreach my $item (@{$logintext}) {
                   5371:         if ($confhash->{$role}{$item}) {
                   5372:             $changes->{$role}{'logintext'}{$item} = 1;
                   5373:         }
                   5374:     }
1.6       raeburn  5375:     foreach my $img (@{$images}) {
                   5376:         if ($env{'form.'.$role.'_del_'.$img}) {
                   5377:             $confhash->{$role}{$img} = '';
1.12      raeburn  5378:             $changes->{$role}{'images'}{$img} = 1;
1.6       raeburn  5379:         }
1.70      raeburn  5380:         if ($role eq 'login') {
                   5381:             if ($confhash->{$role}{'showlogo'}{$img} == 0) {
                   5382:                 $changes->{$role}{'showlogo'}{$img} = 1;
                   5383:             }
                   5384:         }
1.6       raeburn  5385:     }
                   5386:     if ($confhash->{$role}{'font'}) {
                   5387:         $changes->{$role}{'font'} = 1;
                   5388:     }
1.48      raeburn  5389: }
1.6       raeburn  5390: 
                   5391: sub display_colorchgs {
                   5392:     my ($dom,$changes,$roles,$confhash) = @_;
                   5393:     my (%choices,$resulttext);
                   5394:     if (!grep(/^login$/,@{$roles})) {
                   5395:         $resulttext = &mt('Changes made:').'<br />';
                   5396:     }
                   5397:     foreach my $role (@{$roles}) {
                   5398:         if ($role eq 'login') {
                   5399:             %choices = &login_choices();
                   5400:         } else {
                   5401:             %choices = &color_font_choices();
                   5402:         }
                   5403:         if (ref($changes->{$role}) eq 'HASH') {
                   5404:             if ($role ne 'login') {
                   5405:                 $resulttext .= '<h4>'.&mt($role).'</h4>';
                   5406:             }
                   5407:             foreach my $key (sort(keys(%{$changes->{$role}}))) {
                   5408:                 if ($role ne 'login') {
                   5409:                     $resulttext .= '<ul>';
                   5410:                 }
                   5411:                 if (ref($changes->{$role}{$key}) eq 'HASH') {
                   5412:                     if ($role ne 'login') {
                   5413:                         $resulttext .= '<li>'.&mt($choices{$key}).':<ul>';
                   5414:                     }
                   5415:                     foreach my $item (sort(keys(%{$changes->{$role}{$key}}))) {
1.70      raeburn  5416:                         if (($role eq 'login') && ($key eq 'showlogo')) {
                   5417:                             if ($confhash->{$role}{$key}{$item}) {
                   5418:                                 $resulttext .= '<li>'.&mt("$choices{$item} set to be displayed").'</li>';
                   5419:                             } else {
                   5420:                                 $resulttext .= '<li>'.&mt("$choices{$item} set to not be displayed").'</li>';
                   5421:                             }
                   5422:                         } elsif ($confhash->{$role}{$item} eq '') {
1.6       raeburn  5423:                             $resulttext .= '<li>'.&mt("$choices{$item} set to default").'</li>';
                   5424:                         } else {
1.12      raeburn  5425:                             my $newitem = $confhash->{$role}{$item};
                   5426:                             if ($key eq 'images') {
                   5427:                                 $newitem = '<img src="'.$confhash->{$role}{$item}.'" alt="'.$choices{$item}.'" valign="bottom" />';
                   5428:                             }
                   5429:                             $resulttext .= '<li>'.&mt("$choices{$item} set to [_1]",$newitem).'</li>';
1.6       raeburn  5430:                         }
                   5431:                     }
                   5432:                     if ($role ne 'login') {
                   5433:                         $resulttext .= '</ul></li>';
                   5434:                     }
                   5435:                 } else {
                   5436:                     if ($confhash->{$role}{$key} eq '') {
                   5437:                         $resulttext .= '<li>'.&mt("$choices{$key} set to default").'</li>';
                   5438:                     } else {
                   5439:                         $resulttext .= '<li>'.&mt("$choices{$key} set to [_1]",$confhash->{$role}{$key}).'</li>';
                   5440:                     }
                   5441:                 }
                   5442:                 if ($role ne 'login') {
                   5443:                     $resulttext .= '</ul>';
                   5444:                 }
                   5445:             }
                   5446:         }
                   5447:     }
1.3       raeburn  5448:     return $resulttext;
1.1       raeburn  5449: }
                   5450: 
1.9       raeburn  5451: sub thumb_dimensions {
                   5452:     return ('200','50');
                   5453: }
                   5454: 
1.16      raeburn  5455: sub check_dimensions {
                   5456:     my ($inputfile) = @_;
                   5457:     my ($fullwidth,$fullheight);
                   5458:     if ($inputfile =~ m|^[/\w.\-]+$|) {
                   5459:         if (open(PIPE,"identify $inputfile 2>&1 |")) {
                   5460:             my $imageinfo = <PIPE>;
                   5461:             if (!close(PIPE)) {
                   5462:                 &Apache::lonnet::logthis("Failed to close PIPE opened to retrieve image information for $inputfile");
                   5463:             }
                   5464:             chomp($imageinfo);
                   5465:             my ($fullsize) = 
1.21      raeburn  5466:                 ($imageinfo =~ /^\Q$inputfile\E\s+\w+\s+(\d+x\d+)/);
1.16      raeburn  5467:             if ($fullsize) {
                   5468:                 ($fullwidth,$fullheight) = split(/x/,$fullsize);
                   5469:             }
                   5470:         }
                   5471:     }
                   5472:     return ($fullwidth,$fullheight);
                   5473: }
                   5474: 
1.9       raeburn  5475: sub check_configuser {
                   5476:     my ($uhome,$dom,$confname,$servadm) = @_;
                   5477:     my ($configuserok,%currroles);
                   5478:     if ($uhome eq 'no_host') {
                   5479:         srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
                   5480:         my $configpass = &LONCAPA::Enrollment::create_password();
                   5481:         $configuserok = 
                   5482:             &Apache::lonnet::modifyuser($dom,$confname,'','internal',
                   5483:                              $configpass,'','','','','',undef,$servadm);
                   5484:     } else {
                   5485:         $configuserok = 'ok';
                   5486:         %currroles = 
                   5487:             &Apache::lonnet::get_my_roles($confname,$dom,'userroles');
                   5488:     }
                   5489:     return ($configuserok,%currroles);
                   5490: }
                   5491: 
                   5492: sub check_authorstatus {
                   5493:     my ($dom,$confname,%currroles) = @_;
                   5494:     my $author_ok;
1.40      raeburn  5495:     if (!$currroles{':'.$dom.':au'}) {
1.9       raeburn  5496:         my $start = time;
                   5497:         my $end = 0;
                   5498:         $author_ok = 
                   5499:             &Apache::lonnet::assignrole($dom,$confname,'/'.$dom.'/',
1.47      raeburn  5500:                                         'au',$end,$start,'','','domconfig');
1.9       raeburn  5501:     } else {
                   5502:         $author_ok = 'ok';
                   5503:     }
                   5504:     return $author_ok;
                   5505: }
                   5506: 
                   5507: sub publishlogo {
1.46      raeburn  5508:     my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight,$savefileas) = @_;
1.9       raeburn  5509:     my ($output,$fname,$logourl);
                   5510:     if ($action eq 'upload') {
                   5511:         $fname=$env{'form.'.$formname.'.filename'};
                   5512:         chop($env{'form.'.$formname});
                   5513:     } else {
                   5514:         ($fname) = ($formname =~ /([^\/]+)$/);
                   5515:     }
1.46      raeburn  5516:     if ($savefileas ne '') {
                   5517:         $fname = $savefileas;
                   5518:     }
1.9       raeburn  5519:     $fname=&Apache::lonnet::clean_filename($fname);
                   5520: # See if there is anything left
                   5521:     unless ($fname) { return ('error: no uploaded file'); }
                   5522:     $fname="$subdir/$fname";
1.160.6.5  raeburn  5523:     my $docroot=$r->dir_config('lonDocRoot');
                   5524:     my $filepath="$docroot/priv";
                   5525:     my $relpath = "$dom/$confname";
1.9       raeburn  5526:     my ($fnamepath,$file,$fetchthumb);
                   5527:     $file=$fname;
                   5528:     if ($fname=~m|/|) {
                   5529:         ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|);
                   5530:     }
1.160.6.26! raeburn  5531:     my @parts=split(/\//,"$filepath/$relpath/$fnamepath");
1.9       raeburn  5532:     my $count;
1.160.6.5  raeburn  5533:     for ($count=5;$count<=$#parts;$count++) {
1.9       raeburn  5534:         $filepath.="/$parts[$count]";
                   5535:         if ((-e $filepath)!=1) {
                   5536:             mkdir($filepath,02770);
                   5537:         }
                   5538:     }
                   5539:     # Check for bad extension and disallow upload
                   5540:     if ($file=~/\.(\w+)$/ &&
                   5541:         (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
                   5542:         $output = 
1.160.6.25  raeburn  5543:             &mt('Invalid file extension ([_1]) - reserved for internal use.',$1); 
1.9       raeburn  5544:     } elsif ($file=~/\.(\w+)$/ &&
                   5545:         !defined(&Apache::loncommon::fileembstyle($1))) {
                   5546:         $output = &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
                   5547:     } elsif ($file=~/\.(\d+)\.(\w+)$/) {
1.160.6.18  raeburn  5548:         $output = &mt('Filename not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
1.9       raeburn  5549:     } elsif (-d "$filepath/$file") {
1.160.6.18  raeburn  5550:         $output = &mt('Filename is a directory name - rename the file and re-upload');
1.9       raeburn  5551:     } else {
                   5552:         my $source = $filepath.'/'.$file;
                   5553:         my $logfile;
                   5554:         if (!open($logfile,">>$source".'.log')) {
1.160.6.19  raeburn  5555:             return (&mt('No write permission to Authoring Space'));
1.9       raeburn  5556:         }
                   5557:         print $logfile
                   5558: "\n================= Publish ".localtime()." ================\n".
                   5559: $env{'user.name'}.':'.$env{'user.domain'}."\n";
                   5560: # Save the file
                   5561:         if (!open(FH,'>'.$source)) {
                   5562:             &Apache::lonnet::logthis('Failed to create '.$source);
                   5563:             return (&mt('Failed to create file'));
                   5564:         }
                   5565:         if ($action eq 'upload') {
                   5566:             if (!print FH ($env{'form.'.$formname})) {
                   5567:                 &Apache::lonnet::logthis('Failed to write to '.$source);
                   5568:                 return (&mt('Failed to write file'));
                   5569:             }
                   5570:         } else {
                   5571:             my $original = &Apache::lonnet::filelocation('',$formname);
                   5572:             if(!copy($original,$source)) {
                   5573:                 &Apache::lonnet::logthis('Failed to copy '.$original.' to '.$source);
                   5574:                 return (&mt('Failed to write file'));
                   5575:             }
                   5576:         }
                   5577:         close(FH);
                   5578:         chmod(0660, $source); # Permissions to rw-rw---.
                   5579: 
                   5580:         my $targetdir=$docroot.'/res/'.$dom.'/'.$confname .'/'.$fnamepath;
                   5581:         my $copyfile=$targetdir.'/'.$file;
                   5582: 
                   5583:         my @parts=split(/\//,$targetdir);
                   5584:         my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
                   5585:         for (my $count=5;$count<=$#parts;$count++) {
                   5586:             $path.="/$parts[$count]";
                   5587:             if (!-e $path) {
                   5588:                 print $logfile "\nCreating directory ".$path;
                   5589:                 mkdir($path,02770);
                   5590:             }
                   5591:         }
                   5592:         my $versionresult;
                   5593:         if (-e $copyfile) {
                   5594:             $versionresult = &logo_versioning($targetdir,$file,$logfile);
                   5595:         } else {
                   5596:             $versionresult = 'ok';
                   5597:         }
                   5598:         if ($versionresult eq 'ok') {
                   5599:             if (copy($source,$copyfile)) {
                   5600:                 print $logfile "\nCopied original source to ".$copyfile."\n";
                   5601:                 $output = 'ok';
                   5602:                 $logourl = '/res/'.$dom.'/'.$confname.'/'.$fname;
1.155     raeburn  5603:                 push(@{$modified_urls},[$copyfile,$source]);
                   5604:                 my $metaoutput = 
                   5605:                     &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile);
                   5606:                 unless ($registered_cleanup) {
                   5607:                     my $handlers = $r->get_handlers('PerlCleanupHandler');
                   5608:                     $r->set_handlers('PerlCleanupHandler' => [\&notifysubscribed,@{$handlers}]);
                   5609:                     $registered_cleanup=1;
                   5610:                 }
1.9       raeburn  5611:             } else {
                   5612:                 print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
                   5613:                 $output = &mt('Failed to copy file to RES space').", $!";
                   5614:             }
                   5615:             if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
                   5616:                 my $inputfile = $filepath.'/'.$file;
                   5617:                 my $outfile = $filepath.'/'.'tn-'.$file;
1.16      raeburn  5618:                 my ($fullwidth,$fullheight) = &check_dimensions($inputfile);
                   5619:                 if ($fullwidth ne '' && $fullheight ne '') { 
                   5620:                     if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) {
                   5621:                         my $thumbsize = $thumbwidth.'x'.$thumbheight;
                   5622:                         system("convert -sample $thumbsize $inputfile $outfile");
                   5623:                         chmod(0660, $filepath.'/tn-'.$file);
                   5624:                         if (-e $outfile) {
                   5625:                             my $copyfile=$targetdir.'/tn-'.$file;
                   5626:                             if (copy($outfile,$copyfile)) {
                   5627:                                 print $logfile "\nCopied source to ".$copyfile."\n";
1.155     raeburn  5628:                                 my $thumb_metaoutput = 
                   5629:                                     &write_metadata($dom,$confname,$formname,
                   5630:                                                     $targetdir,'tn-'.$file,$logfile);
                   5631:                                 push(@{$modified_urls},[$copyfile,$outfile]);
                   5632:                                 unless ($registered_cleanup) {
                   5633:                                     my $handlers = $r->get_handlers('PerlCleanupHandler');
                   5634:                                     $r->set_handlers('PerlCleanupHandler' => [\&notifysubscribed,@{$handlers}]);
                   5635:                                     $registered_cleanup=1;
                   5636:                                 }
1.16      raeburn  5637:                             } else {
                   5638:                                 print $logfile "\nUnable to write ".$copyfile.
                   5639:                                                ':'.$!."\n";
                   5640:                             }
                   5641:                         }
1.9       raeburn  5642:                     }
                   5643:                 }
                   5644:             }
                   5645:         } else {
                   5646:             $output = $versionresult;
                   5647:         }
                   5648:     }
                   5649:     return ($output,$logourl);
                   5650: }
                   5651: 
                   5652: sub logo_versioning {
                   5653:     my ($targetdir,$file,$logfile) = @_;
                   5654:     my $target = $targetdir.'/'.$file;
                   5655:     my ($maxversion,$fn,$extn,$output);
                   5656:     $maxversion = 0;
                   5657:     if ($file =~ /^(.+)\.(\w+)$/) {
                   5658:         $fn=$1;
                   5659:         $extn=$2;
                   5660:     }
                   5661:     opendir(DIR,$targetdir);
                   5662:     while (my $filename=readdir(DIR)) {
                   5663:         if ($filename=~/\Q$fn\E\.(\d+)\.\Q$extn\E$/) {
                   5664:             $maxversion=($1>$maxversion)?$1:$maxversion;
                   5665:         }
                   5666:     }
                   5667:     $maxversion++;
                   5668:     print $logfile "\nCreating old version ".$maxversion."\n";
                   5669:     my $copyfile=$targetdir.'/'.$fn.'.'.$maxversion.'.'.$extn;
                   5670:     if (copy($target,$copyfile)) {
                   5671:         print $logfile "Copied old target to ".$copyfile."\n";
                   5672:         $copyfile=$copyfile.'.meta';
                   5673:         if (copy($target.'.meta',$copyfile)) {
                   5674:             print $logfile "Copied old target metadata to ".$copyfile."\n";
                   5675:             $output = 'ok';
                   5676:         } else {
                   5677:             print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
                   5678:             $output = &mt('Failed to copy old meta').", $!, ";
                   5679:         }
                   5680:     } else {
                   5681:         print $logfile "Unable to write ".$copyfile.':'.$!."\n";
                   5682:         $output = &mt('Failed to copy old target').", $!, ";
                   5683:     }
                   5684:     return $output;
                   5685: }
                   5686: 
                   5687: sub write_metadata {
                   5688:     my ($dom,$confname,$formname,$targetdir,$file,$logfile) = @_;
                   5689:     my (%metadatafields,%metadatakeys,$output);
                   5690:     $metadatafields{'title'}=$formname;
                   5691:     $metadatafields{'creationdate'}=time;
                   5692:     $metadatafields{'lastrevisiondate'}=time;
                   5693:     $metadatafields{'copyright'}='public';
                   5694:     $metadatafields{'modifyinguser'}=$env{'user.name'}.':'.
                   5695:                                          $env{'user.domain'};
                   5696:     $metadatafields{'authorspace'}=$confname.':'.$dom;
                   5697:     $metadatafields{'domain'}=$dom;
                   5698:     {
                   5699:         print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file;
                   5700:         my $mfh;
1.155     raeburn  5701:         if (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) {
1.160.6.13  raeburn  5702:             foreach (sort(keys(%metadatafields))) {
1.155     raeburn  5703:                 unless ($_=~/\./) {
                   5704:                     my $unikey=$_;
                   5705:                     $unikey=~/^([A-Za-z]+)/;
                   5706:                     my $tag=$1;
                   5707:                     $tag=~tr/A-Z/a-z/;
                   5708:                     print $mfh "\n\<$tag";
                   5709:                     foreach (split(/\,/,$metadatakeys{$unikey})) {
                   5710:                         my $value=$metadatafields{$unikey.'.'.$_};
                   5711:                         $value=~s/\"/\'\'/g;
                   5712:                         print $mfh ' '.$_.'="'.$value.'"';
                   5713:                     }
                   5714:                     print $mfh '>'.
                   5715:                         &HTML::Entities::encode($metadatafields{$unikey},'<>&"')
                   5716:                             .'</'.$tag.'>';
                   5717:                 }
                   5718:             }
                   5719:             $output = 'ok';
                   5720:             print $logfile "\nWrote metadata";
                   5721:             close($mfh);
                   5722:         } else {
                   5723:             print $logfile "\nFailed to open metadata file";
1.9       raeburn  5724:             $output = &mt('Could not write metadata');
                   5725:         }
                   5726:     }
1.155     raeburn  5727:     return $output;
                   5728: }
                   5729: 
                   5730: sub notifysubscribed {
                   5731:     foreach my $targetsource (@{$modified_urls}){
                   5732:         next unless (ref($targetsource) eq 'ARRAY');
                   5733:         my ($target,$source)=@{$targetsource};
                   5734:         if ($source ne '') {
                   5735:             if (open(my $logfh,'>>'.$source.'.log')) {
                   5736:                 print $logfh "\nCleanup phase: Notifications\n";
                   5737:                 my @subscribed=&subscribed_hosts($target);
                   5738:                 foreach my $subhost (@subscribed) {
                   5739:                     print $logfh "\nNotifying host ".$subhost.':';
                   5740:                     my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
                   5741:                     print $logfh $reply;
                   5742:                 }
                   5743:                 my @subscribedmeta=&subscribed_hosts("$target.meta");
                   5744:                 foreach my $subhost (@subscribedmeta) {
                   5745:                     print $logfh "\nNotifying host for metadata only ".$subhost.':';
                   5746:                     my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
                   5747:                                                         $subhost);
                   5748:                     print $logfh $reply;
                   5749:                 }
                   5750:                 print $logfh "\n============ Done ============\n";
1.160     raeburn  5751:                 close($logfh);
1.155     raeburn  5752:             }
                   5753:         }
                   5754:     }
                   5755:     return OK;
                   5756: }
                   5757: 
                   5758: sub subscribed_hosts {
                   5759:     my ($target) = @_;
                   5760:     my @subscribed;
                   5761:     if (open(my $fh,"<$target.subscription")) {
                   5762:         while (my $subline=<$fh>) {
                   5763:             if ($subline =~ /^($match_lonid):/) {
                   5764:                 my $host = $1;
                   5765:                 if ($host ne $Apache::lonnet::perlvar{'lonHostID'}) {
                   5766:                     unless (grep(/^\Q$host\E$/,@subscribed)) {
                   5767:                         push(@subscribed,$host);
                   5768:                     }
                   5769:                 }
                   5770:             }
                   5771:         }
                   5772:     }
                   5773:     return @subscribed;
1.9       raeburn  5774: }
                   5775: 
                   5776: sub check_switchserver {
                   5777:     my ($dom,$confname) = @_;
                   5778:     my ($allowed,$switchserver);
                   5779:     my $home = &Apache::lonnet::homeserver($confname,$dom);
                   5780:     if ($home eq 'no_host') {
                   5781:         $home = &Apache::lonnet::domain($dom,'primary');
                   5782:     }
                   5783:     my @ids=&Apache::lonnet::current_machine_ids();
1.10      albertel 5784:     foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
                   5785:     if (!$allowed) {
1.160.6.11  raeburn  5786: 	$switchserver='<a href="/adm/switchserver?otherserver='.$home.'&amp;role=dc./'.$dom.'/&amp;destinationurl=/adm/domainprefs">'.&mt('Switch Server').'</a>';
1.9       raeburn  5787:     }
                   5788:     return $switchserver;
                   5789: }
                   5790: 
1.1       raeburn  5791: sub modify_quotas {
1.86      raeburn  5792:     my ($dom,$action,%domconfig) = @_;
1.101     raeburn  5793:     my ($context,@usertools,@options,%validations,%titles,%confhash,%toolshash,
                   5794:         %limithash,$toolregexp,%conditions,$resulttext,%changes);
1.86      raeburn  5795:     if ($action eq 'quotas') {
                   5796:         $context = 'tools'; 
1.160.6.26! raeburn  5797:     } else {
1.86      raeburn  5798:         $context = $action;
                   5799:     }
                   5800:     if ($context eq 'requestcourses') {
1.98      raeburn  5801:         @usertools = ('official','unofficial','community');
1.106     raeburn  5802:         @options =('norequest','approval','validate','autolimit');
1.101     raeburn  5803:         %validations = &Apache::lonnet::auto_courserequest_checks($dom);
                   5804:         %titles = &courserequest_titles();
                   5805:         $toolregexp = join('|',@usertools);
                   5806:         %conditions = &courserequest_conditions();
1.160.6.5  raeburn  5807:     } elsif ($context eq 'requestauthor') {
                   5808:         @usertools = ('author');
                   5809:         %titles = &authorrequest_titles();
1.86      raeburn  5810:     } else {
1.160.6.4  raeburn  5811:         @usertools = ('aboutme','blog','webdav','portfolio');
1.101     raeburn  5812:         %titles = &tool_titles();
1.86      raeburn  5813:     }
1.72      raeburn  5814:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
1.44      raeburn  5815:     my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
1.1       raeburn  5816:     foreach my $key (keys(%env)) {
1.101     raeburn  5817:         if ($context eq 'requestcourses') {
                   5818:             if ($key =~ /^form\.crsreq_($toolregexp)_(.+)$/) {
                   5819:                 my $item = $1;
                   5820:                 my $type = $2;
                   5821:                 if ($type =~ /^limit_(.+)/) {
                   5822:                     $limithash{$item}{$1} = $env{$key};
                   5823:                 } else {
                   5824:                     $confhash{$item}{$type} = $env{$key};
                   5825:                 }
                   5826:             }
1.160.6.5  raeburn  5827:         } elsif ($context eq 'requestauthor') {
                   5828:             if ($key =~ /^\Qform.authorreq_\E(.+)$/) {
                   5829:                 $confhash{$1} = $env{$key};
                   5830:             }
1.101     raeburn  5831:         } else {
1.86      raeburn  5832:             if ($key =~ /^form\.quota_(.+)$/) {
                   5833:                 $confhash{'defaultquota'}{$1} = $env{$key};
1.160.6.20  raeburn  5834:             } elsif ($key =~ /^form\.authorquota_(.+)$/) {
                   5835:                 $confhash{'authorquota'}{$1} = $env{$key};
                   5836:             } elsif ($key =~ /^form\.\Q$context\E_(.+)$/) {
1.101     raeburn  5837:                 @{$toolshash{$1}} = &Apache::loncommon::get_env_multiple($key);
                   5838:             }
1.72      raeburn  5839:         }
                   5840:     }
1.160.6.5  raeburn  5841:     if (($context eq 'requestcourses') || ($context eq 'requestauthor')) {
1.102     raeburn  5842:         my @approvalnotify = &Apache::loncommon::get_env_multiple('form.reqapprovalnotify');
                   5843:         @approvalnotify = sort(@approvalnotify);
                   5844:         $confhash{'notify'}{'approval'} = join(',',@approvalnotify);
                   5845:         if (ref($domconfig{$action}) eq 'HASH') {
                   5846:             if (ref($domconfig{$action}{'notify'}) eq 'HASH') {
                   5847:                 if ($domconfig{$action}{'notify'}{'approval'} ne $confhash{'notify'}{'approval'}) {
                   5848:                     $changes{'notify'}{'approval'} = 1;
                   5849:                 }
                   5850:             } else {
1.144     raeburn  5851:                 if ($confhash{'notify'}{'approval'}) {
1.102     raeburn  5852:                     $changes{'notify'}{'approval'} = 1;
                   5853:                 }
                   5854:             }
                   5855:         } else {
1.144     raeburn  5856:             if ($confhash{'notify'}{'approval'}) {
1.102     raeburn  5857:                 $changes{'notify'}{'approval'} = 1;
                   5858:             }
                   5859:         }
                   5860:     } else {
1.86      raeburn  5861:         $confhash{'defaultquota'}{'default'} = $env{'form.defaultquota'};
1.160.6.20  raeburn  5862:         $confhash{'authorquota'}{'default'} = $env{'form.authorquota'};
1.86      raeburn  5863:     }
1.72      raeburn  5864:     foreach my $item (@usertools) {
                   5865:         foreach my $type (@{$types},'default','_LC_adv') {
1.104     raeburn  5866:             my $unset; 
1.101     raeburn  5867:             if ($context eq 'requestcourses') {
1.104     raeburn  5868:                 $unset = '0';
                   5869:                 if ($type eq '_LC_adv') {
                   5870:                     $unset = '';
                   5871:                 }
1.101     raeburn  5872:                 if ($confhash{$item}{$type} eq 'autolimit') {
                   5873:                     $confhash{$item}{$type} .= '=';
                   5874:                     unless ($limithash{$item}{$type} =~ /\D/) {
                   5875:                         $confhash{$item}{$type} .= $limithash{$item}{$type};
                   5876:                     }
                   5877:                 }
1.160.6.5  raeburn  5878:             } elsif ($context eq 'requestauthor') {
                   5879:                 $unset = '0';
                   5880:                 if ($type eq '_LC_adv') {
                   5881:                     $unset = '';
                   5882:                 }
1.72      raeburn  5883:             } else {
1.101     raeburn  5884:                 if (grep(/^\Q$type\E$/,@{$toolshash{$item}})) {
                   5885:                     $confhash{$item}{$type} = 1;
                   5886:                 } else {
                   5887:                     $confhash{$item}{$type} = 0;
                   5888:                 }
1.72      raeburn  5889:             }
1.86      raeburn  5890:             if (ref($domconfig{$action}) eq 'HASH') {
1.160.6.5  raeburn  5891:                 if ($action eq 'requestauthor') {
                   5892:                     if ($domconfig{$action}{$type} ne $confhash{$type}) {
                   5893:                         $changes{$type} = 1;
                   5894:                     }
                   5895:                 } elsif (ref($domconfig{$action}{$item}) eq 'HASH') {
1.86      raeburn  5896:                     if ($domconfig{$action}{$item}{$type} ne $confhash{$item}{$type}) {
                   5897:                         $changes{$item}{$type} = 1;
                   5898:                     }
                   5899:                 } else {
                   5900:                     if ($context eq 'requestcourses') {
1.104     raeburn  5901:                         if ($confhash{$item}{$type} ne $unset) {
1.86      raeburn  5902:                             $changes{$item}{$type} = 1;
                   5903:                         }
                   5904:                     } else {
                   5905:                         if (!$confhash{$item}{$type}) {
                   5906:                             $changes{$item}{$type} = 1;
                   5907:                         }
                   5908:                     }
                   5909:                 }
                   5910:             } else {
                   5911:                 if ($context eq 'requestcourses') {
1.104     raeburn  5912:                     if ($confhash{$item}{$type} ne $unset) {
1.72      raeburn  5913:                         $changes{$item}{$type} = 1;
                   5914:                     }
1.160.6.5  raeburn  5915:                 } elsif ($context eq 'requestauthor') {
                   5916:                     if ($confhash{$type} ne $unset) {
                   5917:                         $changes{$type} = 1;
                   5918:                     }
1.72      raeburn  5919:                 } else {
                   5920:                     if (!$confhash{$item}{$type}) {
                   5921:                         $changes{$item}{$type} = 1;
                   5922:                     }
                   5923:                 }
                   5924:             }
1.1       raeburn  5925:         }
                   5926:     }
1.160.6.5  raeburn  5927:     unless (($context eq 'requestcourses') || ($context eq 'requestauthor')) {
1.86      raeburn  5928:         if (ref($domconfig{'quotas'}) eq 'HASH') {
                   5929:             if (ref($domconfig{'quotas'}{'defaultquota'}) eq 'HASH') {
                   5930:                 foreach my $key (keys(%{$domconfig{'quotas'}{'defaultquota'}})) {
                   5931:                     if (exists($confhash{'defaultquota'}{$key})) {
                   5932:                         if ($confhash{'defaultquota'}{$key} ne $domconfig{'quotas'}{'defaultquota'}{$key}) {
                   5933:                             $changes{'defaultquota'}{$key} = 1;
                   5934:                         }
                   5935:                     } else {
                   5936:                         $confhash{'defaultquota'}{$key} = $domconfig{'quotas'}{'defaultquota'}{$key};
1.72      raeburn  5937:                     }
                   5938:                 }
1.86      raeburn  5939:             } else {
                   5940:                 foreach my $key (keys(%{$domconfig{'quotas'}})) {
                   5941:                     if (exists($confhash{'defaultquota'}{$key})) {
                   5942:                         if ($confhash{'defaultquota'}{$key} ne $domconfig{'quotas'}{$key}) {
                   5943:                             $changes{'defaultquota'}{$key} = 1;
                   5944:                         }
                   5945:                     } else {
                   5946:                         $confhash{'defaultquota'}{$key} = $domconfig{'quotas'}{$key};
1.72      raeburn  5947:                     }
1.1       raeburn  5948:                 }
                   5949:             }
1.160.6.20  raeburn  5950:             if (ref($domconfig{'quotas'}{'authorquota'}) eq 'HASH') {
                   5951:                 foreach my $key (keys(%{$domconfig{'quotas'}{'authorquota'}})) {
                   5952:                     if (exists($confhash{'authorquota'}{$key})) {
                   5953:                         if ($confhash{'authorquota'}{$key} ne $domconfig{'quotas'}{'authorquota'}{$key}) {
                   5954:                             $changes{'authorquota'}{$key} = 1;
                   5955:                         }
                   5956:                     } else {
                   5957:                         $confhash{'authorquota'}{$key} = $domconfig{'quotas'}{'authorquota'}{$key};
                   5958:                     }
                   5959:                 }
                   5960:             }
1.1       raeburn  5961:         }
1.86      raeburn  5962:         if (ref($confhash{'defaultquota'}) eq 'HASH') {
                   5963:             foreach my $key (keys(%{$confhash{'defaultquota'}})) {
                   5964:                 if (ref($domconfig{'quotas'}) eq 'HASH') {
                   5965:                     if (ref($domconfig{'quotas'}{'defaultquota'}) eq 'HASH') {
                   5966:                         if (!exists($domconfig{'quotas'}{'defaultquota'}{$key})) {
                   5967:                             $changes{'defaultquota'}{$key} = 1;
                   5968:                         }
                   5969:                     } else {
                   5970:                         if (!exists($domconfig{'quotas'}{$key})) {
                   5971:                             $changes{'defaultquota'}{$key} = 1;
                   5972:                         }
1.72      raeburn  5973:                     }
                   5974:                 } else {
1.86      raeburn  5975:                     $changes{'defaultquota'}{$key} = 1;
1.55      raeburn  5976:                 }
1.1       raeburn  5977:             }
                   5978:         }
1.160.6.20  raeburn  5979:         if (ref($confhash{'authorquota'}) eq 'HASH') {
                   5980:             foreach my $key (keys(%{$confhash{'authorquota'}})) {
                   5981:                 if (ref($domconfig{'quotas'}) eq 'HASH') {
                   5982:                     if (ref($domconfig{'quotas'}{'authorquota'}) eq 'HASH') {
                   5983:                         if (!exists($domconfig{'quotas'}{'authorquota'}{$key})) {
                   5984:                             $changes{'authorquota'}{$key} = 1;
                   5985:                         }
                   5986:                     } else {
                   5987:                         $changes{'authorquota'}{$key} = 1;
                   5988:                     }
                   5989:                 } else {
                   5990:                     $changes{'authorquota'}{$key} = 1;
                   5991:                 }
                   5992:             }
                   5993:         }
1.1       raeburn  5994:     }
1.72      raeburn  5995: 
1.160.6.5  raeburn  5996:     if ($context eq 'requestauthor') {
                   5997:         $domdefaults{'requestauthor'} = \%confhash;
                   5998:     } else {
                   5999:         foreach my $key (keys(%confhash)) {
                   6000:             $domdefaults{$key} = $confhash{$key};
                   6001:         }
1.72      raeburn  6002:     }
1.160.6.5  raeburn  6003: 
1.1       raeburn  6004:     my %quotahash = (
1.86      raeburn  6005:                       $action => { %confhash }
1.1       raeburn  6006:                     );
                   6007:     my $putresult = &Apache::lonnet::put_dom('configuration',\%quotahash,
                   6008:                                              $dom);
                   6009:     if ($putresult eq 'ok') {
                   6010:         if (keys(%changes) > 0) {
1.72      raeburn  6011:             my $cachetime = 24*60*60;
                   6012:             &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime);
                   6013: 
1.1       raeburn  6014:             $resulttext = &mt('Changes made:').'<ul>';
1.160.6.5  raeburn  6015:             unless (($context eq 'requestcourses') ||
                   6016:                     ($context eq 'requestauthor')) {
1.86      raeburn  6017:                 if (ref($changes{'defaultquota'}) eq 'HASH') {
                   6018:                     $resulttext .= '<li>'.&mt('Portfolio default quotas').'<ul>';
                   6019:                     foreach my $type (@{$types},'default') {
                   6020:                         if (defined($changes{'defaultquota'}{$type})) {
                   6021:                             my $typetitle = $usertypes->{$type};
                   6022:                             if ($type eq 'default') {
                   6023:                                 $typetitle = $othertitle;
                   6024:                             }
                   6025:                             $resulttext .= '<li>'.&mt('[_1] set to [_2] Mb',$typetitle,$confhash{'defaultquota'}{$type}).'</li>';
1.72      raeburn  6026:                         }
                   6027:                     }
1.86      raeburn  6028:                     $resulttext .= '</ul></li>';
1.72      raeburn  6029:                 }
1.160.6.20  raeburn  6030:                 if (ref($changes{'authorquota'}) eq 'HASH') {
                   6031:                     $resulttext .= '<li>'.&mt('Authoring space default quotas').'<ul>';
                   6032:                     foreach my $type (@{$types},'default') {
                   6033:                         if (defined($changes{'authorquota'}{$type})) {
                   6034:                             my $typetitle = $usertypes->{$type};
                   6035:                             if ($type eq 'default') {
                   6036:                                 $typetitle = $othertitle;
                   6037:                             }
                   6038:                             $resulttext .= '<li>'.&mt('[_1] set to [_2] Mb',$typetitle,$confhash{'authorquota'}{$type}).'</li>';
                   6039:                         }
                   6040:                     }
                   6041:                     $resulttext .= '</ul></li>';
                   6042:                 }
1.72      raeburn  6043:             }
1.80      raeburn  6044:             my %newenv;
1.72      raeburn  6045:             foreach my $item (@usertools) {
1.160.6.5  raeburn  6046:                 my (%haschgs,%inconf);
                   6047:                 if ($context eq 'requestauthor') {
                   6048:                     %haschgs = %changes;
                   6049:                     %inconf = %confhash;
                   6050:                 } else {
                   6051:                     if (ref($changes{$item}) eq 'HASH') {
                   6052:                         %haschgs = %{$changes{$item}};
                   6053:                     }
                   6054:                     if (ref($confhash{$item}) eq 'HASH') {
                   6055:                         %inconf = %{$confhash{$item}};
                   6056:                     }
                   6057:                 }
                   6058:                 if (keys(%haschgs) > 0) {
1.80      raeburn  6059:                     my $newacc = 
                   6060:                         &Apache::lonnet::usertools_access($env{'user.name'},
                   6061:                                                           $env{'user.domain'},
1.86      raeburn  6062:                                                           $item,'reload',$context);
1.160.6.5  raeburn  6063:                     if (($context eq 'requestcourses') ||
                   6064:                         ($context eq 'requestauthor')) {
1.108     raeburn  6065:                         if ($env{'environment.canrequest.'.$item} ne $newacc) {
                   6066:                             $newenv{'environment.canrequest.'.$item} = $newacc;
1.86      raeburn  6067:                         }
                   6068:                     } else {
                   6069:                         if ($env{'environment.availabletools.'.$item} ne $newacc) { 
                   6070:                             $newenv{'environment.availabletools.'.$item} = $newacc;
                   6071:                         }
1.80      raeburn  6072:                     }
1.160.6.5  raeburn  6073:                     unless ($context eq 'requestauthor') {
                   6074:                         $resulttext .= '<li>'.$titles{$item}.'<ul>';
                   6075:                     }
1.72      raeburn  6076:                     foreach my $type (@{$types},'default','_LC_adv') {
1.160.6.5  raeburn  6077:                         if ($haschgs{$type}) {
1.72      raeburn  6078:                             my $typetitle = $usertypes->{$type};
                   6079:                             if ($type eq 'default') {
                   6080:                                 $typetitle = $othertitle;
                   6081:                             } elsif ($type eq '_LC_adv') {
                   6082:                                 $typetitle = 'LON-CAPA Advanced Users'; 
                   6083:                             }
1.160.6.5  raeburn  6084:                             if ($inconf{$type}) {
1.101     raeburn  6085:                                 if ($context eq 'requestcourses') {
                   6086:                                     my $cond;
1.160.6.5  raeburn  6087:                                     if ($inconf{$type} =~ /^autolimit=(\d*)$/) {
1.101     raeburn  6088:                                         if ($1 eq '') {
                   6089:                                             $cond = &mt('(Automatic processing of any request).');
                   6090:                                         } else {
                   6091:                                             $cond = &mt('(Automatic processing of requests up to limit of [quant,_1,request] per user).',$1);
                   6092:                                         }
                   6093:                                     } else { 
1.160.6.5  raeburn  6094:                                         $cond = $conditions{$inconf{$type}};
1.101     raeburn  6095:                                     }
                   6096:                                     $resulttext .= '<li>'.&mt('Set to be available to [_1].',$typetitle).' '.$cond.'</li>';
1.160.6.8  raeburn  6097:                                 } elsif ($context eq 'requestauthor') {
                   6098:                                     $resulttext .= '<li>'.&mt('Set to "[_1]" for "[_2]".',
                   6099:                                                              $titles{$inconf{$type}},$typetitle);
                   6100: 
1.101     raeburn  6101:                                 } else {
                   6102:                                     $resulttext .= '<li>'.&mt('Set to be available to [_1]',$typetitle).'</li>';
                   6103:                                 }
1.72      raeburn  6104:                             } else {
1.104     raeburn  6105:                                 if ($type eq '_LC_adv') {
1.160.6.5  raeburn  6106:                                     if ($inconf{$type} eq '0') {
1.104     raeburn  6107:                                         $resulttext .= '<li>'.&mt('Set to be unavailable to [_1]',$typetitle).'</li>';
                   6108:                                     } else { 
                   6109:                                         $resulttext .= '<li>'.&mt('No override set for [_1]',$typetitle).'</li>';
                   6110:                                     }
                   6111:                                 } else {
                   6112:                                     $resulttext .= '<li>'.&mt('Set to be unavailable to [_1]',$typetitle).'</li>';
                   6113:                                 }
1.72      raeburn  6114:                             }
                   6115:                         }
1.26      raeburn  6116:                     }
1.160.6.5  raeburn  6117:                     unless ($context eq 'requestauthor') {
                   6118:                         $resulttext .= '</ul></li>';
                   6119:                     }
1.26      raeburn  6120:                 }
1.1       raeburn  6121:             }
1.160.6.5  raeburn  6122:             if (($action eq 'requestcourses') || ($action eq 'requestauthor')) {
1.102     raeburn  6123:                 if (ref($changes{'notify'}) eq 'HASH') {
                   6124:                     if ($changes{'notify'}{'approval'}) {
                   6125:                         if (ref($confhash{'notify'}) eq 'HASH') {
                   6126:                             if ($confhash{'notify'}{'approval'}) {
                   6127:                                 $resulttext .= '<li>'.&mt('Notification of requests requiring approval will be sent to: ').$confhash{'notify'}{'approval'}.'</li>';
                   6128:                             } else {
1.160.6.5  raeburn  6129:                                 $resulttext .= '<li>'.&mt('No Domain Coordinators will receive notification of requests requiring approval.').'</li>';
1.102     raeburn  6130:                             }
                   6131:                         }
                   6132:                     }
                   6133:                 }
                   6134:             }
1.1       raeburn  6135:             $resulttext .= '</ul>';
1.80      raeburn  6136:             if (keys(%newenv)) {
                   6137:                 &Apache::lonnet::appenv(\%newenv);
                   6138:             }
1.1       raeburn  6139:         } else {
1.86      raeburn  6140:             if ($context eq 'requestcourses') {
                   6141:                 $resulttext = &mt('No changes made to rights to request creation of courses.');
1.160.6.5  raeburn  6142:             } elsif ($context eq 'requestauthor') {
                   6143:                 $resulttext = &mt('No changes made to rights to request author space.');
1.86      raeburn  6144:             } else {
1.90      weissno  6145:                 $resulttext = &mt('No changes made to availability of personal information pages, blogs, portfolios or default quotas');
1.86      raeburn  6146:             }
1.1       raeburn  6147:         }
                   6148:     } else {
1.11      albertel 6149:         $resulttext = '<span class="LC_error">'.
                   6150: 	    &mt('An error occurred: [_1]',$putresult).'</span>';
1.1       raeburn  6151:     }
1.3       raeburn  6152:     return $resulttext;
1.1       raeburn  6153: }
                   6154: 
1.3       raeburn  6155: sub modify_autoenroll {
1.160.6.24  raeburn  6156:     my ($dom,$lastactref,%domconfig) = @_;
1.1       raeburn  6157:     my ($resulttext,%changes);
                   6158:     my %currautoenroll;
                   6159:     if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   6160:         foreach my $key (keys(%{$domconfig{'autoenroll'}})) {
                   6161:             $currautoenroll{$key} = $domconfig{'autoenroll'}{$key};
                   6162:         }
                   6163:     }
                   6164:     my $autorun = &Apache::lonnet::auto_run(undef,$dom),
                   6165:     my %title = ( run => 'Auto-enrollment active',
1.129     raeburn  6166:                   sender => 'Sender for notification messages',
                   6167:                   coowners => 'Automatic assignment of co-ownership to instructors of record (institutional data)');
1.1       raeburn  6168:     my @offon = ('off','on');
1.17      raeburn  6169:     my $sender_uname = $env{'form.sender_uname'};
                   6170:     my $sender_domain = $env{'form.sender_domain'};
                   6171:     if ($sender_domain eq '') {
                   6172:         $sender_uname = '';
                   6173:     } elsif ($sender_uname eq '') {
                   6174:         $sender_domain = '';
                   6175:     }
1.129     raeburn  6176:     my $coowners = $env{'form.autoassign_coowners'};
1.1       raeburn  6177:     my %autoenrollhash =  (
1.129     raeburn  6178:                        autoenroll => { 'run' => $env{'form.autoenroll_run'},
                   6179:                                        'sender_uname' => $sender_uname,
                   6180:                                        'sender_domain' => $sender_domain,
                   6181:                                        'co-owners' => $coowners,
1.1       raeburn  6182:                                 }
                   6183:                      );
1.4       raeburn  6184:     my $putresult = &Apache::lonnet::put_dom('configuration',\%autoenrollhash,
                   6185:                                              $dom);
1.1       raeburn  6186:     if ($putresult eq 'ok') {
                   6187:         if (exists($currautoenroll{'run'})) {
                   6188:              if ($currautoenroll{'run'} ne $env{'form.autoenroll_run'}) {
                   6189:                  $changes{'run'} = 1;
                   6190:              }
                   6191:         } elsif ($autorun) {
                   6192:             if ($env{'form.autoenroll_run'} ne '1') {
1.23      raeburn  6193:                  $changes{'run'} = 1;
1.1       raeburn  6194:             }
                   6195:         }
1.17      raeburn  6196:         if ($currautoenroll{'sender_uname'} ne $sender_uname) {
1.1       raeburn  6197:             $changes{'sender'} = 1;
                   6198:         }
1.17      raeburn  6199:         if ($currautoenroll{'sender_domain'} ne $sender_domain) {
1.1       raeburn  6200:             $changes{'sender'} = 1;
                   6201:         }
1.129     raeburn  6202:         if ($currautoenroll{'co-owners'} ne '') {
                   6203:             if ($currautoenroll{'co-owners'} ne $coowners) {
                   6204:                 $changes{'coowners'} = 1;
                   6205:             }
                   6206:         } elsif ($coowners) {
                   6207:             $changes{'coowners'} = 1;
                   6208:         }      
1.1       raeburn  6209:         if (keys(%changes) > 0) {
                   6210:             $resulttext = &mt('Changes made:').'<ul>';
1.3       raeburn  6211:             if ($changes{'run'}) {
1.1       raeburn  6212:                 $resulttext .= '<li>'.&mt("$title{'run'} set to $offon[$env{'form.autoenroll_run'}]").'</li>';
                   6213:             }
                   6214:             if ($changes{'sender'}) {
1.17      raeburn  6215:                 if ($sender_uname eq '' || $sender_domain eq '') {
                   6216:                     $resulttext .= '<li>'.&mt("$title{'sender'} set to default (course owner).").'</li>';
                   6217:                 } else {
                   6218:                     $resulttext .= '<li>'.&mt("$title{'sender'} set to [_1]",$sender_uname.':'.$sender_domain).'</li>';
                   6219:                 }
1.1       raeburn  6220:             }
1.129     raeburn  6221:             if ($changes{'coowners'}) {
                   6222:                 $resulttext .= '<li>'.&mt("$title{'coowners'} set to $offon[$env{'form.autoassign_coowners'}]").'</li>';
                   6223:                 &Apache::loncommon::devalidate_domconfig_cache($dom);
1.160.6.24  raeburn  6224:                 $$lastactref = 'update';
1.129     raeburn  6225:             }
1.1       raeburn  6226:             $resulttext .= '</ul>';
                   6227:         } else {
                   6228:             $resulttext = &mt('No changes made to auto-enrollment settings');
                   6229:         }
                   6230:     } else {
1.11      albertel 6231:         $resulttext = '<span class="LC_error">'.
                   6232: 	    &mt('An error occurred: [_1]',$putresult).'</span>';
1.1       raeburn  6233:     }
1.3       raeburn  6234:     return $resulttext;
1.1       raeburn  6235: }
                   6236: 
                   6237: sub modify_autoupdate {
1.3       raeburn  6238:     my ($dom,%domconfig) = @_;
1.1       raeburn  6239:     my ($resulttext,%currautoupdate,%fields,%changes);
                   6240:     if (ref($domconfig{'autoupdate'}) eq 'HASH') {
                   6241:         foreach my $key (keys(%{$domconfig{'autoupdate'}})) {
                   6242:             $currautoupdate{$key} = $domconfig{'autoupdate'}{$key};
                   6243:         }
                   6244:     }
                   6245:     my @offon = ('off','on');
                   6246:     my %title = &Apache::lonlocal::texthash (
                   6247:                    run => 'Auto-update:',
                   6248:                    classlists => 'Updates to user information in classlists?'
                   6249:                 );
1.44      raeburn  6250:     my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
1.1       raeburn  6251:     my %fieldtitles = &Apache::lonlocal::texthash (
                   6252:                         id => 'Student/Employee ID',
1.20      raeburn  6253:                         permanentemail => 'E-mail address',
1.1       raeburn  6254:                         lastname => 'Last Name',
                   6255:                         firstname => 'First Name',
                   6256:                         middlename => 'Middle Name',
1.132     raeburn  6257:                         generation => 'Generation',
1.1       raeburn  6258:                       );
1.142     raeburn  6259:     $othertitle = &mt('All users');
1.1       raeburn  6260:     if (keys(%{$usertypes}) >  0) {
1.26      raeburn  6261:         $othertitle = &mt('Other users');
1.1       raeburn  6262:     }
                   6263:     foreach my $key (keys(%env)) {
                   6264:         if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) {
1.132     raeburn  6265:             my ($usertype,$item) = ($1,$2);
                   6266:             if (grep(/^\Q$item\E$/,keys(%fieldtitles))) {
                   6267:                 if ($usertype eq 'default') {   
                   6268:                     push(@{$fields{$1}},$2);
                   6269:                 } elsif (ref($types) eq 'ARRAY') {
                   6270:                     if (grep(/^\Q$usertype\E$/,@{$types})) {
                   6271:                         push(@{$fields{$1}},$2);
                   6272:                     }
                   6273:                 }
                   6274:             }
1.1       raeburn  6275:         }
                   6276:     }
1.131     raeburn  6277:     my @lockablenames = &Apache::loncommon::get_env_multiple('form.lockablenames');
                   6278:     @lockablenames = sort(@lockablenames);
                   6279:     if (ref($currautoupdate{'lockablenames'}) eq 'ARRAY') {
                   6280:         my @changed = &Apache::loncommon::compare_arrays($currautoupdate{'lockablenames'},\@lockablenames);
                   6281:         if (@changed) {
                   6282:             $changes{'lockablenames'} = 1;
                   6283:         }
                   6284:     } else {
                   6285:         if (@lockablenames) {
                   6286:             $changes{'lockablenames'} = 1;
                   6287:         }
                   6288:     }
1.1       raeburn  6289:     my %updatehash = (
                   6290:                       autoupdate => { run => $env{'form.autoupdate_run'},
                   6291:                                       classlists => $env{'form.classlists'},
                   6292:                                       fields => {%fields},
1.131     raeburn  6293:                                       lockablenames => \@lockablenames,
1.1       raeburn  6294:                                     }
                   6295:                      );
                   6296:     foreach my $key (keys(%currautoupdate)) {
                   6297:         if (($key eq 'run') || ($key eq 'classlists')) {
                   6298:             if (exists($updatehash{autoupdate}{$key})) {
                   6299:                 if ($currautoupdate{$key} ne $updatehash{autoupdate}{$key}) {
                   6300:                     $changes{$key} = 1;
                   6301:                 }
                   6302:             }
                   6303:         } elsif ($key eq 'fields') {
                   6304:             if (ref($currautoupdate{$key}) eq 'HASH') {
1.26      raeburn  6305:                 foreach my $item (@{$types},'default') {
1.1       raeburn  6306:                     if (ref($currautoupdate{$key}{$item}) eq 'ARRAY') {
                   6307:                         my $change = 0;
                   6308:                         foreach my $type (@{$currautoupdate{$key}{$item}}) {
                   6309:                             if (!exists($fields{$item})) {
                   6310:                                 $change = 1;
1.132     raeburn  6311:                                 last;
1.1       raeburn  6312:                             } elsif (ref($fields{$item}) eq 'ARRAY') {
1.26      raeburn  6313:                                 if (!grep(/^\Q$type\E$/,@{$fields{$item}})) {
1.1       raeburn  6314:                                     $change = 1;
1.132     raeburn  6315:                                     last;
1.1       raeburn  6316:                                 }
                   6317:                             }
                   6318:                         }
                   6319:                         if ($change) {
                   6320:                             push(@{$changes{$key}},$item);
                   6321:                         }
1.26      raeburn  6322:                     } 
1.1       raeburn  6323:                 }
                   6324:             }
1.131     raeburn  6325:         } elsif ($key eq 'lockablenames') {
                   6326:             if (ref($currautoupdate{$key}) eq 'ARRAY') {
                   6327:                 my @changed = &Apache::loncommon::compare_arrays($currautoupdate{'lockablenames'},\@lockablenames);
                   6328:                 if (@changed) {
                   6329:                     $changes{'lockablenames'} = 1;
                   6330:                 }
                   6331:             } else {
                   6332:                 if (@lockablenames) {
                   6333:                     $changes{'lockablenames'} = 1;
                   6334:                 }
                   6335:             }
                   6336:         }
                   6337:     }
                   6338:     unless (grep(/^\Qlockablenames\E$/,keys(%currautoupdate))) {
                   6339:         if (@lockablenames) {
                   6340:             $changes{'lockablenames'} = 1;
1.1       raeburn  6341:         }
                   6342:     }
1.26      raeburn  6343:     foreach my $item (@{$types},'default') {
                   6344:         if (defined($fields{$item})) {
                   6345:             if (ref($currautoupdate{'fields'}) eq 'HASH') {
1.132     raeburn  6346:                 if (ref($currautoupdate{'fields'}{$item}) eq 'ARRAY') {
                   6347:                     my $change = 0;
                   6348:                     if (ref($fields{$item}) eq 'ARRAY') {
                   6349:                         foreach my $type (@{$fields{$item}}) {
                   6350:                             if (!grep(/^\Q$type\E$/,@{$currautoupdate{'fields'}{$item}})) {
                   6351:                                 $change = 1;
                   6352:                                 last;
                   6353:                             }
                   6354:                         }
                   6355:                     }
                   6356:                     if ($change) {
                   6357:                         push(@{$changes{'fields'}},$item);
                   6358:                     }
                   6359:                 } else {
1.26      raeburn  6360:                     push(@{$changes{'fields'}},$item);
                   6361:                 }
                   6362:             } else {
                   6363:                 push(@{$changes{'fields'}},$item);
1.1       raeburn  6364:             }
                   6365:         }
                   6366:     }
                   6367:     my $putresult = &Apache::lonnet::put_dom('configuration',\%updatehash,
                   6368:                                              $dom);
                   6369:     if ($putresult eq 'ok') {
                   6370:         if (keys(%changes) > 0) {
                   6371:             $resulttext = &mt('Changes made:').'<ul>';
                   6372:             foreach my $key (sort(keys(%changes))) {
1.131     raeburn  6373:                 if ($key eq 'lockablenames') {
                   6374:                     $resulttext .= '<li>';
                   6375:                     if (@lockablenames) {
                   6376:                         $usertypes->{'default'} = $othertitle;
                   6377:                         $resulttext .= &mt("User preference to disable replacement of user's name with institutional data (by auto-update), available for the following affiliations:").' '.
                   6378:                                    join(', ', map { $usertypes->{$_}; } @lockablenames).'</li>';
                   6379:                     } else {
                   6380:                         $resulttext .= &mt("User preference to disable replacement of user's name with institutional data (by auto-update) is unavailable.");
                   6381:                     }
                   6382:                     $resulttext .= '</li>';
                   6383:                 } elsif (ref($changes{$key}) eq 'ARRAY') {
1.1       raeburn  6384:                     foreach my $item (@{$changes{$key}}) {
                   6385:                         my @newvalues;
                   6386:                         foreach my $type (@{$fields{$item}}) {
                   6387:                             push(@newvalues,$fieldtitles{$type});
                   6388:                         }
1.3       raeburn  6389:                         my $newvaluestr;
                   6390:                         if (@newvalues > 0) {
                   6391:                             $newvaluestr = join(', ',@newvalues);
                   6392:                         } else {
                   6393:                             $newvaluestr = &mt('none');
1.6       raeburn  6394:                         }
1.1       raeburn  6395:                         if ($item eq 'default') {
1.26      raeburn  6396:                             $resulttext .= '<li>'.&mt("Updates for '[_1]' set to: '[_2]'",$othertitle,$newvaluestr).'</li>';
1.1       raeburn  6397:                         } else {
1.26      raeburn  6398:                             $resulttext .= '<li>'.&mt("Updates for '[_1]' set to: '[_2]'",$usertypes->{$item},$newvaluestr).'</li>';
1.1       raeburn  6399:                         }
                   6400:                     }
                   6401:                 } else {
                   6402:                     my $newvalue;
                   6403:                     if ($key eq 'run') {
                   6404:                         $newvalue = $offon[$env{'form.autoupdate_run'}];
                   6405:                     } else {
                   6406:                         $newvalue = $offon[$env{'form.'.$key}];
1.3       raeburn  6407:                     }
1.1       raeburn  6408:                     $resulttext .= '<li>'.&mt("[_1] set to $newvalue",$title{$key}).'</li>';
                   6409:                 }
                   6410:             }
                   6411:             $resulttext .= '</ul>';
                   6412:         } else {
1.3       raeburn  6413:             $resulttext = &mt('No changes made to autoupdates');
1.1       raeburn  6414:         }
                   6415:     } else {
1.11      albertel 6416:         $resulttext = '<span class="LC_error">'.
                   6417: 	    &mt('An error occurred: [_1]',$putresult).'</span>';
1.1       raeburn  6418:     }
1.3       raeburn  6419:     return $resulttext;
1.1       raeburn  6420: }
                   6421: 
1.125     raeburn  6422: sub modify_autocreate {
                   6423:     my ($dom,%domconfig) = @_;
                   6424:     my ($resulttext,%changes,%currautocreate,%newvals,%autocreatehash);
                   6425:     if (ref($domconfig{'autocreate'}) eq 'HASH') {
                   6426:         foreach my $key (keys(%{$domconfig{'autocreate'}})) {
                   6427:             $currautocreate{$key} = $domconfig{'autocreate'}{$key};
                   6428:         }
                   6429:     }
                   6430:     my %title= ( xml => 'Auto-creation of courses in XML course description files',
                   6431:                  req => 'Auto-creation of validated requests for official courses',
                   6432:                  xmldc => 'Identity of course creator of courses from XML files',
                   6433:                );
                   6434:     my @types = ('xml','req');
                   6435:     foreach my $item (@types) {
                   6436:         $newvals{$item} = $env{'form.autocreate_'.$item};
                   6437:         $newvals{$item} =~ s/\D//g;
                   6438:         $newvals{$item} = 0 if ($newvals{$item} eq '');
                   6439:     }
                   6440:     $newvals{'xmldc'} = $env{'form.autocreate_xmldc'};
                   6441:     my %domcoords = &get_active_dcs($dom);
                   6442:     unless (exists($domcoords{$newvals{'xmldc'}})) {
                   6443:         $newvals{'xmldc'} = '';
                   6444:     } 
                   6445:     %autocreatehash =  (
                   6446:                         autocreate => { xml => $newvals{'xml'},
                   6447:                                         req => $newvals{'req'},
                   6448:                                       }
                   6449:                        );
                   6450:     if ($newvals{'xmldc'} ne '') {
                   6451:         $autocreatehash{'autocreate'}{'xmldc'} = $newvals{'xmldc'};
                   6452:     }
                   6453:     my $putresult = &Apache::lonnet::put_dom('configuration',\%autocreatehash,
                   6454:                                              $dom);
                   6455:     if ($putresult eq 'ok') {
                   6456:         my @items = @types;
                   6457:         if ($newvals{'xml'}) {
                   6458:             push(@items,'xmldc');
                   6459:         }
                   6460:         foreach my $item (@items) {
                   6461:             if (exists($currautocreate{$item})) {
                   6462:                 if ($currautocreate{$item} ne $newvals{$item}) {
                   6463:                     $changes{$item} = 1;
                   6464:                 }
                   6465:             } elsif ($newvals{$item}) {
                   6466:                 $changes{$item} = 1;
                   6467:             }
                   6468:         }
                   6469:         if (keys(%changes) > 0) {
                   6470:             my @offon = ('off','on'); 
                   6471:             $resulttext = &mt('Changes made:').'<ul>';
                   6472:             foreach my $item (@types) {
                   6473:                 if ($changes{$item}) {
                   6474:                     my $newtxt = $offon[$newvals{$item}];
1.160.6.13  raeburn  6475:                     $resulttext .= '<li>'.
                   6476:                                    &mt("$title{$item} set to [_1]$newtxt [_2]",
                   6477:                                        '<b>','</b>').
                   6478:                                    '</li>';
1.125     raeburn  6479:                 }
                   6480:             }
                   6481:             if ($changes{'xmldc'}) {
                   6482:                 my ($dcname,$dcdom) = split(':',$newvals{'xmldc'});
                   6483:                 my $newtxt = &Apache::loncommon::plainname($dcname,$dcdom);
1.160.6.13  raeburn  6484:                 $resulttext .= '<li>'.&mt("$title{'xmldc'} set to [_1]",'<b>'.$newtxt.'</b>').'</li>'; 
1.125     raeburn  6485:             }
                   6486:             $resulttext .= '</ul>';
                   6487:         } else {
                   6488:             $resulttext = &mt('No changes made to auto-creation settings');
                   6489:         }
                   6490:     } else {
                   6491:         $resulttext = '<span class="LC_error">'.
                   6492:             &mt('An error occurred: [_1]',$putresult).'</span>';
                   6493:     }
                   6494:     return $resulttext;
                   6495: }
                   6496: 
1.23      raeburn  6497: sub modify_directorysrch {
                   6498:     my ($dom,%domconfig) = @_;
                   6499:     my ($resulttext,%changes);
                   6500:     my %currdirsrch;
                   6501:     if (ref($domconfig{'directorysrch'}) eq 'HASH') {
                   6502:         foreach my $key (keys(%{$domconfig{'directorysrch'}})) {
                   6503:             $currdirsrch{$key} = $domconfig{'directorysrch'}{$key};
                   6504:         }
                   6505:     }
                   6506:     my %title = ( available => 'Directory search available',
1.24      raeburn  6507:                   localonly => 'Other domains can search',
1.23      raeburn  6508:                   searchby => 'Search types',
                   6509:                   searchtypes => 'Search latitude');
                   6510:     my @offon = ('off','on');
1.24      raeburn  6511:     my @otherdoms = ('Yes','No');
1.23      raeburn  6512: 
1.25      raeburn  6513:     my @searchtypes = &Apache::loncommon::get_env_multiple('form.searchtypes');  
1.23      raeburn  6514:     my @cansearch = &Apache::loncommon::get_env_multiple('form.cansearch');
                   6515:     my @searchby = &Apache::loncommon::get_env_multiple('form.searchby');
                   6516: 
1.44      raeburn  6517:     my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
1.26      raeburn  6518:     if (keys(%{$usertypes}) == 0) {
                   6519:         @cansearch = ('default');
                   6520:     } else {
                   6521:         if (ref($currdirsrch{'cansearch'}) eq 'ARRAY') {
                   6522:             foreach my $type (@{$currdirsrch{'cansearch'}}) {
                   6523:                 if (!grep(/^\Q$type\E$/,@cansearch)) {
                   6524:                     push(@{$changes{'cansearch'}},$type);
                   6525:                 }
1.23      raeburn  6526:             }
1.26      raeburn  6527:             foreach my $type (@cansearch) {
                   6528:                 if (!grep(/^\Q$type\E$/,@{$currdirsrch{'cansearch'}})) {
                   6529:                     push(@{$changes{'cansearch'}},$type);
                   6530:                 }
1.23      raeburn  6531:             }
1.26      raeburn  6532:         } else {
                   6533:             push(@{$changes{'cansearch'}},@cansearch);
1.23      raeburn  6534:         }
                   6535:     }
                   6536: 
                   6537:     if (ref($currdirsrch{'searchby'}) eq 'ARRAY') {
                   6538:         foreach my $by (@{$currdirsrch{'searchby'}}) {
                   6539:             if (!grep(/^\Q$by\E$/,@searchby)) {
                   6540:                 push(@{$changes{'searchby'}},$by);
                   6541:             }
                   6542:         }
                   6543:         foreach my $by (@searchby) {
                   6544:             if (!grep(/^\Q$by\E$/,@{$currdirsrch{'searchby'}})) {
                   6545:                 push(@{$changes{'searchby'}},$by);
                   6546:             }
                   6547:         }
                   6548:     } else {
                   6549:         push(@{$changes{'searchby'}},@searchby);
                   6550:     }
1.25      raeburn  6551: 
                   6552:     if (ref($currdirsrch{'searchtypes'}) eq 'ARRAY') {
                   6553:         foreach my $type (@{$currdirsrch{'searchtypes'}}) {
                   6554:             if (!grep(/^\Q$type\E$/,@searchtypes)) {
                   6555:                 push(@{$changes{'searchtypes'}},$type);
                   6556:             }
                   6557:         }
                   6558:         foreach my $type (@searchtypes) {
                   6559:             if (!grep(/^\Q$type\E$/,@{$currdirsrch{'searchtypes'}})) {
                   6560:                 push(@{$changes{'searchtypes'}},$type);
                   6561:             }
                   6562:         }
                   6563:     } else {
                   6564:         if (exists($currdirsrch{'searchtypes'})) {
                   6565:             foreach my $type (@searchtypes) {  
                   6566:                 if ($type ne $currdirsrch{'searchtypes'}) { 
                   6567:                     push(@{$changes{'searchtypes'}},$type);
                   6568:                 }
                   6569:             }
                   6570:             if (!grep(/^\Q$currdirsrch{'searchtypes'}\E/,@searchtypes)) {
                   6571:                 push(@{$changes{'searchtypes'}},$currdirsrch{'searchtypes'});
                   6572:             }   
                   6573:         } else {
                   6574:             push(@{$changes{'searchtypes'}},@searchtypes); 
                   6575:         }
                   6576:     }
                   6577: 
1.23      raeburn  6578:     my %dirsrch_hash =  (
                   6579:             directorysrch => { available => $env{'form.dirsrch_available'},
                   6580:                                cansearch => \@cansearch,
1.24      raeburn  6581:                                localonly => $env{'form.dirsrch_localonly'},
1.23      raeburn  6582:                                searchby => \@searchby,
1.25      raeburn  6583:                                searchtypes => \@searchtypes,
1.23      raeburn  6584:                              }
                   6585:             );
                   6586:     my $putresult = &Apache::lonnet::put_dom('configuration',\%dirsrch_hash,
                   6587:                                              $dom);
                   6588:     if ($putresult eq 'ok') {
                   6589:         if (exists($currdirsrch{'available'})) {
                   6590:              if ($currdirsrch{'available'} ne $env{'form.dirsrch_available'}) {
                   6591:                  $changes{'available'} = 1;
                   6592:              }
                   6593:         } else {
                   6594:             if ($env{'form.dirsrch_available'} eq '1') {
                   6595:                 $changes{'available'} = 1;
                   6596:             }
                   6597:         }
1.24      raeburn  6598:         if (exists($currdirsrch{'localonly'})) {
                   6599:              if ($currdirsrch{'localonly'} ne $env{'form.dirsrch_localonly'}) {
                   6600:                  $changes{'localonly'} = 1;
                   6601:              }
                   6602:         } else {
                   6603:             if ($env{'form.dirsrch_localonly'} eq '1') {
                   6604:                 $changes{'localonly'} = 1;
                   6605:             }
                   6606:         }
1.23      raeburn  6607:         if (keys(%changes) > 0) {
                   6608:             $resulttext = &mt('Changes made:').'<ul>';
                   6609:             if ($changes{'available'}) {
                   6610:                 $resulttext .= '<li>'.&mt("$title{'available'} set to: $offon[$env{'form.dirsrch_available'}]").'</li>';
                   6611:             }
1.24      raeburn  6612:             if ($changes{'localonly'}) {
                   6613:                 $resulttext .= '<li>'.&mt("$title{'localonly'} set to: $otherdoms[$env{'form.dirsrch_localonly'}]").'</li>';
                   6614:             }
                   6615: 
1.23      raeburn  6616:             if (ref($changes{'cansearch'}) eq 'ARRAY') {
                   6617:                 my $chgtext;
1.26      raeburn  6618:                 if (ref($usertypes) eq 'HASH') {
                   6619:                     if (keys(%{$usertypes}) > 0) {
                   6620:                         foreach my $type (@{$types}) {
                   6621:                             if (grep(/^\Q$type\E$/,@cansearch)) {
                   6622:                                 $chgtext .= $usertypes->{$type}.'; ';
                   6623:                             }
                   6624:                         }
                   6625:                         if (grep(/^default$/,@cansearch)) {
                   6626:                             $chgtext .= $othertitle;
                   6627:                         } else {
                   6628:                             $chgtext =~ s/\; $//;
                   6629:                         }
1.160.6.13  raeburn  6630:                         $resulttext .=
                   6631:                             '<li>'.
                   6632:                             &mt("Users from domain '[_1]' permitted to search the institutional directory set to: [_2]",
                   6633:                                 '<span class="LC_cusr_emph">'.$dom.'</span>',$chgtext).
                   6634:                             '</li>';
1.23      raeburn  6635:                     }
                   6636:                 }
                   6637:             }
                   6638:             if (ref($changes{'searchby'}) eq 'ARRAY') {
                   6639:                 my ($searchtitles,$titleorder) = &sorted_searchtitles();
                   6640:                 my $chgtext;
                   6641:                 foreach my $type (@{$titleorder}) {
                   6642:                     if (grep(/^\Q$type\E$/,@searchby)) {
                   6643:                         if (defined($searchtitles->{$type})) {
                   6644:                             $chgtext .= $searchtitles->{$type}.'; ';
                   6645:                         }
                   6646:                     }
                   6647:                 }
                   6648:                 $chgtext =~ s/\; $//;
                   6649:                 $resulttext .= '<li>'.&mt("$title{'searchby'} set to: [_1]",$chgtext).'</li>';
                   6650:             }
1.25      raeburn  6651:             if (ref($changes{'searchtypes'}) eq 'ARRAY') {
                   6652:                 my ($srchtypes_desc,$srchtypeorder) = &sorted_searchtypes(); 
                   6653:                 my $chgtext;
                   6654:                 foreach my $type (@{$srchtypeorder}) {
                   6655:                     if (grep(/^\Q$type\E$/,@searchtypes)) {
                   6656:                         if (defined($srchtypes_desc->{$type})) {
                   6657:                             $chgtext .= $srchtypes_desc->{$type}.'; ';
                   6658:                         }
                   6659:                     }
                   6660:                 }
                   6661:                 $chgtext =~ s/\; $//;
1.160.6.13  raeburn  6662:                 $resulttext .= '<li>'.&mt($title{'searchtypes'}.' set to: "[_1]"',$chgtext).'</li>';
1.23      raeburn  6663:             }
                   6664:             $resulttext .= '</ul>';
                   6665:         } else {
                   6666:             $resulttext = &mt('No changes made to institution directory search settings');
                   6667:         }
                   6668:     } else {
                   6669:         $resulttext = '<span class="LC_error">'.
1.27      raeburn  6670:                       &mt('An error occurred: [_1]',$putresult).'</span>';
                   6671:     }
                   6672:     return $resulttext;
                   6673: }
                   6674: 
1.28      raeburn  6675: sub modify_contacts {
1.160.6.24  raeburn  6676:     my ($dom,$lastactref,%domconfig) = @_;
1.28      raeburn  6677:     my ($resulttext,%currsetting,%newsetting,%changes,%contacts_hash);
                   6678:     if (ref($domconfig{'contacts'}) eq 'HASH') {
                   6679:         foreach my $key (keys(%{$domconfig{'contacts'}})) {
                   6680:             $currsetting{$key} = $domconfig{'contacts'}{$key};
                   6681:         }
                   6682:     }
1.134     raeburn  6683:     my (%others,%to,%bcc);
1.28      raeburn  6684:     my @contacts = ('supportemail','adminemail');
1.102     raeburn  6685:     my @mailings = ('errormail','packagesmail','helpdeskmail','lonstatusmail',
1.160.6.23  raeburn  6686:                     'requestsmail','updatesmail','idconflictsmail');
                   6687:     my @toggles = ('reporterrors','reportupdates');
1.28      raeburn  6688:     foreach my $type (@mailings) {
                   6689:         @{$newsetting{$type}} = 
                   6690:             &Apache::loncommon::get_env_multiple('form.'.$type);
                   6691:         foreach my $item (@contacts) {
                   6692:             if (grep(/^\Q$item\E$/,@{$newsetting{$type}})) {
                   6693:                 $contacts_hash{contacts}{$type}{$item} = 1;
                   6694:             } else {
                   6695:                 $contacts_hash{contacts}{$type}{$item} = 0;
                   6696:             }
                   6697:         }  
                   6698:         $others{$type} = $env{'form.'.$type.'_others'};
                   6699:         $contacts_hash{contacts}{$type}{'others'} = $others{$type};
1.134     raeburn  6700:         if ($type eq 'helpdeskmail') {
                   6701:             $bcc{$type} = $env{'form.'.$type.'_bcc'};
                   6702:             $contacts_hash{contacts}{$type}{'bcc'} = $bcc{$type};
                   6703:         }
1.28      raeburn  6704:     }
                   6705:     foreach my $item (@contacts) {
                   6706:         $to{$item} = $env{'form.'.$item};
                   6707:         $contacts_hash{'contacts'}{$item} = $to{$item};
                   6708:     }
1.160.6.23  raeburn  6709:     foreach my $item (@toggles) {
                   6710:         if ($env{'form.'.$item} =~ /^(0|1)$/) {
                   6711:             $contacts_hash{'contacts'}{$item} = $env{'form.'.$item};
                   6712:         }
                   6713:     }
1.28      raeburn  6714:     if (keys(%currsetting) > 0) {
                   6715:         foreach my $item (@contacts) {
                   6716:             if ($to{$item} ne $currsetting{$item}) {
                   6717:                 $changes{$item} = 1;
                   6718:             }
                   6719:         }
                   6720:         foreach my $type (@mailings) {
                   6721:             foreach my $item (@contacts) {
                   6722:                 if (ref($currsetting{$type}) eq 'HASH') {
                   6723:                     if ($currsetting{$type}{$item} ne $contacts_hash{contacts}{$type}{$item}) {
                   6724:                         push(@{$changes{$type}},$item);
                   6725:                     }
                   6726:                 } else {
                   6727:                     push(@{$changes{$type}},@{$newsetting{$type}});
                   6728:                 }
                   6729:             }
                   6730:             if ($others{$type} ne $currsetting{$type}{'others'}) {
                   6731:                 push(@{$changes{$type}},'others');
                   6732:             }
1.134     raeburn  6733:             if ($type eq 'helpdeskmail') {   
                   6734:                 if ($bcc{$type} ne $currsetting{$type}{'bcc'}) {
                   6735:                     push(@{$changes{$type}},'bcc'); 
                   6736:                 }
                   6737:             }
1.28      raeburn  6738:         }
                   6739:     } else {
                   6740:         my %default;
                   6741:         $default{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'};
                   6742:         $default{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'};
                   6743:         $default{'errormail'} = 'adminemail';
                   6744:         $default{'packagesmail'} = 'adminemail';
                   6745:         $default{'helpdeskmail'} = 'supportemail';
1.89      raeburn  6746:         $default{'lonstatusmail'} = 'adminemail';
1.102     raeburn  6747:         $default{'requestsmail'} = 'adminemail';
1.160.6.15  raeburn  6748:         $default{'updatesmail'} = 'adminemail';
1.28      raeburn  6749:         foreach my $item (@contacts) {
                   6750:            if ($to{$item} ne $default{$item}) {
                   6751:               $changes{$item} = 1;
1.160.6.23  raeburn  6752:            }
1.28      raeburn  6753:         }
                   6754:         foreach my $type (@mailings) {
                   6755:             if ((@{$newsetting{$type}} != 1) || ($newsetting{$type}[0] ne $default{$type})) {
                   6756:                
                   6757:                 push(@{$changes{$type}},@{$newsetting{$type}});
                   6758:             }
                   6759:             if ($others{$type} ne '') {
                   6760:                 push(@{$changes{$type}},'others');
1.134     raeburn  6761:             }
                   6762:             if ($type eq 'helpdeskmail') {
                   6763:                 if ($bcc{$type} ne '') {
                   6764:                     push(@{$changes{$type}},'bcc');
                   6765:                 }
                   6766:             }
1.28      raeburn  6767:         }
                   6768:     }
1.160.6.23  raeburn  6769:     foreach my $item (@toggles) {
                   6770:         if (($env{'form.'.$item} == 1) && ($currsetting{$item} == 0)) {
                   6771:             $changes{$item} = 1;
                   6772:         } elsif ((!$env{'form.'.$item}) &&
                   6773:                  (($currsetting{$item} eq '') || ($currsetting{$item} == 1))) {
                   6774:             $changes{$item} = 1;
                   6775:         }
                   6776:     }
1.28      raeburn  6777:     my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash,
                   6778:                                              $dom);
                   6779:     if ($putresult eq 'ok') {
                   6780:         if (keys(%changes) > 0) {
1.160.6.24  raeburn  6781:             &Apache::loncommon::devalidate_domconfig_cache($dom);
                   6782:             $$lastactref = 'update';
1.28      raeburn  6783:             my ($titles,$short_titles)  = &contact_titles();
                   6784:             $resulttext = &mt('Changes made:').'<ul>';
                   6785:             foreach my $item (@contacts) {
                   6786:                 if ($changes{$item}) {
                   6787:                     $resulttext .= '<li>'.$titles->{$item}.
                   6788:                                     &mt(' set to: ').
                   6789:                                     '<span class="LC_cusr_emph">'.
                   6790:                                     $to{$item}.'</span></li>';
                   6791:                 }
                   6792:             }
                   6793:             foreach my $type (@mailings) {
                   6794:                 if (ref($changes{$type}) eq 'ARRAY') {
                   6795:                     $resulttext .= '<li>'.$titles->{$type}.': ';
                   6796:                     my @text;
                   6797:                     foreach my $item (@{$newsetting{$type}}) {
                   6798:                         push(@text,$short_titles->{$item});
                   6799:                     }
                   6800:                     if ($others{$type} ne '') {
                   6801:                         push(@text,$others{$type});
                   6802:                     }
                   6803:                     $resulttext .= '<span class="LC_cusr_emph">'.
1.134     raeburn  6804:                                    join(', ',@text).'</span>';
                   6805:                     if ($type eq 'helpdeskmail') {
                   6806:                         if ($bcc{$type} ne '') {
                   6807:                             $resulttext .= '&nbsp;'.&mt('with Bcc to').': <span class="LC_cusr_emph">'.$bcc{$type}.'</span>';
                   6808:                         }
                   6809:                     }
                   6810:                     $resulttext .= '</li>';
1.28      raeburn  6811:                 }
                   6812:             }
1.160.6.23  raeburn  6813:             my @offon = ('off','on');
                   6814:             if ($changes{'reporterrors'}) {
                   6815:                 $resulttext .= '<li>'.
                   6816:                                &mt('E-mail error reports to [_1] set to "'.
                   6817:                                    $offon[$env{'form.reporterrors'}].'".',
                   6818:                                    &Apache::loncommon::modal_link('http://loncapa.org/core.html',
                   6819:                                        &mt('LON-CAPA core group - MSU'),600,500)).
                   6820:                                '</li>';
                   6821:             }
                   6822:             if ($changes{'reportupdates'}) {
                   6823:                 $resulttext .= '<li>'.
                   6824:                                 &mt('E-mail record of completed LON-CAPA updates to [_1] set to "'.
                   6825:                                     $offon[$env{'form.reportupdates'}].'".',
                   6826:                                     &Apache::loncommon::modal_link('http://loncapa.org/core.html',
                   6827:                                         &mt('LON-CAPA core group - MSU'),600,500)).
                   6828:                                 '</li>';
                   6829:             }
1.28      raeburn  6830:             $resulttext .= '</ul>';
                   6831:         } else {
1.34      raeburn  6832:             $resulttext = &mt('No changes made to contact information');
1.28      raeburn  6833:         }
                   6834:     } else {
                   6835:         $resulttext = '<span class="LC_error">'.
                   6836:             &mt('An error occurred: [_1].',$putresult).'</span>';
                   6837:     }
                   6838:     return $resulttext;
                   6839: }
                   6840: 
                   6841: sub modify_usercreation {
1.27      raeburn  6842:     my ($dom,%domconfig) = @_;
1.34      raeburn  6843:     my ($resulttext,%curr_usercreation,%changes,%authallowed,%cancreate);
1.43      raeburn  6844:     my $warningmsg;
1.27      raeburn  6845:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   6846:         foreach my $key (keys(%{$domconfig{'usercreation'}})) {
                   6847:             $curr_usercreation{$key} = $domconfig{'usercreation'}{$key};
                   6848:         }
                   6849:     }
                   6850:     my @username_rule = &Apache::loncommon::get_env_multiple('form.username_rule');
1.32      raeburn  6851:     my @id_rule = &Apache::loncommon::get_env_multiple('form.id_rule');
1.43      raeburn  6852:     my @email_rule = &Apache::loncommon::get_env_multiple('form.email_rule');
1.100     raeburn  6853:     my @contexts = ('author','course','requestcrs','selfcreate');
1.34      raeburn  6854:     foreach my $item(@contexts) {
1.45      raeburn  6855:         if ($item eq 'selfcreate') {
1.50      raeburn  6856:             @{$cancreate{$item}} = &Apache::loncommon::get_env_multiple('form.can_createuser_'.$item);
1.43      raeburn  6857:             my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   6858:             if (!((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth'))) {
1.50      raeburn  6859:                 if (ref($cancreate{$item}) eq 'ARRAY') { 
                   6860:                     if (grep(/^login$/,@{$cancreate{$item}})) {
                   6861:                         $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.');   
                   6862:                     }
1.43      raeburn  6863:                 }
                   6864:             }
1.50      raeburn  6865:         } else {
                   6866:             $cancreate{$item} = $env{'form.can_createuser_'.$item};
1.43      raeburn  6867:         }
1.34      raeburn  6868:     }
1.93      raeburn  6869:     my ($othertitle,$usertypes,$types) = 
                   6870:         &Apache::loncommon::sorted_inst_types($dom);
                   6871:     if (ref($types) eq 'ARRAY') {
                   6872:         if (@{$types} > 0) {
                   6873:             @{$cancreate{'statustocreate'}} = 
                   6874:                 &Apache::loncommon::get_env_multiple('form.statustocreate');
1.103     raeburn  6875:         } else {
                   6876:             @{$cancreate{'statustocreate'}} = ();
1.93      raeburn  6877:         }
                   6878:         push(@contexts,'statustocreate');
                   6879:     }
1.160.6.5  raeburn  6880:     &process_captcha('cancreate',\%changes,\%cancreate,\%curr_usercreation);
1.34      raeburn  6881:     if (ref($curr_usercreation{'cancreate'}) eq 'HASH') {
                   6882:         foreach my $item (@contexts) {
1.93      raeburn  6883:             if (($item eq 'selfcreate') || ($item eq 'statustocreate')) {
                   6884:                 if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
1.50      raeburn  6885:                     foreach my $curr (@{$curr_usercreation{'cancreate'}{$item}}) {
1.103     raeburn  6886:                         if (ref($cancreate{$item}) eq 'ARRAY') {
                   6887:                             if (!grep(/^$curr$/,@{$cancreate{$item}})) {
                   6888:                                 if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                   6889:                                     push(@{$changes{'cancreate'}},$item);
                   6890:                                 }
1.50      raeburn  6891:                             }
                   6892:                         }
                   6893:                     }
                   6894:                 } else {
                   6895:                     if ($curr_usercreation{'cancreate'}{$item} eq '') {
                   6896:                         if (@{$cancreate{$item}} > 0) {
                   6897:                             if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                   6898:                                 push(@{$changes{'cancreate'}},$item);
                   6899:                             }
                   6900:                         }
                   6901:                     } else {
                   6902:                         if ($curr_usercreation{'cancreate'}{$item} eq 'any') {
                   6903:                             if (@{$cancreate{$item}} < 3) {
                   6904:                                 if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                   6905:                                     push(@{$changes{'cancreate'}},$item);
                   6906:                                 }
                   6907:                             }
                   6908:                         } elsif ($curr_usercreation{'cancreate'}{$item} eq 'none') {
                   6909:                             if (@{$cancreate{$item}} > 0) {
                   6910:                                 if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                   6911:                                     push(@{$changes{'cancreate'}},$item);
                   6912:                                 }
                   6913:                             }
                   6914:                         } elsif (!grep(/^$curr_usercreation{'cancreate'}{$item}$/,@{$cancreate{$item}})) {
                   6915:                             if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                   6916:                                 push(@{$changes{'cancreate'}},$item);
                   6917:                             }
                   6918:                         }
                   6919:                     }
                   6920:                 }
                   6921:                 if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                   6922:                     foreach my $type (@{$cancreate{$item}}) {
                   6923:                         if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
                   6924:                             if (!grep(/^$type$/,@{$curr_usercreation{'cancreate'}{$item}})) {
                   6925:                                 if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                   6926:                                     push(@{$changes{'cancreate'}},$item);
                   6927:                                 }
                   6928:                             }
                   6929:                         } elsif (($curr_usercreation{'cancreate'}{$item} ne 'any') &&
                   6930:                                  ($curr_usercreation{'cancreate'}{$item} ne 'none')) {
                   6931:                             if ($curr_usercreation{'cancreate'}{$item} ne $type) {
                   6932:                                 if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                   6933:                                     push(@{$changes{'cancreate'}},$item);
                   6934:                                 }
                   6935:                             }
                   6936:                         }
                   6937:                     }
                   6938:                 }
                   6939:             } else {
                   6940:                 if ($curr_usercreation{'cancreate'}{$item} ne $cancreate{$item}) {
                   6941:                     push(@{$changes{'cancreate'}},$item);
                   6942:                 }
                   6943:             }
1.27      raeburn  6944:         }
1.34      raeburn  6945:     } elsif (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') {
                   6946:         foreach my $item (@contexts) {
1.43      raeburn  6947:             if (!grep(/^\Q$item\E$/,@{$curr_usercreation{'cancreate'}})) {
1.34      raeburn  6948:                 if ($cancreate{$item} ne 'any') {
                   6949:                     push(@{$changes{'cancreate'}},$item);
                   6950:                 }
                   6951:             } else {
                   6952:                 if ($cancreate{$item} ne 'none') {
                   6953:                     push(@{$changes{'cancreate'}},$item);
                   6954:                 }
1.27      raeburn  6955:             }
                   6956:         }
                   6957:     } else {
1.43      raeburn  6958:         foreach my $item (@contexts)  {
1.34      raeburn  6959:             push(@{$changes{'cancreate'}},$item);
                   6960:         }
1.27      raeburn  6961:     }
1.34      raeburn  6962: 
1.27      raeburn  6963:     if (ref($curr_usercreation{'username_rule'}) eq 'ARRAY') {
                   6964:         foreach my $type (@{$curr_usercreation{'username_rule'}}) {
                   6965:             if (!grep(/^\Q$type\E$/,@username_rule)) {
                   6966:                 push(@{$changes{'username_rule'}},$type);
                   6967:             }
                   6968:         }
                   6969:         foreach my $type (@username_rule) {
                   6970:             if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'username_rule'}})) {
                   6971:                 push(@{$changes{'username_rule'}},$type);
                   6972:             }
                   6973:         }
                   6974:     } else {
                   6975:         push(@{$changes{'username_rule'}},@username_rule);
                   6976:     }
                   6977: 
1.32      raeburn  6978:     if (ref($curr_usercreation{'id_rule'}) eq 'ARRAY') {
                   6979:         foreach my $type (@{$curr_usercreation{'id_rule'}}) {
                   6980:             if (!grep(/^\Q$type\E$/,@id_rule)) {
                   6981:                 push(@{$changes{'id_rule'}},$type);
                   6982:             }
                   6983:         }
                   6984:         foreach my $type (@id_rule) {
                   6985:             if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'id_rule'}})) {
                   6986:                 push(@{$changes{'id_rule'}},$type);
                   6987:             }
                   6988:         }
                   6989:     } else {
                   6990:         push(@{$changes{'id_rule'}},@id_rule);
                   6991:     }
                   6992: 
1.43      raeburn  6993:     if (ref($curr_usercreation{'email_rule'}) eq 'ARRAY') {
                   6994:         foreach my $type (@{$curr_usercreation{'email_rule'}}) {
                   6995:             if (!grep(/^\Q$type\E$/,@email_rule)) {
                   6996:                 push(@{$changes{'email_rule'}},$type);
                   6997:             }
                   6998:         }
                   6999:         foreach my $type (@email_rule) {
                   7000:             if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'email_rule'}})) {
                   7001:                 push(@{$changes{'email_rule'}},$type);
                   7002:             }
                   7003:         }
                   7004:     } else {
                   7005:         push(@{$changes{'email_rule'}},@email_rule);
                   7006:     }
                   7007: 
                   7008:     my @authen_contexts = ('author','course','domain');
1.28      raeburn  7009:     my @authtypes = ('int','krb4','krb5','loc');
                   7010:     my %authhash;
1.43      raeburn  7011:     foreach my $item (@authen_contexts) {
1.28      raeburn  7012:         my @authallowed =  &Apache::loncommon::get_env_multiple('form.'.$item.'_auth');
                   7013:         foreach my $auth (@authtypes) {
                   7014:             if (grep(/^\Q$auth\E$/,@authallowed)) {
                   7015:                 $authhash{$item}{$auth} = 1;
                   7016:             } else {
                   7017:                 $authhash{$item}{$auth} = 0;
                   7018:             }
                   7019:         }
                   7020:     }
                   7021:     if (ref($curr_usercreation{'authtypes'}) eq 'HASH') {
1.43      raeburn  7022:         foreach my $item (@authen_contexts) {
1.28      raeburn  7023:             if (ref($curr_usercreation{'authtypes'}{$item}) eq 'HASH') {
                   7024:                 foreach my $auth (@authtypes) {
                   7025:                     if ($authhash{$item}{$auth} ne $curr_usercreation{'authtypes'}{$item}{$auth}) {
                   7026:                         push(@{$changes{'authtypes'}},$item);
                   7027:                         last;
                   7028:                     }
                   7029:                 }
                   7030:             }
                   7031:         }
                   7032:     } else {
1.43      raeburn  7033:         foreach my $item (@authen_contexts) {
1.28      raeburn  7034:             push(@{$changes{'authtypes'}},$item);
                   7035:         }
                   7036:     }
                   7037: 
1.27      raeburn  7038:     my %usercreation_hash =  (
1.28      raeburn  7039:             usercreation => {
1.34      raeburn  7040:                               cancreate     => \%cancreate,
1.27      raeburn  7041:                               username_rule => \@username_rule,
1.32      raeburn  7042:                               id_rule       => \@id_rule,
1.43      raeburn  7043:                               email_rule    => \@email_rule,
1.32      raeburn  7044:                               authtypes     => \%authhash,
1.27      raeburn  7045:                             }
                   7046:             );
                   7047: 
                   7048:     my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash,
                   7049:                                              $dom);
1.50      raeburn  7050: 
                   7051:     my %selfcreatetypes = (
                   7052:                              sso   => 'users authenticated by institutional single sign on',
                   7053:                              login => 'users authenticated by institutional log-in',
                   7054:                              email => 'users who provide a valid e-mail address for use as the username',
                   7055:                           );
1.27      raeburn  7056:     if ($putresult eq 'ok') {
                   7057:         if (keys(%changes) > 0) {
                   7058:             $resulttext = &mt('Changes made:').'<ul>';
                   7059:             if (ref($changes{'cancreate'}) eq 'ARRAY') {
1.34      raeburn  7060:                 my %lt = &usercreation_types();
                   7061:                 foreach my $type (@{$changes{'cancreate'}}) {
1.100     raeburn  7062:                     my $chgtext;
1.160.6.5  raeburn  7063:                     unless (($type eq 'statustocreate') || ($type eq 'captcha') || ($type eq 'recaptchakeys')) {
1.100     raeburn  7064:                         $chgtext = $lt{$type}.', ';
                   7065:                     }
1.45      raeburn  7066:                     if ($type eq 'selfcreate') {
1.50      raeburn  7067:                         if (@{$cancreate{$type}} == 0) {
1.43      raeburn  7068:                             $chgtext .= &mt('creation of a new user account is not permitted.');
1.50      raeburn  7069:                         } else {
1.100     raeburn  7070:                             $chgtext .= &mt('creation of a new account is permitted for:').'<ul>';
1.50      raeburn  7071:                             foreach my $case (@{$cancreate{$type}}) {
                   7072:                                 $chgtext .= '<li>'.$selfcreatetypes{$case}.'</li>';
                   7073:                             }
                   7074:                             $chgtext .= '</ul>';
1.100     raeburn  7075:                             if (ref($cancreate{$type}) eq 'ARRAY') {
                   7076:                                 if (grep(/^(login|sso)$/,@{$cancreate{$type}})) {
                   7077:                                     if (ref($cancreate{'statustocreate'}) eq 'ARRAY') {
                   7078:                                         if (@{$cancreate{'statustocreate'}} == 0) {
                   7079:                                             $chgtext .= '<br /><span class="LC_warning">'.&mt("However, no institutional affiliations (including 'other') are currently permitted to create accounts.").'</span>';
                   7080:                                         }
                   7081:                                     }
                   7082:                                 }
                   7083:                             }
1.43      raeburn  7084:                         }
1.93      raeburn  7085:                     } elsif ($type eq 'statustocreate') {
1.96      raeburn  7086:                         if ((ref($cancreate{'selfcreate'}) eq 'ARRAY') &&
                   7087:                             (ref($cancreate{'statustocreate'}) eq 'ARRAY')) {
                   7088:                             if (@{$cancreate{'selfcreate'}} > 0) {
                   7089:                                 if (@{$cancreate{'statustocreate'}} == 0) {
1.100     raeburn  7090: 
                   7091:                                     $chgtext .= &mt("Institutional affiliations permitted to create accounts set to 'None'.");
1.96      raeburn  7092:                                     if (!grep(/^email$/,@{$cancreate{'selfcreate'}})) {
1.100     raeburn  7093:                                         $chgtext .= '<br /><span class="LC_warning">'.&mt("However, no institutional affiliations (including 'other') are currently permitted to create accounts.").'</span>';
                   7094:                                     } 
1.96      raeburn  7095:                                 } elsif (ref($usertypes) eq 'HASH') {
                   7096:                                     if (grep(/^(login|sso)$/,@{$cancreate{'selfcreate'}})) {
1.100     raeburn  7097:                                         $chgtext .= &mt('Creation of a new account for an institutional user is restricted to the following institutional affiliation(s):');
                   7098:                                     } else {
                   7099:                                         $chgtext .= &mt('Institutional affiliations permitted to create accounts with institutional authentication were set as follows:');
                   7100:                                     }
                   7101:                                     $chgtext .= '<ul>';
                   7102:                                     foreach my $case (@{$cancreate{$type}}) {
                   7103:                                         if ($case eq 'default') {
                   7104:                                             $chgtext .= '<li>'.$othertitle.'</li>';
                   7105:                                         } else {
                   7106:                                             $chgtext .= '<li>'.$usertypes->{$case}.'</li>';
1.93      raeburn  7107:                                         }
                   7108:                                     }
1.100     raeburn  7109:                                     $chgtext .= '</ul>';
                   7110:                                     if (!grep(/^(login|sso)$/,@{$cancreate{'selfcreate'}})) {
                   7111:                                         $chgtext .= '<br /><span class="LC_warning">'.&mt('However, users authenticated by institutional login/single sign on are not currently permitted to create accounts.').'</span>';
                   7112:                                     }
                   7113:                                 }
                   7114:                             } else {
                   7115:                                 if (@{$cancreate{$type}} == 0) {
                   7116:                                     $chgtext .= &mt("Institutional affiliations permitted to create accounts were set to 'none'.");
                   7117:                                 } else {
                   7118:                                     $chgtext .= &mt('Although institutional affiliations permitted to create accounts were changed, self creation of accounts is not currently permitted for any authentication types.');
1.93      raeburn  7119:                                 }
                   7120:                             }
                   7121:                         }
1.160.6.5  raeburn  7122:                     } elsif ($type eq 'captcha') {
                   7123:                         if ($cancreate{$type} eq 'notused') {
                   7124:                             $chgtext .= &mt('No CAPTCHA validation in use for self-creation screen.');
                   7125:                         } else {
                   7126:                             my %captchas = &captcha_phrases();
                   7127:                             if ($captchas{$cancreate{$type}}) {
                   7128:                                 $chgtext .= &mt("Validation for self-creation screen set to $captchas{$cancreate{$type}}.");
                   7129:                             } else {
                   7130:                                 $chgtext .= &mt('Validation for self-creation screen set to unknown type.');
                   7131:                             }
                   7132:                         }
                   7133:                     } elsif ($type eq 'recaptchakeys') {
                   7134:                         my ($privkey,$pubkey);
                   7135:                         if (ref($cancreate{$type}) eq 'HASH') {
                   7136:                             $pubkey = $cancreate{$type}{'public'};
                   7137:                             $privkey = $cancreate{$type}{'private'};
                   7138:                         }
                   7139:                         $chgtext .= &mt('ReCAPTCHA keys changes').'<ul>';
                   7140:                         if (!$pubkey) {
                   7141:                             $chgtext .= '<li>'.&mt('Public key deleted').'</li>';
                   7142:                         } else {
                   7143:                             $chgtext .= '<li>'.&mt('Public key set to [_1]',$pubkey).'</li>';
                   7144:                         }
                   7145:                         if (!$privkey) {
                   7146:                             $chgtext .= '<li>'.&mt('Private key deleted').'</li>';
                   7147:                         } else {
                   7148:                             $chgtext .= '<li>'.&mt('Private key set to [_1]',$pubkey).'</li>';
                   7149:                         }
                   7150:                         $chgtext .= '</ul>';
1.43      raeburn  7151:                     } else {
                   7152:                         if ($cancreate{$type} eq 'none') {
                   7153:                             $chgtext .= &mt('creation of new users is not permitted, except by a Domain Coordinator.');
                   7154:                         } elsif ($cancreate{$type} eq 'any') {
                   7155:                             $chgtext .= &mt('creation of new users is permitted for both institutional and non-institutional usernames.');
                   7156:                         } elsif ($cancreate{$type} eq 'official') {
                   7157:                             $chgtext .= &mt('creation of new users is only permitted for institutional usernames.');
                   7158:                         } elsif ($cancreate{$type} eq 'unofficial') {
                   7159:                             $chgtext .= &mt('creation of new users is only permitted for non-institutional usernames.');
                   7160:                         }
1.34      raeburn  7161:                     }
                   7162:                     $resulttext .= '<li>'.$chgtext.'</li>';
1.27      raeburn  7163:                 }
                   7164:             }
                   7165:             if (ref($changes{'username_rule'}) eq 'ARRAY') {
1.32      raeburn  7166:                 my ($rules,$ruleorder) = 
                   7167:                     &Apache::lonnet::inst_userrules($dom,'username');
1.27      raeburn  7168:                 my $chgtext = '<ul>';
                   7169:                 foreach my $type (@username_rule) {
                   7170:                     if (ref($rules->{$type}) eq 'HASH') {
                   7171:                         $chgtext .= '<li>'.$rules->{$type}{'name'}.'</li>';
                   7172:                     }
                   7173:                 }
                   7174:                 $chgtext .= '</ul>';
                   7175:                 if (@username_rule > 0) {
                   7176:                     $resulttext .= '<li>'.&mt('Usernames with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'</li>';     
                   7177:                 } else {
1.28      raeburn  7178:                     $resulttext .= '<li>'.&mt('There are now no username formats restricted to verified users in the institutional directory.').'</li>'; 
1.27      raeburn  7179:                 }
                   7180:             }
1.32      raeburn  7181:             if (ref($changes{'id_rule'}) eq 'ARRAY') {
                   7182:                 my ($idrules,$idruleorder) = 
                   7183:                     &Apache::lonnet::inst_userrules($dom,'id');
                   7184:                 my $chgtext = '<ul>';
                   7185:                 foreach my $type (@id_rule) {
                   7186:                     if (ref($idrules->{$type}) eq 'HASH') {
                   7187:                         $chgtext .= '<li>'.$idrules->{$type}{'name'}.'</li>';
                   7188:                     }
                   7189:                 }
                   7190:                 $chgtext .= '</ul>';
                   7191:                 if (@id_rule > 0) {
                   7192:                     $resulttext .= '<li>'.&mt('IDs with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'</li>';
                   7193:                 } else {
                   7194:                     $resulttext .= '<li>'.&mt('There are now no ID formats restricted to verified users in the institutional directory.').'</li>';
                   7195:                 }
                   7196:             }
1.43      raeburn  7197:             if (ref($changes{'email_rule'}) eq 'ARRAY') {
                   7198:                 my ($emailrules,$emailruleorder) =
                   7199:                     &Apache::lonnet::inst_userrules($dom,'email');
                   7200:                 my $chgtext = '<ul>';
                   7201:                 foreach my $type (@email_rule) {
                   7202:                     if (ref($emailrules->{$type}) eq 'HASH') {
                   7203:                         $chgtext .= '<li>'.$emailrules->{$type}{'name'}.'</li>';
                   7204:                     }
                   7205:                 }
                   7206:                 $chgtext .= '</ul>';
                   7207:                 if (@email_rule > 0) {
                   7208:                     $resulttext .= '<li>'.&mt('Accounts may not be created by users self-enrolling with e-mail addresses of the following types: ').$chgtext.'</li>';
                   7209:                 } else {
                   7210:                     $resulttext .= '<li>'.&mt('There are now no restrictions on e-mail addresses which may be used as a username when self-enrolling.').'</li>';
                   7211:                 }
                   7212:             }
                   7213: 
1.28      raeburn  7214:             my %authname = &authtype_names();
                   7215:             my %context_title = &context_names();
                   7216:             if (ref($changes{'authtypes'}) eq 'ARRAY') {
                   7217:                 my $chgtext = '<ul>';
                   7218:                 foreach my $type (@{$changes{'authtypes'}}) {
                   7219:                     my @allowed;
                   7220:                     $chgtext .= '<li><span class="LC_cusr_emph">'.$context_title{$type}.'</span> - '.&mt('assignable authentication types: ');
                   7221:                     foreach my $auth (@authtypes) {
                   7222:                         if ($authhash{$type}{$auth}) {
                   7223:                             push(@allowed,$authname{$auth});
                   7224:                         }
                   7225:                     }
1.43      raeburn  7226:                     if (@allowed > 0) {
                   7227:                         $chgtext .= join(', ',@allowed).'</li>';
                   7228:                     } else {
                   7229:                         $chgtext .= &mt('none').'</li>';
                   7230:                     }
1.28      raeburn  7231:                 }
                   7232:                 $chgtext .= '</ul>';
                   7233:                 $resulttext .= '<li>'.&mt('Authentication types available for assignment to new users').'<br />'.$chgtext;
                   7234:                 $resulttext .= '</li>';
                   7235:             }
1.27      raeburn  7236:             $resulttext .= '</ul>';
                   7237:         } else {
1.28      raeburn  7238:             $resulttext = &mt('No changes made to user creation settings');
1.27      raeburn  7239:         }
                   7240:     } else {
                   7241:         $resulttext = '<span class="LC_error">'.
1.23      raeburn  7242:             &mt('An error occurred: [_1]',$putresult).'</span>';
                   7243:     }
1.43      raeburn  7244:     if ($warningmsg ne '') {
                   7245:         $resulttext .= '<br /><span class="LC_warning">'.$warningmsg.'</span><br />';
                   7246:     }
1.23      raeburn  7247:     return $resulttext;
                   7248: }
                   7249: 
1.160.6.5  raeburn  7250: sub process_captcha {
                   7251:     my ($container,$changes,$newsettings,$current) = @_;
                   7252:     return unless ((ref($changes) eq 'HASH') && (ref($newsettings) eq 'HASH') || (ref($current) eq 'HASH'));
                   7253:     $newsettings->{'captcha'} = $env{'form.'.$container.'_captcha'};
                   7254:     unless ($newsettings->{'captcha'} eq 'recaptcha' || $newsettings->{'captcha'} eq 'notused') {
                   7255:         $newsettings->{'captcha'} = 'original';
                   7256:     }
                   7257:     if ($current->{'captcha'} ne $newsettings->{'captcha'}) {
                   7258:         if ($container eq 'cancreate') {
                   7259:             if (ref($changes->{'cancreate'}) eq 'ARRAY') {
                   7260:                 push(@{$changes->{'cancreate'}},'captcha');
                   7261:             } elsif (!defined($changes->{'cancreate'})) {
                   7262:                 $changes->{'cancreate'} = ['captcha'];
                   7263:             }
                   7264:         } else {
                   7265:             $changes->{'captcha'} = 1;
                   7266:         }
                   7267:     }
                   7268:     my ($newpub,$newpriv,$currpub,$currpriv);
                   7269:     if ($newsettings->{'captcha'} eq 'recaptcha') {
                   7270:         $newpub = $env{'form.'.$container.'_recaptchapub'};
                   7271:         $newpriv = $env{'form.'.$container.'_recaptchapriv'};
                   7272:         $newpub =~ s/\W//g;
                   7273:         $newpriv =~ s/\W//g;
                   7274:         $newsettings->{'recaptchakeys'} = {
                   7275:                                              public  => $newpub,
                   7276:                                              private => $newpriv,
                   7277:                                           };
                   7278:     }
                   7279:     if (ref($current->{'recaptchakeys'}) eq 'HASH') {
                   7280:         $currpub = $current->{'recaptchakeys'}{'public'};
                   7281:         $currpriv = $current->{'recaptchakeys'}{'private'};
1.160.6.10  raeburn  7282:         unless ($newsettings->{'captcha'} eq 'recaptcha') {
                   7283:             $newsettings->{'recaptchakeys'} = {
                   7284:                                                  public  => '',
                   7285:                                                  private => '',
                   7286:                                               }
                   7287:         }
1.160.6.5  raeburn  7288:     }
                   7289:     if (($newpub ne $currpub) || ($newpriv ne $currpriv)) {
                   7290:         if ($container eq 'cancreate') {
                   7291:             if (ref($changes->{'cancreate'}) eq 'ARRAY') {
                   7292:                 push(@{$changes->{'cancreate'}},'recaptchakeys');
                   7293:             } elsif (!defined($changes->{'cancreate'})) {
                   7294:                 $changes->{'cancreate'} = ['recaptchakeys'];
                   7295:             }
                   7296:         } else {
                   7297:             $changes->{'recaptchakeys'} = 1;
                   7298:         }
                   7299:     }
                   7300:     return;
                   7301: }
                   7302: 
1.33      raeburn  7303: sub modify_usermodification {
                   7304:     my ($dom,%domconfig) = @_;
                   7305:     my ($resulttext,%curr_usermodification,%changes);
                   7306:     if (ref($domconfig{'usermodification'}) eq 'HASH') {
                   7307:         foreach my $key (keys(%{$domconfig{'usermodification'}})) {
                   7308:             $curr_usermodification{$key} = $domconfig{'usermodification'}{$key};
                   7309:         }
                   7310:     }
1.63      raeburn  7311:     my @contexts = ('author','course','selfcreate');
1.33      raeburn  7312:     my %context_title = (
                   7313:                            author => 'In author context',
                   7314:                            course => 'In course context',
1.63      raeburn  7315:                            selfcreate => 'When self creating account', 
1.33      raeburn  7316:                         );
                   7317:     my @fields = ('lastname','firstname','middlename','generation',
                   7318:                   'permanentemail','id');
                   7319:     my %roles = (
                   7320:                   author => ['ca','aa'],
                   7321:                   course => ['st','ep','ta','in','cr'],
                   7322:                 );
1.63      raeburn  7323:     my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
                   7324:     if (ref($types) eq 'ARRAY') {
                   7325:         push(@{$types},'default');
                   7326:         $usertypes->{'default'} = $othertitle;
                   7327:     }
                   7328:     $roles{'selfcreate'} = $types;  
1.33      raeburn  7329:     my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
                   7330:     my %modifyhash;
                   7331:     foreach my $context (@contexts) {
                   7332:         foreach my $role (@{$roles{$context}}) {
                   7333:             my @modifiable =  &Apache::loncommon::get_env_multiple('form.canmodify_'.$role);
                   7334:             foreach my $item (@fields) {
                   7335:                 if (grep(/^\Q$item\E$/,@modifiable)) {
                   7336:                     $modifyhash{$context}{$role}{$item} = 1;
                   7337:                 } else {
                   7338:                     $modifyhash{$context}{$role}{$item} = 0;
                   7339:                 }
                   7340:             }
                   7341:         }
                   7342:         if (ref($curr_usermodification{$context}) eq 'HASH') {
                   7343:             foreach my $role (@{$roles{$context}}) {
                   7344:                 if (ref($curr_usermodification{$context}{$role}) eq 'HASH') {
                   7345:                     foreach my $field (@fields) {
                   7346:                         if ($modifyhash{$context}{$role}{$field} ne 
                   7347:                                 $curr_usermodification{$context}{$role}{$field}) {
                   7348:                             push(@{$changes{$context}},$role);
                   7349:                             last;
                   7350:                         }
                   7351:                     }
                   7352:                 }
                   7353:             }
                   7354:         } else {
                   7355:             foreach my $context (@contexts) {
                   7356:                 foreach my $role (@{$roles{$context}}) {
                   7357:                     push(@{$changes{$context}},$role);
                   7358:                 }
                   7359:             }
                   7360:         }
                   7361:     }
                   7362:     my %usermodification_hash =  (
                   7363:                                    usermodification => \%modifyhash,
                   7364:                                  );
                   7365:     my $putresult = &Apache::lonnet::put_dom('configuration',
                   7366:                                              \%usermodification_hash,$dom);
                   7367:     if ($putresult eq 'ok') {
                   7368:         if (keys(%changes) > 0) {
                   7369:             $resulttext = &mt('Changes made: ').'<ul>';
                   7370:             foreach my $context (@contexts) {
                   7371:                 if (ref($changes{$context}) eq 'ARRAY') {
                   7372:                     $resulttext .= '<li>'.$context_title{$context}.':<ul>';
                   7373:                     if (ref($changes{$context}) eq 'ARRAY') {
                   7374:                         foreach my $role (@{$changes{$context}}) {
                   7375:                             my $rolename;
1.63      raeburn  7376:                             if ($context eq 'selfcreate') {
                   7377:                                 $rolename = $role;
                   7378:                                 if (ref($usertypes) eq 'HASH') {
                   7379:                                     if ($usertypes->{$role} ne '') {
                   7380:                                         $rolename = $usertypes->{$role};
                   7381:                                     }
                   7382:                                 }
1.33      raeburn  7383:                             } else {
1.63      raeburn  7384:                                 if ($role eq 'cr') {
                   7385:                                     $rolename = &mt('Custom');
                   7386:                                 } else {
                   7387:                                     $rolename = &Apache::lonnet::plaintext($role);
                   7388:                                 }
1.33      raeburn  7389:                             }
                   7390:                             my @modifiable;
1.63      raeburn  7391:                             if ($context eq 'selfcreate') {
1.126     bisitz   7392:                                 $resulttext .= '<li><span class="LC_cusr_emph">'.&mt('Self-creation of account by users with status: [_1]',$rolename).'</span> - '.&mt('modifiable fields (if institutional data blank): ');
1.63      raeburn  7393:                             } else {
                   7394:                                 $resulttext .= '<li><span class="LC_cusr_emph">'.&mt('Target user with [_1] role',$rolename).'</span> - '.&mt('modifiable fields: ');
                   7395:                             }
1.33      raeburn  7396:                             foreach my $field (@fields) {
                   7397:                                 if ($modifyhash{$context}{$role}{$field}) {
                   7398:                                     push(@modifiable,$fieldtitles{$field});
                   7399:                                 }
                   7400:                             }
                   7401:                             if (@modifiable > 0) {
                   7402:                                 $resulttext .= join(', ',@modifiable);
                   7403:                             } else {
                   7404:                                 $resulttext .= &mt('none'); 
                   7405:                             }
                   7406:                             $resulttext .= '</li>';
                   7407:                         }
                   7408:                         $resulttext .= '</ul></li>';
                   7409:                     }
                   7410:                 }
                   7411:             }
                   7412:             $resulttext .= '</ul>';
                   7413:         } else {
                   7414:             $resulttext = &mt('No changes made to user modification settings');
                   7415:         }
                   7416:     } else {
                   7417:         $resulttext = '<span class="LC_error">'.
                   7418:             &mt('An error occurred: [_1]',$putresult).'</span>';
                   7419:     }
                   7420:     return $resulttext;
                   7421: }
                   7422: 
1.43      raeburn  7423: sub modify_defaults {
1.160.6.23  raeburn  7424:     my ($dom,$r,%domconfig) = @_;
1.43      raeburn  7425:     my ($resulttext,$mailmsgtxt,%newvalues,%changes,@errors);
                   7426:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
1.141     raeburn  7427:     my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def','portal_def');
1.43      raeburn  7428:     my @authtypes = ('internal','krb4','krb5','localauth');
                   7429:     foreach my $item (@items) {
                   7430:         $newvalues{$item} = $env{'form.'.$item};
                   7431:         if ($item eq 'auth_def') {
                   7432:             if ($newvalues{$item} ne '') {
                   7433:                 if (!grep(/^\Q$newvalues{$item}\E$/,@authtypes)) {
                   7434:                     push(@errors,$item);
                   7435:                 }
                   7436:             }
                   7437:         } elsif ($item eq 'lang_def') {
                   7438:             if ($newvalues{$item} ne '') {
                   7439:                 if ($newvalues{$item} =~ /^(\w+)/) {
                   7440:                     my $langcode = $1;
1.103     raeburn  7441:                     if ($langcode ne 'x_chef') {
                   7442:                         if (code2language($langcode) eq '') {
                   7443:                             push(@errors,$item);
                   7444:                         }
1.43      raeburn  7445:                     }
                   7446:                 } else {
                   7447:                     push(@errors,$item);
                   7448:                 }
                   7449:             }
1.54      raeburn  7450:         } elsif ($item eq 'timezone_def') {
                   7451:             if ($newvalues{$item} ne '') {
1.62      raeburn  7452:                 if (!DateTime::TimeZone->is_valid_name($newvalues{$item})) {
1.54      raeburn  7453:                     push(@errors,$item);   
                   7454:                 }
                   7455:             }
1.68      raeburn  7456:         } elsif ($item eq 'datelocale_def') {
                   7457:             if ($newvalues{$item} ne '') {
                   7458:                 my @datelocale_ids = DateTime::Locale->ids();
                   7459:                 if (!grep(/^\Q$newvalues{$item}\E$/,@datelocale_ids)) {
                   7460:                     push(@errors,$item);
                   7461:                 }
                   7462:             }
1.141     raeburn  7463:         } elsif ($item eq 'portal_def') {
                   7464:             if ($newvalues{$item} ne '') {
                   7465:                 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])\/?$/) {
                   7466:                     push(@errors,$item);
                   7467:                 }
                   7468:             }
1.43      raeburn  7469:         }
                   7470:         if (grep(/^\Q$item\E$/,@errors)) {
                   7471:             $newvalues{$item} = $domdefaults{$item};
                   7472:         } elsif ($domdefaults{$item} ne $newvalues{$item}) {
                   7473:             $changes{$item} = 1;
                   7474:         }
1.72      raeburn  7475:         $domdefaults{$item} = $newvalues{$item};
1.43      raeburn  7476:     }
                   7477:     my %defaults_hash = (
1.72      raeburn  7478:                          defaults => \%newvalues,
                   7479:                         );
1.43      raeburn  7480:     my $title = &defaults_titles();
                   7481:     my $putresult = &Apache::lonnet::put_dom('configuration',\%defaults_hash,
                   7482:                                              $dom);
                   7483:     if ($putresult eq 'ok') {
                   7484:         if (keys(%changes) > 0) {
                   7485:             $resulttext = &mt('Changes made:').'<ul>';
                   7486:             my $version = $r->dir_config('lonVersion');
                   7487:             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";
                   7488:             foreach my $item (sort(keys(%changes))) {
                   7489:                 my $value = $env{'form.'.$item};
                   7490:                 if ($value eq '') {
                   7491:                     $value = &mt('none');
                   7492:                 } elsif ($item eq 'auth_def') {
                   7493:                     my %authnames = &authtype_names();
                   7494:                     my %shortauth = (
                   7495:                              internal => 'int',
                   7496:                              krb4 => 'krb4',
                   7497:                              krb5 => 'krb5',
                   7498:                              localauth  => 'loc',
                   7499:                     );
                   7500:                     $value = $authnames{$shortauth{$value}};
                   7501:                 }
                   7502:                 $resulttext .= '<li>'.&mt('[_1] set to "[_2]"',$title->{$item},$value).'</li>';
                   7503:                 $mailmsgtext .= "$title->{$item} set to $value\n";  
                   7504:             }
                   7505:             $resulttext .= '</ul>';
                   7506:             $mailmsgtext .= "\n";
                   7507:             my $cachetime = 24*60*60;
1.72      raeburn  7508:             &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime);
1.68      raeburn  7509:             if ($changes{'auth_def'} || $changes{'auth_arg_def'} || $changes{'lang_def'} || $changes{'datelocale_def'}) {
1.160.6.23  raeburn  7510:                 my $notify = 1;
                   7511:                 if (ref($domconfig{'contacts'}) eq 'HASH') {
                   7512:                     if ($domconfig{'contacts'}{'reportupdates'} == 0) {
                   7513:                         $notify = 0;
                   7514:                     }
                   7515:                 }
                   7516:                 if ($notify) {
                   7517:                     &Apache::lonmsg::sendemail('installrecord@loncapa.org',
                   7518:                                                "LON-CAPA Domain Settings Change - $dom",
                   7519:                                                $mailmsgtext);
                   7520:                 }
1.54      raeburn  7521:             }
1.43      raeburn  7522:         } else {
1.54      raeburn  7523:             $resulttext = &mt('No changes made to default authentication/language/timezone settings');
1.43      raeburn  7524:         }
                   7525:     } else {
                   7526:         $resulttext = '<span class="LC_error">'.
                   7527:             &mt('An error occurred: [_1]',$putresult).'</span>';
                   7528:     }
                   7529:     if (@errors > 0) {
                   7530:         $resulttext .= '<br />'.&mt('The following were left unchanged because the values entered were invalid:');
                   7531:         foreach my $item (@errors) {
                   7532:             $resulttext .= ' "'.$title->{$item}.'",';
                   7533:         }
                   7534:         $resulttext =~ s/,$//;
                   7535:     }
                   7536:     return $resulttext;
                   7537: }
                   7538: 
1.46      raeburn  7539: sub modify_scantron {
1.160.6.24  raeburn  7540:     my ($r,$dom,$confname,$lastactref,%domconfig) = @_;
1.46      raeburn  7541:     my ($resulttext,%confhash,%changes,$errors);
                   7542:     my $custom = 'custom.tab';
                   7543:     my $default = 'default.tab';
                   7544:     my $servadm = $r->dir_config('lonAdmEMail');
                   7545:     my ($configuserok,$author_ok,$switchserver) = 
                   7546:         &config_check($dom,$confname,$servadm);
                   7547:     if ($env{'form.scantronformat.filename'} ne '') {
                   7548:         my $error;
                   7549:         if ($configuserok eq 'ok') {
                   7550:             if ($switchserver) {
1.130     raeburn  7551:                 $error = &mt("Upload of bubblesheet format file is not permitted to this server: [_1]",$switchserver);
1.46      raeburn  7552:             } else {
                   7553:                 if ($author_ok eq 'ok') {
                   7554:                     my ($result,$scantronurl) =
                   7555:                         &publishlogo($r,'upload','scantronformat',$dom,
                   7556:                                      $confname,'scantron','','',$custom);
                   7557:                     if ($result eq 'ok') {
                   7558:                         $confhash{'scantron'}{'scantronformat'} = $scantronurl;
1.48      raeburn  7559:                         $changes{'scantronformat'} = 1;
1.46      raeburn  7560:                     } else {
                   7561:                         $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$custom,$result);
                   7562:                     }
                   7563:                 } else {
                   7564:                     $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);
                   7565:                 }
                   7566:             }
                   7567:         } else {
                   7568:             $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);
                   7569:         }
                   7570:         if ($error) {
                   7571:             &Apache::lonnet::logthis($error);
                   7572:             $errors .= '<li><span class="LC_error">'.$error.'</span></li>';
                   7573:         }
                   7574:     }
1.48      raeburn  7575:     if (ref($domconfig{'scantron'}) eq 'HASH') {
                   7576:         if ($domconfig{'scantron'}{'scantronformat'} ne '') {
                   7577:             if ($env{'form.scantronformat_del'}) {
                   7578:                 $confhash{'scantron'}{'scantronformat'} = '';
                   7579:                 $changes{'scantronformat'} = 1;
1.46      raeburn  7580:             }
                   7581:         }
                   7582:     }
                   7583:     if (keys(%confhash) > 0) {
                   7584:         my $putresult = &Apache::lonnet::put_dom('configuration',\%confhash,
                   7585:                                                  $dom);
                   7586:         if ($putresult eq 'ok') {
                   7587:             if (keys(%changes) > 0) {
1.48      raeburn  7588:                 if (ref($confhash{'scantron'}) eq 'HASH') {
                   7589:                     $resulttext = &mt('Changes made:').'<ul>';
                   7590:                     if ($confhash{'scantron'}{'scantronformat'} eq '') {
1.130     raeburn  7591:                         $resulttext .= '<li>'.&mt('[_1] bubblesheet format file removed; [_2] file will be used for courses in this domain.',$custom,$default).'</li>';
1.48      raeburn  7592:                     } else {
1.130     raeburn  7593:                         $resulttext .= '<li>'.&mt('Custom bubblesheet format file ([_1]) uploaded for use with courses in this domain.',$custom).'</li>';
1.46      raeburn  7594:                     }
1.48      raeburn  7595:                     $resulttext .= '</ul>';
                   7596:                 } else {
1.130     raeburn  7597:                     $resulttext = &mt('Changes made to bubblesheet format file.');
1.46      raeburn  7598:                 }
                   7599:                 $resulttext .= '</ul>';
                   7600:                 &Apache::loncommon::devalidate_domconfig_cache($dom);
1.160.6.24  raeburn  7601:                 $$lastactref = 'update';
1.46      raeburn  7602:             } else {
1.130     raeburn  7603:                 $resulttext = &mt('No changes made to bubblesheet format file');
1.46      raeburn  7604:             }
                   7605:         } else {
                   7606:             $resulttext = '<span class="LC_error">'.
                   7607:                 &mt('An error occurred: [_1]',$putresult).'</span>';
                   7608:         }
                   7609:     } else {
1.130     raeburn  7610:         $resulttext = &mt('No changes made to bubblesheet format file'); 
1.46      raeburn  7611:     }
                   7612:     if ($errors) {
                   7613:         $resulttext .= &mt('The following errors occurred: ').'<ul>'.
                   7614:                        $errors.'</ul>';
                   7615:     }
                   7616:     return $resulttext;
                   7617: }
                   7618: 
1.48      raeburn  7619: sub modify_coursecategories {
                   7620:     my ($dom,%domconfig) = @_;
1.57      raeburn  7621:     my ($resulttext,%deletions,%reorderings,%needreordering,%adds,%changes,$errors,
                   7622:         $cathash);
1.48      raeburn  7623:     my @deletecategory = &Apache::loncommon::get_env_multiple('form.deletecategory');
1.55      raeburn  7624:     if (ref($domconfig{'coursecategories'}) eq 'HASH') {
1.57      raeburn  7625:         $cathash = $domconfig{'coursecategories'}{'cats'};
                   7626:         if ($domconfig{'coursecategories'}{'togglecats'} ne $env{'form.togglecats'}) {
                   7627:             $changes{'togglecats'} = 1;
                   7628:             $domconfig{'coursecategories'}{'togglecats'} = $env{'form.togglecats'};
                   7629:         }
                   7630:         if ($domconfig{'coursecategories'}{'categorize'} ne $env{'form.categorize'}) {
                   7631:             $changes{'categorize'} = 1;
                   7632:             $domconfig{'coursecategories'}{'categorize'} = $env{'form.categorize'};
                   7633:         }
1.120     raeburn  7634:         if ($domconfig{'coursecategories'}{'togglecatscomm'} ne $env{'form.togglecatscomm'}) {
                   7635:             $changes{'togglecatscomm'} = 1;
                   7636:             $domconfig{'coursecategories'}{'togglecatscomm'} = $env{'form.togglecatscomm'};
                   7637:         }
                   7638:         if ($domconfig{'coursecategories'}{'categorizecomm'} ne $env{'form.categorizecomm'}) {
                   7639:             $changes{'categorizecomm'} = 1;
                   7640:             $domconfig{'coursecategories'}{'categorizecomm'} = $env{'form.categorizecomm'};
                   7641:         }
1.57      raeburn  7642:     } else {
                   7643:         $changes{'togglecats'} = 1;
                   7644:         $changes{'categorize'} = 1;
1.124     raeburn  7645:         $changes{'togglecatscomm'} = 1;
                   7646:         $changes{'categorizecomm'} = 1;
1.87      raeburn  7647:         $domconfig{'coursecategories'} = {
                   7648:                                              togglecats => $env{'form.togglecats'},
                   7649:                                              categorize => $env{'form.categorize'},
1.124     raeburn  7650:                                              togglecatscomm => $env{'form.togglecatscomm'},
                   7651:                                              categorizecomm => $env{'form.categorizecomm'},
1.120     raeburn  7652:                                          };
1.57      raeburn  7653:     }
                   7654:     if (ref($cathash) eq 'HASH') {
                   7655:         if (($domconfig{'coursecategories'}{'cats'}{'instcode::0'} ne '')  && ($env{'form.instcode'} == 0)) {
1.55      raeburn  7656:             push (@deletecategory,'instcode::0');
                   7657:         }
1.120     raeburn  7658:         if (($domconfig{'coursecategories'}{'cats'}{'communities::0'} ne '')  && ($env{'form.communities'} == 0)) {
                   7659:             push(@deletecategory,'communities::0');
                   7660:         }
1.48      raeburn  7661:     }
1.57      raeburn  7662:     my (@predelcats,@predeltrails,%predelallitems,%sort_by_deltrail);
                   7663:     if (ref($cathash) eq 'HASH') {
1.48      raeburn  7664:         if (@deletecategory > 0) {
                   7665:             #FIXME Need to remove category from all courses using a deleted category 
1.57      raeburn  7666:             &Apache::loncommon::extract_categories($cathash,\@predelcats,\@predeltrails,\%predelallitems);
1.48      raeburn  7667:             foreach my $item (@deletecategory) {
1.57      raeburn  7668:                 if ($domconfig{'coursecategories'}{'cats'}{$item} ne '') {
                   7669:                     delete($domconfig{'coursecategories'}{'cats'}{$item});
1.48      raeburn  7670:                     $deletions{$item} = 1;
1.57      raeburn  7671:                     &recurse_cat_deletes($item,$cathash,\%deletions);
1.48      raeburn  7672:                 }
                   7673:             }
                   7674:         }
1.57      raeburn  7675:         foreach my $item (keys(%{$cathash})) {
1.48      raeburn  7676:             my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
1.57      raeburn  7677:             if ($cathash->{$item} ne $env{'form.'.$item}) {
1.48      raeburn  7678:                 $reorderings{$item} = 1;
1.57      raeburn  7679:                 $domconfig{'coursecategories'}{'cats'}{$item} = $env{'form.'.$item};
1.48      raeburn  7680:             }
                   7681:             if ($env{'form.addcategory_name_'.$item} ne '') {
                   7682:                 my $newcat = $env{'form.addcategory_name_'.$item};
                   7683:                 my $newdepth = $depth+1;
                   7684:                 my $newitem = &escape($newcat).':'.&escape($cat).':'.$newdepth;
1.57      raeburn  7685:                 $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.addcategory_pos_'.$item};
1.48      raeburn  7686:                 $adds{$newitem} = 1; 
                   7687:             }
                   7688:             if ($env{'form.subcat_'.$item} ne '') {
                   7689:                 my $newcat = $env{'form.subcat_'.$item};
                   7690:                 my $newdepth = $depth+1;
                   7691:                 my $newitem = &escape($newcat).':'.&escape($cat).':'.$newdepth;
1.57      raeburn  7692:                 $domconfig{'coursecategories'}{'cats'}{$newitem} = 0;
1.48      raeburn  7693:                 $adds{$newitem} = 1;
                   7694:             }
                   7695:         }
                   7696:     }
                   7697:     if ($env{'form.instcode'} eq '1') {
1.57      raeburn  7698:         if (ref($cathash) eq 'HASH') {
1.48      raeburn  7699:             my $newitem = 'instcode::0';
1.57      raeburn  7700:             if ($cathash->{$newitem} eq '') {  
                   7701:                 $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.instcode_pos'};
1.48      raeburn  7702:                 $adds{$newitem} = 1;
                   7703:             }
                   7704:         } else {
                   7705:             my $newitem = 'instcode::0';
1.57      raeburn  7706:             $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.instcode_pos'};
1.48      raeburn  7707:             $adds{$newitem} = 1;
                   7708:         }
                   7709:     }
1.120     raeburn  7710:     if ($env{'form.communities'} eq '1') {
                   7711:         if (ref($cathash) eq 'HASH') {
                   7712:             my $newitem = 'communities::0';
                   7713:             if ($cathash->{$newitem} eq '') {
                   7714:                 $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.communities_pos'};
                   7715:                 $adds{$newitem} = 1;
                   7716:             }
                   7717:         } else {
                   7718:             my $newitem = 'communities::0';
                   7719:             $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.communities_pos'};
                   7720:             $adds{$newitem} = 1;
                   7721:         }
                   7722:     }
1.48      raeburn  7723:     if ($env{'form.addcategory_name'} ne '') {
1.120     raeburn  7724:         if (($env{'form.addcategory_name'} ne 'instcode') &&
                   7725:             ($env{'form.addcategory_name'} ne 'communities')) {
                   7726:             my $newitem = &escape($env{'form.addcategory_name'}).'::0';
                   7727:             $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.addcategory_pos'};
                   7728:             $adds{$newitem} = 1;
                   7729:         }
1.48      raeburn  7730:     }
1.57      raeburn  7731:     my $putresult;
1.48      raeburn  7732:     if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
                   7733:         if (keys(%deletions) > 0) {
                   7734:             foreach my $key (keys(%deletions)) {
                   7735:                 if ($predelallitems{$key} ne '') {
                   7736:                     $sort_by_deltrail{$predelallitems{$key}} = $predeltrails[$predelallitems{$key}];
                   7737:                 }
                   7738:             }
                   7739:         }
                   7740:         my (@chkcats,@chktrails,%chkallitems);
1.57      raeburn  7741:         &Apache::loncommon::extract_categories($domconfig{'coursecategories'}{'cats'},\@chkcats,\@chktrails,\%chkallitems);
1.48      raeburn  7742:         if (ref($chkcats[0]) eq 'ARRAY') {
                   7743:             my $depth = 0;
                   7744:             my $chg = 0;
                   7745:             for (my $i=0; $i<@{$chkcats[0]}; $i++) {
                   7746:                 my $name = $chkcats[0][$i];
                   7747:                 my $item;
                   7748:                 if ($name eq '') {
                   7749:                     $chg ++;
                   7750:                 } else {
                   7751:                     $item = &escape($name).'::0';
                   7752:                     if ($chg) {
1.57      raeburn  7753:                         $domconfig{'coursecategories'}{'cats'}{$item} -= $chg;
1.48      raeburn  7754:                     }
                   7755:                     $depth ++; 
1.57      raeburn  7756:                     &recurse_check(\@chkcats,$domconfig{'coursecategories'}{'cats'},$depth,$name);
1.48      raeburn  7757:                     $depth --;
                   7758:                 }
                   7759:             }
                   7760:         }
1.57      raeburn  7761:     }
                   7762:     if ((keys(%changes) > 0) || (keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
                   7763:         $putresult = &Apache::lonnet::put_dom('configuration',\%domconfig,$dom);
1.48      raeburn  7764:         if ($putresult eq 'ok') {
1.57      raeburn  7765:             my %title = (
1.120     raeburn  7766:                          togglecats     => 'Show/Hide a course in catalog',
                   7767:                          categorize     => 'Assign a category to a course',
                   7768:                          togglecatscomm => 'Show/Hide a community in catalog',
                   7769:                          categorizecomm => 'Assign a category to a community',
1.57      raeburn  7770:                         );
                   7771:             my %level = (
1.120     raeburn  7772:                          dom  => 'set in Domain ("Modify Course/Community")',
                   7773:                          crs  => 'set in Course ("Course Configuration")',
                   7774:                          comm => 'set in Community ("Community Configuration")',
1.57      raeburn  7775:                         );
1.48      raeburn  7776:             $resulttext = &mt('Changes made:').'<ul>';
1.57      raeburn  7777:             if ($changes{'togglecats'}) {
                   7778:                 $resulttext .= '<li>'.&mt("$title{'togglecats'} $level{$env{'form.togglecats'}}").'</li>'; 
                   7779:             }
                   7780:             if ($changes{'categorize'}) {
                   7781:                 $resulttext .= '<li>'.&mt("$title{'categorize'} $level{$env{'form.categorize'}}").'</li>';
1.48      raeburn  7782:             }
1.120     raeburn  7783:             if ($changes{'togglecatscomm'}) {
                   7784:                 $resulttext .= '<li>'.&mt("$title{'togglecatscomm'} $level{$env{'form.togglecatscomm'}}").'</li>';
                   7785:             }
                   7786:             if ($changes{'categorizecomm'}) {
                   7787:                 $resulttext .= '<li>'.&mt("$title{'categorizecomm'} $level{$env{'form.categorizecomm'}}").'</li>';
                   7788:             }
1.57      raeburn  7789:             if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
                   7790:                 my $cathash;
                   7791:                 if (ref($domconfig{'coursecategories'}) eq 'HASH') {
                   7792:                     $cathash = $domconfig{'coursecategories'}{'cats'};
                   7793:                 } else {
                   7794:                     $cathash = {};
                   7795:                 } 
                   7796:                 my (@cats,@trails,%allitems);
                   7797:                     &Apache::loncommon::extract_categories($cathash,\@cats,\@trails,\%allitems);
                   7798:                 if (keys(%deletions) > 0) {
                   7799:                     $resulttext .= '<li>'.&mt('Deleted categories:').'<ul>';
                   7800:                     foreach my $predeltrail (sort {$a <=> $b } (keys(%sort_by_deltrail))) { 
                   7801:                         $resulttext .= '<li>'.$predeltrails[$predeltrail].'</li>';
                   7802:                     }
                   7803:                     $resulttext .= '</ul></li>';
                   7804:                 }
                   7805:                 if (keys(%reorderings) > 0) {
                   7806:                     my %sort_by_trail;
                   7807:                     $resulttext .= '<li>'.&mt('Reordered categories:').'<ul>';
                   7808:                     foreach my $key (keys(%reorderings)) {
                   7809:                         if ($allitems{$key} ne '') {
                   7810:                             $sort_by_trail{$allitems{$key}} = $trails[$allitems{$key}];
                   7811:                         }
1.48      raeburn  7812:                     }
1.57      raeburn  7813:                     foreach my $trail (sort {$a <=> $b } (keys(%sort_by_trail))) {
                   7814:                         $resulttext .= '<li>'.$trails[$trail].'</li>';
                   7815:                     }
                   7816:                     $resulttext .= '</ul></li>';
1.48      raeburn  7817:                 }
1.57      raeburn  7818:                 if (keys(%adds) > 0) {
                   7819:                     my %sort_by_trail;
                   7820:                     $resulttext .= '<li>'.&mt('Added categories:').'<ul>';
                   7821:                     foreach my $key (keys(%adds)) {
                   7822:                         if ($allitems{$key} ne '') {
                   7823:                             $sort_by_trail{$allitems{$key}} = $trails[$allitems{$key}];
                   7824:                         }
                   7825:                     }
                   7826:                     foreach my $trail (sort {$a <=> $b } (keys(%sort_by_trail))) {
                   7827:                         $resulttext .= '<li>'.$trails[$trail].'</li>';
1.48      raeburn  7828:                     }
1.57      raeburn  7829:                     $resulttext .= '</ul></li>';
1.48      raeburn  7830:                 }
                   7831:             }
                   7832:             $resulttext .= '</ul>';
                   7833:         } else {
                   7834:             $resulttext = '<span class="LC_error">'.
1.57      raeburn  7835:                           &mt('An error occurred: [_1]',$putresult).'</span>';
1.48      raeburn  7836:         }
                   7837:     } else {
1.120     raeburn  7838:         $resulttext = &mt('No changes made to course and community categories');
1.48      raeburn  7839:     }
                   7840:     return $resulttext;
                   7841: }
                   7842: 
1.69      raeburn  7843: sub modify_serverstatuses {
                   7844:     my ($dom,%domconfig) = @_;
                   7845:     my ($resulttext,%changes,%currserverstatus,%newserverstatus);
                   7846:     if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
                   7847:         %currserverstatus = %{$domconfig{'serverstatuses'}};
                   7848:     }
                   7849:     my @pages = &serverstatus_pages();
                   7850:     foreach my $type (@pages) {
                   7851:         $newserverstatus{$type}{'namedusers'} = '';
                   7852:         $newserverstatus{$type}{'machines'} = '';
                   7853:         if (defined($env{'form.'.$type.'_namedusers'})) {
                   7854:             my @users = split(/,/,$env{'form.'.$type.'_namedusers'});
                   7855:             my @okusers;
                   7856:             foreach my $user (@users) {
                   7857:                 my ($uname,$udom) = split(/:/,$user);
                   7858:                 if (($udom =~ /^$match_domain$/) &&   
                   7859:                     (&Apache::lonnet::domain($udom)) &&
                   7860:                     ($uname =~ /^$match_username$/)) {
                   7861:                     if (!grep(/^\Q$user\E/,@okusers)) {
                   7862:                         push(@okusers,$user);
                   7863:                     }
                   7864:                 }
                   7865:             }
                   7866:             if (@okusers > 0) {
                   7867:                  @okusers = sort(@okusers);
                   7868:                  $newserverstatus{$type}{'namedusers'} = join(',',@okusers);
                   7869:             }
                   7870:         }
                   7871:         if (defined($env{'form.'.$type.'_machines'})) {
                   7872:             my @machines = split(/,/,$env{'form.'.$type.'_machines'});
                   7873:             my @okmachines;
                   7874:             foreach my $ip (@machines) {
                   7875:                 my @parts = split(/\./,$ip);
                   7876:                 next if (@parts < 4);
                   7877:                 my $badip = 0;
                   7878:                 for (my $i=0; $i<4; $i++) {
                   7879:                     if (!(($parts[$i] >= 0) && ($parts[$i] <= 255))) {
                   7880:                         $badip = 1;
                   7881:                         last;
                   7882:                     }
                   7883:                 }
                   7884:                 if (!$badip) {
                   7885:                     push(@okmachines,$ip);     
                   7886:                 }
                   7887:             }
                   7888:             @okmachines = sort(@okmachines);
                   7889:             $newserverstatus{$type}{'machines'} = join(',',@okmachines);
                   7890:         }
                   7891:     }
                   7892:     my %serverstatushash =  (
                   7893:                                 serverstatuses => \%newserverstatus,
                   7894:                             );
                   7895:     foreach my $type (@pages) {
1.83      raeburn  7896:         foreach my $setting ('namedusers','machines') {
1.84      raeburn  7897:             my (@current,@new);
1.83      raeburn  7898:             if (ref($currserverstatus{$type}) eq 'HASH') {
1.84      raeburn  7899:                 if ($currserverstatus{$type}{$setting} ne '') { 
                   7900:                     @current = split(/,/,$currserverstatus{$type}{$setting});
                   7901:                 }
                   7902:             }
                   7903:             if ($newserverstatus{$type}{$setting} ne '') {
                   7904:                 @new = split(/,/,$newserverstatus{$type}{$setting});
1.83      raeburn  7905:             }
                   7906:             if (@current > 0) {
                   7907:                 if (@new > 0) {
                   7908:                     foreach my $item (@current) {
                   7909:                         if (!grep(/^\Q$item\E$/,@new)) {
                   7910:                             $changes{$type}{$setting} = 1;
1.82      raeburn  7911:                             last;
                   7912:                         }
                   7913:                     }
1.84      raeburn  7914:                     foreach my $item (@new) {
                   7915:                         if (!grep(/^\Q$item\E$/,@current)) {
                   7916:                             $changes{$type}{$setting} = 1;
                   7917:                             last;
1.82      raeburn  7918:                         }
                   7919:                     }
                   7920:                 } else {
1.83      raeburn  7921:                     $changes{$type}{$setting} = 1;
1.69      raeburn  7922:                 }
1.83      raeburn  7923:             } elsif (@new > 0) {
                   7924:                 $changes{$type}{$setting} = 1;
1.69      raeburn  7925:             }
                   7926:         }
                   7927:     }
                   7928:     if (keys(%changes) > 0) {
1.81      raeburn  7929:         my $titles= &LONCAPA::lonauthcgi::serverstatus_titles();
1.69      raeburn  7930:         my $putresult = &Apache::lonnet::put_dom('configuration',
                   7931:                                                  \%serverstatushash,$dom);
                   7932:         if ($putresult eq 'ok') {
                   7933:             $resulttext .= &mt('Changes made:').'<ul>';
                   7934:             foreach my $type (@pages) {
1.84      raeburn  7935:                 if (ref($changes{$type}) eq 'HASH') {
1.69      raeburn  7936:                     $resulttext .= '<li>'.$titles->{$type}.'<ul>';
1.84      raeburn  7937:                     if ($changes{$type}{'namedusers'}) {
1.69      raeburn  7938:                         if ($newserverstatus{$type}{'namedusers'} eq '') {
                   7939:                             $resulttext .= '<li>'.&mt("Access terminated for all specific (named) users").'</li>'."\n";
                   7940:                         } else {
                   7941:                             $resulttext .= '<li>'.&mt("Access available for the following specified users: ").$newserverstatus{$type}{'namedusers'}.'</li>'."\n";
                   7942:                         }
1.84      raeburn  7943:                     }
                   7944:                     if ($changes{$type}{'machines'}) {
1.69      raeburn  7945:                         if ($newserverstatus{$type}{'machines'} eq '') {
                   7946:                             $resulttext .= '<li>'.&mt("Access terminated for all specific IP addresses").'</li>'."\n";
                   7947:                         } else {
                   7948:                             $resulttext .= '<li>'.&mt("Access available for the following specified IP addresses: ").$newserverstatus{$type}{'machines'}.'</li>'."\n";
                   7949:                         }
                   7950: 
                   7951:                     }
                   7952:                     $resulttext .= '</ul></li>';
                   7953:                 }
                   7954:             }
                   7955:             $resulttext .= '</ul>';
                   7956:         } else {
                   7957:             $resulttext = '<span class="LC_error">'.
                   7958:                           &mt('An error occurred saving access settings for server status pages: [_1].',$putresult).'</span>';
                   7959: 
                   7960:         }
                   7961:     } else {
                   7962:         $resulttext = &mt('No changes made to access to server status pages');
                   7963:     }
                   7964:     return $resulttext;
                   7965: }
                   7966: 
1.118     jms      7967: sub modify_helpsettings {
1.122     jms      7968:     my ($r,$dom,$confname,%domconfig) = @_;
1.160.6.5  raeburn  7969:     my ($resulttext,$errors,%changes,%helphash);
                   7970:     my %defaultchecked = ('submitbugs' => 'on');
                   7971:     my @offon = ('off','on');
1.118     jms      7972:     my @toggles = ('submitbugs');
                   7973:     if (ref($domconfig{'helpsettings'}) eq 'HASH') {
                   7974:         foreach my $item (@toggles) {
1.160.6.5  raeburn  7975:             if ($defaultchecked{$item} eq 'on') { 
                   7976:                 if ($domconfig{'helpsettings'}{$item} eq '') {
                   7977:                     if ($env{'form.'.$item} eq '0') {
                   7978:                         $changes{$item} = 1;
                   7979:                     }
                   7980:                 } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) {
                   7981:                     $changes{$item} = 1;
                   7982:                 }
                   7983:             } elsif ($defaultchecked{$item} eq 'off') {
                   7984:                 if ($domconfig{'helpsettings'}{$item} eq '') {
                   7985:                     if ($env{'form.'.$item} eq '1') {
                   7986:                         $changes{$item} = 1;
                   7987:                     }
                   7988:                 } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) {
                   7989:                     $changes{$item} = 1;
                   7990:                 }
1.160.6.26! raeburn  7991:             }
1.160.6.5  raeburn  7992:             if (($env{'form.'.$item} eq '0') || ($env{'form.'.$item} eq '1')) {
                   7993:                 $helphash{'helpsettings'}{$item} = $env{'form.'.$item};
1.122     jms      7994:             }
                   7995:         }
1.118     jms      7996:     }
1.123     jms      7997:     my $putresult;
                   7998:     if (keys(%changes) > 0) {
1.160.6.5  raeburn  7999:         $putresult = &Apache::lonnet::put_dom('configuration',\%helphash,$dom);
                   8000:         if ($putresult eq 'ok') {
                   8001:             $resulttext = &mt('Changes made:').'<ul>';
                   8002:             foreach my $item (sort(keys(%changes))) {
                   8003:                 if ($item eq 'submitbugs') {
                   8004:                     $resulttext .= '<li>'.&mt('Display link to: [_1] set to "'.$offon[$env{'form.'.$item}].'".',
                   8005:                                               &Apache::loncommon::modal_link('http://bugs.loncapa.org',
                   8006:                                               &mt('LON-CAPA bug tracker'),600,500)).'</li>';
                   8007:                 }
                   8008:             }
                   8009:             $resulttext .= '</ul>';
                   8010:         } else {
                   8011:             $resulttext = &mt('No changes made to help settings');
                   8012:             $errors .= '<li><span class="LC_error">'.
                   8013:                        &mt('An error occurred storing the settings: [_1]',
                   8014:                            $putresult).'</span></li>';
                   8015:         }
1.118     jms      8016:     }
                   8017:     if ($errors) {
1.160.6.5  raeburn  8018:         $resulttext .= '<br />'.&mt('The following errors occurred: ').'<ul>'.
1.118     jms      8019:                        $errors.'</ul>';
                   8020:     }
                   8021:     return $resulttext;
                   8022: }
                   8023: 
1.121     raeburn  8024: sub modify_coursedefaults {
                   8025:     my ($dom,%domconfig) = @_;
                   8026:     my ($resulttext,$errors,%changes,%defaultshash);
                   8027:     my %defaultchecked = ('canuse_pdfforms' => 'off');
                   8028:     my @toggles = ('canuse_pdfforms');
1.160.6.21  raeburn  8029:     my @numbers = ('anonsurvey_threshold','uploadquota_official','uploadquota_unofficial',
                   8030:                    'uploadquota_community');
                   8031:     my @types = ('official','unofficial','community');
                   8032:     my %staticdefaults = (
                   8033:                            anonsurvey_threshold => 10,
                   8034:                            uploadquota          => 500,
                   8035:                          );
1.121     raeburn  8036: 
                   8037:     $defaultshash{'coursedefaults'} = {};
                   8038: 
                   8039:     if (ref($domconfig{'coursedefaults'}) ne 'HASH') {
                   8040:         if ($domconfig{'coursedefaults'} eq '') {
                   8041:             $domconfig{'coursedefaults'} = {};
                   8042:         }
                   8043:     }
                   8044: 
                   8045:     if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
                   8046:         foreach my $item (@toggles) {
                   8047:             if ($defaultchecked{$item} eq 'on') {
                   8048:                 if (($domconfig{'coursedefaults'}{$item} eq '') &&
                   8049:                     ($env{'form.'.$item} eq '0')) {
                   8050:                     $changes{$item} = 1;
1.160.6.16  raeburn  8051:                 } elsif ($domconfig{'coursedefaults'}{$item} ne $env{'form.'.$item}) {
1.121     raeburn  8052:                     $changes{$item} = 1;
                   8053:                 }
                   8054:             } elsif ($defaultchecked{$item} eq 'off') {
                   8055:                 if (($domconfig{'coursedefaults'}{$item} eq '') &&
                   8056:                     ($env{'form.'.$item} eq '1')) {
                   8057:                     $changes{$item} = 1;
                   8058:                 } elsif ($domconfig{'coursedefaults'}{$item} ne $env{'form.'.$item}) {
                   8059:                     $changes{$item} = 1;
                   8060:                 }
                   8061:             }
                   8062:             $defaultshash{'coursedefaults'}{$item} = $env{'form.'.$item};
                   8063:         }
1.160.6.21  raeburn  8064:         foreach my $item (@numbers) {
                   8065:             my ($currdef,$newdef);
1.160.6.26! raeburn  8066:             $newdef = $env{'form.'.$item};
1.160.6.21  raeburn  8067:             if ($item eq 'anonsurvey_threshold') {
                   8068:                 $currdef = $domconfig{'coursedefaults'}{$item};
                   8069:                 $newdef =~ s/\D//g;
                   8070:                 if ($newdef eq '' || $newdef < 1) {
                   8071:                     $newdef = 1;
                   8072:                 }
                   8073:                 $defaultshash{'coursedefaults'}{$item} = $newdef;
                   8074:             } else {
                   8075:                 my ($type) = ($item =~ /^\Quploadquota_\E(\w+)$/);
                   8076:                 if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
                   8077:                     $currdef = $domconfig{'coursedefaults'}{'uploadquota'}{$type};
                   8078:                 }
                   8079:                 $newdef =~ s/[^\w.\-]//g;
                   8080:                 $defaultshash{'coursedefaults'}{'uploadquota'}{$type} = $newdef;
                   8081:             }
                   8082:             if ($currdef ne $newdef) {
                   8083:                 my $staticdef;
                   8084:                 if ($item eq 'anonsurvey_threshold') {
                   8085:                     unless (($currdef eq '') && ($newdef == $staticdefaults{$item})) {
                   8086:                         $changes{$item} = 1;
                   8087:                     }
                   8088:                 } else {
                   8089:                     unless (($currdef eq '') && ($newdef == $staticdefaults{'uploadquota'})) {
                   8090:                         $changes{'uploadquota'} = 1;
                   8091:                     }
                   8092:                 }
1.139     raeburn  8093:             }
                   8094:         }
1.160.6.16  raeburn  8095:         my $officialcreds = $env{'form.official_credits'};
                   8096:         $officialcreds =~ s/^[^\d\.]//g;
                   8097:         my $unofficialcreds = $env{'form.unofficial_credits'};
                   8098:         $unofficialcreds =~ s/^[^\d\.]//g;
                   8099:         if (ref($domconfig{'coursedefaults'}{'coursecredits'} ne 'HASH') &&
                   8100:                 ($env{'form.coursecredits'} eq '1')) {
                   8101:                 $changes{'coursecredits'} = 1;
                   8102:         } else {
                   8103:             if (($domconfig{'coursedefaults'}{'coursecredits'}{'official'} ne $officialcreds)  ||
                   8104:                 ($domconfig{'coursedefaults'}{'coursecredits'}{'unofficial'} ne $unofficialcreds)) {
                   8105:                 $changes{'coursecredits'} = 1;
                   8106:             }
                   8107:         }
                   8108:         $defaultshash{'coursedefaults'}{'coursecredits'} = {
                   8109:             official   => $officialcreds,
                   8110:             unofficial => $unofficialcreds,
                   8111:         }
1.121     raeburn  8112:     }
                   8113:     my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash,
                   8114:                                              $dom);
                   8115:     if ($putresult eq 'ok') {
1.160.6.16  raeburn  8116:         my %domdefaults;
1.121     raeburn  8117:         if (keys(%changes) > 0) {
1.160.6.21  raeburn  8118:             if (($changes{'canuse_pdfforms'}) || ($changes{'coursecredits'}) || ($changes{'uploadquota'})) {
1.160.6.16  raeburn  8119:                 %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   8120:                 if ($changes{'canuse_pdfforms'}) {
                   8121:                     $domdefaults{'canuse_pdfforms'}=$defaultshash{'coursedefaults'}{'canuse_pdfforms'};
                   8122:                 }
                   8123:                 if ($changes{'coursecredits'}) {
                   8124:                     if (ref($defaultshash{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
                   8125:                         $domdefaults{'officialcredits'} =
                   8126:                             $defaultshash{'coursedefaults'}{'coursecredits'}{'official'};
                   8127:                         $domdefaults{'unofficialcredits'} =
                   8128:                             $defaultshash{'coursedefaults'}{'coursecredits'}{'unofficial'};
                   8129:                     }
                   8130:                 }
1.160.6.21  raeburn  8131:                 if ($changes{'uploadquota'}) {
                   8132:                     if (ref($defaultshash{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
                   8133:                         foreach my $type (@types) {
                   8134:                             $domdefaults{$type.'quota'}=$defaultshash{'coursedefaults'}{'uploadquota'}{$type};
                   8135:                         }
                   8136:                     }
                   8137:                 }
1.121     raeburn  8138:                 my $cachetime = 24*60*60;
                   8139:                 &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime);
                   8140:             }
                   8141:             $resulttext = &mt('Changes made:').'<ul>';
                   8142:             foreach my $item (sort(keys(%changes))) {
                   8143:                 if ($item eq 'canuse_pdfforms') {
                   8144:                     if ($env{'form.'.$item} eq '1') {
                   8145:                         $resulttext .= '<li>'.&mt("Course/Community users can create/upload PDF forms set to 'on'").'</li>';
                   8146:                     } else {
                   8147:                         $resulttext .= '<li>'.&mt('Course/Community users can create/upload PDF forms set to "off"').'</li>';
                   8148:                     }
1.139     raeburn  8149:                 } elsif ($item eq 'anonsurvey_threshold') {
1.160.6.26! raeburn  8150:                     $resulttext .= '<li>'.&mt('Responder count required for display of anonymous survey submissions set to [_1].',$defaultshash{'coursedefaults'}{'anonsurvey_threshold'}).'</li>';
1.160.6.21  raeburn  8151:                 } elsif ($item eq 'uploadquota') {
                   8152:                     if (ref($defaultshash{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
                   8153:                         $resulttext .= '<li>'.&mt('Default quota for content uploaded to a course/community via Course Editor set as follows:').'<ul>'.
                   8154:                                        '<li>'.&mt('Official courses: [_1] MB','<b>'.$defaultshash{'coursedefaults'}{'uploadquota'}{'official'}.'</b>').'</li>'.
                   8155:                                        '<li>'.&mt('Unofficial courses: [_1] MB','<b>'.$defaultshash{'coursedefaults'}{'uploadquota'}{'unofficial'}.'</b>').'</li>'.
                   8156:                                        '<li>'.&mt('Communities: [_1] MB','<b>'.$defaultshash{'coursedefaults'}{'uploadquota'}{'community'}.'</b>').'</li>'.
                   8157:                                        '</ul>'.
                   8158:                                        '</li>';
                   8159:                     } else {
                   8160:                         $resulttext .= '<li>'.&mt('Default quota for content uploaded via Course Editor remains default: [_1] MB',$staticdefaults{'uploadquota'}).'</li>';
                   8161:                     }
1.160.6.16  raeburn  8162:                 } elsif ($item eq 'coursecredits') {
                   8163:                     if (ref($defaultshash{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
                   8164:                         if (($domdefaults{'officialcredits'} eq '') &&
                   8165:                             ($domdefaults{'unofficialcredits'} eq '')) {
                   8166:                             $resulttext .= '<li>'.&mt('Student credits not in use for courses in this domain').'</li>';
                   8167:                         } else {
                   8168:                             $resulttext .= '<li>'.&mt('Student credits can be set per course by a Domain Coordinator, with the following defaults applying:').'<ul>'.
                   8169:                                            '<li>'.&mt('Official courses: [_1]',$defaultshash{'coursedefaults'}{'coursecredits'}{'official'}).'</li>'.
                   8170:                                            '<li>'.&mt('Unofficial courses: [_1]',$defaultshash{'coursedefaults'}{'coursecredits'}{'unofficial'}).'</li>'.
                   8171:                                            '</ul>'.
                   8172:                                            '</li>';
                   8173:                         }
                   8174:                     } else {
                   8175:                         $resulttext .= '<li>'.&mt('Student credits not in use for courses in this domain').'</li>';
                   8176:                     }
1.140     raeburn  8177:                 }
1.121     raeburn  8178:             }
                   8179:             $resulttext .= '</ul>';
                   8180:         } else {
                   8181:             $resulttext = &mt('No changes made to course defaults');
                   8182:         }
                   8183:     } else {
                   8184:         $resulttext = '<span class="LC_error">'.
                   8185:             &mt('An error occurred: [_1]',$putresult).'</span>';
                   8186:     }
                   8187:     return $resulttext;
                   8188: }
                   8189: 
1.137     raeburn  8190: sub modify_usersessions {
                   8191:     my ($dom,%domconfig) = @_;
1.145     raeburn  8192:     my @hostingtypes = ('version','excludedomain','includedomain');
                   8193:     my @offloadtypes = ('primary','default');
                   8194:     my %types = (
                   8195:                   remote => \@hostingtypes,
                   8196:                   hosted => \@hostingtypes,
                   8197:                   spares => \@offloadtypes,
                   8198:                 );
                   8199:     my @prefixes = ('remote','hosted','spares');
1.137     raeburn  8200:     my @lcversions = &Apache::lonnet::all_loncaparevs();
1.138     raeburn  8201:     my (%by_ip,%by_location,@intdoms);
                   8202:     &build_location_hashes(\@intdoms,\%by_ip,\%by_location);
                   8203:     my @locations = sort(keys(%by_location));
1.137     raeburn  8204:     my (%defaultshash,%changes);
                   8205:     foreach my $prefix (@prefixes) {
                   8206:         $defaultshash{'usersessions'}{$prefix} = {};
                   8207:     }
                   8208:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   8209:     my $resulttext;
1.138     raeburn  8210:     my %iphost = &Apache::lonnet::get_iphost();
1.137     raeburn  8211:     foreach my $prefix (@prefixes) {
1.145     raeburn  8212:         next if ($prefix eq 'spares');
                   8213:         foreach my $type (@{$types{$prefix}}) {
1.137     raeburn  8214:             my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'};
                   8215:             if ($type eq 'version') {
                   8216:                 my $value = $env{'form.'.$prefix.'_'.$type};
                   8217:                 my $okvalue;
                   8218:                 if ($value ne '') {
                   8219:                     if (grep(/^\Q$value\E$/,@lcversions)) {
                   8220:                         $okvalue = $value;
                   8221:                     }
                   8222:                 }
                   8223:                 if (ref($domconfig{'usersessions'}) eq 'HASH') {
                   8224:                     if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') {
                   8225:                         if ($domconfig{'usersessions'}{$prefix}{$type} ne '') {
                   8226:                             if ($inuse == 0) {
                   8227:                                 $changes{$prefix}{$type} = 1;
                   8228:                             } else {
                   8229:                                 if ($okvalue ne $domconfig{'usersessions'}{$prefix}{$type}) {
                   8230:                                     $changes{$prefix}{$type} = 1;
                   8231:                                 }
                   8232:                                 if ($okvalue ne '') {
                   8233:                                     $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
                   8234:                                 } 
                   8235:                             }
                   8236:                         } else {
                   8237:                             if (($inuse == 1) && ($okvalue ne '')) {
                   8238:                                 $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
                   8239:                                 $changes{$prefix}{$type} = 1;
                   8240:                             }
                   8241:                         }
                   8242:                     } else {
                   8243:                         if (($inuse == 1) && ($okvalue ne '')) {
                   8244:                             $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
                   8245:                             $changes{$prefix}{$type} = 1;
                   8246:                         }
                   8247:                     }
                   8248:                 } else {
                   8249:                     if (($inuse == 1) && ($okvalue ne '')) {
                   8250:                         $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
                   8251:                         $changes{$prefix}{$type} = 1;
                   8252:                     }
                   8253:                 }
                   8254:             } else {
                   8255:                 my @vals = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_'.$type);
                   8256:                 my @okvals;
                   8257:                 foreach my $val (@vals) {
1.138     raeburn  8258:                     if ($val =~ /:/) {
                   8259:                         my @items = split(/:/,$val);
                   8260:                         foreach my $item (@items) {
                   8261:                             if (ref($by_location{$item}) eq 'ARRAY') {
                   8262:                                 push(@okvals,$item);
                   8263:                             }
                   8264:                         }
                   8265:                     } else {
                   8266:                         if (ref($by_location{$val}) eq 'ARRAY') {
                   8267:                             push(@okvals,$val);
                   8268:                         }
1.137     raeburn  8269:                     }
                   8270:                 }
                   8271:                 @okvals = sort(@okvals);
                   8272:                 if (ref($domconfig{'usersessions'}) eq 'HASH') {
                   8273:                     if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') {
                   8274:                         if (ref($domconfig{'usersessions'}{$prefix}{$type}) eq 'ARRAY') {
                   8275:                             if ($inuse == 0) {
                   8276:                                 $changes{$prefix}{$type} = 1; 
                   8277:                             } else {
                   8278:                                 $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
                   8279:                                 my @changed = &Apache::loncommon::compare_arrays($domconfig{'usersessions'}{$prefix}{$type},$defaultshash{'usersessions'}{$prefix}{$type});
                   8280:                                 if (@changed > 0) {
                   8281:                                     $changes{$prefix}{$type} = 1;
                   8282:                                 }
                   8283:                             }
                   8284:                         } else {
                   8285:                             if ($inuse == 1) {
                   8286:                                 $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
                   8287:                                 $changes{$prefix}{$type} = 1;
                   8288:                             }
                   8289:                         } 
                   8290:                     } else {
                   8291:                         if ($inuse == 1) {
                   8292:                             $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
                   8293:                             $changes{$prefix}{$type} = 1;
                   8294:                         }
                   8295:                     }
                   8296:                 } else {
                   8297:                     if ($inuse == 1) {
                   8298:                         $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
                   8299:                         $changes{$prefix}{$type} = 1;
                   8300:                     }
                   8301:                 }
                   8302:             }
                   8303:         }
                   8304:     }
1.145     raeburn  8305: 
                   8306:     my @alldoms = &Apache::lonnet::all_domains();
1.149     raeburn  8307:     my %servers = &Apache::lonnet::internet_dom_servers($dom);
1.145     raeburn  8308:     my %spareid = &current_offloads_to($dom,$domconfig{'usersessions'},\%servers);
                   8309:     my $savespares;
                   8310: 
                   8311:     foreach my $lonhost (sort(keys(%servers))) {
                   8312:         my $serverhomeID =
                   8313:             &Apache::lonnet::get_server_homeID($servers{$lonhost});
1.152     raeburn  8314:         my $serverhostname = &Apache::lonnet::hostname($lonhost);
1.145     raeburn  8315:         $defaultshash{'usersessions'}{'spares'}{$lonhost} = {};
                   8316:         my %spareschg;
                   8317:         foreach my $type (@{$types{'spares'}}) {
                   8318:             my @okspares;
                   8319:             my @checked = &Apache::loncommon::get_env_multiple('form.spare_'.$type.'_'.$lonhost);
                   8320:             foreach my $server (@checked) {
1.152     raeburn  8321:                 if (&Apache::lonnet::hostname($server) ne '') {
                   8322:                     unless (&Apache::lonnet::hostname($server) eq $serverhostname) {
                   8323:                         unless (grep(/^\Q$server\E$/,@okspares)) {
                   8324:                             push(@okspares,$server);
                   8325:                         }
1.145     raeburn  8326:                     }
                   8327:                 }
                   8328:             }
                   8329:             my $new = $env{'form.newspare_'.$type.'_'.$lonhost};
                   8330:             my $newspare;
1.152     raeburn  8331:             if (($new ne '') && (&Apache::lonnet::hostname($new))) {
                   8332:                 unless (&Apache::lonnet::hostname($new) eq $serverhostname) {
1.145     raeburn  8333:                     $newspare = $new;
                   8334:                 }
                   8335:             }
1.152     raeburn  8336:             my @spares;
                   8337:             if (($newspare ne '') && (!grep(/^\Q$newspare\E$/,@okspares))) {
                   8338:                 @spares = sort(@okspares,$newspare);
                   8339:             } else {
                   8340:                 @spares = sort(@okspares);
                   8341:             }
                   8342:             $defaultshash{'usersessions'}{'spares'}{$lonhost}{$type} = \@spares;
1.145     raeburn  8343:             if (ref($spareid{$lonhost}) eq 'HASH') {
                   8344:                 if (ref($spareid{$lonhost}{$type}) eq 'ARRAY') {
1.152     raeburn  8345:                     my @diffs = &Apache::loncommon::compare_arrays($spareid{$lonhost}{$type},\@spares);
1.145     raeburn  8346:                     if (@diffs > 0) {
                   8347:                         $spareschg{$type} = 1;
                   8348:                     }
                   8349:                 }
                   8350:             }
                   8351:         }
                   8352:         if (keys(%spareschg) > 0) {
                   8353:             $changes{'spares'}{$lonhost} = \%spareschg;
                   8354:         }
                   8355:     }
                   8356: 
                   8357:     if (ref($domconfig{'usersessions'}) eq 'HASH') {
                   8358:         if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
                   8359:             if (ref($changes{'spares'}) eq 'HASH') {
                   8360:                 if (keys(%{$changes{'spares'}}) > 0) {
                   8361:                     $savespares = 1;
                   8362:                 }
                   8363:             }
                   8364:         } else {
                   8365:             $savespares = 1;
                   8366:         }
                   8367:     }
                   8368: 
1.147     raeburn  8369:     my $nochgmsg = &mt('No changes made to settings for user session hosting/offloading.');
                   8370:     if ((keys(%changes) > 0) || ($savespares)) {
1.137     raeburn  8371:         my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash,
                   8372:                                                  $dom);
                   8373:         if ($putresult eq 'ok') {
                   8374:             if (ref($defaultshash{'usersessions'}) eq 'HASH') {
                   8375:                 if (ref($defaultshash{'usersessions'}{'remote'}) eq 'HASH') {
                   8376:                     $domdefaults{'remotesessions'} = $defaultshash{'usersessions'}{'remote'};
                   8377:                 }
                   8378:                 if (ref($defaultshash{'usersessions'}{'hosted'}) eq 'HASH') {
                   8379:                     $domdefaults{'hostedsessions'} = $defaultshash{'usersessions'}{'hosted'};
                   8380:                 }
                   8381:             }
                   8382:             my $cachetime = 24*60*60;
                   8383:             &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime);
1.147     raeburn  8384:             if (keys(%changes) > 0) {
                   8385:                 my %lt = &usersession_titles();
                   8386:                 $resulttext = &mt('Changes made:').'<ul>';
                   8387:                 foreach my $prefix (@prefixes) {
                   8388:                     if (ref($changes{$prefix}) eq 'HASH') {
                   8389:                         $resulttext .= '<li>'.$lt{$prefix}.'<ul>';
                   8390:                         if ($prefix eq 'spares') {
                   8391:                             if (ref($changes{$prefix}) eq 'HASH') {
                   8392:                                 foreach my $lonhost (sort(keys(%{$changes{$prefix}}))) {
                   8393:                                     $resulttext .= '<li><b>'.$lonhost.'</b> ';
1.148     raeburn  8394:                                     my $lonhostdom = &Apache::lonnet::host_domain($lonhost);
                   8395:                                     &Apache::lonnet::remote_devalidate_cache($lonhost,'spares',$lonhostdom);
1.147     raeburn  8396:                                     if (ref($changes{$prefix}{$lonhost}) eq 'HASH') {
                   8397:                                         foreach my $type (@{$types{$prefix}}) {
                   8398:                                             if ($changes{$prefix}{$lonhost}{$type}) {
                   8399:                                                 my $offloadto = &mt('None');
                   8400:                                                 if (ref($defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}) eq 'ARRAY') {
                   8401:                                                     if (@{$defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}} > 0) {   
                   8402:                                                         $offloadto = join(', ',@{$defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}});
                   8403:                                                     }
1.145     raeburn  8404:                                                 }
1.147     raeburn  8405:                                                 $resulttext .= &mt('[_1] set to: [_2].','<i>'.$lt{$type}.'</i>',$offloadto).('&nbsp;'x3);
1.145     raeburn  8406:                                             }
1.137     raeburn  8407:                                         }
                   8408:                                     }
1.147     raeburn  8409:                                     $resulttext .= '</li>';
1.137     raeburn  8410:                                 }
                   8411:                             }
1.147     raeburn  8412:                         } else {
                   8413:                             foreach my $type (@{$types{$prefix}}) {
                   8414:                                 if (defined($changes{$prefix}{$type})) {
                   8415:                                     my $newvalue;
                   8416:                                     if (ref($defaultshash{'usersessions'}) eq 'HASH') {
                   8417:                                         if (ref($defaultshash{'usersessions'}{$prefix})) {
                   8418:                                             if ($type eq 'version') {
                   8419:                                                 $newvalue = $defaultshash{'usersessions'}{$prefix}{$type};
                   8420:                                             } elsif (ref($defaultshash{'usersessions'}{$prefix}{$type}) eq 'ARRAY') {
                   8421:                                                 if (@{$defaultshash{'usersessions'}{$prefix}{$type}} > 0) {
                   8422:                                                     $newvalue = join(', ',@{$defaultshash{'usersessions'}{$prefix}{$type}});
                   8423:                                                 }
1.145     raeburn  8424:                                             }
                   8425:                                         }
                   8426:                                     }
1.147     raeburn  8427:                                     if ($newvalue eq '') {
                   8428:                                         if ($type eq 'version') {
                   8429:                                             $resulttext .= '<li>'.&mt('[_1] set to: off',$lt{$type}).'</li>';
                   8430:                                         } else {
                   8431:                                             $resulttext .= '<li>'.&mt('[_1] set to: none',$lt{$type}).'</li>';
                   8432:                                         }
1.145     raeburn  8433:                                     } else {
1.147     raeburn  8434:                                         if ($type eq 'version') {
                   8435:                                             $newvalue .= ' '.&mt('(or later)'); 
                   8436:                                         }
                   8437:                                         $resulttext .= '<li>'.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'</li>';
1.145     raeburn  8438:                                     }
1.137     raeburn  8439:                                 }
                   8440:                             }
                   8441:                         }
1.147     raeburn  8442:                         $resulttext .= '</ul>';
1.137     raeburn  8443:                     }
                   8444:                 }
1.147     raeburn  8445:                 $resulttext .= '</ul>';
                   8446:             } else {
                   8447:                 $resulttext = $nochgmsg;
1.137     raeburn  8448:             }
                   8449:         } else {
                   8450:             $resulttext = '<span class="LC_error">'.
                   8451:                           &mt('An error occurred: [_1]',$putresult).'</span>';
                   8452:         }
                   8453:     } else {
1.147     raeburn  8454:         $resulttext = $nochgmsg;
1.137     raeburn  8455:     }
                   8456:     return $resulttext;
                   8457: }
                   8458: 
1.150     raeburn  8459: sub modify_loadbalancing {
                   8460:     my ($dom,%domconfig) = @_;
                   8461:     my $primary_id = &Apache::lonnet::domain($dom,'primary');
                   8462:     my $intdom = &Apache::lonnet::internet_dom($primary_id);
                   8463:     my ($othertitle,$usertypes,$types) =
                   8464:         &Apache::loncommon::sorted_inst_types($dom);
                   8465:     my %servers = &Apache::lonnet::internet_dom_servers($dom);
                   8466:     my @sparestypes = ('primary','default');
                   8467:     my %typetitles = &sparestype_titles();
                   8468:     my $resulttext;
1.160.6.7  raeburn  8469:     my (%currbalancer,%currtargets,%currrules,%existing);
                   8470:     if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
                   8471:         %existing = %{$domconfig{'loadbalancing'}};
                   8472:     }
                   8473:     &get_loadbalancers_config(\%servers,\%existing,\%currbalancer,
                   8474:                               \%currtargets,\%currrules);
                   8475:     my ($saveloadbalancing,%defaultshash,%changes);
                   8476:     my ($alltypes,$othertypes,$titles) =
                   8477:         &loadbalancing_titles($dom,$intdom,$usertypes,$types);
                   8478:     my %ruletitles = &offloadtype_text();
                   8479:     my @deletions = &Apache::loncommon::get_env_multiple('form.loadbalancing_delete');
                   8480:     for (my $i=0; $i<$env{'form.loadbalancing_total'}; $i++) {
                   8481:         my $balancer = $env{'form.loadbalancing_lonhost_'.$i};
                   8482:         if ($balancer eq '') {
                   8483:             next;
                   8484:         }
                   8485:         if (!exists($servers{$balancer})) {
                   8486:             if (exists($currbalancer{$balancer})) {
                   8487:                 push(@{$changes{'delete'}},$balancer);
1.150     raeburn  8488:             }
1.160.6.7  raeburn  8489:             next;
                   8490:         }
                   8491:         if ((@deletions > 0) && (grep(/^\Q$i\E$/,@deletions))) {
                   8492:             push(@{$changes{'delete'}},$balancer);
                   8493:             next;
                   8494:         }
                   8495:         if (!exists($currbalancer{$balancer})) {
                   8496:             push(@{$changes{'add'}},$balancer);
                   8497:         }
                   8498:         $defaultshash{'loadbalancing'}{$balancer}{'targets'}{'primary'} = [];
                   8499:         $defaultshash{'loadbalancing'}{$balancer}{'targets'}{'default'} = [];
                   8500:         $defaultshash{'loadbalancing'}{$balancer}{'rules'} = {};
                   8501:         unless (ref($domconfig{'loadbalancing'}) eq 'HASH') {
                   8502:             $saveloadbalancing = 1;
                   8503:         }
                   8504:         foreach my $sparetype (@sparestypes) {
                   8505:             my @targets = &Apache::loncommon::get_env_multiple('form.loadbalancing_target_'.$i.'_'.$sparetype);
                   8506:             my @offloadto;
                   8507:             foreach my $target (@targets) {
                   8508:                 if (($servers{$target}) && ($target ne $balancer)) {
                   8509:                     if ($sparetype eq 'default') {
                   8510:                         if (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{'primary'}) eq 'ARRAY') {
                   8511:                             next if (grep(/^\Q$target\E$/,@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{'primary'}}));
1.150     raeburn  8512:                         }
                   8513:                     }
1.160.6.7  raeburn  8514:                     unless(grep(/^\Q$target\E$/,@offloadto)) {
                   8515:                         push(@offloadto,$target);
                   8516:                     }
1.150     raeburn  8517:                 }
1.160.6.7  raeburn  8518:                 $defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype} = \@offloadto;
1.150     raeburn  8519:             }
                   8520:         }
1.160.6.7  raeburn  8521:         if (ref($currtargets{$balancer}) eq 'HASH') {
1.150     raeburn  8522:             foreach my $sparetype (@sparestypes) {
1.160.6.7  raeburn  8523:                 if (ref($currtargets{$balancer}{$sparetype}) eq 'ARRAY') {
                   8524:                     my @targetdiffs = &Apache::loncommon::compare_arrays($currtargets{$balancer}{$sparetype},$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype});
1.150     raeburn  8525:                     if (@targetdiffs > 0) {
1.160.6.7  raeburn  8526:                         $changes{'curr'}{$balancer}{'targets'} = 1;
1.150     raeburn  8527:                     }
1.160.6.7  raeburn  8528:                 } elsif (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}) eq 'ARRAY') {
                   8529:                     if (@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}} > 0) {
                   8530:                         $changes{'curr'}{$balancer}{'targets'} = 1;
1.150     raeburn  8531:                     }
                   8532:                 }
                   8533:             }
                   8534:         } else {
1.160.6.7  raeburn  8535:             if (ref($defaultshash{'loadbalancing'}{$balancer}) eq 'HASH') {
                   8536:                 foreach my $sparetype (@sparestypes) {
                   8537:                     if (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}) eq 'ARRAY') {
                   8538:                         if (@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}} > 0) {
                   8539:                             $changes{'curr'}{$balancer}{'targets'} = 1;
                   8540:                         }
1.150     raeburn  8541:                     }
                   8542:                 }
1.160.6.7  raeburn  8543:             }
1.150     raeburn  8544:         }
                   8545:         my $ishomedom;
1.160.6.7  raeburn  8546:         if (&Apache::lonnet::host_domain($balancer) eq $dom) {
                   8547:             $ishomedom = 1;
1.150     raeburn  8548:         }
                   8549:         if (ref($alltypes) eq 'ARRAY') {
                   8550:             foreach my $type (@{$alltypes}) {
                   8551:                 my $rule;
1.160.6.7  raeburn  8552:                 unless ((($type eq '_LC_external') || ($type eq '_LC_internetdom')) &&
1.150     raeburn  8553:                          (!$ishomedom)) {
1.160.6.7  raeburn  8554:                     $rule = $env{'form.loadbalancing_rules_'.$i.'_'.$type};
                   8555:                 }
                   8556:                 if ($rule eq 'specific') {
                   8557:                     $rule = $env{'form.loadbalancing_singleserver_'.$i.'_'.$type};
1.150     raeburn  8558:                 }
1.160.6.7  raeburn  8559:                 $defaultshash{'loadbalancing'}{$balancer}{'rules'}{$type} = $rule;
                   8560:                 if (ref($currrules{$balancer}) eq 'HASH') {
                   8561:                     if ($rule ne $currrules{$balancer}{$type}) {
                   8562:                         $changes{'curr'}{$balancer}{'rules'}{$type} = 1;
1.150     raeburn  8563:                     }
                   8564:                 } elsif ($rule ne '') {
1.160.6.7  raeburn  8565:                     $changes{'curr'}{$balancer}{'rules'}{$type} = 1;
1.150     raeburn  8566:                 }
                   8567:             }
                   8568:         }
1.160.6.7  raeburn  8569:     }
                   8570:     my $nochgmsg = &mt('No changes made to Load Balancer settings.');
                   8571:     if ((keys(%changes) > 0) || ($saveloadbalancing)) {
                   8572:         unless (ref($defaultshash{'loadbalancing'}) eq 'HASH') {
                   8573:             $defaultshash{'loadbalancing'} = {};
                   8574:         }
                   8575:         my $putresult = &Apache::lonnet::put_dom('configuration',
                   8576:                                                  \%defaultshash,$dom);
                   8577:         if ($putresult eq 'ok') {
                   8578:             if (keys(%changes) > 0) {
                   8579:                 if (ref($changes{'delete'}) eq 'ARRAY') {
                   8580:                     foreach my $balancer (sort(@{$changes{'delete'}})) {
                   8581:                         $resulttext .= '<li>'.&mt('Load Balancing discontinued for: [_1]',$balancer).'</li>';
1.150     raeburn  8582:                         &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom);
                   8583:                     }
1.160.6.7  raeburn  8584:                 }
                   8585:                 if (ref($changes{'add'}) eq 'ARRAY') {
                   8586:                     foreach my $balancer (sort(@{$changes{'add'}})) {
                   8587:                         $resulttext .= '<li>'.&mt('Load Balancing enabled for: [_1]',$balancer);
                   8588:                     }
                   8589:                 }
                   8590:                 if (ref($changes{'curr'}) eq 'HASH') {
                   8591:                     foreach my $balancer (sort(keys(%{$changes{'curr'}}))) {
                   8592:                         if (ref($changes{'curr'}{$balancer}) eq 'HASH') {
                   8593:                             if ($changes{'curr'}{$balancer}{'targets'}) {
                   8594:                                 my %offloadstr;
                   8595:                                 foreach my $sparetype (@sparestypes) {
                   8596:                                     if (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}) eq 'ARRAY') {
                   8597:                                         if (@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}} > 0) {
                   8598:                                             $offloadstr{$sparetype} = join(', ',@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}});
                   8599:                                         }
                   8600:                                     }
1.150     raeburn  8601:                                 }
1.160.6.7  raeburn  8602:                                 if (keys(%offloadstr) == 0) {
                   8603:                                     $resulttext .= '<li>'.&mt("Servers to which Load Balance server offloads set to 'None', by default").'</li>';
1.150     raeburn  8604:                                 } else {
1.160.6.7  raeburn  8605:                                     my $showoffload;
                   8606:                                     foreach my $sparetype (@sparestypes) {
                   8607:                                         $showoffload .= '<i>'.$typetitles{$sparetype}.'</i>:&nbsp;';
                   8608:                                         if (defined($offloadstr{$sparetype})) {
                   8609:                                             $showoffload .= $offloadstr{$sparetype};
                   8610:                                         } else {
                   8611:                                             $showoffload .= &mt('None');
                   8612:                                         }
                   8613:                                         $showoffload .= ('&nbsp;'x3);
                   8614:                                     }
                   8615:                                     $resulttext .= '<li>'.&mt('By default, Load Balancer: [_1] set to offload to - [_2]',$balancer,$showoffload).'</li>';
1.150     raeburn  8616:                                 }
                   8617:                             }
                   8618:                         }
1.160.6.7  raeburn  8619:                         if (ref($changes{'curr'}{$balancer}{'rules'}) eq 'HASH') {
                   8620:                             if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH')) {
                   8621:                                 foreach my $type (@{$alltypes}) {
                   8622:                                     if ($changes{'curr'}{$balancer}{'rules'}{$type}) {
                   8623:                                         my $rule = $defaultshash{'loadbalancing'}{$balancer}{'rules'}{$type};
                   8624:                                         my $balancetext;
                   8625:                                         if ($rule eq '') {
                   8626:                                             $balancetext =  $ruletitles{'default'};
1.160.6.26! raeburn  8627:                                         } elsif (($rule eq 'homeserver') || ($rule eq 'externalbalancer') ||
        !          8628:                                                  ($rule eq 'balancer') || ($rule eq 'offloadedto')) {
1.160.6.7  raeburn  8629:                                             $balancetext =  $ruletitles{$rule};
                   8630:                                         } else {
                   8631:                                             $balancetext = &mt('offload to [_1]',$defaultshash{'loadbalancing'}{$balancer}{'rules'}{$type});
                   8632:                                         }
1.160.6.26! raeburn  8633:                                         $resulttext .= '<li>'.&mt('Load Balancer: [_1] -- balancing for [_2] set to - "[_3]"',$balancer,$titles->{$type},$balancetext).'</li>';
1.150     raeburn  8634:                                     }
                   8635:                                 }
                   8636:                             }
                   8637:                         }
1.160.6.7  raeburn  8638:                         &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom);
1.150     raeburn  8639:                     }
1.160.6.7  raeburn  8640:                 }
                   8641:                 if ($resulttext ne '') {
                   8642:                     $resulttext = &mt('Changes made:').'<ul>'.$resulttext.'</ul>';
1.150     raeburn  8643:                 } else {
                   8644:                     $resulttext = $nochgmsg;
                   8645:                 }
                   8646:             } else {
1.160.6.7  raeburn  8647:                 $resulttext = $nochgmsg;
1.150     raeburn  8648:             }
                   8649:         } else {
1.160.6.7  raeburn  8650:             $resulttext = '<span class="LC_error">'.
                   8651:                           &mt('An error occurred: [_1]',$putresult).'</span>';
1.150     raeburn  8652:         }
                   8653:     } else {
1.160.6.7  raeburn  8654:         $resulttext = $nochgmsg;
1.150     raeburn  8655:     }
                   8656:     return $resulttext;
                   8657: }
                   8658: 
1.48      raeburn  8659: sub recurse_check {
                   8660:     my ($chkcats,$categories,$depth,$name) = @_;
                   8661:     if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') {
                   8662:         my $chg = 0;
                   8663:         for (my $j=0; $j<@{$chkcats->[$depth]{$name}}; $j++) {
                   8664:             my $category = $chkcats->[$depth]{$name}[$j];
                   8665:             my $item;
                   8666:             if ($category eq '') {
                   8667:                 $chg ++;
                   8668:             } else {
                   8669:                 my $deeper = $depth + 1;
                   8670:                 $item = &escape($category).':'.&escape($name).':'.$depth;
                   8671:                 if ($chg) {
                   8672:                     $categories->{$item} -= $chg;
                   8673:                 }
                   8674:                 &recurse_check($chkcats,$categories,$deeper,$category);
                   8675:                 $deeper --;
                   8676:             }
                   8677:         }
                   8678:     }
                   8679:     return;
                   8680: }
                   8681: 
                   8682: sub recurse_cat_deletes {
                   8683:     my ($item,$coursecategories,$deletions) = @_;
                   8684:     my ($deleted,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   8685:     my $subdepth = $depth + 1;
                   8686:     if (ref($coursecategories) eq 'HASH') {
                   8687:         foreach my $subitem (keys(%{$coursecategories})) {
                   8688:             my ($child,$parent,$itemdepth) = map { &unescape($_); } split(/:/,$subitem);
                   8689:             if (($parent eq $deleted) && ($itemdepth == $subdepth)) {
                   8690:                 delete($coursecategories->{$subitem});
                   8691:                 $deletions->{$subitem} = 1;
                   8692:                 &recurse_cat_deletes($subitem,$coursecategories,$deletions);
1.160.6.26! raeburn  8693:             }
1.48      raeburn  8694:         }
                   8695:     }
                   8696:     return;
                   8697: }
                   8698: 
1.125     raeburn  8699: sub get_active_dcs {
                   8700:     my ($dom) = @_;
1.160.6.16  raeburn  8701:     my $now = time;
                   8702:     my %dompersonnel = &Apache::lonnet::get_domain_roles($dom,['dc'],$now,$now);
1.125     raeburn  8703:     my %domcoords;
                   8704:     my $numdcs = 0;
                   8705:     foreach my $server (keys(%dompersonnel)) {
                   8706:         foreach my $user (sort(keys(%{$dompersonnel{$server}}))) {
                   8707:             my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user);
1.160.6.16  raeburn  8708:             $domcoords{$uname.':'.$udom} = $dompersonnel{$server}{$user};
1.125     raeburn  8709:         }
                   8710:     }
                   8711:     return %domcoords;
                   8712: }
                   8713: 
                   8714: sub active_dc_picker {
1.160.6.16  raeburn  8715:     my ($dom,$numinrow,$inputtype,$name,%currhash) = @_;
1.125     raeburn  8716:     my %domcoords = &get_active_dcs($dom); 
1.160.6.16  raeburn  8717:     my @domcoord = keys(%domcoords);
                   8718:     if (keys(%currhash)) {
                   8719:         foreach my $dc (keys(%currhash)) {
                   8720:             unless (exists($domcoords{$dc})) {
                   8721:                 push(@domcoord,$dc);
                   8722:             }
                   8723:         }
                   8724:     }
                   8725:     @domcoord = sort(@domcoord);
                   8726:     my $numdcs = scalar(@domcoord);
                   8727:     my $rows = 0;
                   8728:     my $table;
1.125     raeburn  8729:     if ($numdcs > 1) {
1.160.6.16  raeburn  8730:         $table = '<table>';
                   8731:         for (my $i=0; $i<@domcoord; $i++) {
1.125     raeburn  8732:             my $rem = $i%($numinrow);
                   8733:             if ($rem == 0) {
                   8734:                 if ($i > 0) {
1.160.6.16  raeburn  8735:                     $table .= '</tr>';
1.125     raeburn  8736:                 }
1.160.6.16  raeburn  8737:                 $table .= '<tr>';
                   8738:                 $rows ++;
1.125     raeburn  8739:             }
1.160.6.16  raeburn  8740:             my $check = '';
                   8741:             if ($inputtype eq 'radio') {
                   8742:                 if (keys(%currhash) == 0) {
                   8743:                     if (!$i) {
                   8744:                         $check = ' checked="checked"';
                   8745:                     }
                   8746:                 } elsif (exists($currhash{$domcoord[$i]})) {
                   8747:                     $check = ' checked="checked"';
                   8748:                 }
                   8749:             } else {
                   8750:                 if (exists($currhash{$domcoord[$i]})) {
                   8751:                     $check = ' checked="checked"';
1.125     raeburn  8752:                 }
                   8753:             }
1.160.6.16  raeburn  8754:             if ($i == @domcoord - 1) {
1.125     raeburn  8755:                 my $colsleft = $numinrow - $rem;
                   8756:                 if ($colsleft > 1) {
1.160.6.16  raeburn  8757:                     $table .= '<td class="LC_left_item" colspan="'.$colsleft.'">';
1.125     raeburn  8758:                 } else {
1.160.6.16  raeburn  8759:                     $table .= '<td class="LC_left_item">';
1.125     raeburn  8760:                 }
                   8761:             } else {
1.160.6.16  raeburn  8762:                 $table .= '<td class="LC_left_item">';
                   8763:             }
                   8764:             my ($dcname,$dcdom) = split(':',$domcoord[$i]);
                   8765:             my $user = &Apache::loncommon::plainname($dcname,$dcdom);
                   8766:             $table .= '<span class="LC_nobreak"><label>'.
                   8767:                       '<input type="'.$inputtype.'" name="'.$name.'"'.
                   8768:                       ' value="'.$domcoord[$i].'"'.$check.' />'.$user;
                   8769:             if ($user ne $dcname.':'.$dcdom) {
                   8770:                 $table .=  ' ('.$dcname.':'.$dcdom.')'.
                   8771:                            '</label></span></td>';
1.125     raeburn  8772:             }
                   8773:         }
1.160.6.16  raeburn  8774:         $table .= '</tr></table>';
                   8775:     } elsif ($numdcs == 1) {
                   8776:         if ($inputtype eq 'radio') {
                   8777:             $table .= '<input type="hidden" name="'.$name.'" value="'.$domcoord[0].'" />';
                   8778:         } else {
                   8779:             my $check;
                   8780:             if (exists($currhash{$domcoord[0]})) {
                   8781:                 $check = ' checked="checked"';
                   8782:             }
                   8783:             $table .= '<input type="checkbox" name="'.$name.'" '.
                   8784:                       'value="'.$domcoord[0].'"'.$check.' />';
                   8785:             $rows ++;
                   8786:         }
1.125     raeburn  8787:     }
1.160.6.16  raeburn  8788:     return ($numdcs,$table,$rows);
1.125     raeburn  8789: }
                   8790: 
1.137     raeburn  8791: sub usersession_titles {
                   8792:     return &Apache::lonlocal::texthash(
                   8793:                hosted => 'Hosting of sessions for users from other domains on servers in this domain',
                   8794:                remote => 'Hosting of sessions for users in this domain on servers in other domains',
1.145     raeburn  8795:                spares => 'Servers offloaded to, when busy',
1.137     raeburn  8796:                version => 'LON-CAPA version requirement',
1.138     raeburn  8797:                excludedomain => 'Allow all, but exclude specific domains',
                   8798:                includedomain => 'Deny all, but include specific domains',
1.145     raeburn  8799:                primary => 'Primary (checked first)',
1.154     raeburn  8800:                default => 'Default',
1.137     raeburn  8801:            );
                   8802: }
                   8803: 
1.152     raeburn  8804: sub id_for_thisdom {
                   8805:     my (%servers) = @_;
                   8806:     my %altids;
                   8807:     foreach my $server (keys(%servers)) {
                   8808:         my $serverhome = &Apache::lonnet::get_server_homeID($servers{$server});
                   8809:         if ($serverhome ne $server) {
                   8810:             $altids{$serverhome} = $server;
                   8811:         }
                   8812:     }
                   8813:     return %altids;
                   8814: }
                   8815: 
1.150     raeburn  8816: sub count_servers {
                   8817:     my ($currbalancer,%servers) = @_;
                   8818:     my (@spares,$numspares);
                   8819:     foreach my $lonhost (sort(keys(%servers))) {
                   8820:         next if ($currbalancer eq $lonhost);
                   8821:         push(@spares,$lonhost);
                   8822:     }
                   8823:     if ($currbalancer) {
                   8824:         $numspares = scalar(@spares);
                   8825:     } else {
                   8826:         $numspares = scalar(@spares) - 1;
                   8827:     }
                   8828:     return ($numspares,@spares);
                   8829: }
                   8830: 
                   8831: sub lonbalance_targets_js {
1.160.6.7  raeburn  8832:     my ($dom,$types,$servers,$settings) = @_;
1.150     raeburn  8833:     my $select = &mt('Select');
                   8834:     my ($alltargets,$allishome,$allinsttypes,@alltypes);
                   8835:     if (ref($servers) eq 'HASH') {
                   8836:         $alltargets = join("','",sort(keys(%{$servers})));
                   8837:         my @homedoms;
                   8838:         foreach my $server (sort(keys(%{$servers}))) {
                   8839:             if (&Apache::lonnet::host_domain($server) eq $dom) {
                   8840:                 push(@homedoms,'1');
                   8841:             } else {
                   8842:                 push(@homedoms,'0');
                   8843:             }
                   8844:         }
                   8845:         $allishome = join("','",@homedoms);
                   8846:     }
                   8847:     if (ref($types) eq 'ARRAY') {
                   8848:         if (@{$types} > 0) {
                   8849:             @alltypes = @{$types};
                   8850:         }
                   8851:     }
                   8852:     push(@alltypes,'default','_LC_adv','_LC_author','_LC_internetdom','_LC_external');
                   8853:     $allinsttypes = join("','",@alltypes);
1.160.6.7  raeburn  8854:     my (%currbalancer,%currtargets,%currrules,%existing);
                   8855:     if (ref($settings) eq 'HASH') {
                   8856:         %existing = %{$settings};
                   8857:     }
                   8858:     &get_loadbalancers_config($servers,\%existing,\%currbalancer,
                   8859:                               \%currtargets,\%currrules);
                   8860:     my $balancers = join("','",sort(keys(%currbalancer)));
1.150     raeburn  8861:     return <<"END";
                   8862: 
                   8863: <script type="text/javascript">
                   8864: // <![CDATA[
                   8865: 
1.160.6.7  raeburn  8866: currBalancers = new Array('$balancers');
                   8867: 
                   8868: function toggleTargets(balnum) {
                   8869:     var lonhostitem = document.getElementById('loadbalancing_lonhost_'+balnum);
                   8870:     var prevhostitem = document.getElementById('loadbalancing_prevlonhost_'+balnum);
                   8871:     var balancer = lonhostitem.options[lonhostitem.selectedIndex].value;
                   8872:     var prevbalancer = prevhostitem.value;
                   8873:     var baltotal = document.getElementById('loadbalancing_total').value;
                   8874:     prevhostitem.value = balancer;
                   8875:     if (prevbalancer != '') {
                   8876:         var prevIdx = currBalancers.indexOf(prevbalancer);
                   8877:         if (prevIdx != -1) {
                   8878:             currBalancers.splice(prevIdx,1);
                   8879:         }
                   8880:     }
1.150     raeburn  8881:     if (balancer == '') {
1.160.6.7  raeburn  8882:         hideSpares(balnum);
1.150     raeburn  8883:     } else {
1.160.6.7  raeburn  8884:         var currIdx = currBalancers.indexOf(balancer);
                   8885:         if (currIdx == -1) {
                   8886:             currBalancers.push(balancer);
                   8887:         }
1.150     raeburn  8888:         var homedoms = new Array('$allishome');
1.160.6.7  raeburn  8889:         var ishomedom = homedoms[lonhostitem.selectedIndex];
                   8890:         showSpares(balancer,ishomedom,balnum);
1.150     raeburn  8891:     }
1.160.6.7  raeburn  8892:     balancerChange(balnum,baltotal,'change',prevbalancer,balancer);
1.150     raeburn  8893:     return;
                   8894: }
                   8895: 
1.160.6.7  raeburn  8896: function showSpares(balancer,ishomedom,balnum) {
1.150     raeburn  8897:     var alltargets = new Array('$alltargets');
                   8898:     var insttypes = new Array('$allinsttypes');
1.151     raeburn  8899:     var offloadtypes = new Array('primary','default');
                   8900: 
1.160.6.7  raeburn  8901:     document.getElementById('loadbalancing_targets_'+balnum).style.display='block';
                   8902:     document.getElementById('loadbalancing_disabled_'+balnum).style.display='none';
1.152     raeburn  8903:  
1.151     raeburn  8904:     for (var i=0; i<offloadtypes.length; i++) {
                   8905:         var count = 0;
                   8906:         for (var j=0; j<alltargets.length; j++) {
                   8907:             if (alltargets[j] != balancer) {
1.160.6.7  raeburn  8908:                 var item = document.getElementById('loadbalancing_target_'+balnum+'_'+offloadtypes[i]+'_'+count);
                   8909:                 item.value = alltargets[j];
                   8910:                 item.style.textAlign='left';
                   8911:                 item.style.textFace='normal';
                   8912:                 document.getElementById('loadbalancing_targettxt_'+balnum+'_'+offloadtypes[i]+'_'+count).innerHTML = alltargets[j];
                   8913:                 if (currBalancers.indexOf(alltargets[j]) == -1) {
                   8914:                     item.disabled = '';
                   8915:                 } else {
                   8916:                     item.disabled = 'disabled';
                   8917:                     item.checked = false;
                   8918:                 }
1.151     raeburn  8919:                 count ++;
                   8920:             }
1.150     raeburn  8921:         }
                   8922:     }
1.151     raeburn  8923:     for (var k=0; k<insttypes.length; k++) {
                   8924:         if ((insttypes[k] == '_LC_external') || (insttypes[k] == '_LC_internetdom')) {
1.150     raeburn  8925:             if (ishomedom == 1) {
1.160.6.7  raeburn  8926:                 document.getElementById('balanceruletitle_'+balnum+'_'+insttypes[k]).style.display='block';
                   8927:                 document.getElementById('balancerule_'+balnum+'_'+insttypes[k]).style.display='block';
1.150     raeburn  8928:             } else {
1.160.6.7  raeburn  8929:                 document.getElementById('balanceruletitle_'+balnum+'_'+insttypes[k]).style.display='none';
                   8930:                 document.getElementById('balancerule_'+balnum+'_'+insttypes[k]).style.display='none';
1.150     raeburn  8931:             }
                   8932:         } else {
1.160.6.7  raeburn  8933:             document.getElementById('balanceruletitle_'+balnum+'_'+insttypes[k]).style.display='block';
                   8934:             document.getElementById('balancerule_'+balnum+'_'+insttypes[k]).style.display='block';
1.150     raeburn  8935:         }
1.151     raeburn  8936:         if ((insttypes[k] != '_LC_external') && 
                   8937:             ((insttypes[k] != '_LC_internetdom') ||
                   8938:              ((insttypes[k] == '_LC_internetdom') && (ishomedom == 1)))) {
1.160.6.7  raeburn  8939:             var item = document.getElementById('loadbalancing_singleserver_'+balnum+'_'+insttypes[k]);
                   8940:             item.options.length = 0;
                   8941:             item.options[0] = new Option("","",true,true);
                   8942:             var idx = 0;
1.151     raeburn  8943:             for (var m=0; m<alltargets.length; m++) {
1.160.6.7  raeburn  8944:                 if ((currBalancers.indexOf(alltargets[m]) == -1) && (alltargets[m] != balancer)) {
                   8945:                     idx ++;
                   8946:                     item.options[idx] = new Option(alltargets[m],alltargets[m],false,false);
1.150     raeburn  8947:                 }
                   8948:             }
                   8949:         }
                   8950:     }
                   8951:     return;
                   8952: }
                   8953: 
1.160.6.7  raeburn  8954: function hideSpares(balnum) {
1.150     raeburn  8955:     var alltargets = new Array('$alltargets');
                   8956:     var insttypes = new Array('$allinsttypes');
                   8957:     var offloadtypes = new Array('primary','default');
                   8958: 
1.160.6.7  raeburn  8959:     document.getElementById('loadbalancing_targets_'+balnum).style.display='none';
                   8960:     document.getElementById('loadbalancing_disabled_'+balnum).style.display='block';
1.150     raeburn  8961: 
                   8962:     var total = alltargets.length - 1;
                   8963:     for (var i=0; i<offloadtypes; i++) {
                   8964:         for (var j=0; j<total; j++) {
1.160.6.7  raeburn  8965:            document.getElementById('loadbalancing_target_'+balnum+'_'+offloadtypes[i]+'_'+j).checked = false;
                   8966:            document.getElementById('loadbalancing_target_'+balnum+'_'+offloadtypes[i]+'_'+j).value = '';
                   8967:            document.getElementById('loadbalancing_targettxt_'+balnum+'_'+offloadtypes[i]+'_'+j).innerHTML = '';
1.151     raeburn  8968:         }
1.150     raeburn  8969:     }
                   8970:     for (var k=0; k<insttypes.length; k++) {
1.160.6.7  raeburn  8971:         document.getElementById('balanceruletitle_'+balnum+'_'+insttypes[k]).style.display='none';
                   8972:         document.getElementById('balancerule_'+balnum+'_'+insttypes[k]).style.display='none';
1.151     raeburn  8973:         if (insttypes[k] != '_LC_external') {
1.160.6.7  raeburn  8974:             document.getElementById('loadbalancing_singleserver_'+balnum+'_'+insttypes[k]).length = 0;
                   8975:             document.getElementById('loadbalancing_singleserver_'+balnum+'_'+insttypes[k]).options[0] = new Option("","",true,true);
1.150     raeburn  8976:         }
                   8977:     }
                   8978:     return;
                   8979: }
                   8980: 
1.160.6.7  raeburn  8981: function checkOffloads(item,balnum,type) {
1.150     raeburn  8982:     var alltargets = new Array('$alltargets');
                   8983:     var offloadtypes = new Array('primary','default');
                   8984:     if (item.checked) {
                   8985:         var total = alltargets.length - 1;
                   8986:         var other;
                   8987:         if (type == offloadtypes[0]) {
1.151     raeburn  8988:             other = offloadtypes[1];
1.150     raeburn  8989:         } else {
1.151     raeburn  8990:             other = offloadtypes[0];
1.150     raeburn  8991:         }
                   8992:         for (var i=0; i<total; i++) {
1.160.6.7  raeburn  8993:             var server = document.getElementById('loadbalancing_target_'+balnum+'_'+other+'_'+i).value;
1.150     raeburn  8994:             if (server == item.value) {
1.160.6.7  raeburn  8995:                 if (document.getElementById('loadbalancing_target_'+balnum+'_'+other+'_'+i).checked) {
                   8996:                     document.getElementById('loadbalancing_target_'+balnum+'_'+other+'_'+i).checked = false;
1.150     raeburn  8997:                 }
                   8998:             }
                   8999:         }
                   9000:     }
                   9001:     return;
                   9002: }
                   9003: 
1.160.6.7  raeburn  9004: function singleServerToggle(balnum,type) {
                   9005:     var offloadtoSelIdx = document.getElementById('loadbalancing_singleserver_'+balnum+'_'+type).selectedIndex;
1.150     raeburn  9006:     if (offloadtoSelIdx == 0) {
1.160.6.7  raeburn  9007:         document.getElementById('loadbalancing_rules_'+balnum+'_'+type+'_0').checked = true;
                   9008:         document.getElementById('loadbalancing_singleserver_'+balnum+'_'+type).options[0].text = '';
1.150     raeburn  9009: 
                   9010:     } else {
1.160.6.7  raeburn  9011:         document.getElementById('loadbalancing_rules_'+balnum+'_'+type+'_2').checked = true;
                   9012:         document.getElementById('loadbalancing_singleserver_'+balnum+'_'+type).options[0].text = '$select';
1.150     raeburn  9013:     }
                   9014:     return;
                   9015: }
                   9016: 
1.160.6.7  raeburn  9017: function balanceruleChange(formname,balnum,type) {
1.150     raeburn  9018:     if (type == '_LC_external') {
1.160.6.26! raeburn  9019:         return;
1.150     raeburn  9020:     }
1.160.6.7  raeburn  9021:     var typesRules = getIndicesByName(formname,'loadbalancing_rules_'+balnum+'_'+type);
1.150     raeburn  9022:     for (var i=0; i<typesRules.length; i++) {
                   9023:         if (formname.elements[typesRules[i]].checked) {
                   9024:             if (formname.elements[typesRules[i]].value != 'specific') {
1.160.6.7  raeburn  9025:                 document.getElementById('loadbalancing_singleserver_'+balnum+'_'+type).selectedIndex = 0;
                   9026:                 document.getElementById('loadbalancing_singleserver_'+balnum+'_'+type).options[0].text = '';
1.150     raeburn  9027:             } else {
1.160.6.7  raeburn  9028:                 document.getElementById('loadbalancing_singleserver_'+balnum+'_'+type).options[0].text = '$select';
                   9029:             }
                   9030:         }
                   9031:     }
                   9032:     return;
                   9033: }
                   9034: 
                   9035: function balancerDeleteChange(balnum) {
                   9036:     var hostitem = document.getElementById('loadbalancing_lonhost_'+balnum);
                   9037:     var baltotal = document.getElementById('loadbalancing_total').value;
                   9038:     var addtarget;
                   9039:     var removetarget;
                   9040:     var action = 'delete';
                   9041:     if (document.getElementById('loadbalancing_delete_'+balnum)) {
                   9042:         var lonhost = hostitem.value;
                   9043:         var currIdx = currBalancers.indexOf(lonhost);
                   9044:         if (document.getElementById('loadbalancing_delete_'+balnum).checked) {
                   9045:             if (currIdx != -1) {
                   9046:                 currBalancers.splice(currIdx,1);
                   9047:             }
                   9048:             addtarget = lonhost;
                   9049:         } else {
                   9050:             if (currIdx == -1) {
                   9051:                 currBalancers.push(lonhost);
                   9052:             }
                   9053:             removetarget = lonhost;
                   9054:             action = 'undelete';
                   9055:         }
                   9056:         balancerChange(balnum,baltotal,action,addtarget,removetarget);
                   9057:     }
                   9058:     return;
                   9059: }
                   9060: 
                   9061: function balancerChange(balnum,baltotal,action,addtarget,removetarget) {
                   9062:     if (baltotal > 1) {
                   9063:         var offloadtypes = new Array('primary','default');
                   9064:         var alltargets = new Array('$alltargets');
                   9065:         var insttypes = new Array('$allinsttypes');
                   9066:         for (var i=0; i<baltotal; i++) {
                   9067:             if (i != balnum) {
                   9068:                 for (var j=0; j<offloadtypes.length; j++) {
                   9069:                     var total = alltargets.length - 1;
                   9070:                     for (var k=0; k<total; k++) {
                   9071:                         var serveritem = document.getElementById('loadbalancing_target_'+i+'_'+offloadtypes[j]+'_'+k);
                   9072:                         var server = serveritem.value;
                   9073:                         if ((action == 'delete') || (action == 'change' && addtarget != ''))  {
                   9074:                             if (server == addtarget) {
                   9075:                                 serveritem.disabled = '';
                   9076:                             }
                   9077:                         }
                   9078:                         if ((action == 'undelete') || (action == 'change' && removetarget != '')) {
                   9079:                             if (server == removetarget) {
                   9080:                                 serveritem.disabled = 'disabled';
                   9081:                                 serveritem.checked = false;
                   9082:                             }
                   9083:                         }
                   9084:                     }
                   9085:                 }
                   9086:                 for (var j=0; j<insttypes.length; j++) {
                   9087:                     if (insttypes[j] != '_LC_external') {
                   9088:                         if (document.getElementById('loadbalancing_singleserver_'+i+'_'+insttypes[j])) {
                   9089:                             var singleserver = document.getElementById('loadbalancing_singleserver_'+i+'_'+insttypes[j]);
                   9090:                             var currSel = singleserver.selectedIndex;
                   9091:                             var currVal = singleserver.options[currSel].value;
                   9092:                             if ((action == 'delete') || (action == 'change' && addtarget != '')) {
                   9093:                                 var numoptions = singleserver.options.length;
                   9094:                                 var needsnew = 1;
                   9095:                                 for (var k=0; k<numoptions; k++) {
                   9096:                                     if (singleserver.options[k] == addtarget) {
                   9097:                                         needsnew = 0;
                   9098:                                         break;
                   9099:                                     }
                   9100:                                 }
                   9101:                                 if (needsnew == 1) {
                   9102:                                     singleserver.options[numoptions] = new Option(addtarget,addtarget,false,false);
                   9103:                                 }
                   9104:                             }
                   9105:                             if ((action == 'undelete') || (action == 'change' && removetarget != '')) {
                   9106:                                 singleserver.options.length = 0;
                   9107:                                 if ((currVal) && (currVal != removetarget)) {
                   9108:                                     singleserver.options[0] = new Option("","",false,false);
                   9109:                                 } else {
                   9110:                                     singleserver.options[0] = new Option("","",true,true);
                   9111:                                 }
                   9112:                                 var idx = 0;
                   9113:                                 for (var m=0; m<alltargets.length; m++) {
                   9114:                                     if (currBalancers.indexOf(alltargets[m]) == -1) {
                   9115:                                         idx ++;
                   9116:                                         if (currVal == alltargets[m]) {
                   9117:                                             singleserver.options[idx] = new Option(alltargets[m],alltargets[m],true,true);
                   9118:                                         } else {
                   9119:                                             singleserver.options[idx] = new Option(alltargets[m],alltargets[m],false,false);
                   9120:                                         }
                   9121:                                     }
                   9122:                                 }
                   9123:                             }
                   9124:                         }
                   9125:                     }
                   9126:                 }
1.150     raeburn  9127:             }
                   9128:         }
                   9129:     }
                   9130:     return;
                   9131: }
                   9132: 
1.152     raeburn  9133: // ]]>
                   9134: </script>
                   9135: 
                   9136: END
                   9137: }
                   9138: 
                   9139: sub new_spares_js {
                   9140:     my @sparestypes = ('primary','default');
                   9141:     my $types = join("','",@sparestypes);
                   9142:     my $select = &mt('Select');
                   9143:     return <<"END";
                   9144: 
                   9145: <script type="text/javascript">
                   9146: // <![CDATA[
                   9147: 
                   9148: function updateNewSpares(formname,lonhost) {
                   9149:     var types = new Array('$types');
                   9150:     var include = new Array();
                   9151:     var exclude = new Array();
                   9152:     for (var i=0; i<types.length; i++) {
                   9153:         var spareboxes = getIndicesByName(formname,'spare_'+types[i]+'_'+lonhost);
                   9154:         for (var j=0; j<spareboxes.length; j++) {
                   9155:             if (formname.elements[spareboxes[j]].checked) {
                   9156:                 exclude.push(formname.elements[spareboxes[j]].value);
                   9157:             } else {
                   9158:                 include.push(formname.elements[spareboxes[j]].value);
                   9159:             }
                   9160:         }
                   9161:     }
                   9162:     for (var i=0; i<types.length; i++) {
                   9163:         var newSpare = document.getElementById('newspare_'+types[i]+'_'+lonhost);
                   9164:         var selIdx = newSpare.selectedIndex;
                   9165:         var currnew = newSpare.options[selIdx].value;
                   9166:         var okSpares = new Array();
                   9167:         for (var j=0; j<newSpare.options.length; j++) {
                   9168:             var possible = newSpare.options[j].value;
                   9169:             if (possible != '') {
                   9170:                 if (exclude.indexOf(possible) == -1) {
                   9171:                     okSpares.push(possible);
                   9172:                 } else {
                   9173:                     if (currnew == possible) {
                   9174:                         selIdx = 0;
                   9175:                     }
                   9176:                 }
                   9177:             }
                   9178:         }
                   9179:         for (var k=0; k<include.length; k++) {
                   9180:             if (okSpares.indexOf(include[k]) == -1) {
                   9181:                 okSpares.push(include[k]);
                   9182:             }
                   9183:         }
                   9184:         okSpares.sort();
                   9185:         newSpare.options.length = 0;
                   9186:         if (selIdx == 0) {
                   9187:             newSpare.options[0] = new Option("$select","",true,true);
                   9188:         } else {
                   9189:             newSpare.options[0] = new Option("$select","",false,false);
                   9190:         }
                   9191:         for (var m=0; m<okSpares.length; m++) {
                   9192:             var idx = m+1;
                   9193:             var selThis = 0;
                   9194:             if (selIdx != 0) {
                   9195:                 if (okSpares[m] == currnew) {
                   9196:                     selThis = 1;
                   9197:                 }
                   9198:             }
                   9199:             if (selThis == 1) {
                   9200:                 newSpare.options[idx] = new Option(okSpares[m],okSpares[m],true,true);
                   9201:             } else {
                   9202:                 newSpare.options[idx] = new Option(okSpares[m],okSpares[m],false,false);
                   9203:             }
                   9204:         }
                   9205:     }
                   9206:     return;
                   9207: }
                   9208: 
                   9209: function checkNewSpares(lonhost,type) {
                   9210:     var newSpare = document.getElementById('newspare_'+type+'_'+lonhost);
                   9211:     var chosen =  newSpare.options[newSpare.selectedIndex].value;
                   9212:     if (chosen != '') { 
                   9213:         var othertype;
                   9214:         var othernewSpare;
                   9215:         if (type == 'primary') {
                   9216:             othernewSpare = document.getElementById('newspare_default_'+lonhost);
                   9217:         }
                   9218:         if (type == 'default') {
                   9219:             othernewSpare = document.getElementById('newspare_primary_'+lonhost);
                   9220:         }
                   9221:         if (othernewSpare.options[othernewSpare.selectedIndex].value == chosen) {
                   9222:             othernewSpare.selectedIndex = 0;
                   9223:         }
                   9224:     }
                   9225:     return;
                   9226: }
                   9227: 
                   9228: // ]]>
                   9229: </script>
                   9230: 
                   9231: END
                   9232: 
                   9233: }
                   9234: 
                   9235: sub common_domprefs_js {
                   9236:     return <<"END";
                   9237: 
                   9238: <script type="text/javascript">
                   9239: // <![CDATA[
                   9240: 
1.150     raeburn  9241: function getIndicesByName(formname,item) {
1.152     raeburn  9242:     var group = new Array();
1.150     raeburn  9243:     for (var i=0;i<formname.elements.length;i++) {
                   9244:         if (formname.elements[i].name == item) {
1.152     raeburn  9245:             group.push(formname.elements[i].id);
1.150     raeburn  9246:         }
                   9247:     }
1.152     raeburn  9248:     return group;
1.150     raeburn  9249: }
                   9250: 
                   9251: // ]]>
                   9252: </script>
                   9253: 
                   9254: END
1.152     raeburn  9255: 
1.150     raeburn  9256: }
                   9257: 
1.160.6.5  raeburn  9258: sub recaptcha_js {
                   9259:     my %lt = &captcha_phrases();
                   9260:     return <<"END";
                   9261: 
                   9262: <script type="text/javascript">
                   9263: // <![CDATA[
                   9264: 
                   9265: function updateCaptcha(caller,context) {
                   9266:     var privitem;
                   9267:     var pubitem;
                   9268:     var privtext;
                   9269:     var pubtext;
                   9270:     if (document.getElementById(context+'_recaptchapub')) {
                   9271:         pubitem = document.getElementById(context+'_recaptchapub');
                   9272:     } else {
                   9273:         return;
                   9274:     }
                   9275:     if (document.getElementById(context+'_recaptchapriv')) {
                   9276:         privitem = document.getElementById(context+'_recaptchapriv');
                   9277:     } else {
                   9278:         return;
                   9279:     }
                   9280:     if (document.getElementById(context+'_recaptchapubtxt')) {
                   9281:         pubtext = document.getElementById(context+'_recaptchapubtxt');
                   9282:     } else {
                   9283:         return;
                   9284:     }
                   9285:     if (document.getElementById(context+'_recaptchaprivtxt')) {
                   9286:         privtext = document.getElementById(context+'_recaptchaprivtxt');
                   9287:     } else {
                   9288:         return;
                   9289:     }
                   9290:     if (caller.checked) {
                   9291:         if (caller.value == 'recaptcha') {
                   9292:             pubitem.type = 'text';
                   9293:             privitem.type = 'text';
                   9294:             pubitem.size = '40';
                   9295:             privitem.size = '40';
                   9296:             pubtext.innerHTML = "$lt{'pub'}";
                   9297:             privtext.innerHTML = "$lt{'priv'}";
                   9298:         } else {
                   9299:             pubitem.type = 'hidden';
                   9300:             privitem.type = 'hidden';
                   9301:             pubtext.innerHTML = '';
                   9302:             privtext.innerHTML = '';
                   9303:         }
                   9304:     }
                   9305:     return;
                   9306: }
                   9307: 
                   9308: // ]]>
                   9309: </script>
                   9310: 
                   9311: END
                   9312: 
                   9313: }
                   9314: 
1.160.6.16  raeburn  9315: sub credits_js {
                   9316:     return <<"END";
                   9317: 
                   9318: <script type="text/javascript">
                   9319: // <![CDATA[
                   9320: 
                   9321: function toggleCredits(domForm) {
                   9322:     if (document.getElementById('credits')) {
                   9323:         creditsitem = document.getElementById('credits');
                   9324:         var creditsLength = domForm.coursecredits.length;
                   9325:         if (creditsLength) {
                   9326:             var currval;
                   9327:             for (var i=0; i<creditsLength; i++) {
                   9328:                 if (domForm.coursecredits[i].checked) {
                   9329:                    currval = domForm.coursecredits[i].value;
                   9330:                 }
                   9331:             }
                   9332:             if (currval == 1) {
                   9333:                 creditsitem.style.display = 'block';
                   9334:             } else {
                   9335:                 creditsitem.style.display = 'none';
                   9336:             }
                   9337:         }
                   9338:     }
                   9339:     return;
                   9340: }
                   9341: 
                   9342: // ]]>
                   9343: </script>
                   9344: 
                   9345: END
                   9346: 
                   9347: }
                   9348: 
1.160.6.5  raeburn  9349: sub captcha_phrases {
                   9350:     return &Apache::lonlocal::texthash (
                   9351:                  priv => 'Private key',
                   9352:                  pub  => 'Public key',
                   9353:                  original  => 'original (CAPTCHA)',
                   9354:                  recaptcha => 'successor (ReCAPTCHA)',
                   9355:                  notused   => 'unused',
                   9356:     );
                   9357: }
                   9358: 
1.160.6.24  raeburn  9359: sub devalidate_remote_domconfs {
                   9360:     my ($dom) = @_;
                   9361:     my $primary_id = &Apache::lonnet::domain($dom,'primary');
                   9362:     my $intdom = &Apache::lonnet::internet_dom($primary_id);
                   9363:     my %servers = &Apache::lonnet::internet_dom_servers($dom);
                   9364:     my %thismachine;
                   9365:     map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids();
                   9366:     if (keys(%servers) > 1) {
                   9367:         foreach my $server (keys(%servers)) {
                   9368:             next if ($thismachine{$server});
                   9369:             &Apache::lonnet::remote_devalidate_cache($server,'domainconfig',$dom);
                   9370:         }
                   9371:     }
                   9372:     return;
                   9373: }
                   9374: 
1.3       raeburn  9375: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.