File:  [LON-CAPA] / loncom / interface / domainprefs.pm
Revision 1.23: download - view: text, annotated - select for diffs
Wed Jul 25 20:12:26 2007 UTC (16 years, 11 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
Domain settings to configure access to institutional directory search (used in loncreateuser).

Institutional user type ordering icode moved to subroutine.

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

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