File:  [LON-CAPA] / loncom / interface / domainprefs.pm
Revision 1.21: download - view: text, annotated - select for diffs
Thu Jun 7 23:19:42 2007 UTC (17 years ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Display message and switch server link if there are still custom logos/image stored in the old format (in /adm/lonDomLogos).
- Remove trailing space regexp applied to output from ImageMagick identify call. Although Image Magick on Fedora has a space after the pixel values, Image Magick shipped with SLES9 does not.

    1: # The LearningOnline Network with CAPA
    2: # Handler to set domain-wide configuration settings
    3: #
    4: # $Id: domainprefs.pm,v 1.21 2007/06/07 23:19:42 raeburn Exp $
    5: #
    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: 
   31: package Apache::domainprefs;
   32: 
   33: use strict;
   34: use Apache::Constants qw(:common :http);
   35: use Apache::lonnet;
   36: use Apache::loncommon();
   37: use Apache::lonhtmlcommon();
   38: use Apache::lonlocal;
   39: use LONCAPA();
   40: use LONCAPA::Enrollment;
   41: use File::Copy;
   42: 
   43: sub handler {
   44:     my $r=shift;
   45:     if ($r->header_only) {
   46:         &Apache::loncommon::content_type($r,'text/html');
   47:         $r->send_http_header;
   48:         return OK;
   49:     }
   50: 
   51:     my $dom = $env{'request.role.domain'};
   52:     my $domdesc = &Apache::lonnet::domain($dom,'description');
   53:     if (&Apache::lonnet::allowed('mau',$dom)) {
   54:         &Apache::loncommon::content_type($r,'text/html');
   55:         $r->send_http_header;
   56:     } else {
   57:         $env{'user.error.msg'}=
   58:         "/adm/domainprefs:mau:0:0:Cannot modify domain settings";
   59:         return HTTP_NOT_ACCEPTABLE;
   60:     }
   61:     &Apache::lonhtmlcommon::clear_breadcrumbs();
   62:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
   63:                                             ['phase']);
   64:     my $phase = "display";
   65:     if ( exists($env{'form.phase'}) ) {
   66:         $phase = $env{'form.phase'};
   67:     }
   68:     my %domconfig =
   69:       &Apache::lonnet::get_dom('configuration',['login','rolecolors',
   70:                                'quotas','autoenroll','autoupdate'],$dom);
   71:     my @prefs = (
   72:       { text => 'Default color schemes',
   73:         help => 'Default_Color_Schemes',
   74:         action => 'rolecolors',
   75:         header => [{col1 => 'Student Settings',
   76:                     col2 => '',},
   77:                    {col1 => 'Coordinator Settings',
   78:                     col2 => '',},
   79:                    {col1 => 'Author Settings',
   80:                     col2 => '',},
   81:                    {col1 => 'Administrator Settings',
   82:                     col2 => '',}],
   83:         },
   84:       { text => 'Log-in page options',
   85:         help => 'Domain_Log-in_Page',
   86:         action => 'login',
   87:         header => [{col1 => 'Item',
   88:                     col2 => '',}],
   89:         },
   90:       { text => 'Default quotas for user portfolios',
   91:         help => 'Default_User_Quota',
   92:         action => 'quotas',
   93:         header => [{col1 => 'User type',
   94:                     col2 => 'Default quota'}],
   95:         },
   96:       { text => 'Auto-enrollment settings',
   97:         help => 'Domain_Auto_Enrollment',
   98:         action => 'autoenroll',
   99:         header => [{col1 => 'Configuration setting',
  100:                     col2 => 'Value(s)'}],
  101:         },
  102:       { text => 'Auto-update settings',
  103:         help => 'Domain_Auto_Update',
  104:         action => 'autoupdate',
  105:         header => [{col1 => 'Setting',
  106:                     col2 => 'Value',},
  107:                    {col1 => 'User Population',
  108:                     col2 => 'Updataeable user data'}],
  109:       },
  110:     );
  111:     my @roles = ('student','coordinator','author','admin');
  112:     &Apache::lonhtmlcommon::add_breadcrumb
  113:     ({href=>"javascript:changePage(document.$phase,'display')",
  114:       text=>"Domain Configuration"});
  115:     my $confname = $dom.'-domainconfig';
  116:     if ($phase eq 'process') {
  117:         &Apache::lonhtmlcommon::add_breadcrumb
  118:           ({href=>"javascript:changePage(document.$phase,'$phase')",
  119:             text=>"Updated"});
  120:         &print_header($r,$phase);
  121:         foreach my $item (@prefs) {
  122:             $r->print('<h3>'.&mt($item->{'text'}).'</h3>'.
  123:                       &process_changes($r,$dom,$confname,
  124:                         $item->{'action'},\@roles,%domconfig));
  125:         }
  126:         $r->print('<p>');
  127:         &print_footer($r,$phase,'display','Back to actions menu');
  128:         $r->print('</p>');
  129:     } else {
  130:         if ($phase eq '') {
  131:             $phase = 'display';
  132:         }
  133:         my %helphash;   
  134:         my $numprefs = @prefs;
  135:         &print_header($r,$phase);
  136:         if (keys(%domconfig) == 0) {
  137:             my $primarylibserv = &Apache::lonnet::domain($dom,'primary');
  138:             my $perlvarref = &LONCAPA::Configuration::read_conf('loncapa.conf');
  139:             my $hostid = $perlvarref->{'lonHostID'};
  140:             if ($hostid ne $primarylibserv) {
  141:                 my %designhash = &Apache::loncommon::get_domainconf($dom);
  142:                 my @loginimages = ('img','logo','domlogo');
  143:                 my $custom_img_count = 0;
  144:                 foreach my $img (@loginimages) {
  145:                     if ($designhash{$dom.'.login.'.$img} ne '') {
  146:                         $custom_img_count ++;
  147:                     }
  148:                 }
  149:                 foreach my $role (@roles) {
  150:                     if ($designhash{$dom.'.'.$role.'.img'} ne '') {
  151:                         $custom_img_count ++;
  152:                     }
  153:                 }
  154:                 if ($custom_img_count > 0) {
  155:                     my $switch_server = &check_switchserver($dom,$confname);
  156:                     $r->print(&mt('Domain configuration settings have yet to be saved for this domain via the web-based domain preferences interface.').'<br />'.&mt("While this remains so, you must switch to the domain's primary library server in order to update settings.").'<br /><br />'.&mt("Thereafter, you will be able to update settings from this screen when logged in to any server in the LON-CAPA network (with a DC role selected in the domain), although you will still need to switch to the domain's primary library server to upload new images or logos.").'<br /><br />'.$switch_server.' '.&mt('to primary library server for domain: [_1]',$dom));
  157:                     return OK;
  158:                 }
  159:             }
  160:         }
  161:         $r->print('<table border="0" width="100%" cellpadding="2" cellspacing="4"><tr><td align="left" valign="top" width="45%">');
  162:         foreach my $item (@prefs) {
  163:             if ($item->{'action'} eq 'login') {
  164:                 $r->print('</td><td width="6%">&nbsp;</td><td align="left" valign="top" width="47%">');
  165:             }
  166:             &print_config_box($r,$dom,$confname,$phase,$item->{'action'},
  167:                               $item,$domconfig{$item->{'action'}});
  168:         }
  169:         $r->print('
  170:       </td>
  171:     </tr>
  172:    </table>');
  173:         &print_footer($r,$phase,'process','Save changes');
  174:     }
  175:     return OK;
  176: }
  177: 
  178: sub process_changes {
  179:     my ($r,$dom,$confname,$action,$roles,%domconfig) = @_;
  180:     my $output;
  181:     if ($action eq 'login') {
  182:         $output = &modify_login($r,$dom,$confname,%domconfig);
  183:     } elsif ($action eq 'rolecolors') {
  184:         $output = &modify_rolecolors($r,$dom,$confname,$roles,
  185:                                      %domconfig);
  186:     } elsif ($action eq 'quotas') {
  187:         $output = &modify_quotas($dom,%domconfig);
  188:     } elsif ($action eq 'autoenroll') {
  189:         $output = &modify_autoenroll($dom,%domconfig);
  190:     } elsif ($action eq 'autoupdate') {
  191:         $output = &modify_autoupdate($dom,%domconfig);
  192:     }
  193:     return $output;
  194: }
  195: 
  196: sub print_config_box {
  197:     my ($r,$dom,$confname,$phase,$action,$item,$settings) = @_;
  198:     $r->print('
  199:          <table class="LC_nested_outer">
  200:           <tr>
  201:            <th>'.&mt($item->{text}).'&nbsp;'.
  202:            &Apache::loncommon::help_open_topic($item->{'help'}).'</th>
  203:           </tr>');
  204:     if (($action eq 'autoupdate') || ($action eq 'rolecolors')) {
  205:         my $colspan = ($action eq 'rolecolors')?' colspan="2"':'';
  206:         $r->print('
  207:           <tr>
  208:            <td>
  209:             <table class="LC_nested">
  210:              <tr class="LC_info_row">
  211:               <td class="LC_left_item"'.$colspan.'>'.$item->{'header'}->[0]->{'col1'}.'</td>
  212:               <td class="LC_right_item">'.$item->{'header'}->[0]->{'col2'}.'</td>
  213:              </tr>');
  214:         if ($action eq 'autoupdate') {
  215:             $r->print(&print_autoupdate('top',$dom,$settings));
  216:         } else {
  217:             $r->print(&print_rolecolors($phase,'student',$dom,$confname,$settings));
  218:         }
  219:         $r->print('
  220:            </table>
  221:           </td>
  222:          </tr>
  223:          <tr>
  224:            <td>
  225:             <table class="LC_nested">
  226:              <tr class="LC_info_row">
  227:               <td class="LC_left_item"'.$colspan.'>'.$item->{'header'}->[1]->{'col1'}.'</td>
  228:               <td class="LC_right_item">'.$item->{'header'}->[1]->{'col2'}.'</td>
  229:              </tr>');
  230:         if ($action eq 'autoupdate') {
  231:             $r->print(&print_autoupdate('bottom',$dom,$settings));
  232:         } else {
  233:             $r->print(&print_rolecolors($phase,'coordinator',$dom,$confname,$settings).'
  234:            </table>
  235:           </td>
  236:          </tr>
  237:          <tr>
  238:            <td>
  239:             <table class="LC_nested">
  240:              <tr class="LC_info_row">
  241:               <td class="LC_left_item"'.$colspan.'>'.$item->{'header'}->[2]->{'col1'}.'</td>
  242:               <td class="LC_right_item">'.$item->{'header'}->[2]->{'col2'}.'</td>
  243:              </tr>'.
  244:             &print_rolecolors($phase,'author',$dom,$confname,$settings).'
  245:            </table>
  246:           </td>
  247:          </tr>
  248:          <tr>
  249:            <td>
  250:             <table class="LC_nested">
  251:              <tr class="LC_info_row">
  252:               <td class="LC_left_item"'.$colspan.'>'.$item->{'header'}->[3]->{'col1'}.'</td>
  253:               <td class="LC_right_item">'.$item->{'header'}->[3]->{'col2'}.'</td>
  254:              </tr>'.
  255:             &print_rolecolors($phase,'admin',$dom,$confname,$settings));
  256:         }
  257:     } else {
  258:         $r->print('
  259:           <tr>
  260:            <td>
  261:             <table class="LC_nested">
  262:              <tr class="LC_info_row">');
  263:         if ($action eq 'login') {
  264:             $r->print('  
  265:               <td class="LC_left_item" colspan="2">'.$item->{'header'}->[0]->{'col1'}.'</td>');
  266:         } else {
  267:             $r->print('
  268:               <td class="LC_left_item">'.$item->{'header'}->[0]->{'col1'}.'</td>');
  269:         }
  270:         $r->print('
  271:               <td class="LC_right_item">'.$item->{'header'}->[0]->{'col2'}.'</td>
  272:              </tr>');
  273:         if ($action eq 'login') {
  274:            $r->print(&print_login($dom,$confname,$phase,$settings));
  275:         } elsif ($action eq 'quotas') {
  276:            $r->print(&print_quotas($dom,$settings));
  277:         } elsif ($action eq 'autoenroll') {
  278:            $r->print(&print_autoenroll($dom,$settings));
  279:         }  
  280:     }
  281:     $r->print('
  282:    </table>
  283:   </td>
  284:  </tr>
  285: </table><br />');
  286:     return;
  287: }
  288: 
  289: sub print_header {
  290:     my ($r,$phase) = @_;
  291:     my $js = '
  292: <script type="text/javascript">
  293: function changePage(formname,newphase) {
  294:     formname.phase.value = newphase;
  295:     formname.submit();
  296: }
  297: '.
  298: &color_pick_js().'
  299: </script>
  300: ';
  301:     $r->print(&Apache::loncommon::start_page('View/Modify Domain Settings',
  302:                                            $js));
  303:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Domain Settings'));
  304:     $r->print('
  305: <form name="parmform" action="">
  306: <input type="hidden" name="pres_marker" />
  307: <input type="hidden" name="pres_type" />
  308: <input type="hidden" name="pres_value" />
  309: </form>
  310: ');
  311:     $r->print('<form method="post" name="'.$phase.'" action="/adm/domainprefs"'.
  312:               ' enctype="multipart/form-data">');
  313:     return;
  314: }
  315: 
  316: sub print_footer {
  317:     my ($r,$phase,$newphase,$button_text) = @_;
  318:     $button_text = &mt($button_text);
  319:     $r->print('<input type="hidden" name="phase" value="" />');
  320:     my $dest='"javascript:changePage(document.'.$phase.','."'$newphase'".')"';
  321:     if ($phase eq 'process') {
  322:         $r->print('<a href='.$dest.'>'.$button_text.'</a>');
  323:     } else {
  324:         $r->print('<input type="button" name="store" value="'.
  325:                   $button_text.'" onclick='.$dest.' />');
  326:     }
  327:     $r->print('</form>');
  328:     $r->print('<br />'.&Apache::loncommon::end_page());
  329:     return;
  330: }
  331: 
  332: sub print_login {
  333:     my ($dom,$confname,$phase,$settings) = @_;
  334:     my %choices = &login_choices();
  335:     my ($catalogon,$catalogoff,$adminmailon,$adminmailoff);
  336:     $catalogon = ' checked="checked" ';
  337:     $adminmailoff = ' checked="checked" ';
  338:     my @images = ('img','logo','domlogo');
  339:     my @bgs = ('pgbg','mainbg','sidebg');
  340:     my @links = ('link','alink','vlink');
  341:     my %designhash = &Apache::loncommon::get_domainconf($dom);
  342:     my %defaultdesign = %Apache::loncommon::defaultdesign;
  343:     my (%is_custom,%designs);
  344:     my %defaults = (
  345:                    font => $defaultdesign{'login.font'},
  346:                    );
  347:     foreach my $item (@images) {
  348:         $defaults{$item} = $defaultdesign{'login.'.$item};
  349:     }
  350:     foreach my $item (@bgs) {
  351:         $defaults{'bgs'}{$item} = $defaultdesign{'login.'.$item};
  352:     }
  353:     foreach my $item (@links) {
  354:         $defaults{'links'}{$item} = $defaultdesign{'login.'.$item};
  355:     }
  356:     if (ref($settings) eq 'HASH') {
  357:         if ($settings->{'coursecatalog'} eq '0') {
  358:             $catalogoff = $catalogon;
  359:             $catalogon = ' ';
  360:         }
  361:         if ($settings->{'adminmail'} eq '1') {
  362:             $adminmailon = $adminmailoff;
  363:             $adminmailoff = ' ';
  364:         }
  365:         foreach my $item (@images) {
  366:             if ($settings->{$item} ne '') {
  367:                 $designs{$item} = $settings->{$item};
  368:                 $is_custom{$item} = 1;
  369:             }
  370:         }
  371:         if ($settings->{'font'} ne '') {
  372:             $designs{'font'} = $settings->{'font'};
  373:             $is_custom{'font'} = 1;
  374:         }
  375:         foreach my $item (@bgs) {
  376:             if ($settings->{$item} ne '') {
  377:                 $designs{'bgs'}{$item} = $settings->{$item};
  378:                 $is_custom{$item} = 1;
  379:             }
  380:         }
  381:         foreach my $item (@links) {
  382:             if ($settings->{$item} ne '') {
  383:                 $designs{'links'}{$item} = $settings->{$item};
  384:                 $is_custom{$item} = 1;
  385:             }
  386:         }
  387:     } else {
  388:         if ($designhash{$dom.'.login.font'} ne '') {
  389:             $designs{'font'} = $designhash{$dom.'.login.font'};
  390:             $is_custom{'font'} = 1;
  391:         }
  392:         foreach my $item (@images) {
  393:             if ($designhash{$dom.'.login.'.$item} ne '') {
  394:                 $designs{$item} = $designhash{$dom.'.login.'.$item};
  395:                 $is_custom{$item} = 1;
  396:             }
  397:         }
  398:         foreach my $item (@bgs) {
  399:             if ($designhash{$dom.'.login.'.$item} ne '') {
  400:                 $designs{'bgs'}{$item} = $designhash{$dom.'.login.'.$item};
  401:                 $is_custom{$item} = 1;
  402:             }
  403:         }
  404:         foreach my $item (@links) {
  405:             if ($designhash{$dom.'.login.'.$item} ne '') {
  406:                 $designs{'links'}{$item} = $designhash{$dom.'.login.'.$item};
  407:                 $is_custom{$item} = 1;
  408:             }
  409:         }
  410:     }
  411:     my %alt_text = &Apache::lonlocal::texthash  ( img => 'Log-in banner',
  412:                                                   logo => 'Institution Logo',
  413:                                                   domlogo => 'Domain Logo');
  414:     my $itemcount = 1;
  415:     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
  416:     my $datatable = 
  417:         '<tr'.$css_class.'><td colspan="2">'.$choices{'coursecatalog'}.
  418:         '</td><td>'.
  419:         '<span class="LC_nobreak"><label><input type="radio" name="coursecatalog"'.
  420:         $catalogon.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
  421:         '<label><input type="radio" name="coursecatalog"'.
  422:         $catalogoff.'value="0" />'.&mt('No').'</label></span></td>'.
  423:         '</tr>';
  424:     $itemcount ++;
  425:     $css_class = $itemcount%2?' class="LC_odd_row"':'';
  426:     $datatable .= '<tr'.$css_class.'>'.
  427:         '<td colspan="2">'.$choices{'adminmail'}.'</td>'.
  428:         '<td><span class="LC_nobreak">'.
  429:         '<label><input type="radio" name="adminmail"'.
  430:         $adminmailon.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
  431:         '<label><input type="radio" name="adminmail"'.
  432:         $adminmailoff.'value="0" />'.&mt('No').'</label></span></td></tr>';
  433:     $itemcount ++;
  434:     $datatable .= &display_color_options($dom,$confname,$phase,'login',$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text);
  435:     $datatable .= '</tr></table></td></tr>';
  436:     return $datatable;
  437: }
  438: 
  439: sub login_choices {
  440:     my %choices =
  441:         &Apache::lonlocal::texthash (
  442:             coursecatalog => 'Display Course Catalog link?',
  443:             adminmail => "Display Administrator's E-mail Address?",
  444:             img => "Header",
  445:             logo => "Main Logo",
  446:             domlogo => "Domain Logo",
  447:             bgs => "Background colors",
  448:             links => "Link colors",
  449:             font => "Font color",
  450:             pgbg => "Page",
  451:             mainbg => "Main panel",
  452:             sidebg => "Side panel",
  453:             link => "Link",
  454:             alink => "Active link",
  455:             vlink => "Visited link",
  456:         );
  457:     return %choices;
  458: }
  459: 
  460: sub print_rolecolors {
  461:     my ($phase,$role,$dom,$confname,$settings) = @_;
  462:     my %choices = &color_font_choices();
  463:     my @bgs = ('pgbg','tabbg','sidebg');
  464:     my @links = ('link','alink','vlink');
  465:     my @images = ('img');
  466:     my %alt_text = &Apache::lonlocal::texthash(img => "Banner for $role role");
  467:     my %designhash = &Apache::loncommon::get_domainconf($dom);
  468:     my %defaultdesign = %Apache::loncommon::defaultdesign;
  469:     my (%is_custom,%designs);
  470:     my %defaults = (
  471:                    img => $defaultdesign{$role.'.img'},
  472:                    font => $defaultdesign{$role.'.font'},
  473:                    );
  474:     foreach my $item (@bgs) {
  475:         $defaults{'bgs'}{$item} = $defaultdesign{$role.'.'.$item};
  476:     }
  477:     foreach my $item (@links) {
  478:         $defaults{'links'}{$item} = $defaultdesign{$role.'.'.$item};
  479:     }
  480:     if (ref($settings) eq 'HASH') {
  481:         if (ref($settings->{$role}) eq 'HASH') {
  482:             if ($settings->{$role}->{'img'} ne '') {
  483:                 $designs{'img'} = $settings->{$role}->{'img'};
  484:                 $is_custom{'img'} = 1;
  485:             }
  486:             if ($settings->{$role}->{'font'} ne '') {
  487:                 $designs{'font'} = $settings->{$role}->{'font'};
  488:                 $is_custom{'font'} = 1;
  489:             }
  490:             foreach my $item (@bgs) {
  491:                 if ($settings->{$role}->{$item} ne '') {
  492:                     $designs{'bgs'}{$item} = $settings->{$role}->{$item};
  493:                     $is_custom{$item} = 1;
  494:                 }
  495:             }
  496:             foreach my $item (@links) {
  497:                 if ($settings->{$role}->{$item} ne '') {
  498:                     $designs{'links'}{$item} = $settings->{$role}->{$item};
  499:                     $is_custom{$item} = 1;
  500:                 }
  501:             }
  502:         }
  503:     } else {
  504:         if ($designhash{$dom.'.'.$role.'.img'} ne '') {
  505:             $designs{img} = $designhash{$dom.'.'.$role.'.img'};
  506:             $is_custom{'img'} = 1;
  507:         }
  508:         if ($designhash{$dom.'.'.$role.'.font'} ne '') {
  509:             $designs{font} = $designhash{$dom.'.'.$role.'.font'};
  510:             $is_custom{'font'} = 1;
  511:         }
  512:         foreach my $item (@bgs) {
  513:             if ($designhash{$dom.'.'.$role.'.'.$item} ne '') {
  514:                 $designs{'bgs'}{$item} = $designhash{$dom.'.'.$role.'.'.$item};
  515:                 $is_custom{$item} = 1;
  516:             
  517:             }
  518:         }
  519:         foreach my $item (@links) {
  520:             if ($designhash{$dom.'.'.$role.'.'.$item} ne '') {
  521:                 $designs{'links'}{$item} = $designhash{$dom.'.'.$role.'.'.$item};
  522:                 $is_custom{$item} = 1;
  523:             }
  524:         }
  525:     }
  526:     my $itemcount = 1;
  527:     my $datatable = &display_color_options($dom,$confname,$phase,$role,$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text);
  528:     $datatable .= '</tr></table></td></tr>';
  529:     return $datatable;
  530: }
  531: 
  532: sub display_color_options {
  533:     my ($dom,$confname,$phase,$role,$itemcount,$choices,$is_custom,$defaults,$designs,
  534:         $images,$bgs,$links,$alt_text) = @_;
  535:     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
  536:     my $datatable = '<tr'.$css_class.'>'.
  537:         '<td>'.$choices->{'font'}.'</td>';
  538:     if (!$is_custom->{'font'}) {
  539:         $datatable .=  '<td>'.&mt('Default in use:').'&nbsp;'.$defaults->{'font'}.'</td>';
  540:     } else {
  541:         $datatable .= '<td>&nbsp;</td>';
  542:     }
  543:     my $fontlink = &color_pick($phase,$role,'font',$choices->{'font'},$designs->{'font'});
  544:     $datatable .= '<td><span class="LC_nobreak">'.
  545:                   '<input type="text" size="10" name="'.$role.'_font"'.
  546:                   ' value="'.$designs->{'font'}.'" />&nbsp;'.$fontlink.
  547:                   '</span></td></tr>';
  548:     my $switchserver = &check_switchserver($dom,$confname);
  549:     foreach my $img (@{$images}) {
  550: 	$itemcount ++;
  551:         $css_class = $itemcount%2?' class="LC_odd_row"':'';
  552:         $datatable .= '<tr'.$css_class.'>'.
  553:                       '<td>'.$choices->{$img}.'</td>';
  554:         my ($imgfile, $img_import);
  555:         if ($designs->{$img} ne '') {
  556:             $imgfile = $designs->{$img};
  557: 	    $img_import = ($imgfile =~ m{^/adm/});
  558:         } else {
  559:             $imgfile = $defaults->{$img};
  560:         }
  561:         if ($imgfile) {
  562:             my ($showfile,$fullsize);
  563:             if ($imgfile =~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) {
  564:                 my $urldir = $1;
  565:                 my $filename = $2;
  566:                 my @info = &Apache::lonnet::stat_file($designs->{$img});
  567:                 if (@info) {
  568:                     my $thumbfile = 'tn-'.$filename;
  569:                     my @thumb=&Apache::lonnet::stat_file($urldir.'/'.$thumbfile);
  570:                     if (@thumb) {
  571:                         $showfile = $urldir.'/'.$thumbfile;
  572:                     } else {
  573:                         $showfile = $imgfile;
  574:                     }
  575:                 } else {
  576:                     $showfile = '';
  577:                 }
  578:             } elsif ($imgfile =~ m-^/(adm/[^/]+)/([^/]+)$-) {
  579:                 $showfile = $imgfile;
  580:                 my $imgdir = $1;
  581:                 my $filename = $2;
  582:                 if (-e "/home/httpd/html/$imgdir/tn-".$filename) {
  583:                     $showfile = "/$imgdir/tn-".$filename;
  584:                 } else {
  585:                     my $input = "/home/httpd/html".$imgfile;
  586:                     my $output = '/home/httpd/html/'.$imgdir.'/tn-'.$filename;
  587:                     if (!-e $output) {
  588:                         my ($width,$height) = &thumb_dimensions();
  589:                         my ($fullwidth,$fullheight) = &check_dimensions($input);
  590:                         if ($fullwidth ne '' && $fullheight ne '') {
  591:                             if ($fullwidth > $width && $fullheight > $height) { 
  592:                                 my $size = $width.'x'.$height;
  593:                                 system("convert -sample $size $input $output");
  594:                                 $showfile = '/'.$imgdir.'/tn-'.$filename;
  595:                             }
  596:                         }
  597:                     }
  598:                 }
  599:             }
  600:             if ($showfile) {
  601:                 $showfile = &Apache::loncommon::lonhttpdurl($showfile);
  602:                 $fullsize =  &Apache::loncommon::lonhttpdurl($imgfile);
  603:                 $datatable.= '<td>';
  604:                 if (!$is_custom->{$img}) {
  605:                     $datatable .= &mt('Default in use:').'<br />';
  606:                 }
  607: 		if ($img_import) {
  608: 		    $datatable.= '<input type="hidden" name="'.$role.'_import_'.$img.'" value="'.$imgfile.'" />';
  609: 		}
  610:                 $datatable.= '<a href="'.$fullsize.'" target="_blank"><img src="'.
  611:                              $showfile.'" alt="'.$alt_text->{$img}.
  612:                              '" border="0" /></a></td>';
  613:                 if ($is_custom->{$img}) {
  614:                     $datatable.='<td><span class="LC_nobreak"><label><input type="checkbox" name="'.
  615:                                 $role.'_del_'.$img.'" value="1" />'.&mt('Delete?').
  616:                                 '</label>&nbsp;'.&mt('Replace:').'</span><br />';
  617:                 } else {
  618:                     $datatable.='<td valign="bottom">'.&mt('Upload:').'<br />';
  619:                 }
  620:             } else {
  621:                 $datatable .= '<td colspan="2" class="LC_right_item"><br />'.
  622:                               &mt('Upload:');
  623:             }
  624:         } else {
  625:             $datatable .= '<td colspan="2" class="LC_right_item"><br />'.
  626:                           &mt('Upload:');
  627:         }
  628:         if ($switchserver) {
  629:             $datatable .= &mt('Upload to library server: [_1]',$switchserver);
  630:         } else {
  631:             $datatable .='&nbsp;<input type="file" name="'.$role.'_'.$img.'" />';
  632:         }
  633:         $datatable .= '</td></tr>';
  634:     }
  635:     $itemcount ++;
  636:     $css_class = $itemcount%2?' class="LC_odd_row"':'';
  637:     $datatable .= '<tr'.$css_class.'>'.
  638:                   '<td>'.$choices->{'bgs'}.'</td>';
  639:     my $bgs_def;
  640:     foreach my $item (@{$bgs}) {
  641:         if (!$is_custom->{$item}) {
  642:             $bgs_def .= '<td>'.$choices->{$item}.'<br />'.$defaults->{'bgs'}{$item}.'</td>';
  643:         }
  644:     }
  645:     if ($bgs_def) {
  646:         $datatable .= '<td>'.&mt('Default(s) in use:').'<br /><table border="0"><tr>'.$bgs_def.'</tr></table></td>';
  647:     } else {
  648:         $datatable .= '<td>&nbsp;</td>';
  649:     }
  650:     $datatable .= '<td class="LC_right_item">'.
  651:                   '<table border="0"><tr>';
  652:     foreach my $item (@{$bgs}) {
  653:         my $link = &color_pick($phase,$role,$item,$choices->{$item},$designs->{'bgs'}{$item});
  654:         $datatable .= '<td align="center">'.$link;
  655:         if ($designs->{'bgs'}{$item}) {
  656:             $datatable .= '<span style="background-color:'.$designs->{'bgs'}{$item}.'width: 10px">&nbsp;</span>';
  657:         }
  658:         $datatable .= '<br /><input type="text" size="8" name="'.$role.'_'.$item.'" value="'.$designs->{'bgs'}{$item}.
  659:                       '" /></td>';
  660:     }
  661:     $datatable .= '</tr></table></td></tr>';
  662:     $itemcount ++;
  663:     $css_class = $itemcount%2?' class="LC_odd_row"':'';
  664:     $datatable .= '<tr'.$css_class.'>'.
  665:                   '<td>'.$choices->{'links'}.'</td>';
  666:     my $links_def;
  667:     foreach my $item (@{$links}) {
  668:         if (!$is_custom->{$item}) {
  669:             $links_def .= '<td>'.$choices->{$item}.'<br />'.$defaults->{'links'}{$item}.'</td>';
  670:         }
  671:     }
  672:     if ($links_def) {
  673:         $datatable .= '<td>'.&mt('Default(s) in use:').'<br /><table border="0"><tr>'.$links_def.'</tr></table></td>';
  674:     } else {
  675:         $datatable .= '<td>&nbsp;</td>';
  676:     }
  677:     $datatable .= '<td class="LC_right_item">'.
  678:                   '<table border="0"><tr>';
  679:     foreach my $item (@{$links}) {
  680:         $datatable .= '<td align="center">';
  681:         my $link = &color_pick($phase,$role,$item,$choices->{$item},$designs->{'links'}{$item});
  682:         if ($designs->{'links'}{$item}) {
  683:             $datatable.='<span style="color: '.$designs->{'links'}{$item}.';">'.
  684:                         $link.'</span>';
  685:         } else {
  686:             $datatable .= $link;
  687:         }
  688:         $datatable .= '<br /><input type="text" size="8" name="'.$role.'_'.$item.'" value="'.$designs->{'links'}{$item}.
  689:                       '" /></td>';
  690:     }
  691:     return $datatable;
  692: }
  693: 
  694: sub color_pick {
  695:     my ($phase,$role,$item,$desc,$curcol) = @_;
  696:     my $link = '<a href="javascript:pjump('."'color_custom','".$desc.
  697:                "','".$curcol."','".$role.'_'.$item."','parmform.pres','psub'".
  698:                ');">'.$desc.'</a>';
  699:     return $link;
  700: }
  701: 
  702: sub color_pick_js {
  703:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
  704:     my $output = <<"ENDCOL";
  705:     function pclose() {
  706:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms","height=350,width=350,scrollbars=no,menubar=no");
  707:         parmwin.close();
  708:     }
  709: 
  710:     $pjump_def
  711: 
  712:     function psub() {
  713:         pclose();
  714:         if (document.parmform.pres_marker.value!='') {
  715:             if (document.parmform.pres_type.value!='') {
  716:                 eval('document.display.'+
  717:                      document.parmform.pres_marker.value+
  718:                      '.value=document.parmform.pres_value.value;');
  719:             }
  720:         } else {
  721:             document.parmform.pres_value.value='';
  722:             document.parmform.pres_marker.value='';
  723:         }
  724:     }
  725: ENDCOL
  726:     return $output;
  727: }
  728: 
  729: sub print_quotas {
  730:     my ($dom,$settings) = @_;
  731:     my $datatable;
  732:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
  733:     my $othertitle = "All users";
  734:     my @types;
  735:     if (ref($order) eq 'ARRAY') {
  736:         @types = @{$order};
  737:     }
  738:     if (@types == 0) {
  739:         if (ref($usertypes) eq 'HASH') {
  740:             @types = sort(keys(%{$usertypes}));
  741:         }
  742:     }
  743:     my $typecount = 0;
  744:     my $css_class;
  745:     if (@types > 0) {
  746:         foreach my $type (@types) {
  747:             if (defined($usertypes->{$type})) {
  748:                 $typecount ++;
  749:                 $css_class = $typecount%2?' class="LC_odd_row"':'';
  750:                 $datatable .= '<tr'.$css_class.'>'. 
  751:                               '<td>'.$usertypes->{$type}.'</td>'.
  752:                               '<td class="LC_right_item"><span class="LC_nobreak">'.
  753:                               '<input type="text" name="quota_'.$type.
  754:                               '" value="'.$settings->{$type}.
  755:                               '" size="5" /> Mb</span></td></tr>';
  756:             }
  757:         }
  758:         $othertitle = "Other users";
  759:     }
  760:     my $defaultquota = '20';
  761:     if (ref($settings) eq 'HASH') {
  762:         if (defined($settings->{'default'})) {
  763:             $defaultquota = $settings->{'default'};
  764:         }
  765:     }
  766:     $typecount ++;
  767:     $css_class = $typecount%2?' class="LC_odd_row"':'';
  768:     $datatable .= '<tr'.$css_class.'>'.
  769:                   '<td>'.&mt($othertitle).'</td>'.
  770:                   '<td class="LC_right_item"><span class="LC_nobreak">'.
  771:                   '<input type="text" name="defaultquota" value="'.
  772:                   $defaultquota.'" size="5" /> Mb</span></td></tr>';
  773:     return $datatable;
  774: }
  775: 
  776: sub print_autoenroll {
  777:     my ($dom,$settings) = @_;
  778:     my $autorun = &Apache::lonnet::auto_run(undef,$dom),
  779:     my ($defdom,$runon,$runoff);
  780:     if (ref($settings) eq 'HASH') {
  781:         if (exists($settings->{'run'})) {
  782:             if ($settings->{'run'} eq '0') {
  783:                 $runoff = ' checked="checked" ';
  784:                 $runon = ' ';
  785:             } else {
  786:                 $runon = ' checked="checked" ';
  787:                 $runoff = ' ';
  788:             }
  789:         } else {
  790:             if ($autorun) {
  791:                 $runon = ' checked="checked" ';
  792:                 $runoff = ' ';
  793:             } else {
  794:                 $runoff = ' checked="checked" ';
  795:                 $runon = ' ';
  796:             }
  797:         }
  798:         if (exists($settings->{'sender_domain'})) {
  799:             $defdom = $settings->{'sender_domain'};
  800:         }
  801:     } else {
  802:         if ($autorun) {
  803:             $runon = ' checked="checked" ';
  804:             $runoff = ' ';
  805:         } else {
  806:             $runoff = ' checked="checked" ';
  807:             $runon = ' ';
  808:         }
  809:     }
  810:     my $domform = &Apache::loncommon::select_dom_form($defdom,'sender_domain',1);
  811:     my $datatable='<tr class="LC_odd_row">'.
  812:                   '<td>'.&mt('Auto-enrollment active?').'</td>'.
  813:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
  814:                   '<input type="radio" name="autoenroll_run"'.
  815:                   $runon.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
  816:                   '<label><input type="radio" name="autoenroll_run"'.
  817:                   $runoff.' value="0" />'.&mt('No').'</label></span></td>'.
  818:                   '</tr><tr>'.
  819:                   '<td>'.&mt('Notification messages - sender').
  820:                   '</td><td class="LC_right_item"><span class="LC_nobreak">'.
  821:                   &mt('username').':&nbsp;'.
  822:                   '<input type="text" name="sender_uname" value="'.
  823:                   $settings->{'sender_uname'}.
  824:                   '" size="10" />&nbsp;&nbsp;'.&mt('domain').
  825:                   ':&nbsp;'.$domform.'</span></td></tr>';
  826:     return $datatable;
  827: }
  828: 
  829: sub print_autoupdate {
  830:     my ($position,$dom,$settings) = @_;
  831:     my $datatable;
  832:     if ($position eq 'top') {
  833:         my $updateon = ' ';
  834:         my $updateoff = ' checked="checked" ';
  835:         my $classlistson = ' ';
  836:         my $classlistsoff = ' checked="checked" ';
  837:         if (ref($settings) eq 'HASH') {
  838:             if ($settings->{'run'} eq '1') {
  839:                 $updateon = $updateoff;
  840:                 $updateoff = ' ';
  841:             }
  842:             if ($settings->{'classlists'} eq '1') {
  843:                 $classlistson = $classlistsoff;
  844:                 $classlistsoff = ' ';
  845:             }
  846:         }
  847:         my %title = (
  848:                    run => 'Auto-update active?',
  849:                    classlists => 'Update information in classlists?',
  850:                     );
  851:         $datatable = '<tr class="LC_odd_row">'. 
  852:                   '<td>'.&mt($title{'run'}).'</td>'.
  853:                   '<td class="LC_right_item"><span class="LC_nobreak"><label>'.
  854:                   '<input type="radio" name="autoupdate_run"'.
  855:                   $updateon.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
  856:                   '<label><input type="radio" name="autoupdate_run"'.
  857:                   $updateoff.'value="0" />'.&mt('No').'</label></span></td>'.
  858:                   '</tr><tr>'.
  859:                   '<td>'.&mt($title{'classlists'}).'</td>'.
  860:                   '<td class="LC_right_item"><span class="LC_nobreak">'.
  861:                   '<label><input type="radio" name="classlists"'.
  862:                   $classlistson.' value="1" />'.&mt('Yes').'</label>&nbsp;'.
  863:                   '<label><input type="radio" name="classlists"'.
  864:                   $classlistsoff.'value="0" />'.&mt('No').'</label></span></td>'.
  865:                   '</tr>';
  866:     } else {
  867:         my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
  868:         my @types;
  869:         if (ref($order) eq 'ARRAY') {
  870:             @types = @{$order};
  871:         }
  872:         if (@types == 0) {
  873:             if (ref($usertypes) eq 'HASH') {
  874:                 @types = sort(keys(%{$usertypes}));
  875:             }
  876:         }
  877:         my $othertitle = &mt('All users');
  878:         if (keys(%{$usertypes}) > 0) {
  879:             $othertitle = &mt('Other users');
  880:         }
  881:         my @fields = ('lastname','firstname','middlename','gen',
  882:                       'permanentemail','id');
  883:         my %fieldtitles = &Apache::lonlocal::texthash (
  884:                             id => 'Student/Employee ID',
  885:                             permanentemail => 'E-mail address',
  886:                             lastname => 'Last Name',
  887:                             firstname => 'First Name',
  888:                             middlename => 'Middle Name',
  889:                             gen => 'Generation',
  890:                       );
  891:         my $numrows = 0;
  892:         if (@types > 0) {
  893:             $datatable = 
  894:                 &usertype_update_row($settings,$usertypes,\%fieldtitles,
  895:                                      \@fields,\@types,\$numrows);
  896:         }
  897:         $datatable .= 
  898:             &usertype_update_row($settings,{'default' => $othertitle},
  899:                                  \%fieldtitles,\@fields,['default'],
  900:                                  \$numrows);
  901:     }
  902:     return $datatable;
  903: }
  904: 
  905: sub usertype_update_row {
  906:     my ($settings,$usertypes,$fieldtitles,$fields,$types,$rownums) = @_;
  907:     my $datatable;
  908:     my $numinrow = 4;
  909:     foreach my $type (@{$types}) {
  910:         if (defined($usertypes->{$type})) {
  911:             $$rownums ++;
  912:             my $css_class = $$rownums%2?' class="LC_odd_row"':'';
  913:             $datatable .= '<tr'.$css_class.'><td>'.$usertypes->{$type}.
  914:                           '</td><td class="LC_left_item"><table>';
  915:             for (my $i=0; $i<@{$fields}; $i++) {
  916:                 my $rem = $i%($numinrow);
  917:                 if ($rem == 0) {
  918:                     if ($i > 0) {
  919:                         $datatable .= '</tr>';
  920:                     }
  921:                     $datatable .= '<tr>';
  922:                 }
  923:                 my $check = ' ';
  924:                 if (ref($settings->{'fields'}) eq 'HASH') {
  925:                     if (ref($settings->{'fields'}{$type}) eq 'ARRAY') {
  926:                         if (grep(/^\Q$fields->[$i]\E$/,@{$settings->{'fields'}{$type}})) {
  927:                             $check = ' checked="checked" ';
  928:                         }
  929:                     }
  930:                 }
  931: 
  932:                 if ($i == @{$fields}-1) {
  933:                     my $colsleft = $numinrow - $rem;
  934:                     if ($colsleft > 1) {
  935:                         $datatable .= '<td colspan="'.$colsleft.'">';
  936:                     } else {
  937:                         $datatable .= '<td>';
  938:                     }
  939:                 } else {
  940:                     $datatable .= '<td>';
  941:                 }
  942:                 $datatable .= '<span class="LC_nobreak"><label>'.
  943:                               '<input type="checkbox" name="updateable_'.$type.
  944:                               '_'.$fields->[$i].'" value="1"'.$check.'/>'.
  945:                               $fieldtitles->{$fields->[$i]}.'</label></span></td>';
  946:             }
  947:             $datatable .= '</tr></table></td></tr>';
  948:         }
  949:     }
  950:     return $datatable;
  951: }
  952: 
  953: sub modify_login {
  954:     my ($r,$dom,$confname,%domconfig) = @_;
  955:     my ($resulttext,$errors,$colchgtext,%changes,%colchanges);
  956:     my %title = ( coursecatalog => 'Display course catalog',
  957:                   adminmail => 'Display administrator E-mail address');
  958:     my @offon = ('off','on');
  959:     my %loginhash;
  960:     ($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'],
  961:                                            \%domconfig,\%loginhash);
  962:     $loginhash{login}{coursecatalog} = $env{'form.coursecatalog'};
  963:     $loginhash{login}{adminmail} = $env{'form.adminmail'};
  964:     if (ref($colchanges{'login'}) eq 'HASH') {  
  965:         $colchgtext = &display_colorchgs($dom,\%colchanges,['login'],
  966:                                          \%loginhash);
  967:     }
  968:     my $putresult = &Apache::lonnet::put_dom('configuration',\%loginhash,
  969:                                              $dom);
  970:     if ($putresult eq 'ok') {
  971:         if (($domconfig{'login'}{'coursecatalog'} eq '0') &&
  972:             ($env{'form.coursecatalog'} eq '1')) {
  973:             $changes{'coursecatalog'} = 1;
  974:         } elsif (($domconfig{'login'}{'coursecatalog'} eq '' ||
  975:                  $domconfig{'login'}{'coursecatalog'} eq '1') &&
  976:                  ($env{'form.coursecatalog'} eq '0')) {
  977:             $changes{'coursecatalog'} = 1;
  978:         }
  979:         if (($domconfig{'login'}{'adminmail'} eq '1') &&
  980:                 ($env{'form.adminmail'} eq '0')) {
  981:             $changes{'adminmail'} = 1;
  982:         } elsif (($domconfig{'login'}{'adminmail'} eq '' ||
  983:                  $domconfig{'login'}{'adminmail'} eq '0') &&
  984:                  ($env{'form.adminmail'} eq '1')) {
  985:             $changes{'adminmail'} = 1;
  986:         }
  987:         if (keys(%changes) > 0 || $colchgtext) {
  988:             $resulttext = &mt('Changes made:').'<ul>';
  989:             foreach my $item (sort(keys(%changes))) {
  990:                 $resulttext .= '<li>'.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'</li>';
  991:             }
  992:             $resulttext .= $colchgtext.'</ul>';
  993:         } else {
  994:             $resulttext = &mt('No changes made to log-in page settings');
  995:         }
  996:     } else {
  997:         $resulttext = '<span class="LC_error">'.
  998: 	    &mt('An error occurred: [_1]',$putresult).'</span>';
  999:     }
 1000:     if ($errors) {
 1001:         $resulttext .= '<br />'.&mt('The following errors occurred: ').'<ul>'.
 1002:                        $errors.'</ul>';
 1003:     }
 1004:     return $resulttext;
 1005: }
 1006: 
 1007: sub color_font_choices {
 1008:     my %choices =
 1009:         &Apache::lonlocal::texthash (
 1010:             img => "Header",
 1011:             bgs => "Background colors",
 1012:             links => "Link colors",
 1013:             font => "Font color",
 1014:             pgbg => "Page",
 1015:             tabbg => "Header",
 1016:             sidebg => "Border",
 1017:             link => "Link",
 1018:             alink => "Active link",
 1019:             vlink => "Visited link",
 1020:         );
 1021:     return %choices;
 1022: }
 1023: 
 1024: sub modify_rolecolors {
 1025:     my ($r,$dom,$confname,$roles,%domconfig) = @_;
 1026:     my ($resulttext,%rolehash);
 1027:     $rolehash{'rolecolors'} = {};
 1028:     my ($errors,%changes) = &modify_colors($r,$dom,$confname,$roles,
 1029:                          $domconfig{'rolecolors'},$rolehash{'rolecolors'});
 1030:     my $putresult = &Apache::lonnet::put_dom('configuration',\%rolehash,
 1031:                                              $dom);
 1032:     if ($putresult eq 'ok') {
 1033:         if (keys(%changes) > 0) {
 1034:             $resulttext = &display_colorchgs($dom,\%changes,$roles,
 1035:                                              $rolehash{'rolecolors'});
 1036:         } else {
 1037:             $resulttext = &mt('No changes made to default color schemes');
 1038:         }
 1039:     } else {
 1040:         $resulttext = '<span class="LC_error">'.
 1041: 	    &mt('An error occurred: [_1]',$putresult).'</span>';
 1042:     }
 1043:     if ($errors) {
 1044:         $resulttext .= &mt('The following errors occurred: ').'<ul>'.
 1045:                        $errors.'</ul>';
 1046:     }
 1047:     return $resulttext;
 1048: }
 1049: 
 1050: sub modify_colors {
 1051:     my ($r,$dom,$confname,$roles,$domconfig,$confhash) = @_;
 1052:     my (%changes,%choices);
 1053:     my @bgs = ('pgbg','mainbg','sidebg');
 1054:     my @links = ('link','alink','vlink');
 1055:     my @images;
 1056:     my $servadm = $r->dir_config('lonAdmEMail');
 1057:     my $errors;
 1058:     foreach my $role (@{$roles}) {
 1059:         if ($role eq 'login') {
 1060:             %choices = &login_choices();
 1061:         } else {
 1062:             %choices = &color_font_choices();
 1063:         }
 1064:         if ($role eq 'login') {
 1065:             @images = ('img','logo','domlogo');
 1066:         } else {
 1067:             @images = ('img');
 1068:         }
 1069:         $confhash->{$role}{'font'} = $env{'form.'.$role.'_font'};
 1070:         foreach my $item (@bgs,@links) {
 1071:             $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item};
 1072:         }
 1073:         my ($configuserok,$author_ok,$switchserver,%currroles);
 1074:         my $uhome = &Apache::lonnet::homeserver($confname,$dom,1);
 1075:         ($configuserok,%currroles) = &check_configuser($uhome,$dom,
 1076:                                                        $confname,$servadm);
 1077:         if ($configuserok eq 'ok') {
 1078:             $switchserver = &check_switchserver($dom,$confname);
 1079:             if ($switchserver eq '') {
 1080:                 $author_ok = &check_authorstatus($dom,$confname,%currroles);
 1081:             }
 1082:         }
 1083:         my ($width,$height) = &thumb_dimensions();
 1084:         foreach my $img (@images) {
 1085: 	    if ( ! $env{'form.'.$role.'_'.$img.'.filename'} 
 1086: 		 && !defined($domconfig->{$role}{$img})
 1087: 		 && !$env{'form.'.$role.'_del_'.$img}
 1088: 		 && $env{'form.'.$role.'_import_'.$img}) {
 1089: 		# import the old configured image from the .tab setting
 1090: 		# if they haven't provided a new one 
 1091: 		$domconfig->{$role}{$img} = 
 1092: 		    $env{'form.'.$role.'_import_'.$img};
 1093: 	    }
 1094:             if ($env{'form.'.$role.'_'.$img.'.filename'} ne '') {
 1095:                 my $error;
 1096:                 if ($configuserok eq 'ok') {
 1097:                     if ($switchserver) {
 1098:                         $error = &mt("Upload of [_1] image for $role page(s) is not permitted to this server: [_2]",$choices{$img},$switchserver);
 1099:                     } else {
 1100:                         if ($author_ok eq 'ok') {
 1101:                             my ($result,$logourl) = 
 1102:                                 &publishlogo($r,'upload',$role.'_'.$img,
 1103:                                            $dom,$confname,$img,$width,$height);
 1104:                             if ($result eq 'ok') {
 1105:                                 $confhash->{$role}{$img} = $logourl;
 1106:                                 $changes{$role}{'images'}{$img} = 1;
 1107:                             } else {
 1108:                                 $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);
 1109:                             }
 1110:                         } else {
 1111:                             $error = &mt("Upload of [_1] image for $role page(s) failed because an author role could not be assigned to a Domain Configuation user ([_2]) in domain: [_3].  Error was: [_4].",$choices{$img},$confname,$dom,$author_ok);
 1112:                         }
 1113:                     }
 1114:                 } else {
 1115:                     $error = &mt("Upload of [_1] image for $role page(s) failed because a Domain Configuation user ([_2]) could not be created in domain: [_3].  Error was: [_4].",$choices{$img},$confname,$dom,$configuserok);
 1116:                 }
 1117:                 if ($error) {
 1118:                     &Apache::lonnet::logthis($error);
 1119:                     $errors .= '<li><span class="LC_error">'.$error.'</span></li>';
 1120:                 }
 1121:             } elsif ($domconfig->{$role}{$img} ne '') {
 1122:                 if ($domconfig->{$role}{$img} !~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) {
 1123:                     my $error;
 1124:                     if ($configuserok eq 'ok') {
 1125: # is confname an author?
 1126:                         if ($switchserver eq '') {
 1127:                             if ($author_ok eq 'ok') {
 1128:                                 my ($result,$logourl) = 
 1129:                                &publishlogo($r,'copy',$domconfig->{$role}{$img},
 1130:                                             $dom,$confname,$img,$width,$height);
 1131:                                 if ($result eq 'ok') {
 1132:                                     $confhash->{$role}{$img} = $logourl;
 1133: 				    $changes{$role}{'images'}{$img} = 1;
 1134:                                 }
 1135:                             }
 1136:                         }
 1137:                     }
 1138:                 }
 1139:             }
 1140:         }
 1141:         if (ref($domconfig) eq 'HASH') {
 1142:             if (ref($domconfig->{$role}) eq 'HASH') {
 1143:                 foreach my $img (@images) {
 1144:                     if ($domconfig->{$role}{$img} ne '') {
 1145:                         if ($env{'form.'.$role.'_del_'.$img}) {
 1146:                             $confhash->{$role}{$img} = '';
 1147:                             $changes{$role}{'images'}{$img} = 1;
 1148:                         } else {
 1149:                             if ($confhash->{$role}{$img} eq '') {
 1150:                                 $confhash->{$role}{$img} = $domconfig->{$role}{$img};
 1151:                             }
 1152:                         }
 1153:                     } else {
 1154:                         if ($env{'form.'.$role.'_del_'.$img}) {
 1155:                             $confhash->{$role}{$img} = '';
 1156:                             $changes{$role}{'images'}{$img} = 1;
 1157:                         } 
 1158:                     }
 1159:                 }  
 1160:                 if ($domconfig->{$role}{'font'} ne '') {
 1161:                     if ($confhash->{$role}{'font'} ne $domconfig->{$role}{'font'}) {
 1162:                         $changes{$role}{'font'} = 1;
 1163:                     }
 1164:                 } else {
 1165:                     if ($confhash->{$role}{'font'}) {
 1166:                         $changes{$role}{'font'} = 1;
 1167:                     }
 1168:                 }
 1169:                 foreach my $item (@bgs) {
 1170:                     if ($domconfig->{$role}{$item} ne '') {
 1171:                         if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
 1172:                             $changes{$role}{'bgs'}{$item} = 1;
 1173:                         } 
 1174:                     } else {
 1175:                         if ($confhash->{$role}{$item}) {
 1176:                             $changes{$role}{'bgs'}{$item} = 1;
 1177:                         }
 1178:                     }
 1179:                 }
 1180:                 foreach my $item (@links) {
 1181:                     if ($domconfig->{$role}{$item} ne '') {
 1182:                         if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
 1183:                             $changes{$role}{'links'}{$item} = 1;
 1184:                         }
 1185:                     } else {
 1186:                         if ($confhash->{$role}{$item}) {
 1187:                             $changes{$role}{'links'}{$item} = 1;
 1188:                         }
 1189:                     }
 1190:                 }
 1191:             } else {
 1192:                 &default_change_checker($role,\@images,\@links,\@bgs,
 1193:                                         $confhash,\%changes); 
 1194:             }
 1195:         } else {
 1196:             &default_change_checker($role,\@images,\@links,\@bgs,
 1197:                                     $confhash,\%changes); 
 1198:         }
 1199:     }
 1200:     return ($errors,%changes);
 1201: }
 1202: 
 1203: sub default_change_checker {
 1204:     my ($role,$images,$links,$bgs,$confhash,$changes) = @_;
 1205:     foreach my $item (@{$links}) {
 1206:         if ($confhash->{$role}{$item}) {
 1207:             $changes->{$role}{'links'}{$item} = 1;
 1208:         }
 1209:     }
 1210:     foreach my $item (@{$bgs}) {
 1211:         if ($confhash->{$role}{$item}) {
 1212:             $changes->{$role}{'bgs'}{$item} = 1;
 1213:         }
 1214:     }
 1215:     foreach my $img (@{$images}) {
 1216:         if ($env{'form.'.$role.'_del_'.$img}) {
 1217:             $confhash->{$role}{$img} = '';
 1218:             $changes->{$role}{'images'}{$img} = 1;
 1219:         }
 1220:     }
 1221:     if ($confhash->{$role}{'font'}) {
 1222:         $changes->{$role}{'font'} = 1;
 1223:     }
 1224: } 
 1225: 
 1226: sub display_colorchgs {
 1227:     my ($dom,$changes,$roles,$confhash) = @_;
 1228:     my (%choices,$resulttext);
 1229:     &Apache::loncommon::devalidate_domconfig_cache($dom);
 1230:     if (!grep(/^login$/,@{$roles})) {
 1231:         $resulttext = &mt('Changes made:').'<br />';
 1232:     }
 1233:     foreach my $role (@{$roles}) {
 1234:         if ($role eq 'login') {
 1235:             %choices = &login_choices();
 1236:         } else {
 1237:             %choices = &color_font_choices();
 1238:         }
 1239:         if (ref($changes->{$role}) eq 'HASH') {
 1240:             if ($role ne 'login') {
 1241:                 $resulttext .= '<h4>'.&mt($role).'</h4>';
 1242:             }
 1243:             foreach my $key (sort(keys(%{$changes->{$role}}))) {
 1244:                 if ($role ne 'login') {
 1245:                     $resulttext .= '<ul>';
 1246:                 }
 1247:                 if (ref($changes->{$role}{$key}) eq 'HASH') {
 1248:                     if ($role ne 'login') {
 1249:                         $resulttext .= '<li>'.&mt($choices{$key}).':<ul>';
 1250:                     }
 1251:                     foreach my $item (sort(keys(%{$changes->{$role}{$key}}))) {
 1252:                         if ($confhash->{$role}{$item} eq '') {
 1253:                             $resulttext .= '<li>'.&mt("$choices{$item} set to default").'</li>';
 1254:                         } else {
 1255:                             my $newitem = $confhash->{$role}{$item};
 1256:                             if ($key eq 'images') {
 1257:                                 $newitem = '<img src="'.$confhash->{$role}{$item}.'" alt="'.$choices{$item}.'" valign="bottom" />';
 1258:                             }
 1259:                             $resulttext .= '<li>'.&mt("$choices{$item} set to [_1]",$newitem).'</li>';
 1260:                         }
 1261:                     }
 1262:                     if ($role ne 'login') {
 1263:                         $resulttext .= '</ul></li>';
 1264:                     }
 1265:                 } else {
 1266:                     if ($confhash->{$role}{$key} eq '') {
 1267:                         $resulttext .= '<li>'.&mt("$choices{$key} set to default").'</li>';
 1268:                     } else {
 1269:                         $resulttext .= '<li>'.&mt("$choices{$key} set to [_1]",$confhash->{$role}{$key}).'</li>';
 1270:                     }
 1271:                 }
 1272:                 if ($role ne 'login') {
 1273:                     $resulttext .= '</ul>';
 1274:                 }
 1275:             }
 1276:         }
 1277:     }
 1278:     return $resulttext;
 1279: }
 1280: 
 1281: sub thumb_dimensions {
 1282:     return ('200','50');
 1283: }
 1284: 
 1285: sub check_dimensions {
 1286:     my ($inputfile) = @_;
 1287:     my ($fullwidth,$fullheight);
 1288:     if ($inputfile =~ m|^[/\w.\-]+$|) {
 1289:         if (open(PIPE,"identify $inputfile 2>&1 |")) {
 1290:             my $imageinfo = <PIPE>;
 1291:             if (!close(PIPE)) {
 1292:                 &Apache::lonnet::logthis("Failed to close PIPE opened to retrieve image information for $inputfile");
 1293:             }
 1294:             chomp($imageinfo);
 1295:             my ($fullsize) = 
 1296:                 ($imageinfo =~ /^\Q$inputfile\E\s+\w+\s+(\d+x\d+)/);
 1297:             if ($fullsize) {
 1298:                 ($fullwidth,$fullheight) = split(/x/,$fullsize);
 1299:             }
 1300:         }
 1301:     }
 1302:     return ($fullwidth,$fullheight);
 1303: }
 1304: 
 1305: sub check_configuser {
 1306:     my ($uhome,$dom,$confname,$servadm) = @_;
 1307:     my ($configuserok,%currroles);
 1308:     if ($uhome eq 'no_host') {
 1309:         srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
 1310:         my $configpass = &LONCAPA::Enrollment::create_password();
 1311:         $configuserok = 
 1312:             &Apache::lonnet::modifyuser($dom,$confname,'','internal',
 1313:                              $configpass,'','','','','',undef,$servadm);
 1314:     } else {
 1315:         $configuserok = 'ok';
 1316:         %currroles = 
 1317:             &Apache::lonnet::get_my_roles($confname,$dom,'userroles');
 1318:     }
 1319:     return ($configuserok,%currroles);
 1320: }
 1321: 
 1322: sub check_authorstatus {
 1323:     my ($dom,$confname,%currroles) = @_;
 1324:     my $author_ok;
 1325:     if (!$currroles{':'.$dom.':au'}) {
 1326:         my $start = time;
 1327:         my $end = 0;
 1328:         $author_ok = 
 1329:             &Apache::lonnet::assignrole($dom,$confname,'/'.$dom.'/',
 1330:                                         'au',$end,$start);
 1331:     } else {
 1332:         $author_ok = 'ok';
 1333:     }
 1334:     return $author_ok;
 1335: }
 1336: 
 1337: sub publishlogo {
 1338:     my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight) = @_;
 1339:     my ($output,$fname,$logourl);
 1340:     if ($action eq 'upload') {
 1341:         $fname=$env{'form.'.$formname.'.filename'};
 1342:         chop($env{'form.'.$formname});
 1343:     } else {
 1344:         ($fname) = ($formname =~ /([^\/]+)$/);
 1345:     }
 1346:     $fname=&Apache::lonnet::clean_filename($fname);
 1347: # See if there is anything left
 1348:     unless ($fname) { return ('error: no uploaded file'); }
 1349:     $fname="$subdir/$fname";
 1350:     my $filepath='/home/'.$confname.'/public_html';
 1351:     my ($fnamepath,$file,$fetchthumb);
 1352:     $file=$fname;
 1353:     if ($fname=~m|/|) {
 1354:         ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|);
 1355:     }
 1356:     my @parts=split(/\//,$filepath.'/'.$fnamepath);
 1357:     my $count;
 1358:     for ($count=4;$count<=$#parts;$count++) {
 1359:         $filepath.="/$parts[$count]";
 1360:         if ((-e $filepath)!=1) {
 1361:             mkdir($filepath,02770);
 1362:         }
 1363:     }
 1364:     # Check for bad extension and disallow upload
 1365:     if ($file=~/\.(\w+)$/ &&
 1366:         (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
 1367:         $output = 
 1368:             &mt('Invalid file extension ([_1]) - reserved for LONCAPA use.',$1); 
 1369:     } elsif ($file=~/\.(\w+)$/ &&
 1370:         !defined(&Apache::loncommon::fileembstyle($1))) {
 1371:         $output = &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
 1372:     } elsif ($file=~/\.(\d+)\.(\w+)$/) {
 1373:         $output = &mt('File name not allowed a rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
 1374:     } elsif (-d "$filepath/$file") {
 1375:         $output = &mt('File name is a directory name - rename the file and re-upload');
 1376:     } else {
 1377:         my $source = $filepath.'/'.$file;
 1378:         my $logfile;
 1379:         if (!open($logfile,">>$source".'.log')) {
 1380:             return (&mt('No write permission to Construction Space'));
 1381:         }
 1382:         print $logfile
 1383: "\n================= Publish ".localtime()." ================\n".
 1384: $env{'user.name'}.':'.$env{'user.domain'}."\n";
 1385: # Save the file
 1386:         if (!open(FH,'>'.$source)) {
 1387:             &Apache::lonnet::logthis('Failed to create '.$source);
 1388:             return (&mt('Failed to create file'));
 1389:         }
 1390:         if ($action eq 'upload') {
 1391:             if (!print FH ($env{'form.'.$formname})) {
 1392:                 &Apache::lonnet::logthis('Failed to write to '.$source);
 1393:                 return (&mt('Failed to write file'));
 1394:             }
 1395:         } else {
 1396:             my $original = &Apache::lonnet::filelocation('',$formname);
 1397:             if(!copy($original,$source)) {
 1398:                 &Apache::lonnet::logthis('Failed to copy '.$original.' to '.$source);
 1399:                 return (&mt('Failed to write file'));
 1400:             }
 1401:         }
 1402:         close(FH);
 1403:         chmod(0660, $source); # Permissions to rw-rw---.
 1404: 
 1405:         my $docroot=$r->dir_config('lonDocRoot');
 1406:         my $targetdir=$docroot.'/res/'.$dom.'/'.$confname .'/'.$fnamepath;
 1407:         my $copyfile=$targetdir.'/'.$file;
 1408: 
 1409:         my @parts=split(/\//,$targetdir);
 1410:         my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
 1411:         for (my $count=5;$count<=$#parts;$count++) {
 1412:             $path.="/$parts[$count]";
 1413:             if (!-e $path) {
 1414:                 print $logfile "\nCreating directory ".$path;
 1415:                 mkdir($path,02770);
 1416:             }
 1417:         }
 1418:         my $versionresult;
 1419:         if (-e $copyfile) {
 1420:             $versionresult = &logo_versioning($targetdir,$file,$logfile);
 1421:         } else {
 1422:             $versionresult = 'ok';
 1423:         }
 1424:         if ($versionresult eq 'ok') {
 1425:             if (copy($source,$copyfile)) {
 1426:                 print $logfile "\nCopied original source to ".$copyfile."\n";
 1427:                 $output = 'ok';
 1428:                 &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile);
 1429:                 $logourl = '/res/'.$dom.'/'.$confname.'/'.$fname;
 1430:             } else {
 1431:                 print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
 1432:                 $output = &mt('Failed to copy file to RES space').", $!";
 1433:             }
 1434:             if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
 1435:                 my $inputfile = $filepath.'/'.$file;
 1436:                 my $outfile = $filepath.'/'.'tn-'.$file;
 1437:                 my ($fullwidth,$fullheight) = &check_dimensions($inputfile);
 1438:                 if ($fullwidth ne '' && $fullheight ne '') { 
 1439:                     if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) {
 1440:                         my $thumbsize = $thumbwidth.'x'.$thumbheight;
 1441:                         system("convert -sample $thumbsize $inputfile $outfile");
 1442:                         chmod(0660, $filepath.'/tn-'.$file);
 1443:                         if (-e $outfile) {
 1444:                             my $copyfile=$targetdir.'/tn-'.$file;
 1445:                             if (copy($outfile,$copyfile)) {
 1446:                                 print $logfile "\nCopied source to ".$copyfile."\n";
 1447:                                 &write_metadata($dom,$confname,$formname,
 1448:                                                 $targetdir,'tn-'.$file,$logfile);
 1449:                             } else {
 1450:                                 print $logfile "\nUnable to write ".$copyfile.
 1451:                                                ':'.$!."\n";
 1452:                             }
 1453:                         }
 1454:                     }
 1455:                 }
 1456:             }
 1457:         } else {
 1458:             $output = $versionresult;
 1459:         }
 1460:     }
 1461:     return ($output,$logourl);
 1462: }
 1463: 
 1464: sub logo_versioning {
 1465:     my ($targetdir,$file,$logfile) = @_;
 1466:     my $target = $targetdir.'/'.$file;
 1467:     my ($maxversion,$fn,$extn,$output);
 1468:     $maxversion = 0;
 1469:     if ($file =~ /^(.+)\.(\w+)$/) {
 1470:         $fn=$1;
 1471:         $extn=$2;
 1472:     }
 1473:     opendir(DIR,$targetdir);
 1474:     while (my $filename=readdir(DIR)) {
 1475:         if ($filename=~/\Q$fn\E\.(\d+)\.\Q$extn\E$/) {
 1476:             $maxversion=($1>$maxversion)?$1:$maxversion;
 1477:         }
 1478:     }
 1479:     $maxversion++;
 1480:     print $logfile "\nCreating old version ".$maxversion."\n";
 1481:     my $copyfile=$targetdir.'/'.$fn.'.'.$maxversion.'.'.$extn;
 1482:     if (copy($target,$copyfile)) {
 1483:         print $logfile "Copied old target to ".$copyfile."\n";
 1484:         $copyfile=$copyfile.'.meta';
 1485:         if (copy($target.'.meta',$copyfile)) {
 1486:             print $logfile "Copied old target metadata to ".$copyfile."\n";
 1487:             $output = 'ok';
 1488:         } else {
 1489:             print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
 1490:             $output = &mt('Failed to copy old meta').", $!, ";
 1491:         }
 1492:     } else {
 1493:         print $logfile "Unable to write ".$copyfile.':'.$!."\n";
 1494:         $output = &mt('Failed to copy old target').", $!, ";
 1495:     }
 1496:     return $output;
 1497: }
 1498: 
 1499: sub write_metadata {
 1500:     my ($dom,$confname,$formname,$targetdir,$file,$logfile) = @_;
 1501:     my (%metadatafields,%metadatakeys,$output);
 1502:     $metadatafields{'title'}=$formname;
 1503:     $metadatafields{'creationdate'}=time;
 1504:     $metadatafields{'lastrevisiondate'}=time;
 1505:     $metadatafields{'copyright'}='public';
 1506:     $metadatafields{'modifyinguser'}=$env{'user.name'}.':'.
 1507:                                          $env{'user.domain'};
 1508:     $metadatafields{'authorspace'}=$confname.':'.$dom;
 1509:     $metadatafields{'domain'}=$dom;
 1510:     {
 1511:         print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file;
 1512:         my $mfh;
 1513:         unless (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) {
 1514:             $output = &mt('Could not write metadata');
 1515:         }
 1516:         foreach (sort keys %metadatafields) {
 1517:             unless ($_=~/\./) {
 1518:                 my $unikey=$_;
 1519:                 $unikey=~/^([A-Za-z]+)/;
 1520:                 my $tag=$1;
 1521:                 $tag=~tr/A-Z/a-z/;
 1522:                 print $mfh "\n\<$tag";
 1523:                 foreach (split(/\,/,$metadatakeys{$unikey})) {
 1524:                     my $value=$metadatafields{$unikey.'.'.$_};
 1525:                     $value=~s/\"/\'\'/g;
 1526:                     print $mfh ' '.$_.'="'.$value.'"';
 1527:                 }
 1528:                 print $mfh '>'.
 1529:                     &HTML::Entities::encode($metadatafields{$unikey},'<>&"')
 1530:                         .'</'.$tag.'>';
 1531:             }
 1532:         }
 1533:         $output = 'ok';
 1534:         print $logfile "\nWrote metadata";
 1535:         close($mfh);
 1536:     }
 1537: }
 1538: 
 1539: sub check_switchserver {
 1540:     my ($dom,$confname) = @_;
 1541:     my ($allowed,$switchserver);
 1542:     my $home = &Apache::lonnet::homeserver($confname,$dom);
 1543:     if ($home eq 'no_host') {
 1544:         $home = &Apache::lonnet::domain($dom,'primary');
 1545:     }
 1546:     my @ids=&Apache::lonnet::current_machine_ids();
 1547:     foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
 1548:     if (!$allowed) {
 1549: 	$switchserver='<a href="/adm/switchserver?otherserver='.$home.'&role=dc./'.$dom.'/">'.&mt('Switch Server').'</a>';
 1550:     }
 1551:     return $switchserver;
 1552: }
 1553: 
 1554: sub modify_quotas {
 1555:     my ($dom,%domconfig) = @_;
 1556:     my ($resulttext,%changes);
 1557:     my ($usertypes,$order) = 
 1558:         &Apache::lonnet::retrieve_inst_usertypes($dom);
 1559:     my %formhash;
 1560:     foreach my $key (keys(%env)) {
 1561:         if ($key =~ /^form\.quota_(.+)$/) {
 1562:             $formhash{$1} = $env{$key};
 1563:         }
 1564:     }
 1565:     $formhash{'default'} = $env{'form.defaultquota'};
 1566:     if (ref($domconfig{'quotas'}) eq 'HASH') {
 1567:         foreach my $key (keys(%{$domconfig{'quotas'}})) {
 1568:             if (exists($formhash{$key})) {
 1569:                 if ($formhash{$key} ne $domconfig{'quotas'}{$key}) {
 1570:                     $changes{$key} = 1;
 1571:                 }
 1572:             } else {
 1573:                 $formhash{$key} = $domconfig{'quotas'}{$key};
 1574:             }
 1575:         }
 1576:     }
 1577:     foreach my $key (keys(%formhash)) {
 1578:         if ($formhash{$key} ne '') {
 1579:             if (!exists($domconfig{'quotas'}{$key})) {
 1580:                 $changes{$key} = 1;
 1581:             }
 1582:         }
 1583:     }
 1584:     my %quotahash = (
 1585:                       quotas => {%formhash},
 1586:                     );
 1587:     my $putresult = &Apache::lonnet::put_dom('configuration',\%quotahash,
 1588:                                              $dom);
 1589:     if ($putresult eq 'ok') {
 1590:         if (keys(%changes) > 0) {
 1591:             $resulttext = &mt('Changes made:').'<ul>';
 1592:             foreach my $item (sort(keys(%changes))) {
 1593:                 $resulttext .= '<li>'.&mt('[_1] set to [_2] Mb',$usertypes->{$item},$formhash{$item}).'</li>';
 1594:             }
 1595:             $resulttext .= '</ul>';
 1596:         } else {
 1597:             $resulttext = &mt('No changes made to default quotas');
 1598:         }
 1599:     } else {
 1600:         $resulttext = '<span class="LC_error">'.
 1601: 	    &mt('An error occurred: [_1]',$putresult).'</span>';
 1602:     }
 1603:     return $resulttext;
 1604: }
 1605: 
 1606: sub modify_autoenroll {
 1607:     my ($dom,%domconfig) = @_;
 1608:     my ($resulttext,%changes);
 1609:     my %currautoenroll;
 1610:     if (ref($domconfig{'autoenroll'}) eq 'HASH') {
 1611:         foreach my $key (keys(%{$domconfig{'autoenroll'}})) {
 1612:             $currautoenroll{$key} = $domconfig{'autoenroll'}{$key};
 1613:         }
 1614:     }
 1615:     my $autorun = &Apache::lonnet::auto_run(undef,$dom),
 1616:     my %title = ( run => 'Auto-enrollment active',
 1617:                   sender => 'Sender for notification messages');
 1618:     my @offon = ('off','on');
 1619:     my $sender_uname = $env{'form.sender_uname'};
 1620:     my $sender_domain = $env{'form.sender_domain'};
 1621:     if ($sender_domain eq '') {
 1622:         $sender_uname = '';
 1623:     } elsif ($sender_uname eq '') {
 1624:         $sender_domain = '';
 1625:     }
 1626:     my %autoenrollhash =  (
 1627:                        autoenroll => { run => $env{'form.autoenroll_run'},
 1628:                                        sender_uname => $sender_uname,
 1629:                                        sender_domain => $sender_domain,
 1630: 
 1631:                                 }
 1632:                      );
 1633:     my $putresult = &Apache::lonnet::put_dom('configuration',\%autoenrollhash,
 1634:                                              $dom);
 1635:     if ($putresult eq 'ok') {
 1636:         if (exists($currautoenroll{'run'})) {
 1637:              if ($currautoenroll{'run'} ne $env{'form.autoenroll_run'}) {
 1638:                  $changes{'run'} = 1;
 1639:              }
 1640:         } elsif ($autorun) {
 1641:             if ($env{'form.autoenroll_run'} ne '1') {
 1642:                 $changes{'run'} = 1;
 1643:             }
 1644:         }
 1645:         if ($currautoenroll{'sender_uname'} ne $sender_uname) {
 1646:             $changes{'sender'} = 1;
 1647:         }
 1648:         if ($currautoenroll{'sender_domain'} ne $sender_domain) {
 1649:             $changes{'sender'} = 1;
 1650:         }
 1651:         if (keys(%changes) > 0) {
 1652:             $resulttext = &mt('Changes made:').'<ul>';
 1653:             if ($changes{'run'}) {
 1654:                 $resulttext .= '<li>'.&mt("$title{'run'} set to $offon[$env{'form.autoenroll_run'}]").'</li>';
 1655:             }
 1656:             if ($changes{'sender'}) {
 1657:                 if ($sender_uname eq '' || $sender_domain eq '') {
 1658:                     $resulttext .= '<li>'.&mt("$title{'sender'} set to default (course owner).").'</li>';
 1659:                 } else {
 1660:                     $resulttext .= '<li>'.&mt("$title{'sender'} set to [_1]",$sender_uname.':'.$sender_domain).'</li>';
 1661:                 }
 1662:             }
 1663:             $resulttext .= '</ul>';
 1664:         } else {
 1665:             $resulttext = &mt('No changes made to auto-enrollment settings');
 1666:         }
 1667:     } else {
 1668:         $resulttext = '<span class="LC_error">'.
 1669: 	    &mt('An error occurred: [_1]',$putresult).'</span>';
 1670:     }
 1671:     return $resulttext;
 1672: }
 1673: 
 1674: sub modify_autoupdate {
 1675:     my ($dom,%domconfig) = @_;
 1676:     my ($resulttext,%currautoupdate,%fields,%changes);
 1677:     if (ref($domconfig{'autoupdate'}) eq 'HASH') {
 1678:         foreach my $key (keys(%{$domconfig{'autoupdate'}})) {
 1679:             $currautoupdate{$key} = $domconfig{'autoupdate'}{$key};
 1680:         }
 1681:     }
 1682:     my @offon = ('off','on');
 1683:     my %title = &Apache::lonlocal::texthash (
 1684:                    run => 'Auto-update:',
 1685:                    classlists => 'Updates to user information in classlists?'
 1686:                 );
 1687:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
 1688:     my %fieldtitles = &Apache::lonlocal::texthash (
 1689:                         id => 'Student/Employee ID',
 1690:                         permanentemail => 'E-mail address',
 1691:                         lastname => 'Last Name',
 1692:                         firstname => 'First Name',
 1693:                         middlename => 'Middle Name',
 1694:                         gen => 'Generation',
 1695:                       );
 1696:     my $othertitle = &mt('All users');
 1697:     if (keys(%{$usertypes}) >  0) {
 1698:         $othertitle = "Other users";
 1699:     }
 1700:     foreach my $key (keys(%env)) {
 1701:         if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) {
 1702:             push(@{$fields{$1}},$2);
 1703:         }
 1704:     }
 1705:     my %updatehash = (
 1706:                       autoupdate => { run => $env{'form.autoupdate_run'},
 1707:                                       classlists => $env{'form.classlists'},
 1708:                                       fields => {%fields},
 1709:                                     }
 1710:                      );
 1711:     foreach my $key (keys(%currautoupdate)) {
 1712:         if (($key eq 'run') || ($key eq 'classlists')) {
 1713:             if (exists($updatehash{autoupdate}{$key})) {
 1714:                 if ($currautoupdate{$key} ne $updatehash{autoupdate}{$key}) {
 1715:                     $changes{$key} = 1;
 1716:                 }
 1717:             }
 1718:         } elsif ($key eq 'fields') {
 1719:             if (ref($currautoupdate{$key}) eq 'HASH') {
 1720:                 foreach my $item (keys(%{$currautoupdate{$key}})) {
 1721:                     if (ref($currautoupdate{$key}{$item}) eq 'ARRAY') {
 1722:                         my $change = 0;
 1723:                         foreach my $type (@{$currautoupdate{$key}{$item}}) {
 1724:                             if (!exists($fields{$item})) {
 1725:                                 $change = 1;
 1726:                             } elsif (ref($fields{$item}) eq 'ARRAY') {
 1727:                                 if (!grep/^\Q$type\E$/,@{$fields{$item}}) {
 1728:                                     $change = 1;
 1729:                                 }
 1730:                             }
 1731:                         }
 1732:                         if ($change) {
 1733:                             push(@{$changes{$key}},$item);
 1734:                         }
 1735:                     }
 1736:                 }
 1737:             }
 1738:         }
 1739:     }
 1740:     foreach my $key (keys(%fields)) {
 1741:         if (ref($currautoupdate{'fields'}) eq 'HASH') {
 1742:             if (!exists($currautoupdate{'fields'}{$key})) {
 1743:                 push(@{$changes{'fields'}},$key);
 1744:             }
 1745:         } else {
 1746:             push(@{$changes{'fields'}},$key);
 1747:         }
 1748:     }
 1749:     my $putresult = &Apache::lonnet::put_dom('configuration',\%updatehash,
 1750:                                              $dom);
 1751:     if ($putresult eq 'ok') {
 1752:         if (keys(%changes) > 0) {
 1753:             $resulttext = &mt('Changes made:').'<ul>';
 1754:             foreach my $key (sort(keys(%changes))) {
 1755:                 if (ref($changes{$key}) eq 'ARRAY') {
 1756:                     foreach my $item (@{$changes{$key}}) {
 1757:                         my @newvalues;
 1758:                         foreach my $type (@{$fields{$item}}) {
 1759:                             push(@newvalues,$fieldtitles{$type});
 1760:                         }
 1761:                         my $newvaluestr;
 1762:                         if (@newvalues > 0) {
 1763:                             $newvaluestr = join(', ',@newvalues);
 1764:                         } else {
 1765:                             $newvaluestr = &mt('none');
 1766:                         }
 1767:                         if ($item eq 'default') {
 1768:                             $resulttext .= '<li>'.&mt("Updates for $othertitle set to: [_1]",$newvaluestr).'</li>';
 1769:                         } else {
 1770:                             $resulttext .= '<li>'.&mt("Updates for [_1] set to: [_2]",$usertypes->{$item},$newvaluestr).'</li>';
 1771:                         }
 1772:                     }
 1773:                 } else {
 1774:                     my $newvalue;
 1775:                     if ($key eq 'run') {
 1776:                         $newvalue = $offon[$env{'form.autoupdate_run'}];
 1777:                     } else {
 1778:                         $newvalue = $offon[$env{'form.'.$key}];
 1779:                     }
 1780:                     $resulttext .= '<li>'.&mt("[_1] set to $newvalue",$title{$key}).'</li>';
 1781:                 }
 1782:             }
 1783:             $resulttext .= '</ul>';
 1784:         } else {
 1785:             $resulttext = &mt('No changes made to autoupdates');
 1786:         }
 1787:     } else {
 1788:         $resulttext = '<span class="LC_error">'.
 1789: 	    &mt('An error occurred: [_1]',$putresult).'</span>';
 1790:     }
 1791:     return $resulttext;
 1792: }
 1793: 
 1794: 1;
 1795: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>