Annotation of loncom/interface/lonpreferences.pm, revision 1.232

1.1       www         1: # The LearningOnline Network
                      2: # Preferences
                      3: #
1.232   ! raeburn     4: # $Id: lonpreferences.pm,v 1.231 2019/04/24 21:15:48 raeburn Exp $
1.2       albertel    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: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.3       matthew    28: # This package uses the "londes.js" javascript code. 
                     29: #
                     30:  
1.1       www        31: package Apache::lonpreferences;
                     32: 
                     33: use strict;
1.86      albertel   34: use LONCAPA;
1.1       www        35: use Apache::Constants qw(:common);
1.3       matthew    36: use Apache::File;
1.4       matthew    37: use Apache::loncommon();
1.23      matthew    38: use Apache::lonhtmlcommon();
1.32      www        39: use Apache::lonlocal;
1.59      albertel   40: use Apache::lonnet;
1.174     raeburn    41: use LONCAPA::lonauthcgi();
1.95      albertel   42: use LONCAPA();
1.3       matthew    43: 
1.4       matthew    44: ################################################################
                     45: #                       Handler subroutines                    #
                     46: ################################################################
1.9       matthew    47: 
                     48: ################################################################
1.28      www        49: #         Language Change Subroutines                          #
                     50: ################################################################
1.44      www        51: 
                     52: sub wysiwygchanger {
                     53:     my $r = shift;
1.126     droeschl   54:     Apache::lonhtmlcommon::add_breadcrumb(
                     55: 	    {	href => '/adm/preferences?action=changewysiwyg',
                     56:                 text => 'Change WYSIWYG Preferences'});
1.147     schafran   57:     $r->print(Apache::loncommon::start_page('Content Display Settings'));
1.126     droeschl   58:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Change WYSIWYG Preferences'));
                     59: 
1.44      www        60:     my %userenv = &Apache::lonnet::get
                     61:         ('environment',['wysiwygeditor']);
1.78      albertel   62:     my $onselect='checked="checked"';
1.44      www        63:     my $offselect='';
1.77      albertel   64:     if ($userenv{'wysiwygeditor'} eq 'on') {
1.44      www        65: 	$onselect='';
1.78      albertel   66: 	$offselect='checked="checked"';
1.44      www        67:     }
                     68:     my $switchoff=&mt('Disable WYSIWYG editor');
                     69:     my $switchon=&mt('Enable WYSIWYG editor');
1.124     www        70:     my $warning='';
                     71:     if ($env{'user.adv'}) {
1.185     droeschl   72:        $warning.='<p class="LC_warning">'.&mt("The WYSIWYG editor only supports simple HTML and is in many cases unsuited for advanced authoring. In a number of cases, it may destroy advanced authoring involving LaTeX and script function calls.")."</p>";
1.124     www        73:     }
1.44      www        74:     $r->print(<<ENDLSCREEN);
1.88      albertel   75: <form name="prefs" action="/adm/preferences" method="post">
1.44      www        76: <input type="hidden" name="action" value="set_wysiwyg" />
1.124     www        77: $warning
1.44      www        78: <br />
1.65      albertel   79: <label><input type="radio" name="wysiwyg" value="off" $onselect /> $switchoff</label><br />
                     80: <label><input type="radio" name="wysiwyg" value="on" $offselect /> $switchon</label>
1.44      www        81: ENDLSCREEN
1.136     schafran   82:     $r->print('<br /><input type="submit" value="'.&mt('Save').'" />');
1.44      www        83: }
                     84: 
                     85: 
                     86: sub verify_and_change_wysiwyg {
                     87:     my $r = shift;
1.59      albertel   88:     my $newsetting=$env{'form.wysiwyg'};
1.44      www        89:     &Apache::lonnet::put('environment',{'wysiwygeditor' => $newsetting});
1.116     raeburn    90:     &Apache::lonnet::appenv({'environment.wysiwygeditor' => $newsetting});
1.158     bisitz     91:     my $message=&Apache::lonhtmlcommon::confirm_success(&mt('Set [_1] to [_2]','<i>'.&mt('WYSIWYG Editor').'</i>','<tt>'.&mt($newsetting).'</tt>'));
                     92:     $message=&Apache::loncommon::confirmwrapper($message);
                     93:     &print_main_menu($r,$message);
1.44      www        94: }
                     95: 
                     96: ################################################################
                     97: #         Language Change Subroutines                          #
                     98: ################################################################
1.28      www        99: sub languagechanger {
                    100:     my $r = shift;
1.126     droeschl  101:     
                    102:     Apache::lonhtmlcommon::add_breadcrumb(
                    103: 	    {	href => '/adm/preferences?action=changelanguages',
1.127     droeschl  104:                 text => 'Change Language'});
1.147     schafran  105:     $r->print(Apache::loncommon::start_page('Content Display Settings'));
1.126     droeschl  106:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Change Language')); 
1.204     raeburn   107:     my %userenv = &Apache::lonnet::get('environment',['languages']);
1.29      www       108:     my $language=$userenv{'languages'};
1.32      www       109: 
1.204     raeburn   110:     $r->print(
                    111:         '<form name="prefs" action="/adm/preferences" method="post">'."\n".
                    112:         '<input type="hidden" name="action" value="verify_and_change_languages" />'.
                    113:         '<br /><span class="LC_nobreak">'.&mt('Preferred language').':&nbsp;'.
                    114:         &Apache::loncommon::select_language('language',$language,1).'</span>'."\n".
                    115:         '<br /><input type="submit" value="'.&mt('Save').'" /></form>'
                    116:     );
1.28      www       117: }
                    118: 
                    119: 
                    120: sub verify_and_change_languages {
                    121:     my $r = shift;
1.59      albertel  122:     my $user       = $env{'user.name'};
                    123:     my $domain     = $env{'user.domain'};
1.28      www       124: # Screenname
1.59      albertel  125:     my $newlanguage  = $env{'form.language'};
1.28      www       126:     $newlanguage=~s/[^\-\w]//g;
                    127:     my $message='';
                    128:     if ($newlanguage) {
1.29      www       129:         &Apache::lonnet::put('environment',{'languages' => $newlanguage});
1.116     raeburn   130:         &Apache::lonnet::appenv({'environment.languages' => $newlanguage});
1.183     bisitz    131:         $message=&Apache::lonhtmlcommon::confirm_success(
                    132:             &mt('Set [_1] to [_2]',
                    133:                 '<i>'.&mt('Preferred language').'</i>',
                    134:                 '<tt>"'.$newlanguage.'"</tt>.'))
                    135:            .'<br />'
                    136:            .&mt('The change will become active on the next page.');
1.28      www       137:     } else {
1.29      www       138:         &Apache::lonnet::del('environment',['languages']);
1.139     raeburn   139:         &Apache::lonnet::delenv('environment.languages');
1.158     bisitz    140:         $message=&Apache::lonhtmlcommon::confirm_success(&mt('Reset [_1]','<i>'.&mt('Preferred language').'</i>'));
1.28      www       141:     }
1.158     bisitz    142:     $message=&Apache::loncommon::confirmwrapper($message);
1.132     raeburn   143:     &Apache::loncommon::flush_langs_cache($user,$domain);
1.152     www       144:     &print_main_menu($r, $message);
1.28      www       145: }
                    146: 
1.50      albertel  147: ################################################################
1.54      albertel  148: #         Tex Engine Change Subroutines                        #
                    149: ################################################################
                    150: sub texenginechanger {
                    151:     my $r = shift;
1.126     droeschl  152:     Apache::lonhtmlcommon::add_breadcrumb(
                    153: 	    {	href => '/adm/preferences?action=changetexenginepref',
1.177     raeburn   154:                 text => 'Math display settings'});
1.147     schafran  155:     $r->print(Apache::loncommon::start_page('Content Display Settings'));
1.177     raeburn   156:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Math display settings'));
1.59      albertel  157:     my $user       = $env{'user.name'};
                    158:     my $domain     = $env{'user.domain'};
1.54      albertel  159:     my %userenv = &Apache::lonnet::get('environment',['texengine']);
                    160:     my $texengine=$userenv{'texengine'};
1.220     raeburn   161:     if (lc($texengine) eq 'jsmath') {
                    162:         $texengine = 'MathJax';
                    163:     }
1.54      albertel  164: 
1.69      albertel  165:     my %mathchoices=('' => 'Default',
1.123     bisitz    166: 		     'tth' => 'tth (TeX to HTML)',
1.64      albertel  167: 		     #'ttm' => 'TeX to MathML',
1.195     dseaton   168: 		     'MathJax' => 'MathJax',
1.168     www       169: 		     'mimetex' => 'mimetex (Convert to Images)',
                    170:                      'raw' => 'Raw (Screen Reader)'
1.54      albertel  171:                      );
1.190     raeburn   172:     %mathchoices = &Apache::lonlocal::texthash(%mathchoices);
1.179     bisitz    173:     my $selectionbox=
                    174:            &Apache::loncommon::select_form(
                    175:                $texengine,
                    176:                'texengine',
1.190     raeburn   177:                \%mathchoices);
1.195     dseaton   178:     my $MathJax_start=&Apache::lontexconvert::MathJax_header();
1.123     bisitz    179:     my %lt=&Apache::lonlocal::texthash(
1.177     raeburn   180:       'headline' => 'Change how math is displayed',
                    181:       'preftxt'  => 'Preferred method to display math',
1.136     schafran  182:       'change'   => 'Save',
1.123     bisitz    183:       'exmpl'    => 'Examples',
1.195     dseaton   184:       'mathjax'  => 'MathJax:',
1.213     bisitz    185:       'mathjaxinfo' => 'MathJax provides rendered equations whose source code can be extracted in TeX and MathML formats by right clicking the equation.',
1.123     bisitz    186:       'tth'      => 'tth (TeX to HTML):',
                    187:       'mimetex'  => 'mimetex (Convert to Images):',
                    188:     );
                    189: 
1.54      albertel  190:     $r->print(<<ENDLSCREEN);
1.123     bisitz    191: <h2>$lt{'headline'}</h2>
1.88      albertel  192: <form name="prefs" action="/adm/preferences" method="post">
1.54      albertel  193: <input type="hidden" name="action" value="verify_and_change_texengine" />
1.123     bisitz    194: <p>
1.136     schafran  195: $lt{'preftxt'}: $selectionbox 
                    196: <br />
                    197: <input type="submit" value="$lt{'change'}" />
1.123     bisitz    198: </p>
1.54      albertel  199: </form>
1.123     bisitz    200: <br />
                    201: <hr />
                    202: $lt{'exmpl'}
                    203: 
1.195     dseaton   204: <h3>$lt{'mathjax'}</h3>
                    205: </script>
1.213     bisitz    206: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=MathJax" width="400" height="150"></iframe>
1.195     dseaton   207: </p>
                    208: <p>
1.213     bisitz    209: $lt{'mathjaxinfo'}
1.195     dseaton   210: </p>
                    211: 
1.123     bisitz    212: <h3>$lt{'mimetex'}</h3>
                    213: <p>
1.213     bisitz    214: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=mimetex" width="400" height="150"></iframe>
1.67      albertel  215: </p>
1.123     bisitz    216: 
                    217: <h3>$lt{'tth'}</h3>
                    218: <p>
1.213     bisitz    219: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=tth" width="400" height="150"></iframe>
1.67      albertel  220: </p>
1.54      albertel  221: ENDLSCREEN
                    222: }
                    223: 
                    224: 
                    225: sub verify_and_change_texengine {
                    226:     my $r = shift;
1.59      albertel  227:     my $user       = $env{'user.name'};
                    228:     my $domain     = $env{'user.domain'};
1.54      albertel  229: # Screenname
1.59      albertel  230:     my $newtexengine  = $env{'form.texengine'};
1.54      albertel  231:     $newtexengine=~s/[^\-\w]//g;
1.220     raeburn   232:     if (lc($newtexengine) eq 'jsmath') {
                    233:         $newtexengine = 'MathJax';
                    234:     }
1.56      albertel  235:     if ($newtexengine eq 'ttm') {
1.116     raeburn   236: 	&Apache::lonnet::appenv({'browser.mathml' => 1});
1.56      albertel  237:     } else {
1.59      albertel  238: 	if ($env{'environment.texengine'} eq 'ttm') {
1.116     raeburn   239: 	    &Apache::lonnet::appenv({'browser.mathml' => 0});
1.56      albertel  240: 	}
                    241:     }
1.54      albertel  242:     my $message='';
                    243:     if ($newtexengine) {
                    244:         &Apache::lonnet::put('environment',{'texengine' => $newtexengine});
1.116     raeburn   245:         &Apache::lonnet::appenv({'environment.texengine' => $newtexengine});
1.158     bisitz    246:         $message=&Apache::lonhtmlcommon::confirm_success(&mt('Set [_1] to [_2]','<i>'.&mt('Preferred method to display Math').'</i>','<tt>"'.$newtexengine.'"</tt>'));
1.54      albertel  247:     } else {
                    248:         &Apache::lonnet::del('environment',['texengine']);
1.139     raeburn   249:         &Apache::lonnet::delenv('environment.texengine');
1.158     bisitz    250:         $message=&Apache::lonhtmlcommon::confirm_success(&mt('Reset [_1]','<i>'.&mt('Preferred method to display Math').'</i>'));
1.54      albertel  251:     }
1.158     bisitz    252:     $message=&Apache::loncommon::confirmwrapper($message);
1.152     www       253:     &print_main_menu($r, $message);
1.54      albertel  254: }
                    255: 
                    256: ################################################################
1.50      albertel  257: #         Roles Page Preference Change Subroutines         #
                    258: ################################################################
                    259: sub rolesprefchanger {
                    260:     my $r = shift;
1.96      albertel  261:     my $role    = ($env{'user.adv'} ? 'Role' : 'Course');
                    262:     my $lc_role = ($env{'user.adv'} ? 'role' : 'course');
1.59      albertel  263:     my $user       = $env{'user.name'};
                    264:     my $domain     = $env{'user.domain'};
1.50      albertel  265:     my %userenv = &Apache::lonnet::get
                    266:         ('environment',['recentroles','recentrolesn']);
1.198     raeburn   267:     my $brtext = 'Change '.$role.' Page Pref';
                    268:     my $brtitle;
                    269:     if ($env{'form.returnurl'} eq '/adm/roles') {
                    270:         $brtext = 'Configure Hotlist';
                    271:     } else {
                    272:         $brtitle = $brtext;
                    273:     }
1.126     droeschl  274:     Apache::lonhtmlcommon::add_breadcrumb(
                    275: 	    {	href => '/adm/preferences?action=changerolespref',
1.198     raeburn   276:                 text => $brtext});
1.147     schafran  277:     $r->print(Apache::loncommon::start_page('Content Display Settings'));
1.198     raeburn   278:     $r->print(Apache::lonhtmlcommon::breadcrumbs($brtitle));
1.50      albertel  279:     my $hotlist_flag=$userenv{'recentroles'};
                    280:     my $hotlist_n=$userenv{'recentrolesn'};
1.198     raeburn   281:     my ($checkedon,$checkedoff);
1.50      albertel  282:     if ($hotlist_flag) {
1.198     raeburn   283: 	$checkedon = 'checked="checked"';
                    284:     } else {
                    285:         $checkedoff = 'checked="checked"';
1.50      albertel  286:     }
                    287:     
                    288:     if (!$hotlist_n) { $hotlist_n=3; }
                    289:     my $options;
                    290:     for (my $i=1; $i<10; $i++) {
                    291: 	my $select;
                    292: 	if ($hotlist_n == $i) { $select = 'selected="selected"'; }
                    293: 	$options .= "<option $select>$i</option>\n";
                    294:     }
                    295: 
1.89      albertel  296: # Get list of recent roles and display with checkbox in front
                    297:     my $roles_check_list = '';
                    298:     my $role_key='';
                    299:     if ($env{'environment.recentroles'}) {
                    300:         my %recent_roles =
                    301:                &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.91      albertel  302:         my %frozen_roles =
                    303:                &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.89      albertel  304:         
1.93      albertel  305:         my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
1.92      albertel  306:         my @sorted_roles = sort {$role_text{$a} cmp $role_text{$b}} keys(%role_text);
                    307: 
1.89      albertel  308:         $roles_check_list .=
                    309: 	    &Apache::loncommon::start_data_table().
                    310: 	    &Apache::loncommon::start_data_table_header_row().
1.96      albertel  311: 	    "<th>".&mt('Freeze '.$role)."</th>".
1.198     raeburn   312: 	    "<th>".&mt($role)."</th>".
1.89      albertel  313: 	    &Apache::loncommon::end_data_table_header_row().
                    314: 	    "\n";
                    315: 	my $count;
1.92      albertel  316:         foreach $role_key (@sorted_roles) {
1.89      albertel  317:             my $checked = "";
                    318:             my $value = $recent_roles{$role_key};
1.91      albertel  319:             if ($frozen_roles{$role_key}) {
1.159     bisitz    320:                 $checked = ' checked="checked"';
1.89      albertel  321:             }
                    322: 	    $count++;
                    323:             $roles_check_list .=
                    324: 		&Apache::loncommon::start_data_table_row().
                    325: 		'<td class="LC_table_cell_checkbox">'.
1.159     bisitz    326: 		"<input type=\"checkbox\"$checked name=\"freezeroles\"".
1.89      albertel  327: 		" id=\"freezeroles$count\" value=\"$role_key\" /></td>".
                    328: 		"<td><label for=\"freezeroles$count\">".
1.92      albertel  329: 		"$role_text{$role_key}</label></td>".
1.89      albertel  330: 		&Apache::loncommon::end_data_table_row(). "\n";
                    331:         }
                    332:         $roles_check_list .= "</table>\n";
                    333:     }
                    334: 
1.198     raeburn   335:     my $actionurl = '/adm/preferences';
                    336:     if ($env{'form.returnurl'} eq '/adm/roles') {
                    337:         $actionurl = '/adm/roles';
                    338:     }
                    339:     $r->print('<h3>'.&mt('Recent Roles Hotlist').'</h3>');
                    340:     unless ($checkedon) {
                    341:         $r->print(&mt('LON-CAPA users with several '.$lc_role.'s may wish to enable the Hotlist.').'<br />');
                    342:     }
1.89      albertel  343:     $r->print('
1.198     raeburn   344: <form name="prefs" action="'.$actionurl.'" method="post">
1.50      albertel  345: <input type="hidden" name="action" value="verify_and_change_rolespref" />
1.198     raeburn   346: <input type="hidden" name="returnurl" value="'.$env{'form.returnurl'}.'" />
                    347: <div class="LC_left_float"><h4>'.&mt('Hotlist options').'</h4>
                    348: <p>'.
                    349: &mt('When enabled, the Hotlist keeps track of the last N '.$lc_role.'s visited.').'<br />'.
                    350: &mt('Those N '.$lc_role.'s are then shown in a table at the top of the '.$lc_role.'s page.').'</p>'.
1.181     wenzelju  351: &Apache::lonhtmlcommon::start_pick_box().
1.198     raeburn   352: &Apache::lonhtmlcommon::row_title(&mt('Use Recent '.$role.'s Hotlist')).
                    353: '<span class="LC_nobreak">
                    354: <label><input id="Hotliston" type="radio" '.$checkedon.' name="recentroles" value="1" />'.&mt('Yes').'</label>'.
                    355: ('&nbsp;'x2).
                    356: '<label><input id="Hotlistoff" type="radio" '.$checkedoff.' name="recentroles" value="0" />'.&mt('No').'</label>
                    357: </span>'.
1.181     wenzelju  358: &Apache::lonhtmlcommon::row_closure().
                    359: &Apache::lonhtmlcommon::row_title('<label for="NumberOfRoles">'.&mt('Number of '.$role.'s in Hotlist').'</label>').
                    360: '<select name="recentrolesn" size="1" id ="NumberOfRoles">'.
1.198     raeburn   361: $options.'
                    362: </select>'.
1.181     wenzelju  363: &Apache::lonhtmlcommon::row_closure(1).
1.198     raeburn   364: &Apache::lonhtmlcommon::end_pick_box().'
                    365: </div>');
                    366:     if ($roles_check_list) { 
                    367:         $r->print('<div class="LC_left_float">
                    368: <h4>'.&mt('Freeze Roles').'</h4>
                    369: <p>'.&mt('The table below can be used to [_1]freeze[_2] '.$lc_role.'s in the Hotlist.','<q>','</q>').'<br />'.
1.201     raeburn   370: &mt('Those '.$lc_role.'s marked frozen will not be removed from the list, even if not recently used.').'
1.89      albertel  371: </p>
                    372: '.$roles_check_list.'
1.198     raeburn   373: </div>');
                    374:      } else {
                    375:          $r->print('<br clear="all" />'.
1.210     raeburn   376:                    &mt('Once the Hotlist contains recently visited '.$lc_role.'s you can return to this page to also set frozen roles.'));
1.198     raeburn   377:      }
                    378:      $r->print('
                    379: <br clear="all" />
1.136     schafran  380: <input type="submit" value="'.&mt('Save').'" />
1.89      albertel  381: </form>');
1.50      albertel  382: }
                    383: 
1.92      albertel  384: sub rolespref_get_role_text {
                    385: # Get a line of text for each role
                    386:     my ($roles) = @_;
                    387:     my %roletext = ();
                    388: 
                    389:     foreach my $item (@$roles) {
                    390: # get course information
                    391:         my ($role,$rest) = split(/\./, $item);
1.93      albertel  392:         my $trole = "";
                    393:         $trole = &Apache::lonnet::plaintext($role);
1.92      albertel  394:         my ($tdomain,$other,$tsection)= split(/\//,Apache::lonnet::declutter($rest));
                    395:         my $tother = '-';
1.93      albertel  396:         if ($role =~ /^(cc|st|in|ta|ep|cr)/ ) {
1.92      albertel  397:             my %newhash=&Apache::lonnet::coursedescription($tdomain."_".$other);
                    398:             $tother = " - ".$newhash{'description'};
                    399:         } elsif ($role =~ /dc/) {
                    400:             $tother = "";
                    401:         } else {
                    402:             $tother = " - $other";
                    403:         }
                    404:  
                    405:         my $section="";
                    406:         if ($tsection) {
                    407:             $section = " - Section/Group: $tsection";
                    408:         }
                    409:         $roletext{$item} = $tdomain." - ".$trole.$tother.$section;
                    410:     }
                    411:     return %roletext;
                    412: }
                    413: 
1.50      albertel  414: sub verify_and_change_rolespref {
                    415:     my $r = shift;
1.96      albertel  416:     my $role = ($env{'user.adv'} ? 'Role' : 'Course');
1.59      albertel  417:     my $user       = $env{'user.name'};
                    418:     my $domain     = $env{'user.domain'};
1.50      albertel  419: # Recent Roles Hotlist Flag
1.59      albertel  420:     my $hotlist_flag  = $env{'form.recentroles'};
                    421:     my $hotlist_n  = $env{'form.recentrolesn'};
1.89      albertel  422:     my $message='<hr />';
1.50      albertel  423:     if ($hotlist_flag) {
                    424:         &Apache::lonnet::put('environment',{'recentroles' => $hotlist_flag});
1.116     raeburn   425:         &Apache::lonnet::appenv({'environment.recentroles' => $hotlist_flag});
1.180     wenzelju  426:         $message=&Apache::lonhtmlcommon::confirm_success(&mt('Recent '.$role.'s Hotlist is Enabled.')." ".&mt('Display [_1] Most Recent '.$role.'s.',$hotlist_n));
1.50      albertel  427:     } else {
                    428:         &Apache::lonnet::del('environment',['recentroles']);
1.139     raeburn   429:         &Apache::lonnet::delenv('environment.recentroles');
1.180     wenzelju  430:         $message=&Apache::lonhtmlcommon::confirm_success(&mt('Recent '.$role.'s Hotlist is Disabled'));
1.50      albertel  431:     }
                    432:     if ($hotlist_n) {
                    433:         &Apache::lonnet::put('environment',{'recentrolesn' => $hotlist_n});
1.116     raeburn   434:         &Apache::lonnet::appenv({'environment.recentrolesn' => $hotlist_n});
1.89      albertel  435:     }
                    436: 
                    437: # Get list of froze roles and list of recent roles
                    438:     my @freeze_list = &Apache::loncommon::get_env_multiple('form.freezeroles');
                    439:     my %freeze = ();
1.92      albertel  440:     my %roletext = ();
                    441: 
1.89      albertel  442:     foreach my $key (@freeze_list) {
1.91      albertel  443:         $freeze{$key}='1';
1.89      albertel  444:     }
1.92      albertel  445: 
1.89      albertel  446:     my %recent_roles =
                    447:         &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.91      albertel  448:     my %frozen_roles =
                    449:         &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.92      albertel  450:     my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
1.89      albertel  451: 
                    452: # Unset any roles that were previously frozen but aren't in list
                    453:     foreach my $role_key (sort(keys(%recent_roles))) {
1.91      albertel  454:         if (($frozen_roles{$role_key}) && (!exists($freeze{$role_key}))) {
1.158     bisitz    455: 	    $message .= "<br />".&Apache::lonhtmlcommon::confirm_success(&mt('Unfreezing '.$role.': [_1]','<i>'.$role_text{$role_key}.'</i>'));
1.91      albertel  456: 	    &Apache::lonhtmlcommon::store_recent('roles',$role_key,' ',0);
1.89      albertel  457:         }
                    458:     }
                    459: 
                    460: # Freeze selected roles
                    461:     foreach my $role_key (@freeze_list) {
1.91      albertel  462:         if (!$frozen_roles{$role_key}) {
1.154     www       463:              $message .= "<br />".
1.158     bisitz    464:              &Apache::lonhtmlcommon::confirm_success(&mt('Freezing '.$role.': [_1]','<i>'.$role_text{$role_key}.'</i>'));
1.89      albertel  465:              &Apache::lonhtmlcommon::store_recent('roles',
1.91      albertel  466:                                           $role_key,' ',1);
1.50      albertel  467:         }
                    468:     }
1.158     bisitz    469:     $message=&Apache::loncommon::confirmwrapper($message);
1.198     raeburn   470:     if ($env{'form.returnurl'} eq '/adm/roles') {
                    471:         return $message;
                    472:     } else {
                    473:         &print_main_menu($r, $message);
                    474:     }
1.50      albertel  475: }
                    476: 
                    477: 
1.28      www       478: ################################################################
1.9       matthew   479: #         Anonymous Discussion Name Change Subroutines         #
                    480: ################################################################
1.5       www       481: sub screennamechanger {
                    482:     my $r = shift;
1.59      albertel  483:     my $user       = $env{'user.name'};
                    484:     my $domain     = $env{'user.domain'};
1.14      www       485:     my %userenv = &Apache::lonnet::get
                    486:         ('environment',['screenname','nickname']);
1.6       www       487:     my $screenname=$userenv{'screenname'};
1.14      www       488:     my $nickname=$userenv{'nickname'};
1.126     droeschl  489:     Apache::lonhtmlcommon::add_breadcrumb(
                    490: 		{ href => '/adm/preferences?action=changescreenname',
                    491:                   text => 'Change Screen Name'});
1.147     schafran  492:     $r->print(Apache::loncommon::start_page('Personal Data'));
1.126     droeschl  493:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Change Screen Name'));
1.133     bisitz    494:     $r->print('<p>'
                    495:              .&mt('Change the name that is displayed in your posts.')
                    496:              .'</p>'
                    497:     );
                    498:     $r->print('<form name="prefs" action="/adm/preferences" method="post">'
                    499:              .'<input type="hidden" name="action" value="verify_and_change_screenname" />'
                    500:              .&Apache::lonhtmlcommon::start_pick_box()
1.158     bisitz    501:              .&Apache::lonhtmlcommon::row_title(&mt('Screenname').' '.&mt('(shown if you post anonymously)'))
1.133     bisitz    502:              .'<input type="text" size="20" value="'.$screenname.'" name="screenname" />'
                    503:              .&Apache::lonhtmlcommon::row_closure()
1.158     bisitz    504:              .&Apache::lonhtmlcommon::row_title(&mt('Nickname').' '.&mt('(shown if you post non-anonymously)'))
1.133     bisitz    505:              .'<input type="text" size="20" value="'.$nickname.'" name="nickname" />'
                    506:              .&Apache::lonhtmlcommon::row_closure()
                    507:              .&Apache::lonhtmlcommon::row_title()
                    508:              .'<input type="submit" value="'.&mt('Save').'" />'
                    509:              .&Apache::lonhtmlcommon::row_closure(1)
                    510:              .&Apache::lonhtmlcommon::end_pick_box()
                    511:              .'</form>'
                    512:     );
1.5       www       513: }
1.6       www       514: 
                    515: sub verify_and_change_screenname {
                    516:     my $r = shift;
1.59      albertel  517:     my $user       = $env{'user.name'};
                    518:     my $domain     = $env{'user.domain'};
1.14      www       519: # Screenname
1.59      albertel  520:     my $newscreen  = $env{'form.screenname'};
1.14      www       521:     $newscreen=~s/[^ \w]//g;
1.6       www       522:     my $message='';
                    523:     if ($newscreen) {
1.7       www       524:         &Apache::lonnet::put('environment',{'screenname' => $newscreen});
1.116     raeburn   525:         &Apache::lonnet::appenv({'environment.screenname' => $newscreen});
1.161     bisitz    526:         $message=&Apache::lonhtmlcommon::confirm_success(&mt('Set [_1] to [_2]','<i>'.&mt('Screenname').'</i>','<tt>"'.$newscreen.'"</tt>'));
1.6       www       527:     } else {
                    528:         &Apache::lonnet::del('environment',['screenname']);
1.139     raeburn   529:         &Apache::lonnet::delenv('environment.screenname');
1.158     bisitz    530:         $message=&Apache::lonhtmlcommon::confirm_success(&mt('Reset [_1]','<i>'.&mt('Screenname').'</i>'));
1.6       www       531:     }
1.14      www       532: # Nickname
                    533:     $message.='<br />';
1.59      albertel  534:     $newscreen  = $env{'form.nickname'};
1.14      www       535:     $newscreen=~s/[^ \w]//g;
                    536:     if ($newscreen) {
                    537:         &Apache::lonnet::put('environment',{'nickname' => $newscreen});
1.116     raeburn   538:         &Apache::lonnet::appenv({'environment.nickname' => $newscreen});
1.161     bisitz    539:         $message.=&Apache::lonhtmlcommon::confirm_success(&mt('Set [_1] to [_2]','<i>'.&mt('Nickname').'</i>','<tt>"'.$newscreen.'"</tt>'));
1.14      www       540:     } else {
                    541:         &Apache::lonnet::del('environment',['nickname']);
1.139     raeburn   542:         &Apache::lonnet::delenv('environment.nickname');
1.158     bisitz    543:         $message.=&Apache::lonhtmlcommon::confirm_success(&mt('Reset [_1]','<i>'.&mt('Nickname').'</i>'));
1.14      www       544:     }
1.68      www       545:     &Apache::lonnet::devalidate_cache_new('namescache',$user.':'.$domain);
1.158     bisitz    546:     $message=&Apache::loncommon::confirmwrapper($message);
1.152     www       547:     &print_main_menu($r, $message);
1.20      www       548: }
                    549: 
                    550: ################################################################
1.192     raeburn   551: #                     Icon Subroutines                         #
                    552: ################################################################
                    553: sub iconchanger {
                    554:     my $r = shift;
                    555:     &Apache::lonhtmlcommon::add_breadcrumb(
                    556:             {   href => '/adm/preferences?action=changeicons',
                    557:                 text => 'Change Menu Display'});
                    558:     $r->print(Apache::loncommon::start_page('Page Display Settings'));
                    559:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Change Menu Display'));
                    560: 
                    561:     my $user       = $env{'user.name'};
                    562:     my $domain     = $env{'user.domain'};
                    563:     my %userenv = &Apache::lonnet::get('environment',['icons']);
                    564:     my $iconic='checked="checked"';
                    565:     my ($classic,$onlyicon,$iconic_preview,$iconsonly_preview);
                    566:     if ($userenv{'icons'} eq 'classic') {
                    567:         $iconic='';
                    568:         $classic='<div class="LC_info">'.
                    569:                  &mt('Your current selection: "Use buttons and text" is deprecated - it is recommended that you change this to "Use icons and text".').'</div>';
                    570:     }
                    571:     if ($userenv{'icons'} eq 'iconsonly') {
                    572:        $onlyicon='checked="checked"';
                    573:        $iconic='';
                    574:     }
                    575:     my $change=&mt('Save');
                    576:     my %lt = &icon_options();
                    577:     my ($inlinetools,$toolsorder) = &icon_previews();
                    578:     if ((ref($inlinetools) eq 'HASH') && (ref($toolsorder) eq 'ARRAY')) {
                    579:         foreach my $tool (@{$toolsorder}) {
                    580:             my ($command,$row,$col,$img,$top,$bot,$act,$desc) = 
                    581:                 split(/\&/,$inlinetools->{$tool});
                    582:             $iconic_preview .= '<li><a title="'.$desc.'" class="LC_menubuttons_link" href=""><img alt="'.$desc.'" src="/res/adm/pages/'.$img.'"  class="LC_icon" /><span class="LC_menubuttons_inline_text">'.$top.('&nbsp;' x 2).'</span></a></li>';
                    583:             $iconsonly_preview .= '<li><a title="'.$desc.'" class="LC_menubuttons_link" href=""><img alt="'.$desc.'" src="/res/adm/pages/'.$img.'"  class="LC_icon" />&nbsp;</a></li>';
                    584:         }
                    585:     }
                    586:     $iconsonly_preview = '<ul class="LC_breadcrumb_tools_outerlist"><li>'.
                    587:                          '<ul>'.
                    588:                          $iconsonly_preview.
                    589:                          '</ul></li></ul>';
                    590:     $iconic_preview = '<ul class="LC_breadcrumb_tools_outerlist"><li>'.
                    591:                       '<ul>'.
                    592:                       $iconic_preview.
                    593:                       '</ul></li></ul>'; 
                    594:     $r->print(<<ENDSCREEN);
                    595: $classic
                    596: <form name="prefs" action="/adm/preferences" method="post">
                    597: <input type="hidden" name="action" value="verify_and_change_icons" />
                    598: <label><input type="radio" name="menumode" value="iconic" $iconic /> $lt{'iconic'}</label>$iconic_preview<br />
                    599: <label><input type="radio" name="menumode" value="iconsonly" $onlyicon /> $lt{'iconsonly'}</label>$iconsonly_preview<br />
                    600: <input type="submit" value="$change" />
                    601: </form>
                    602: ENDSCREEN
                    603: }
                    604: 
                    605: sub verify_and_change_icons {
                    606:     my $r = shift;
                    607:     my $user       = $env{'user.name'};
                    608:     my $domain     = $env{'user.domain'};
                    609:     my $newicons   = $env{'form.menumode'};
                    610:     my %lt = &icon_options();
                    611:     my $newchoice = $newicons;
                    612:     if ($lt{$newicons}) {
                    613:         $newchoice = $lt{$newicons};
                    614:     }
                    615:     &Apache::lonnet::put('environment',{'icons' => $newicons});
                    616:     &Apache::lonnet::appenv({'environment.icons' => $newicons});
                    617:     my $message=&Apache::lonhtmlcommon::confirm_success(&mt('Set [_1] to [_2]','<i>'.&mt('Menu Display').'</i>','<tt>'.$newchoice.'</tt>'));
                    618:     $message=&Apache::loncommon::confirmwrapper($message);
                    619:     &print_main_menu($r, $message);
                    620: }
                    621: 
                    622: sub icon_options {
                    623:     return &Apache::lonlocal::texthash(
                    624:                                         iconic    => 'Use icons and text',
                    625:                                         iconsonly => 'Use icons only',
                    626:                                       );
                    627: }
                    628: 
                    629: sub icon_previews {
                    630:      my %icon_text = (
                    631:                       annotate => 'Notes',
1.197     raeburn   632:                       wishlist => 'Stored Links',
1.192     raeburn   633:                       catalog  => 'Info',
                    634:                       evaluate => 'Evaluate',
                    635:                       feedback => 'Communicate',
                    636:                       printout => 'Print',
                    637:                      );
                    638:     my %inlinetools = (
                    639:         printout => "s&8&3&prt.png&$icon_text{'printout'}&printout[_1]&gopost('/adm/printout',currentURL)&Prepare a printable document",
1.197     raeburn   640:         wishlist => "s&9&1&wishlist-link.png&$icon_text{'wishlist'}&wishlistlink[_2]&set_wishlistlink()&Save a link for this resource in your personal Stored Links repository",
1.192     raeburn   641:         evaluate => "s&8&1&eval.png&$icon_text{'evaluate'}&this[_1]&gopost('/adm/evaluate',currentURL,1)&Provide my evaluation of this resource",
                    642:         feedback => "s&8&2&fdbk.png&$icon_text{'feedback'}&discuss[_1]&gopost('/adm/feedback',currentURL,1)&Provide feedback messages or contribute to the course discussion about this resource",
                    643:         annotate => "s&9&3&anot.png&$icon_text{'annotate'}&tations[_1]&annotate()&Make notes and annotations about this resource",
                    644:         catalog  => "s&6&3&catalog.png&$icon_text{'catalog'}&info[_1]&catalog_info()&Show Metadata",
                    645:     );
                    646:     my @toolsorder = qw(annotate wishlist evaluate feedback printout catalog);
                    647:     return (\%inlinetools,\@toolsorder);
                    648: }
                    649: 
                    650: ################################################################
1.105     www       651: #                     Clicker Subroutines                      #
                    652: ################################################################
                    653: 
                    654: sub clickerchanger {
                    655:     my $r = shift;
1.152     www       656:     &Apache::lonhtmlcommon::add_breadcrumb(
1.126     droeschl  657: 	    {	href => '/adm/preferences?action=changeclicker',
                    658:                 text => 'Register Clicker'});
1.147     schafran  659:     $r->print(Apache::loncommon::start_page('Other'));
1.126     droeschl  660:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Register Clicker'));
1.105     www       661:     my $user       = $env{'user.name'};
                    662:     my $domain     = $env{'user.domain'};
                    663:     my %userenv = &Apache::lonnet::get
                    664:         ('environment',['clickers']);
                    665:     my $clickers=$userenv{'clickers'};
                    666:     $clickers=~s/\,/\n/gs;
                    667:     my $text=&mt('Enter response device ("clicker") numbers');
1.151     bisitz    668:     my $change=&mt('Save');
1.114     bisitz    669:     my $helplink=&Apache::loncommon::help_open_topic('Clicker_Registration',&mt('Locating your clicker ID'));
1.105     www       670:     $r->print(<<ENDSCREEN);
                    671: <form name="prefs" action="/adm/preferences" method="post">
                    672: <input type="hidden" name="action" value="verify_and_change_clicker" />
1.151     bisitz    673: <label>$helplink<br /><br />$text<br />
1.108     www       674: <textarea name="clickers" rows="5" cols="20">$clickers</textarea>
1.105     www       675: </label>
1.151     bisitz    676: <br />
1.105     www       677: <input type="submit" value="$change" />
                    678: </form>
                    679: ENDSCREEN
                    680: }
                    681: 
                    682: sub verify_and_change_clicker {
                    683:     my $r = shift;
                    684:     my $user       = $env{'user.name'};
                    685:     my $domain     = $env{'user.domain'};
1.218     raeburn   686:     my $uhome      = $env{'user.home'};
1.105     www       687:     my $newclickers  = $env{'form.clickers'};
1.218     raeburn   688:     my $message;
1.108     www       689:     $newclickers=~s/[^\w\:\-]+/\,/gs;
1.105     www       690:     $newclickers=~tr/a-z/A-Z/;
1.108     www       691:     $newclickers=~s/[\:\-]+/\-/g;
                    692:     $newclickers=~s/\,+/\,/g;
1.105     www       693:     $newclickers=~s/^\,//;
                    694:     $newclickers=~s/\,$//;
1.218     raeburn   695:     my @oldclickers = split(/,/,$env{'environment.clickers'});
                    696:     my @newclickers = split(/,/,$newclickers);
                    697:     my %newuniq;
                    698:     map { $newuniq{$_} = 1; }  @newclickers;
                    699:     @newclickers = sort(keys(%newuniq));
                    700:     my @differences = &Apache::loncommon::compare_arrays(\@oldclickers,\@newclickers);
                    701:     if (@differences) {
                    702:         my $putres = &Apache::lonnet::put('environment',{'clickers' => $newclickers});
                    703:         if ($putres eq 'ok') {
                    704:             my @adds = ();
                    705:             my @dels = ();
                    706:             foreach my $item (@differences) {
                    707:                 if (grep(/^\Q$item\E$/,@newclickers)) {
                    708:                     push(@adds,$item);
                    709:                 } else {
                    710:                     push(@dels,$item);
                    711:                 }
                    712:             }
                    713:             if (@dels) {
                    714:                  my %delclicker;
                    715:                  map { $delclicker{$_} = $user; } @dels;
                    716:                  my $putresult = &Apache::lonnet::iddel($domain,\%delclicker,$uhome,'clickers');
                    717:             }
                    718:             if (@adds) {
                    719:                  my %addclicker;
                    720:                  map { $addclicker{$_} = $user; } @adds;
                    721:                  my $putresult = &Apache::lonnet::updateclickers($domain,'add',\%addclicker,$uhome,1);
                    722:             }
                    723:             &Apache::lonnet::appenv({'environment.clickers' => $newclickers});
                    724:             $message=&Apache::lonhtmlcommon::confirm_success(&mt('Registering clickers: [_1]',$newclickers));
                    725:         } else {
                    726:             $message=&Apache::lonhtmlcommon::confirm_success(&mt('Error saving clicker ID').1);
                    727:         }
                    728:     } else {
                    729:         $message='<span class="LC_info">'.&mt('Clicker information unchanged').'</span>';
                    730:     }
1.158     bisitz    731:     $message=&Apache::loncommon::confirmwrapper($message);
                    732:     &print_main_menu($r, $message);
1.105     www       733: }
                    734: 
1.119     www       735: ################################################################
                    736: #               Domcoord Access Subroutines                    #
                    737: ################################################################
                    738: 
                    739: sub domcoordchanger {
                    740:     my $r = shift;
1.154     www       741:     &Apache::lonhtmlcommon::add_breadcrumb(
1.126     droeschl  742: 	    {	href => '/adm/preferences?action=changedomcoord',
                    743:                 text => 'Restrict Domain Coordinator Access'});
                    744:     $r->print(Apache::loncommon::start_page('Restrict Domain Coordinator Access'));
                    745:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Restrict Domain Coordinator Access'));
1.119     www       746:     my $user       = $env{'user.name'};
                    747:     my $domain     = $env{'user.domain'};
                    748:     my %userenv = &Apache::lonnet::get
1.120     www       749:         ('environment',['domcoord.author']);
1.119     www       750:     my $constchecked='';
                    751:     if ($userenv{'domcoord.author'} eq 'blocked') {
1.159     bisitz    752:        $constchecked=' checked="checked"';
1.119     www       753:     }
1.205     bisitz    754:     my $text=&mt('By default, the Domain Coordinator can enter your Authoring Space.');
                    755:     my $construction=&mt('Block access to Authoring Space');
1.136     schafran  756:     my $change=&mt('Save');
1.225     raeburn   757:     my $returnurl = &HTML::Entities::encode($env{'form.returnurl'},'"<>&\'');
1.119     www       758:     $r->print(<<ENDSCREEN);
                    759: <form name="prefs" action="/adm/preferences" method="post">
1.225     raeburn   760: <input type="hidden" name="returnurl" value="$returnurl" />
1.119     www       761: <input type="hidden" name="action" value="verify_and_change_domcoord" />
                    762: $text<br />
1.159     bisitz    763: <label><input type="checkbox" name="construction"$constchecked />$construction</label><br />
1.119     www       764: <input type="submit" value="$change" />
                    765: </form>
                    766: ENDSCREEN
                    767: }
                    768: 
                    769: sub verify_and_change_domcoord {
                    770:     my $r = shift;
                    771:     my $user       = $env{'user.name'};
                    772:     my $domain     = $env{'user.domain'};
1.120     www       773:     my %domcoord=('domcoord.author' => '');
1.119     www       774:     if ($env{'form.construction'}) { $domcoord{'domcoord.author'}='blocked'; }
                    775:     &Apache::lonnet::put('environment',\%domcoord);
1.120     www       776:     &Apache::lonnet::appenv({'environment.domcoord.author' => $domcoord{'domcoord.author'}});
1.158     bisitz    777:     my $status='';
                    778:     if ($domcoord{'domcoord.author'} eq 'blocked') {
                    779:         $status=&mt('on');
                    780:     } else {
                    781:         $status=&mt('off');
                    782:     }
1.205     bisitz    783:     my $message=&Apache::lonhtmlcommon::confirm_success(&mt('Set [_1] to [_2]','<i>'.&mt('Block access to Authoring Space').'</i>','<tt>'.$status.'</tt>'));
1.158     bisitz    784:     $message=&Apache::loncommon::confirmwrapper($message);
1.225     raeburn   785:     if ($env{'form.returnurl'}) {
                    786:         &do_redirect($r,$env{'form.returnurl'},$message);
                    787:     } else {
                    788:         &print_main_menu($r,$message);
                    789:     }
1.119     www       790: }
                    791: 
1.118     www       792: #################################################################
                    793: ##                      Lock Subroutines                        #
                    794: #################################################################
                    795: 
                    796: sub lockwarning {
                    797:     my $r = shift;
                    798:     my $title=&mt('Action locked');
                    799:     my $texttop=&mt('LON-CAPA is currently performing the following actions:');
                    800:     my $textbottom=&mt('Changing roles or logging out may result in data corruption.');
                    801:     my ($num,%which)=&Apache::lonnet::get_locks();
                    802:     my $which='';
1.214     raeburn   803:     foreach my $id (keys(%which)) {
1.118     www       804:        $which.='<li>'.$which{$id}.'</li>';
                    805:     }
                    806:     my $change=&mt('Override');
                    807:     $r->print(<<ENDSCREEN);
                    808: <form name="prefs" action="/adm/preferences" method="post">
                    809: <input type="hidden" name="action" value="verify_and_change_locks" />
                    810: <h1>$title</h1>
                    811: $texttop
                    812: <ul>
                    813: $which
                    814: </ul>
                    815: $textbottom
                    816: <input type="submit" value="$change" />
                    817: </form>
                    818: ENDSCREEN
                    819: }
                    820: 
                    821: sub verify_and_change_lockwarning {
                    822:     my $r = shift;
                    823:     &Apache::lonnet::remove_all_locks();
                    824:     $r->print(&mt('Cleared locks.'));
                    825: }
                    826: 
                    827: 
1.105     www       828: ################################################################
1.20      www       829: #         Message Forward                                      #
                    830: ################################################################
                    831: 
                    832: sub msgforwardchanger {
1.102     raeburn   833:     my ($r,$message) = @_;
1.59      albertel  834:     my $user       = $env{'user.name'};
                    835:     my $domain     = $env{'user.domain'};
1.102     raeburn   836:     my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification','notifywithhtml']);
1.20      www       837:     my $msgforward=$userenv{'msgforward'};
1.102     raeburn   838:     my %lt = &Apache::lonlocal::texthash(
                    839:                                           all   => 'All',
                    840:                                           crit  => 'Critical only',
                    841:                                           reg   => 'Non-critical only',
1.175     raeburn   842:                                           foad  => 'Forward to account(s)',
                    843:                                           fwdm  => 'Forward messages to other account(s) in LON-CAPA',
                    844:                                           noti  => 'E-mail notification of LON-CAPA messages',
                    845:                                           mnot  => 'E-mail address(es) which should be notified about new LON-CAPA messages',
1.136     schafran  846:                                           chg   => 'Save',
1.104     raeburn   847:                                           email => 'The e-mail address entered in row ',
1.102     raeburn   848:                                           notv => 'is not a valid e-mail address',
1.103     raeburn   849:                                           toen => "To enter multiple addresses, enter one address at a time, click 'Change' and then add the next one", 
1.136     schafran  850:                                           prme => 'Back',
1.102     raeburn   851:                                         );
1.208     bisitz    852:     $lt{'foad_exmpl'} = &mt('e.g. [_1]userA:domain1,userB:domain2,...[_2]','<tt>','</tt>');
                    853:     $lt{'mnot_exmpl'} = &mt('e.g. [_1]joe@doe.com[_2]','<tt>','</tt>');
1.126     droeschl  854:     Apache::lonhtmlcommon::add_breadcrumb(
                    855: 	    {	href => '/adm/preferences?action=changemsgforward',
1.176     raeburn   856: 		text => 'Messages & Notifications'});
1.178     bisitz    857:     $r->print(Apache::loncommon::start_page('Messages &amp; Notifications'));
                    858:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Messages &amp; Notifications'));
1.113     raeburn   859:     my $forwardingHelp = &Apache::loncommon::help_open_topic("Prefs_Forwarding");
                    860:     my $notificationHelp = &Apache::loncommon::help_open_topic("Prefs_Notification");
                    861:     my $criticalMessageHelp = &Apache::loncommon::help_open_topic("Course_Critical_Message");
1.102     raeburn   862:     my @allow_html = split(/,/,$userenv{'notifywithhtml'});
                    863:     my %allnot = &get_notifications(\%userenv);
                    864:     my $validatescript = &Apache::lonhtmlcommon::javascript_valid_email();
                    865:     my $jscript = qq|
1.148     bisitz    866: <script type="text/javascript" language="JavaScript">
1.102     raeburn   867: function validate() {
                    868:     for (var i=0; i<document.prefs.numnotify.value; i++) {
1.104     raeburn   869:         var checkaddress = 0;
1.102     raeburn   870:         var addr = document.prefs.elements['address_'+i].value;
1.104     raeburn   871:         var rownum = i+1;
1.102     raeburn   872:         if (i < document.prefs.numnotify.value-1) {
1.104     raeburn   873:             if (document.prefs.elements['modify_notify_'+i].checked) {
1.102     raeburn   874:                 checkaddress = 1;
1.104     raeburn   875:             }
1.102     raeburn   876:         } else {
                    877:             if (document.prefs.elements['add_notify_'+i].checked == true) { 
                    878:                 checkaddress = 1;
                    879:             }
                    880:         }
1.104     raeburn   881:         if (checkaddress == 1)  {
1.102     raeburn   882:             var addr = document.prefs.elements['address_'+i].value;
                    883:             if (validmail(document.prefs.elements['address_'+i]) == false) {
1.104     raeburn   884:                 var multimsg = '';
                    885:                 if (addr.indexOf(",") >= 0) {
                    886:                     multimsg = "\\n($lt{'toen'}).";
                    887:                 }
1.110     bisitz    888:                 alert("$lt{'email'} "+rownum+" ('"+addr+"') $lt{'notv'}."+multimsg);
1.102     raeburn   889:                 return;
                    890:             }
                    891:         }
                    892:     }
                    893:     document.prefs.submit();
                    894: }
1.104     raeburn   895: 
                    896: function address_changes (adnum) {
                    897:      if (!document.prefs.elements['del_notify_'+adnum].checked) { 
                    898:          document.prefs.elements['modify_notify_'+adnum].checked = true;
                    899:      }   
                    900: }
                    901: 
                    902: function new_address(adnum) {
                    903:      document.prefs.elements['add_notify_'+adnum].checked = true;
                    904: }
                    905: 
                    906: function delete_address(adnum) {
                    907:      if (document.prefs.elements['del_notify_'+adnum].checked) {
                    908:           document.prefs.elements['modify_notify_'+adnum].checked = false;
                    909:      }
                    910: }
                    911: 
                    912: function modify_address(adnum) {
                    913:     if (document.prefs.elements['modify_notify_'+adnum].checked) {
                    914:         document.prefs.elements['del_notify_'+adnum].checked = false;
                    915:     }
                    916: } 
                    917: 
1.102     raeburn   918: $validatescript
                    919: </script>
                    920: |;
1.20      www       921:     $r->print(<<ENDMSG);
1.102     raeburn   922: $jscript
                    923: $message
1.175     raeburn   924: <h3>$lt{'fwdm'} $forwardingHelp</h3>
1.88      albertel  925: <form name="prefs" action="/adm/preferences" method="post">
1.20      www       926: <input type="hidden" name="action" value="verify_and_change_msgforward" />
1.110     bisitz    927: $lt{'foad'} ($lt{'foad_exmpl'}):
1.175     raeburn   928: <input type="text" size="40" value="$msgforward" name="msgforward" />
                    929: <br /><br />
1.113     raeburn   930: <h3>$lt{'noti'} $notificationHelp</h3>
1.110     bisitz    931: $lt{'mnot'} ($lt{'mnot_exmpl'}):<br />
1.102     raeburn   932: ENDMSG
                    933:     my @sortforwards = sort (keys(%allnot));
                    934:     my $output = &Apache::loncommon::start_data_table().
                    935:                  &Apache::loncommon::start_data_table_header_row().
1.104     raeburn   936:                  '<th>&nbsp;</th>'.
1.102     raeburn   937:                  '<th>'.&mt('Action').'</th>'.
                    938:                  '<th>'.&mt('Notification address').'</th><th>'.
1.113     raeburn   939:                  &mt('Types of message for which notification is sent').
                    940:                  $criticalMessageHelp.'</th><th>'.
1.104     raeburn   941:                  &mt('Excerpt retains HTML tags in message').'</th>'.
1.102     raeburn   942:                  &Apache::loncommon::end_data_table_header_row();
                    943:     my $num = 0;
1.104     raeburn   944:     my $counter = 1;
1.102     raeburn   945:     foreach my $item (@sortforwards) {
                    946:         $output .= &Apache::loncommon::start_data_table_row().
1.104     raeburn   947:                    '<td><b>'.$counter.'</b></td>'.
                    948:                    '<td><span class="LC_nobreak"><label>'.
                    949:                    '<input type="checkbox" name="modify_notify_'.
                    950:                    $num.'" onclick="javscript:modify_address('."'$num'".')" />'.
                    951:                    &mt('Modify').'</label></span>&nbsp;&nbsp; '.
                    952:                    '<span class="LC_nobreak"><label>'.
                    953:                    '<input type="checkbox" name="del_notify_'.$num.
                    954:                    '" onclick="javscript:delete_address('."'$num'".')" />'.
                    955:                    &mt('Delete').'</label></span></td>'.
1.102     raeburn   956:                    '<td><input type="text" value="'.$item.'" name="address_'.
1.206     bisitz    957:                    $num.'" onfocus="javascript:address_changes('."'$num'".
1.104     raeburn   958:                    ')" /></td><td>';
1.102     raeburn   959:         my %chk;
                    960:         if (defined($allnot{$item}{'crit'})) {
                    961:             if (defined($allnot{$item}{'reg'})) {
                    962:                 $chk{'all'} = 'checked="checked" ';
                    963:             } else {
                    964:                 $chk{'crit'} = 'checked="checked" ';
                    965:             }
                    966:         } else {
                    967:             $chk{'reg'} = 'checked="checked" ';
                    968:         }
                    969:         foreach my $type ('all','crit','reg') {
                    970:             $output .= '<span class="LC_nobreak"><label>'.
                    971:                        '<input type="radio" name="notify_type_'.$num. 
1.104     raeburn   972:                        '" value="'.$type.'" '.$chk{$type}.
                    973:                        ' onchange="javascript:address_changes('."'$num'".')" />'.
1.175     raeburn   974:                        $lt{$type}.'</label></span>'.('&nbsp;' x4);
1.102     raeburn   975:         }
                    976:         my $htmlon = '';
                    977:         my $htmloff = '';
                    978:         if (grep/^\Q$item\E/,@allow_html) {
                    979:             $htmlon = 'checked="checked" '; 
                    980:         } else {
                    981:             $htmloff = 'checked="checked" ';
                    982:         }
                    983:         $output .= '</td><td><label><input type="radio" name="html_'.$num.
1.104     raeburn   984:                    '" value="1" '.$htmlon.
                    985:                    ' onchange="javascript:address_changes('."'$num'".')" />'.
1.175     raeburn   986:                    &mt('Yes').'</label>'.('&nbsp;' x3).
1.102     raeburn   987:                    '<label><input type="radio" name="html_'.$num.'" value="0" '.
1.104     raeburn   988:                    $htmloff. ' onchange="javascript:address_changes('."'$num'".
                    989: ')" />'.
                    990:                    &mt('No').'</label></td>'.
1.102     raeburn   991:                    &Apache::loncommon::end_data_table_row();
                    992:         $num ++;
1.104     raeburn   993:         $counter ++;
1.102     raeburn   994:     }
                    995:     my %defchk = (
                    996:                    all => 'checked="checked" ',
                    997:                    crit => '',
                    998:                    reg => '',
                    999:                  );
                   1000:     $output .= &Apache::loncommon::start_data_table_row().
1.104     raeburn  1001:                '<td><b>'.$counter.'</b></td>'.
                   1002:                '<td><span class="LC_nobreak"><label>'.
                   1003:                '<input type="checkbox" name="add_notify_'.$num.
                   1004:                '" value="1" />'.&mt('Add new address').'</label></span></td>'.
1.102     raeburn  1005:                '<td><input type="text" value="" name="address_'.$num.
1.206     bisitz   1006:                '" onfocus="javascript:new_address('."'$num'".')" /></td><td>';
1.102     raeburn  1007:     foreach my $type ('all','crit','reg') {
                   1008:         $output .= '<span class="LC_nobreak"><label>'.
                   1009:                    '<input type="radio" name="notify_type_'.$num.
                   1010:                    '" value="'.$type.'" '.$defchk{$type}.'/>'.
1.175     raeburn  1011:                    $lt{$type}.'</label></span>'.('&nbsp;' x4);
1.102     raeburn  1012:     }
                   1013:     $output .= '</td><td><label><input type="radio" name="html_'.$num.
1.175     raeburn  1014:                '" value="1" />'.&mt('Yes').'</label>'.('&nbsp;' x3).
1.102     raeburn  1015:                '<label><input type="radio" name="html_'.$num.'" value="0" '.
                   1016:                ' checked="checked" />'.
                   1017:                &mt('No').'</label></td>'.
                   1018:                &Apache::loncommon::end_data_table_row().
                   1019:                &Apache::loncommon::end_data_table();
                   1020:     $num ++;
                   1021:     $r->print($output);
                   1022:     $r->print(qq|
1.113     raeburn  1023: <br /><hr />
1.102     raeburn  1024: <input type="hidden" name="numnotify" value="$num" />
1.136     schafran 1025: <input type="button" value="$lt{'prme'}" onclick="location.href='/adm/preferences'" />
1.102     raeburn  1026: <input type="button" value="$lt{'chg'}" onclick="javascript:validate()" />
1.20      www      1027: </form>
1.102     raeburn  1028: |);
                   1029: 
                   1030: }
                   1031: 
                   1032: sub get_notifications {
                   1033:     my ($userenv) = @_;
                   1034:     my %allnot;
                   1035:     my @critnot = split(/,/,$userenv->{'critnotification'});
                   1036:     my @regnot = split(/,/,$userenv->{'notification'});
                   1037:     foreach my $item (@critnot) {
                   1038:         $allnot{$item}{crit} = 1;
                   1039:     }
                   1040:     foreach my $item (@regnot) {
                   1041:         $allnot{$item}{reg} = 1;
                   1042:     }
                   1043:     return %allnot;
1.20      www      1044: }
                   1045: 
                   1046: sub verify_and_change_msgforward {
                   1047:     my $r = shift;
1.59      albertel 1048:     my $user       = $env{'user.name'};
                   1049:     my $domain     = $env{'user.domain'};
1.20      www      1050:     my $newscreen  = '';
                   1051:     my $message='';
1.182     raeburn  1052:     foreach my $recip (split(/\,/,$env{'form.msgforward'})) {
                   1053:         my ($msuser,$msdomain);
                   1054:         if ($recip =~ /:/) {
                   1055:             ($msuser,$msdomain)=split(':',$recip);
                   1056:         } else {
                   1057:             ($msuser,$msdomain)=split(/\@/,$recip);
                   1058:         }
1.95      albertel 1059:         $msuser = &LONCAPA::clean_username($msuser);
                   1060:         $msdomain = &LONCAPA::clean_domain($msdomain);
1.20      www      1061:         if (($msuser) && ($msdomain)) {
                   1062: 	    if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
1.182     raeburn  1063:                 $newscreen.=$msuser.':'.$msdomain.',';
                   1064: 	    } else {
                   1065:                 $message.= &mt('No such user: ').'<tt>'.$msuser.':'.$msdomain.'</tt><br />';
                   1066:             }
1.20      www      1067:         }
                   1068:     }
                   1069:     $newscreen=~s/\,$//;
                   1070:     if ($newscreen) {
                   1071:         &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
1.116     raeburn  1072:         &Apache::lonnet::appenv({'environment.msgforward' => $newscreen});
1.180     wenzelju 1073:         $message .= &Apache::lonhtmlcommon::confirm_success(&mt('Set message forwarding to ').'<tt>"'.$newscreen.'"</tt>.<br />');
1.20      www      1074:     } else {
                   1075:         &Apache::lonnet::del('environment',['msgforward']);
1.139     raeburn  1076:         &Apache::lonnet::delenv('environment.msgforward');
1.180     wenzelju 1077:         $message.= &Apache::lonhtmlcommon::confirm_success(&mt("Set message forwarding to 'off'.").'<br />');
1.20      www      1078:     }
1.102     raeburn  1079:     my $critnotification;
                   1080:     my $notification;
                   1081:     my $notify_with_html;
                   1082:     my $lastnotify = $env{'form.numnotify'}-1;
1.104     raeburn  1083:     my $totaladdresses = 0;
1.102     raeburn  1084:     for (my $i=0; $i<$env{'form.numnotify'}; $i++) {
                   1085:         if ((!defined($env{'form.del_notify_'.$i})) &&  
1.104     raeburn  1086:            ((($i==$lastnotify) && ($env{'form.add_notify_'.$lastnotify} == 1)) ||
1.102     raeburn  1087:             ($i<$lastnotify))) {
                   1088:             if (defined($env{'form.address_'.$i})) {
                   1089:                 if ($env{'form.notify_type_'.$i} eq 'all') {
                   1090:                     $critnotification .= $env{'form.address_'.$i}.',';
                   1091:                     $notification .= $env{'form.address_'.$i}.',';
                   1092:                 } elsif ($env{'form.notify_type_'.$i} eq 'crit') {
                   1093:                     $critnotification .= $env{'form.address_'.$i}.',';
                   1094:                 } elsif ($env{'form.notify_type_'.$i} eq 'reg') {
                   1095:                     $notification .= $env{'form.address_'.$i}.','; 
                   1096:                 }
                   1097:                 if ($env{'form.html_'.$i} eq '1') {
                   1098: 		    $notify_with_html .= $env{'form.address_'.$i}.',';       	
                   1099:                 }
1.104     raeburn  1100:                 $totaladdresses ++;
1.102     raeburn  1101:             }
                   1102:         }
                   1103:     }
                   1104:     $critnotification =~ s/,$//;
                   1105:     $critnotification=~s/\s//gs;
                   1106:     $notification =~ s/,$//;
1.20      www      1107:     $notification=~s/\s//gs;
1.102     raeburn  1108:     $notify_with_html =~ s/,$//;
                   1109:     $notify_with_html =~ s/\s//gs;
1.20      www      1110:     if ($notification) {
                   1111:         &Apache::lonnet::put('environment',{'notification' => $notification});
1.116     raeburn  1112:         &Apache::lonnet::appenv({'environment.notification' => $notification});
1.180     wenzelju 1113:         $message.=&Apache::lonhtmlcommon::confirm_success(&mt('Set non-critical message notification address(es) to ').'<tt>"'.$notification.'"</tt>.<br />');
1.20      www      1114:     } else {
                   1115:         &Apache::lonnet::del('environment',['notification']);
1.139     raeburn  1116:         &Apache::lonnet::delenv('environment.notification');
1.180     wenzelju 1117:         $message.=&Apache::lonhtmlcommon::confirm_success(&mt("Set non-critical message notification to 'off'.").'<br />');
1.20      www      1118:     }
                   1119:     if ($critnotification) {
                   1120:         &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
1.116     raeburn  1121:         &Apache::lonnet::appenv({'environment.critnotification' => $critnotification});
1.180     wenzelju 1122:         $message.=&Apache::lonhtmlcommon::confirm_success(&mt('Set critical message notification address(es) to ').'<tt>"'.$critnotification.'"</tt>.<br />');
1.20      www      1123:     } else {
                   1124:         &Apache::lonnet::del('environment',['critnotification']);
1.139     raeburn  1125:         &Apache::lonnet::delenv('environment.critnotification');
1.180     wenzelju 1126:         $message.=&Apache::lonhtmlcommon::confirm_success(&mt("Set critical message notification to 'off'.").'<br />');
1.102     raeburn  1127:     }
                   1128:     if ($critnotification || $notification) {
                   1129:         if ($notify_with_html) {
                   1130:             &Apache::lonnet::put('environment',{'notifywithhtml' => $notify_with_html});
1.116     raeburn  1131:             &Apache::lonnet::appenv({'environment.notifywithhtml' => $notify_with_html});
1.180     wenzelju 1132:             $message.=&Apache::lonhtmlcommon::confirm_success(&mt('Set address(es) to receive excerpts with html retained ').'<tt>"'.$notify_with_html.'"</tt>.');
1.102     raeburn  1133:         } else {
                   1134:             &Apache::lonnet::del('environment',['notifywithhtml']);
1.139     raeburn  1135:             &Apache::lonnet::delenv('environment.notifywithhtml');
1.104     raeburn  1136:             if ($totaladdresses == 1) {
1.180     wenzelju 1137:                 $message.=&Apache::lonhtmlcommon::confirm_success(&mt("Set notification address to receive excerpts with html stripped."));
1.104     raeburn  1138:             } else {
1.180     wenzelju 1139:                 $message.=&Apache::lonhtmlcommon::confirm_success(&mt("Set all notification addresses to receive excerpts with html stripped."));
1.104     raeburn  1140:             }
1.102     raeburn  1141:         }
                   1142:     } else {
                   1143:         &Apache::lonnet::del('environment',['notifywithhtml']);
1.139     raeburn  1144:         &Apache::lonnet::delenv('environment.notifywithhtml');
1.102     raeburn  1145:     }
1.109     albertel 1146:     &Apache::loncommon::flush_email_cache($user,$domain);
1.180     wenzelju 1147:     $message=&Apache::loncommon::confirmwrapper($message);
1.102     raeburn  1148:     &msgforwardchanger($r,$message);
1.6       www      1149: }
                   1150: 
1.12      www      1151: ################################################################
1.19      www      1152: #         Colors                                               #
1.12      www      1153: ################################################################
                   1154: 
1.19      www      1155: sub colorschanger {
1.12      www      1156:     my $r = shift;
1.126     droeschl 1157:     Apache::lonhtmlcommon::add_breadcrumb(
                   1158: 	    {	href => '/adm/preferences?action=changecolors',
                   1159:                 text => 'Change Colors'});
1.147     schafran 1160:     $r->print(Apache::loncommon::start_page('Page Display Settings'));
1.126     droeschl 1161:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Change Colors'));
1.19      www      1162: # figure out colors
1.80      albertel 1163:     my $function=&Apache::loncommon::get_users_function();
1.19      www      1164:     my $domain=&Apache::loncommon::determinedomain();
1.157     bisitz   1165:     my %colortypes=&Apache::lonlocal::texthash(
                   1166:         'pgbg'     => 'Page Background Color',
                   1167:         'tabbg'    => 'Header Background Color',
                   1168:         'sidebg'   => 'Header Border Color',
                   1169:         'font'     => 'Font Color',
                   1170:         'fontmenu' => 'Font Menu Color',
                   1171:         'link'     => 'Un-Visited Link Color',
                   1172:         'vlink'    => 'Visited Link Color',
                   1173:         'alink'    => 'Active Link Color',
                   1174:     );
1.82      albertel 1175:     my $start_data_table = &Apache::loncommon::start_data_table();
1.19      www      1176:     my $chtable='';
1.22      matthew  1177:     foreach my $item (sort(keys(%colortypes))) {
1.19      www      1178:        my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
1.82      albertel 1179:        $chtable.=&Apache::loncommon::start_data_table_row().
1.200     foxr     1180: 	   '<td>'.$colortypes{$item}.'<td><input name="'.$item.
                   1181:         '" class="colorchooser"  size="10" value="'.$curcol.
                   1182: '" /></td>'.
1.83      albertel 1183: 	    &Apache::loncommon::end_data_table_row()."\n";
1.19      www      1184:     }
1.82      albertel 1185:     my $end_data_table = &Apache::loncommon::end_data_table();
1.23      matthew  1186:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.157     bisitz   1187:     my $savebutton = &mt('Save');
                   1188:     my $resetbutton = &mt('Reset All');
                   1189:     my $resetbuttondesc = &mt('Reset All Colors to Default');
1.200     foxr     1190:     my $colorchooser=&Apache::lonhtmlcommon::color_picker();
1.202     raeburn  1191:     $r->print('<script type="text/javascript" language="JavaScript">
1.200     foxr     1192: ' . $colorchooser . '
                   1193: </script>
                   1194: ');
1.19      www      1195:     $r->print(<<ENDCOL);
                   1196: 
1.207     bisitz   1197: <form name="parmform" action="">
1.21      www      1198: <input type="hidden" name="pres_marker" />
                   1199: <input type="hidden" name="pres_type" />
                   1200: <input type="hidden" name="pres_value" />
                   1201: </form>
1.88      albertel 1202: <form name="prefs" action="/adm/preferences" method="post">
1.19      www      1203: <input type="hidden" name="action" value="verify_and_change_colors" />
1.82      albertel 1204: $start_data_table
1.19      www      1205: $chtable
1.82      albertel 1206: $end_data_table
1.19      www      1207: </table>
1.157     bisitz   1208: <p>
                   1209: <input type="submit" value="$savebutton" />
                   1210: <input type="submit" name="resetall" value="$resetbutton" title="$resetbuttondesc" />
                   1211: </p>
1.12      www      1212: </form>
1.19      www      1213: ENDCOL
1.12      www      1214: }
                   1215: 
1.19      www      1216: sub verify_and_change_colors {
1.12      www      1217:     my $r = shift;
1.19      www      1218: # figure out colors
1.80      albertel 1219:     my $function=&Apache::loncommon::get_users_function();
1.19      www      1220:     my $domain=&Apache::loncommon::determinedomain();
1.157     bisitz   1221:     my %colortypes=&Apache::lonlocal::texthash(
                   1222:         'pgbg'     => 'Page Background Color',
                   1223:         'tabbg'    => 'Header Background Color',
                   1224:         'sidebg'   => 'Header Border Color',
                   1225:         'font'     => 'Font Color',
                   1226: 	'fontmenu' => 'Font Menu Color',
                   1227:         'link'     => 'Un-Visited Link Color',
                   1228:         'vlink'    => 'Visited Link Color',
                   1229:         'alink'    => 'Active Link Color',
                   1230:     );
1.19      www      1231: 
1.12      www      1232:     my $message='';
1.214     raeburn  1233:     foreach my $item (keys(%colortypes)) {
1.59      albertel 1234:         my $color=$env{'form.'.$item};
1.200     foxr     1235: 	if (!($color =~ /^#/)) {
                   1236: 	    $color = '#' . $color;
                   1237: 	}
1.21      www      1238:         my $entry='color.'.$function.'.'.$item;
1.59      albertel 1239: 	if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$env{'form.resetall'})) {
1.21      www      1240: 	    &Apache::lonnet::put('environment',{$entry => $color});
1.116     raeburn  1241: 	    &Apache::lonnet::appenv({'environment.'.$entry => $color});
1.157     bisitz   1242:             $message.=&Apache::lonhtmlcommon::confirm_success(&mt('Set [_1] to [_2]','<i>'.$colortypes{$item}.'</i>','<tt>"'.$color.'"</tt>'))
                   1243:                     .'<br />';
1.21      www      1244: 	} else {
                   1245: 	    &Apache::lonnet::del('environment',[$entry]);
1.138     schafran 1246: 	    &Apache::lonnet::delenv('environment.'.$entry);
1.157     bisitz   1247:             $message.=&Apache::lonhtmlcommon::confirm_success(&mt('Reset [_1]','<i>'.$colortypes{$item}.'</i>'))
                   1248:                      .'<br />';
1.21      www      1249: 	}
                   1250:     }
1.158     bisitz   1251:     $message=&Apache::loncommon::confirmwrapper($message);
1.157     bisitz   1252: 
1.84      albertel 1253:     my $now = time;
                   1254:     &Apache::lonnet::put('environment',{'color.timestamp' => $now});
1.116     raeburn  1255:     &Apache::lonnet::appenv({'environment.color.timestamp' => $now});
1.84      albertel 1256: 
1.152     www      1257:     &print_main_menu($r, $message);
1.12      www      1258: }
                   1259: 
1.4       matthew  1260: ######################################################
                   1261: #            password handler subroutines            #
                   1262: ######################################################
1.3       matthew  1263: sub passwordchanger {
1.228     raeburn  1264:     my ($r,$errormessage,$caller,$mailtoken,$timelimit,$extrafields) = @_;
1.4       matthew  1265:     # This function is a bit of a mess....
1.3       matthew  1266:     # Passwords are encrypted using londes.js (DES encryption)
1.4       matthew  1267:     $errormessage = ($errormessage || '');
1.193     raeburn  1268:     my ($user,$domain,$currentpass);
1.152     www      1269:     &Apache::lonhtmlcommon::add_breadcrumb(
1.126     droeschl 1270: 		{ href => '/adm/preferences?action=changepass',
                   1271:                   text => 'Change Password'});
1.144     raeburn  1272:     unless ($caller eq 'reset_by_email') {
1.147     schafran 1273:         $r->print(Apache::loncommon::start_page('Personal Data'));
1.144     raeburn  1274:         $r->print(Apache::lonhtmlcommon::breadcrumbs('Change Password'));
                   1275:     }
1.217     raeburn  1276:     my ($blocked,$blocktext) =
                   1277:         &Apache::loncommon::blocking_status('passwd');
                   1278:     if ($blocked) {
                   1279:         $r->print('<p class="LC_warning">'.$blocktext.'</p>');
                   1280:         return;
                   1281:     }
1.94      raeburn  1282:     if ((!defined($caller)) || ($caller eq 'preferences')) {
                   1283:         $user = $env{'user.name'};
                   1284:         $domain = $env{'user.domain'};
                   1285:         if (!defined($caller)) {
                   1286:             $caller = 'preferences';
                   1287:         }
                   1288:     } elsif ($caller eq 'reset_by_email') {
1.229     raeburn  1289:         my %data = &Apache::lonnet::tmpget($mailtoken);
                   1290:         if (keys(%data) == 0) {
                   1291:             $r->print(
                   1292:                 '<p class="LC_warning">'
                   1293:                .&mt('Sorry, the URL you provided to complete the reset of your password was invalid. Either the token included in the URL has been deleted or the URL you provided was invalid. Please submit a [_1]new request[_2] for a password reset, and follow the link to the new URL included in the e-mail that will be sent to you, to allow you to enter a new password.'
                   1294:                    ,'<a href="/adm/resetpw">','</a>')
                   1295:                .'</p>'
                   1296:             );
                   1297:             return;
                   1298:         }
                   1299:         if (defined($data{time})) {
                   1300:             if (time - $data{'time'} < $timelimit) {
                   1301:                 $user = $data{'username'};
                   1302:                 $domain = $data{'domain'};
                   1303:                 $currentpass = $data{'temppasswd'};
1.94      raeburn  1304:             } else {
1.199     bisitz   1305:                 $r->print(
                   1306:                     '<p class="LC_warning">'
1.229     raeburn  1307:                    .&mt('Sorry, the token generated when you requested'
                   1308:                        .' a password reset has expired.')
1.199     bisitz   1309:                    .'</p>'
                   1310:                 );
1.94      raeburn  1311:                 return;
                   1312:             }
1.231     raeburn  1313:         } else {
1.229     raeburn  1314:             $r->print(
                   1315:                 '<p class="LC_warning">'
                   1316:                .&mt('Sorry, the URL generated when you requested reset of'
                   1317:                    .' your password contained incomplete information.')
                   1318:                .'</p>'
                   1319:             );
                   1320:             return;
                   1321:         }
                   1322:         if (&Apache::lonnet::domain($domain) eq '') {
                   1323:             $domain = $r->dir_config('lonDefDomain');
                   1324:         }
1.193     raeburn  1325:     } else {
1.199     bisitz   1326:         $r->print(
                   1327:             '<p class="LC_error">'
                   1328:            .&mt('Page requested in unexpected context')
                   1329:            .'</p>'
                   1330:         );
1.94      raeburn  1331:         return;
                   1332:     }
1.3       matthew  1333:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                   1334:     # Check for authentication types that allow changing of the password.
                   1335:     return if ($currentauth !~ /^(unix|internal):/);
                   1336:     #
                   1337:     # Generate keys
1.212     raeburn  1338:     my ($lkey_cpass ,$ukey_cpass ) = &Apache::loncommon::des_keys();
                   1339:     my ($lkey_npass1,$ukey_npass1) = &Apache::loncommon::des_keys();
                   1340:     my ($lkey_npass2,$ukey_npass2) = &Apache::loncommon::des_keys();
1.4       matthew  1341:     # Store the keys in the log files
1.3       matthew  1342:     my $lonhost = $r->dir_config('lonHostID');
                   1343:     my $logtoken=Apache::lonnet::reply('tmpput:'
                   1344: 				       .$ukey_cpass  . $lkey_cpass .'&'
                   1345: 				       .$ukey_npass1 . $lkey_npass1.'&'
                   1346: 				       .$ukey_npass2 . $lkey_npass2,
                   1347: 				       $lonhost);
1.4       matthew  1348:     # Hexify the keys for output as javascript variables
1.94      raeburn  1349:     my %hexkey;
                   1350:     $hexkey{'ukey_cpass'}  = hex($ukey_cpass);
                   1351:     $hexkey{'lkey_cpass'}  = hex($lkey_cpass);
                   1352:     $hexkey{'ukey_npass1'} = hex($ukey_npass1);
                   1353:     $hexkey{'lkey_npass1'} = hex($lkey_npass1);
                   1354:     $hexkey{'ukey_npass2'} = hex($ukey_npass2);
                   1355:     $hexkey{'lkey_npass2'} = hex($lkey_npass2);
1.3       matthew  1356:     # Output javascript to deal with passwords
1.4       matthew  1357:     # Output DES javascript
1.3       matthew  1358:     {
                   1359: 	my $include = $r->dir_config('lonIncludes');
                   1360: 	my $jsh=Apache::File->new($include."/londes.js");
                   1361: 	$r->print(<$jsh>);
                   1362:     }
1.228     raeburn  1363:     $r->print(&jscript_send($caller,$extrafields));
1.3       matthew  1364:     $r->print(<<ENDFORM);
1.94      raeburn  1365: $errormessage
                   1366: 
                   1367: <p>
                   1368: <!-- We separate the forms into 'server' and 'client' in order to
                   1369:      ensure that unencrypted passwords will not be sent out by a
                   1370:      crappy browser -->
                   1371: ENDFORM
1.228     raeburn  1372:     $r->print(&server_form($logtoken,$caller,$mailtoken,$extrafields));
                   1373:     $r->print(&client_form($caller,\%hexkey,$currentpass,$domain,$extrafields));
1.94      raeburn  1374: 
                   1375:     #
                   1376:     return;
                   1377: }
                   1378: 
                   1379: sub jscript_send {
1.228     raeburn  1380:     my ($caller,$extrafields) = @_;
1.94      raeburn  1381:     my $output = qq|
1.148     bisitz   1382: <script type="text/javascript" language="JavaScript">
1.3       matthew  1383: 
                   1384:     function send() {
                   1385:         uextkey=this.document.client.elements.ukey_cpass.value;
                   1386:         lextkey=this.document.client.elements.lkey_cpass.value;
                   1387:         initkeys();
1.219     raeburn  1388:         this.document.pserver.elements.currentpass.value =
                   1389:             getCrypted(this.document.client.elements.currentpass.value);
1.3       matthew  1390:         uextkey=this.document.client.elements.ukey_npass1.value;
                   1391:         lextkey=this.document.client.elements.lkey_npass1.value;
                   1392:         initkeys();
1.52      raeburn  1393:         this.document.pserver.elements.newpass_1.value
1.219     raeburn  1394:             =getCrypted(this.document.client.elements.newpass_1.value);
1.3       matthew  1395:         uextkey=this.document.client.elements.ukey_npass2.value;
                   1396:         lextkey=this.document.client.elements.lkey_npass2.value;
                   1397:         initkeys();
1.52      raeburn  1398:         this.document.pserver.elements.newpass_2.value
1.219     raeburn  1399:             =getCrypted(this.document.client.elements.newpass_2.value);
1.94      raeburn  1400: |;
                   1401:     if ($caller eq 'reset_by_email') {
1.228     raeburn  1402:         if ((ref($extrafields) eq 'HASH') && ($extrafields->{'username'})) {
                   1403:             $output .= qq|
1.94      raeburn  1404:         this.document.pserver.elements.uname.value =
                   1405:                    this.document.client.elements.uname.value;
                   1406:         this.document.pserver.elements.udom.value =
                   1407:                    this.document.client.elements.udom.options[this.document.client.elements.udom.selectedIndex].value;
1.228     raeburn  1408: |;
                   1409:         }
                   1410:         if ((ref($extrafields) eq 'HASH') && ($extrafields->{'email'})) {
                   1411:             $output .= qq| 
1.173     raeburn  1412:         this.document.pserver.elements.email.value =
                   1413:                    this.document.client.elements.email.value;
1.94      raeburn  1414: |;
1.228     raeburn  1415:         }
1.94      raeburn  1416:     }
                   1417:     $ output .= qq|
1.52      raeburn  1418:         this.document.pserver.submit();
1.3       matthew  1419:     }
1.219     raeburn  1420: 
1.3       matthew  1421: </script>
1.94      raeburn  1422: |;
                   1423: }
1.3       matthew  1424: 
1.94      raeburn  1425: sub client_form {
1.228     raeburn  1426:     my ($caller,$hexkey,$currentpass,$defdom,$extrafields) = @_;
1.99      www      1427:     my %lt=&Apache::lonlocal::texthash(
1.115     raeburn  1428:                 'email' => 'E-mail Address',
1.99      www      1429:                 'username' => 'Username',
                   1430:                 'domain' => 'Domain',
                   1431:                 'currentpass' => 'Current Password',
                   1432:                 'newpass' => 'New Password',
                   1433:                 'confirmpass' => 'Confirm Password',
1.169     raeburn  1434:                 'changepass' => 'Save',
                   1435:     );
1.99      www      1436: 
1.207     bisitz   1437:     my $output = '<form name="client" action="">'
1.164     bisitz   1438:                 .&Apache::lonhtmlcommon::start_pick_box();
1.94      raeburn  1439:     if ($caller eq 'reset_by_email') {
1.228     raeburn  1440:         if ((ref($extrafields) eq 'HASH') && ($extrafields->{'email'})) {
                   1441:             $output .= &Apache::lonhtmlcommon::row_title(
                   1442:                        '<label for="email">'.$lt{'email'}.'</label>')
                   1443:                       .'<input type="text" name="email" size="30" autocapitalize="off" autocorrect="off" />'
                   1444:                       .&Apache::lonhtmlcommon::row_closure();
1.221     raeburn  1445:         }
1.228     raeburn  1446:         if ((ref($extrafields) eq 'HASH') && ($extrafields->{'username'})) {
                   1447:             $output .= &Apache::lonhtmlcommon::row_title(  
1.164     bisitz   1448:                        '<label for="uname">'.$lt{'username'}.'</label>')
1.228     raeburn  1449:                       .'<input type="text" name="uname" size="20" autocapitalize="off" autocorrect="off" />'
                   1450:                       .&Apache::lonhtmlcommon::row_closure()
                   1451:                       .&Apache::lonhtmlcommon::row_title(
1.164     bisitz   1452:                        '<label for="udom">'.$lt{'domain'}.'</label>')
1.228     raeburn  1453:                       .&Apache::loncommon::select_dom_form($defdom,'udom')
                   1454:                       .&Apache::lonhtmlcommon::row_closure();
                   1455:         }
1.94      raeburn  1456:     } else {
1.164     bisitz   1457:         $output .= &Apache::lonhtmlcommon::row_title(
                   1458:                        '<label for="currentpass">'.$lt{'currentpass'}.'</label>')
1.219     raeburn  1459:                   .'<input type="password" name="currentpass" size="20"/>'
1.164     bisitz   1460:                   .&Apache::lonhtmlcommon::row_closure();
                   1461:     }
                   1462:     $output .= &Apache::lonhtmlcommon::row_title(
                   1463:                    '<label for="newpass_1">'.$lt{'newpass'}.'</label>')
1.219     raeburn  1464:               .'<input type="password" name="newpass_1" size="20" />'
1.164     bisitz   1465:               .&Apache::lonhtmlcommon::row_closure()
                   1466:               .&Apache::lonhtmlcommon::row_title(
                   1467:                    '<label for="newpass_2">'.$lt{'confirmpass'}.'</label>')
1.219     raeburn  1468:               .'<input type="password" name="newpass_2" size="20" />'
1.164     bisitz   1469:               .&Apache::lonhtmlcommon::row_closure(1)
                   1470:               .&Apache::lonhtmlcommon::end_pick_box();
1.228     raeburn  1471:     if ($caller eq 'reset_by_email') {
                   1472:         $output .= '<input type="hidden" name="currentpass" value="'.$currentpass.'" />';
                   1473:     }
1.206     bisitz   1474:     $output .= '<p><input type="button" value="'.$lt{'changepass'}.'" onclick="send();" /></p>'
1.164     bisitz   1475:               .qq|
1.94      raeburn  1476: <input type="hidden" name="ukey_cpass"  value="$hexkey->{'ukey_cpass'}" />
                   1477: <input type="hidden" name="lkey_cpass"  value="$hexkey->{'lkey_cpass'}" />
                   1478: <input type="hidden" name="ukey_npass1" value="$hexkey->{'ukey_npass1'}" />
                   1479: <input type="hidden" name="lkey_npass1" value="$hexkey->{'lkey_npass1'}" />
                   1480: <input type="hidden" name="ukey_npass2" value="$hexkey->{'ukey_npass2'}" />
                   1481: <input type="hidden" name="lkey_npass2" value="$hexkey->{'lkey_npass2'}" />
1.3       matthew  1482: </form>
                   1483: </p>
1.164     bisitz   1484: |;
1.94      raeburn  1485:     return $output;
                   1486: }
                   1487: 
                   1488: sub server_form {
1.228     raeburn  1489:     my ($logtoken,$caller,$mailtoken,$extrafields) = @_;
1.94      raeburn  1490:     my $action = '/adm/preferences';
                   1491:     if ($caller eq 'reset_by_email') {
                   1492:         $action = '/adm/resetpw';
                   1493:     }
                   1494:     my $output = qq|
                   1495: <form name="pserver" action="$action" method="post">
                   1496: <input type="hidden" name="logtoken"    value="$logtoken" />
                   1497: <input type="hidden" name="currentpass" value="" />
                   1498: <input type="hidden" name="newpass_1"   value="" />
                   1499: <input type="hidden" name="newpass_2"   value="" />
1.228     raeburn  1500: |;
1.94      raeburn  1501:     if ($caller eq 'reset_by_email') {
                   1502:         $output .=  qq|
                   1503: <input type="hidden" name="token"   value="$mailtoken" />
1.228     raeburn  1504: |;
                   1505:        if ((ref($extrafields) eq 'HASH') && ($extrafields->{'username'})) {
                   1506:            $output .=  qq|
1.94      raeburn  1507: <input type="hidden" name="uname"   value="" />
                   1508: <input type="hidden" name="udom"   value="" />
1.228     raeburn  1509: |;
                   1510:        }
                   1511:        if ((ref($extrafields) eq 'HASH') && ($extrafields->{'email'})) {
                   1512:            $output .=  qq|
1.173     raeburn  1513: <input type="hidden" name="email"   value="" />
1.94      raeburn  1514: |;
1.228     raeburn  1515:        }
1.94      raeburn  1516:     }
                   1517:     $output .= qq|
                   1518: <input type="hidden" name="action" value="verify_and_change_pass" />
                   1519: </form>
                   1520: |;
                   1521:     return $output;
1.3       matthew  1522: }
                   1523: 
                   1524: sub verify_and_change_password {
1.226     raeburn  1525:     my ($r,$caller,$mailtoken,$ended) = @_;
1.94      raeburn  1526:     my ($user,$domain,$homeserver);
1.217     raeburn  1527:     my ($blocked,$blocktext) =
                   1528:         &Apache::loncommon::blocking_status('passwd');
                   1529:     if ($blocked) {
                   1530:         $r->print('<p class="LC_warning">'.$blocktext.'</p>');
                   1531:         return;
                   1532:     }
1.94      raeburn  1533:     if ($caller eq 'reset_by_email') {
                   1534:         $user       = $env{'form.uname'};
                   1535:         $domain     = $env{'form.udom'};
                   1536:         if ($user ne '' && $domain ne '') {
                   1537:             $homeserver = &Apache::lonnet::homeserver($user,$domain);
                   1538:             if ($homeserver eq 'no_host') {
1.99      www      1539:         &passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1540:                          &mt("Invalid username and/or domain")."</span>\n</p>",
1.94      raeburn  1541:                          $caller,$mailtoken);
                   1542:                 return 1;
                   1543:             }
                   1544:         } else {
1.99      www      1545:             &passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1546:                              &mt("Username and domain were blank")."</span>\n</p>",
1.94      raeburn  1547:                              $caller,$mailtoken);
                   1548:             return 1;
                   1549:         }
                   1550:     } else {
                   1551:         $user       = $env{'user.name'};
                   1552:         $domain     = $env{'user.domain'};
                   1553:         $homeserver = $env{'user.home'};
                   1554:     }
1.3       matthew  1555:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4       matthew  1556:     # Check for authentication types that allow changing of the password.
1.94      raeburn  1557:     if ($currentauth !~ /^(unix|internal):/) {
                   1558:         if ($caller eq 'reset_by_email') {
1.99      www      1559:             &passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1560:                              &mt("Authentication type for this user can not be changed by this mechanism").
                   1561:                              "</span>\n</p>",
1.94      raeburn  1562:                               $caller,$mailtoken);
                   1563:             return 1;
                   1564:         } else {
                   1565:             return;
                   1566:         }
                   1567:     }
1.3       matthew  1568:     #
1.59      albertel 1569:     my $currentpass = $env{'form.currentpass'}; 
                   1570:     my $newpass1    = $env{'form.newpass_1'}; 
                   1571:     my $newpass2    = $env{'form.newpass_2'};
                   1572:     my $logtoken    = $env{'form.logtoken'};
1.3       matthew  1573:     # Check for empty data 
1.4       matthew  1574:     unless (defined($currentpass) && 
                   1575: 	    defined($newpass1)    && 
                   1576: 	    defined($newpass2)    ){
1.99      www      1577: 	&passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1578: 			 &mt("One or more password fields were blank").
                   1579:                          "</span>\n</p>",$caller,$mailtoken);
1.3       matthew  1580: 	return;
                   1581:     }
1.16      albertel 1582:     # Get the keys
                   1583:     my $lonhost = $r->dir_config('lonHostID');
1.3       matthew  1584:     my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
                   1585:     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4       matthew  1586:         # I do not a have a better idea about how to handle this
1.94      raeburn  1587:         my $tryagain_text = &mt('Please log out and try again.');
                   1588:         if ($caller eq 'reset_by_email') {
                   1589:             $tryagain_text = &mt('Please try again later.');
                   1590:         }
1.101     albertel 1591:         my $unable=&mt("Unable to retrieve saved token for password decryption");
1.3       matthew  1592: 	$r->print(<<ENDERROR);
                   1593: <p>
1.99      www      1594: <span class="LC_error">$unable.  $tryagain_text</span>
1.3       matthew  1595: </p>
                   1596: ENDERROR
1.4       matthew  1597:         # Probably should log an error here
1.75      albertel 1598:         return 1;
1.3       matthew  1599:     }
                   1600:     my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.219     raeburn  1601:     #
1.211     raeburn  1602:     $currentpass = &Apache::loncommon::des_decrypt($ckey ,$currentpass);
                   1603:     $newpass1    = &Apache::loncommon::des_decrypt($n1key,$newpass1);
                   1604:     $newpass2    = &Apache::loncommon::des_decrypt($n2key,$newpass2);
1.94      raeburn  1605:     #
                   1606:     if ($caller eq 'reset_by_email') {
                   1607:         my %data = &Apache::lonnet::tmpget($mailtoken);
1.117     raeburn  1608:         if (keys(%data) == 0) {
                   1609:             &passwordchanger($r,
                   1610:                          '<span class="LC_error">'.
                   1611:                          &mt('Could not verify current authentication.').'  '.
                   1612:                          &mt('Please try again.').'</span>',$caller,$mailtoken);
                   1613:             return 1;
                   1614:         }
1.94      raeburn  1615:         if ($currentpass ne $data{'temppasswd'}) {
                   1616:             &passwordchanger($r,
1.99      www      1617:                          '<span class="LC_error">'.
1.110     bisitz   1618:                          &mt('Could not verify current authentication.').'  '.
                   1619:                          &mt('Please try again.').'</span>',$caller,$mailtoken);
1.94      raeburn  1620:             return 1;
                   1621:         }
1.231     raeburn  1622:     }
1.3       matthew  1623:     if ($newpass1 ne $newpass2) {
1.4       matthew  1624: 	&passwordchanger($r,
1.199     bisitz   1625: 			 '<span class="LC_warning">'.
1.110     bisitz   1626: 			 &mt('The new passwords you entered do not match.').'  '.
                   1627: 			 &mt('Please try again.').'</span>',$caller,$mailtoken);
1.75      albertel 1628: 	return 1;
1.4       matthew  1629:     }
1.231     raeburn  1630:     if ($currentauth eq 'unix:') {
                   1631:         if (length($newpass1) < 7) {
                   1632:             &passwordchanger($r,
                   1633:                              '<span class="LC_warning">'.
                   1634:                              &mt('Passwords must be a minimum of 7 characters long.').'  '.
                   1635:                              &mt('Please try again.').'</span>',$caller,$mailtoken);
                   1636:             return 1;
                   1637:         }
                   1638:     } else {
                   1639:         my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
                   1640:         my ($min,$max,@chars,@brokerule);
                   1641:         if (ref($passwdconf{'chars'}) eq 'ARRAY') {
                   1642:             if ($passwdconf{'min'} =~ /^\d+$/) {
                   1643:                 $min = $passwdconf{'min'};
                   1644:             }
                   1645:             if ($passwdconf{'max'} =~ /^\d+$/) {
                   1646:                 $max = $passwdconf{'max'};
                   1647:             }
                   1648:             @chars = @{$passwdconf{'chars'}};
                   1649:         } else {
                   1650:             $min = 7;
                   1651:         }
                   1652:         if (($min) && (length($newpass1) < $min)) {
                   1653:             push(@brokerule,'min');
                   1654:         }
                   1655:         if (($max) && (length($newpass1) > $max)) {
                   1656:             push(@brokerule,'max');
                   1657:         }
                   1658:         if (@chars) {
                   1659:             my %rules;
                   1660:             map { $rules{$_} = 1; } @chars;
                   1661:             if ($rules{'uc'}) {
                   1662:                 unless ($newpass1 =~ /[A-Z]/) {
                   1663:                     push(@brokerule,'uc');
                   1664:                 }
                   1665:             }
                   1666:             if ($rules{'lc'}) {
                   1667:                 unless ($newpass1 =~ /a-z/) {
                   1668:                     push(@brokerule,'lc');
                   1669:                 }
                   1670:             }
                   1671:             if ($rules{'num'}) {
                   1672:                 unless ($newpass1 =~ /\d/) {
                   1673:                     push(@brokerule,'num');
                   1674:                 }
                   1675:             }
                   1676:             if ($rules{'spec'}) {
                   1677:                 unless ($newpass1 =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
                   1678:                     push(@brokerule,'spec');
                   1679:                 }
                   1680:             }
                   1681:         }
                   1682:         if (@brokerule) {
                   1683:             my %rulenames = &Apache::lonlocal::texthash(
                   1684:                 uc   => 'At least one upper case letter',
                   1685:                 lc   => 'At least one lower case letter',
                   1686:                 num  => 'At least one number',
                   1687:                 spec => 'At least one non-alphanumeric',
                   1688:             );
                   1689:             $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
                   1690:             $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
                   1691:             $rulenames{'num'} .= ': 0123456789';
                   1692:             $rulenames{'spec'} .= ': !&quot;\#$%&amp;\'()*+,-./:;&lt;=&gt;?@[\]^_\`{|}~';
                   1693:             $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
                   1694:             $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
                   1695:             my $warning = &mt('Password did not satisfy the following:').'<ul>';
                   1696:             foreach my $rule ('min','max','uc','ls','num','spec') {
                   1697:                 if (grep(/^$rule$/,@brokerule)) {
                   1698:                     $warning .= '<li>'.$rulenames{$rule}.'</li>';
                   1699:                 }
                   1700:             }
                   1701:             $warning .= '</ul>';
                   1702:             &passwordchanger($r,'<span class="LC_warning">'.
                   1703:                             $warning.
                   1704:                             &mt('Please try again.').'</span>',
                   1705:                             $caller,$mailtoken);
                   1706:             return 1;
                   1707:         }
1.3       matthew  1708:     }
1.4       matthew  1709:     #
                   1710:     # Check for bad characters
                   1711:     my $badpassword = 0;
                   1712:     foreach (split(//,$newpass1)) {
                   1713: 	$badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
                   1714:     }
                   1715:     if ($badpassword) {
                   1716: 	# I can't figure out how to enter bad characters on my browser.
1.199     bisitz   1717: 	my $errormessage ='<span class="LC_warning">'.
1.110     bisitz   1718:            &mt('The password you entered contained illegal characters.').'<br />'.
1.99      www      1719:            &mt('Valid characters are').(<<"ENDERROR");
                   1720: : space and <br />
1.4       matthew  1721: <pre>
                   1722: !&quot;\#$%&amp;\'()*+,-./0123456789:;&lt;=&gt;?\@
                   1723: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
1.99      www      1724: </pre></span>
1.4       matthew  1725: ENDERROR
1.94      raeburn  1726:         &passwordchanger($r,$errormessage,$caller,$mailtoken);
                   1727:         return 1;
1.4       matthew  1728:     }
                   1729:     # 
                   1730:     # Change the password (finally)
                   1731:     my $result = &Apache::lonnet::changepass
1.94      raeburn  1732: 	($user,$domain,$currentpass,$newpass1,$homeserver,$caller);
1.4       matthew  1733:     # Inform the user the password has (not?) been changed
1.126     droeschl 1734:     my $message;
1.4       matthew  1735:     if ($result =~ /^ok$/) {
1.170     bisitz   1736:         $message = &Apache::lonhtmlcommon::confirm_success(&mt('The password for user [_1] was successfully changed.','<i>'.$user.'</i>'));
1.180     wenzelju 1737:         $message = &Apache::loncommon::confirmwrapper($message);
1.144     raeburn  1738:         if ($caller eq 'reset_by_email') {
                   1739:             $r->print($message.'<br />');
                   1740:         } else {
                   1741:             &print_main_menu($r, $message);
1.226     raeburn  1742:             if (ref($ended)) {
                   1743:                 $$ended = 1;
                   1744:             }
1.144     raeburn  1745:         }
1.4       matthew  1746:     } else {
                   1747: 	# error error: run in circles, scream and shout
1.173     raeburn  1748:         if ($caller eq 'reset_by_email') {
                   1749:             if (!$result) {
                   1750:                 return 1;
                   1751:             } else {
                   1752:                 return $result;
                   1753:             }
                   1754:         } else {
1.232   ! raeburn  1755:             my $feedback;
        !          1756:             if ($result eq 'prioruse') {
        !          1757:                 $feedback = &mt('Please enter a password that you have not used recently.');
        !          1758:             } else {
        !          1759:                 $feedback = &mt('Please make sure your old password was entered correctly.');
        !          1760:             }
1.173     raeburn  1761:             $message = &Apache::lonhtmlcommon::confirm_success(
1.232   ! raeburn  1762:                 &mt("The password for user [_1] was not changed.",'<i>'.$user.'</i>').' '.$feedback,1);
1.158     bisitz   1763:             $message=&Apache::loncommon::confirmwrapper($message);
1.144     raeburn  1764:             &print_main_menu($r, $message);
1.226     raeburn  1765:             if (ref($ended)) {
                   1766:                 $$ended = 1;
                   1767:             }
1.144     raeburn  1768:         }
1.4       matthew  1769:     }
                   1770:     return;
1.3       matthew  1771: }
                   1772: 
1.42      raeburn  1773: ################################################################
                   1774: #            discussion display subroutines 
                   1775: ################################################################
                   1776: sub discussionchanger {
                   1777:     my $r = shift;
1.126     droeschl 1778:     Apache::lonhtmlcommon::add_breadcrumb(
                   1779: 	    {	href => '/adm/preferences?action=changediscussions',
                   1780:                 text => 'Change Discussion Preferences'});
1.178     bisitz   1781:     $r->print(Apache::loncommon::start_page('Change Discussion Preferences'));
1.126     droeschl 1782:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Change Discussion Preferences'));
1.59      albertel 1783:     my $user       = $env{'user.name'};
                   1784:     my $domain     = $env{'user.domain'};
1.42      raeburn  1785:     my %userenv = &Apache::lonnet::get
1.43      raeburn  1786:         ('environment',['discdisplay','discmarkread']);
                   1787:     my $discdisp = 'allposts';
                   1788:     my $discmark = 'onmark';
                   1789: 
                   1790:     if (defined($userenv{'discdisplay'})) {
                   1791:         unless ($userenv{'discdisplay'} eq '') { 
                   1792:             $discdisp = $userenv{'discdisplay'};
                   1793:         }
                   1794:     }
                   1795:     if (defined($userenv{'discmarkread'})) {
1.171     raeburn  1796:         unless ($userenv{'discmarkread'} eq '') { 
1.43      raeburn  1797:             $discmark = $userenv{'discmarkread'};
                   1798:         }
                   1799:     }
                   1800: 
                   1801:     my $newdisp = 'unread';
                   1802:     my $newmark = 'ondisp';
                   1803: 
                   1804:     my $function = &Apache::loncommon::get_users_function();
                   1805:     my $color = &Apache::loncommon::designparm($function.'.tabbg',
1.59      albertel 1806:                                                     $env{'user.domain'});
1.43      raeburn  1807:     my %lt = &Apache::lonlocal::texthash(
                   1808:         'pref' => 'Display Preference',
                   1809:         'curr' => 'Current setting ',
                   1810:         'actn' => 'Action',
1.135     schafran 1811:         'sdpf' => 'Set display preferences for discussion posts for both discussion boards and individual resources in all your courses.',
1.43      raeburn  1812:         'prca' => 'Preferences can be set that determine',
1.135     schafran 1813:         'whpo' => 'Which posts are displayed when you display a discussion board or resource, and',
1.194     raeburn  1814:         'unwh' => 'Under what circumstances posts are identified as "NEW"',
1.43      raeburn  1815:         'allposts' => 'All posts',
                   1816:         'unread' => 'New posts only',
                   1817:         'ondisp' => 'Once displayed',
1.194     raeburn  1818:         'onmark' => 'Once marked not NEW',
1.43      raeburn  1819:         'disa' => 'Posts displayed?',
1.194     raeburn  1820:         'npmr' => 'New posts cease to be identified as "NEW"?',
1.43      raeburn  1821:         'thde'  => 'The preferences you set here can be overridden within each individual discussion.',
                   1822:         'chgt' => 'Change to '
                   1823:     );
                   1824:     my $dispchange = $lt{'unread'};
                   1825:     my $markchange = $lt{'ondisp'};
                   1826:     my $currdisp = $lt{'allposts'};
                   1827:     my $currmark = $lt{'onmark'};
                   1828: 
                   1829:     if ($discdisp eq 'unread') {
                   1830:         $dispchange = $lt{'allposts'};
                   1831:         $currdisp = $lt{'unread'};
                   1832:         $newdisp = 'allposts';
                   1833:     }
                   1834: 
                   1835:     if ($discmark eq 'ondisp') {
                   1836:         $markchange = $lt{'onmark'};
                   1837:         $currmark = $lt{'ondisp'};
                   1838:         $newmark = 'onmark';
1.42      raeburn  1839:     }
1.171     raeburn  1840: 
1.43      raeburn  1841:     $r->print(<<"END");
1.88      albertel 1842: <form name="prefs" action="/adm/preferences" method="post">
1.42      raeburn  1843: <input type="hidden" name="action" value="verify_and_change_discussion" />
                   1844: <br />
1.87      albertel 1845: $lt{'sdpf'}<br /> $lt{'prca'}  <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol> 
1.82      albertel 1846: END
1.158     bisitz   1847: 
                   1848:     $r->print('<p class="LC_info">'.$lt{'thde'}.'</p>');
                   1849: 
1.82      albertel 1850:     $r->print(&Apache::loncommon::start_data_table());
                   1851:     $r->print(<<"END");
                   1852:        <tr>
                   1853:         <th>$lt{'pref'}</th>
                   1854:         <th>$lt{'curr'}</th>
                   1855:         <th>$lt{'actn'}?</th>
1.43      raeburn  1856:        </tr>
1.82      albertel 1857: END
                   1858:     $r->print(&Apache::loncommon::start_data_table_row());
                   1859:     $r->print(<<"END");
1.43      raeburn  1860:        <td>$lt{'disa'}</td>
                   1861:        <td>$lt{$discdisp}</td>
1.82      albertel 1862:        <td><label><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" />&nbsp;$lt{'chgt'} "$dispchange"</label></td>
                   1863: END
                   1864:     $r->print(&Apache::loncommon::end_data_table_row().
                   1865: 	      &Apache::loncommon::start_data_table_row());
                   1866:     $r->print(<<"END");
1.43      raeburn  1867:        <td>$lt{'npmr'}</td>
                   1868:        <td>$lt{$discmark}</td>
1.82      albertel 1869:        <td><label><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" />&nbsp;$lt{'chgt'} "$markchange"</label></td>
1.43      raeburn  1870:       </tr>
1.82      albertel 1871: END
                   1872:     $r->print(&Apache::loncommon::end_data_table_row().
                   1873: 	      &Apache::loncommon::end_data_table());
1.142     zhu      1874: 
1.158     bisitz   1875:     $r->print('<br />'
                   1876:              .'<input type="submit" name="sub" value="'.&mt('Save').'" />'
                   1877:              .'</form>'
                   1878:     );
1.42      raeburn  1879: }
                   1880:                                                                                                                 
                   1881: sub verify_and_change_discussion {
                   1882:     my $r = shift;
1.59      albertel 1883:     my $user     = $env{'user.name'};
                   1884:     my $domain   = $env{'user.domain'};
1.42      raeburn  1885:     my $message='';
1.59      albertel 1886:     if (defined($env{'form.discdisp'}) ) {
                   1887:         my $newdisp  = $env{'form.newdisp'};
1.43      raeburn  1888:         if ($newdisp eq 'unread') {
1.171     raeburn  1889:             $message .=&Apache::lonhtmlcommon::confirm_success(&mt('In discussions: only new posts will be displayed.')).'<br />';
1.43      raeburn  1890:             &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
1.116     raeburn  1891:             &Apache::lonnet::appenv({'environment.discdisplay' => $newdisp});
1.43      raeburn  1892:         } else {
1.171     raeburn  1893:             $message .= &Apache::lonhtmlcommon::confirm_success(&mt('In discussions: all posts will be displayed.')).'<br />';
1.43      raeburn  1894:             &Apache::lonnet::del('environment',['discdisplay']);
1.139     raeburn  1895:             &Apache::lonnet::delenv('environment.discdisplay');
1.43      raeburn  1896:         }
                   1897:     }
1.59      albertel 1898:     if (defined($env{'form.discmark'}) ) {
                   1899:         my $newmark = $env{'form.newmark'};
1.43      raeburn  1900:         if ($newmark eq 'ondisp') {
1.209     bisitz   1901:             $message.=&Apache::lonhtmlcommon::confirm_success(&mt('In discussions: new posts will cease to be identified as "NEW" after display.')).'<br />';
1.43      raeburn  1902:             &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
1.116     raeburn  1903:             &Apache::lonnet::appenv({'environment.discmarkread' => $newmark});
1.43      raeburn  1904:         } else {
1.194     raeburn  1905:             $message.=&Apache::lonhtmlcommon::confirm_success(&mt('In discussions: posts will be identified as "NEW" until marked as not "NEW".')).'<br />';
1.43      raeburn  1906:             &Apache::lonnet::del('environment',['discmarkread']);
1.139     raeburn  1907:             &Apache::lonnet::delenv('environment.discmarkread');
1.43      raeburn  1908:         }
1.42      raeburn  1909:     }
1.158     bisitz   1910:     $message=&Apache::loncommon::confirmwrapper($message);
1.152     www      1911:     &print_main_menu($r, $message);
1.42      raeburn  1912: }
                   1913: 
1.63      raeburn  1914: ################################################################
                   1915: # Subroutines for page display on course access (Course Coordinators)
                   1916: ################################################################
                   1917: sub coursedisplaychanger {
                   1918:     my $r = shift;
1.152     www      1919:     &Apache::lonhtmlcommon::add_breadcrumb(
1.126     droeschl 1920: 	    {	href => '/adm/preferences?action=changecourseinit',
                   1921:                 text => 'Change Course Init. Pref.'});
                   1922:     $r->print(Apache::loncommon::start_page('Change Course Initialization Preference'));
                   1923:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Change Course Init. Pref.'));
1.63      raeburn  1924:     my $user       = $env{'user.name'};
                   1925:     my $domain     = $env{'user.domain'};
1.66      albertel 1926:     my %userenv = &Apache::lonnet::get('environment',['course_init_display']);
1.71      raeburn  1927:     my $currvalue = 'whatsnew';
1.73      albertel 1928:     my $firstselect = '';
                   1929:     my $whatsnewselect = 'checked="checked"';
1.71      raeburn  1930:     if (exists($userenv{'course_init_display'})) {
                   1931:         if ($userenv{'course_init_display'} eq 'firstres') {
                   1932:             $currvalue = 'firstres';
1.73      albertel 1933:             $firstselect = 'checked="checked"';
                   1934: 	    $whatsnewselect = '';
1.71      raeburn  1935:         }
1.63      raeburn  1936:     }
1.134     bisitz   1937:     my %pagenames = &Apache::lonlocal::texthash(
1.71      raeburn  1938:                        firstres => 'First resource',
1.143     hauer    1939:                        whatsnew => "What's New Page",
1.71      raeburn  1940:                     );
1.134     bisitz   1941:     my $whatsnew_off=&mt('Display the [_1]first resource[_2] in the course.','<b>','</b>');
1.143     hauer    1942:     my $whatsnew_on=&mt("Display the [_1]What's New Page[_2] - a summary of items in the course which require attention.",'<b>','</b>');
1.63      raeburn  1943: 
1.134     bisitz   1944:     $r->print('<br /><b>'
                   1945:              .&mt('Set the default page to be displayed when you select a course role')
                   1946:              .'</b>&nbsp;'
                   1947:              .&mt('(Currently: [_1])',$pagenames{$currvalue})
                   1948:              .'<br />'
1.143     hauer    1949:              .&mt("The global user preference you set for your courses can be overridden in an individual course by setting a course specific setting via the [_1]What's New Page[_2] in the course.",'<i>','</i>')
1.134     bisitz   1950:              .'<br /><br />'
                   1951:     );
1.63      raeburn  1952:     $r->print(<<ENDLSCREEN);
1.88      albertel 1953: <form name="prefs" action="/adm/preferences" method="post">
1.63      raeburn  1954: <input type="hidden" name="action" value="verify_and_change_coursepage" />
1.72      albertel 1955: <br />
1.65      albertel 1956: <label><input type="radio" name="newdisp" value="firstres" $firstselect /> $whatsnew_off</label><br />
1.70      raeburn  1957: <label><input type="radio" name="newdisp" value="whatsnew" $whatsnewselect /> $whatsnew_on</label><input type="hidden" name="refpage" value="$env{'form.refpage'}" />
1.63      raeburn  1958: ENDLSCREEN
1.140     schafran 1959:     $r->print('<br /><br /><input type="submit" value="'.&mt('Save').'" />
1.63      raeburn  1960: </form>');
                   1961: }
                   1962: 
                   1963: sub verify_and_change_coursepage {
                   1964:     my $r = shift;
                   1965:     my $message='';
                   1966:     my %lt = &Apache::lonlocal::texthash(
1.70      raeburn  1967:         'defs' => 'Default now set',
1.71      raeburn  1968:         'when' => 'when you select a course role from the roles screen',
1.63      raeburn  1969:         'ywbt' => 'you will be taken to the start of the course.',
                   1970:         'apwb' => 'a page will be displayed that lists items in the course that may require action from you.',
                   1971:         'gtts' => 'Go to the start of the course',
1.146     hauer    1972:         'dasp' => "Display the What's New Page", 
1.63      raeburn  1973:     );
                   1974:     my $newdisp  = $env{'form.newdisp'};
1.70      raeburn  1975:     $message = '<b>'.$lt{'defs'}.'</b>: '.$lt{'when'}.', ';
1.63      raeburn  1976:     if ($newdisp eq 'firstres') {
1.87      albertel 1977:         $message .= $lt{'ywbt'}.'<br />';
1.63      raeburn  1978:         &Apache::lonnet::put('environment',{'course_init_display' => $newdisp});
1.116     raeburn  1979:         &Apache::lonnet::appenv({'environment.course_init_display' => $newdisp});
1.63      raeburn  1980:     } else {
1.87      albertel 1981:         $message .= $lt{'apwb'}.'<br />';
1.63      raeburn  1982:         &Apache::lonnet::del('environment',['course_init_display']);
1.139     raeburn  1983:         &Apache::lonnet::delenv('environment.course_init_display');
1.63      raeburn  1984:     }
1.70      raeburn  1985:     my $refpage = $env{'form.refpage'};
1.63      raeburn  1986:     if (($env{'request.course.fn'}) && ($env{'request.course.id'})) {
                   1987:         if ($newdisp eq 'firstres') {
                   1988:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1989:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 
                   1990:             my ($furl,$ferr)=
                   1991:                 &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
1.180     wenzelju 1992:             $message .= '<br /><a href="'.$furl.'">'.$lt{'gtts'}.' <i>'.&mt('now').'</i></a>';
1.63      raeburn  1993:         } else {
1.180     wenzelju 1994:             $message .= '<br /><a href="/adm/whatsnew?refpage='.
                   1995:                         $refpage.'">'.$lt{'dasp'}.'</a>';
1.63      raeburn  1996:         }
                   1997:     }
1.180     wenzelju 1998:     $message = &Apache::lonhtmlcommon::confirm_success($message);
                   1999:     $message = &Apache::loncommon::confirmwrapper($message);
                   2000:     &print_main_menu($r,$message);
1.63      raeburn  2001: }
                   2002: 
1.215     golterma 2003: sub author_space_settings {
                   2004:     my $r = shift;
                   2005:     &Apache::lonhtmlcommon::add_breadcrumb(
                   2006:             {   href => '/adm/preferences?action=authorsettings',
                   2007:                 text => 'Authoring Space Settings'});
                   2008:     my $user       = $env{'user.name'};
                   2009:     my $domain     = $env{'user.domain'};
                   2010:     my %author_roles = &Apache::lonnet::get_my_roles($user,$domain,'userroles','',['au','ca','aa']);
                   2011:     if (keys(%author_roles) > 0) {
                   2012:             $r->print(Apache::loncommon::start_page('Authoring Space Settings'));
                   2013:             $r->print(Apache::lonhtmlcommon::breadcrumbs('Authoring Space Settings'));
                   2014:             my %userenv = &Apache::lonnet::get('environment',['nocodemirror']);
                   2015:             my $constchecked='';
                   2016:             if ($env{'environment.nocodemirror'}) {
                   2017:                $constchecked=' checked="checked"';
                   2018:             }
1.216     droeschl 2019:             my $text=&mt('By default, CodeMirror an editor with advanced functionality for editing code is activated for authors.');
                   2020:             my $cmoff=&mt('Deactivate CodeMirror. This can improve performance on slow computers and accessibility.');
1.215     golterma 2021:             my $change=&mt('Save');
1.225     raeburn  2022:             my $returnurl = &HTML::Entities::encode($env{'form.returnurl'},'"<>&\'');
1.215     golterma 2023:             $r->print(<<ENDSCREEN);
                   2024:         <form name="prefs" action="/adm/preferences" method="post">
1.225     raeburn  2025:         <input type="hidden" name="returnurl" value="$returnurl" />
1.215     golterma 2026:         <input type="hidden" name="action" value="change_authoring_settings" />
                   2027:         $text<br />
                   2028:         <label><input type="checkbox" name="cmoff"$constchecked />$cmoff</label><br />
                   2029:         <input type="submit" value="$change" />
                   2030:         </form>
                   2031: ENDSCREEN
                   2032:     }
                   2033: }
                   2034: 
                   2035: sub change_authoring_settings {
                   2036:     my $r = shift;
                   2037:     my $user       = $env{'user.name'};
                   2038:     my $domain     = $env{'user.domain'};
                   2039:     my %author_roles = &Apache::lonnet::get_my_roles($user,$domain,'userroles','',['au','ca','aa']);
                   2040:     if (keys(%author_roles) > 0) {
                   2041:             my %ausettings=('environment.nocodemirror' => '');
                   2042:             if ($env{'form.cmoff'}) { $ausettings{'environment.nocodemirror'}='yes'; }
                   2043:             &Apache::lonnet::put('environment',\%ausettings);
                   2044:             &Apache::lonnet::appenv({'environment.nocodemirror' => $ausettings{'environment.nocodemirror'}});
                   2045:             my $status='';
                   2046:             if ($ausettings{'environment.nocodemirror'} eq 'yes') {
                   2047:                 $status=&mt('on');
                   2048:             } else {
                   2049:                 $status=&mt('off');
                   2050:             }
1.216     droeschl 2051:             my $message=&Apache::lonhtmlcommon::confirm_success(&mt('Set [_1] to [_2]','<i>'.&mt('Deactivate CodeMirror in Authoring Space').'</i>','<tt>'.$status.'</tt>'));
1.215     golterma 2052:             $message=&Apache::loncommon::confirmwrapper($message);
1.225     raeburn  2053:             if ($env{'form.returnurl'}) {
                   2054:                 &do_redirect($r,$env{'form.returnurl'},$message);
                   2055:             } else {
                   2056:                 &print_main_menu($r,$message);
                   2057:             }
1.215     golterma 2058:     }
                   2059: }
                   2060: 
1.186     raeburn  2061: sub lockednameschanger {
                   2062:     my $r = shift;
                   2063:     &Apache::lonhtmlcommon::add_breadcrumb(
                   2064:             {   href => '/adm/preferences?action=changelockednames',
                   2065:                 text => 'Automatic name changes'});
                   2066:     $r->print(Apache::loncommon::start_page('Automatic name changes'));
                   2067:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Allow/disallow name updates'));
                   2068:     my %userenv = &Apache::lonnet::get('environment',['lockedname']);
                   2069:     my $lockedname='';
                   2070:     if (&can_toggle_namelocking()) {
                   2071:         if ($userenv{'lockedname'}) {
                   2072:             $lockedname = ' checked="checked"';
                   2073:         }
                   2074:         my %updateable;
                   2075:         my %domconfig =
                   2076:             &Apache::lonnet::get_dom('configuration',['autoupdate'],$env{'user.domain'});
                   2077:         if (ref($domconfig{'autoupdate'}) eq 'HASH') {
                   2078:             if ($domconfig{'autoupdate'}{'run'}) {
                   2079:                 my @inststatuses = split(':',$env{'environment.inststatus'});
                   2080:                 unless (@inststatuses) {
                   2081:                     @inststatuses = ('default');
                   2082:                 }
                   2083:                 %updateable = &updateable_userinfo($domconfig{'autoupdate'},\@inststatuses);
                   2084:             }
                   2085:         }
                   2086:         if (keys(%updateable)) {
                   2087:             my %longnames = &Apache::lonlocal::texthash (
                   2088:                                 firstname  => 'First Name',
                   2089:                                 middlename => 'Middle Name',
                   2090:                                 lastname   => 'Last Name',
                   2091:                             );
                   2092:             my $text=&mt('By default, based on your institutional affiliation, your LON-CAPA account can be automatically updated nightly based on directory information from your institution.').'<br />'.&mt('The following may be updated, unless you disallow updates:').
                   2093:                      '<ul>';
                   2094:            foreach my $item ('firstname','middlename','lastname') {
                   2095:                if ($updateable{$item}) {
                   2096:                    $text .= '<li>'.$longnames{$item}.'</li>';
                   2097:                }
                   2098:            }
                   2099:            $text .= '</ul>'; 
                   2100:            my $locking=&mt('Disallow automatic updates to name information for your LON-CAPA account');
                   2101:            my $change=&mt('Save');
                   2102:            $r->print(<<ENDSCREEN);
                   2103: <form name="prefs" action="/adm/preferences" method="post">
                   2104: <input type="hidden" name="action" value="verify_and_change_lockednames" />
                   2105: $text<br />
                   2106: <label><input type="checkbox" value="1" name="lockednames"$lockedname />$locking</label><br />
                   2107: <input type="submit" value="$change" />
                   2108: </form>
                   2109: ENDSCREEN
                   2110:         } else {
                   2111:             my $message = &mt('Based on your institutional affiliation no name information is automatically updated for your LON-CAPA account.');
                   2112:             &print_main_menu($r,$message);
                   2113:         }
                   2114:     } else {
                   2115:         my $message = &mt('You are not permitted to set a user preference for automatic name updates for your LON-CAPA account.');
                   2116:         &print_main_menu($r,$message);
                   2117:     }
                   2118: }
                   2119: 
                   2120: sub verify_and_change_lockednames {
                   2121:     my $r = shift;
                   2122:     my $message;
                   2123:     if (&can_toggle_namelocking()) {
                   2124:         my $newlockedname = $env{'form.lockednames'};
                   2125:         $newlockedname =~ s/\D//g;
                   2126:         my $currlockedname = $env{'environment.lockedname'};
                   2127:         if ($newlockedname ne $currlockedname) {
                   2128:             if ($newlockedname) {
                   2129:                 if (&Apache::lonnet::put('environment',{lockedname => $newlockedname}) eq 'ok') {
                   2130:                     &Apache::lonnet::appenv({'environment.lockedname' => $newlockedname});
                   2131:                 }
                   2132:             } elsif (&Apache::lonnet::del('environment',['lockedname']) eq 'ok') {
                   2133:                 &Apache::lonnet::delenv('environment.lockedname');
                   2134:             }
                   2135:         }
                   2136:         my $status='';
                   2137:         if ($newlockedname) {
                   2138:             $status=&mt('disallowed');
                   2139:         } else {
                   2140:             $status=&mt('allowed');
                   2141:         }
                   2142:         $message=&Apache::lonhtmlcommon::confirm_success(&mt('[_1] set to [_2]','<i>'.&mt('Automatic update of first, middle and last names if institutional directory information indicates changes').'</i>','<tt>'.$status.'</tt>'));
                   2143:         $message=&Apache::loncommon::confirmwrapper($message);
                   2144:     }
                   2145:     &print_main_menu($r,$message);
                   2146: }
                   2147: 
1.126     droeschl 2148: sub print_main_menu {
                   2149:     my ($r, $message) = @_;
                   2150:     # Determine current authentication method
                   2151:     my $user = $env{'user.name'};
                   2152:     my $domain = $env{'user.domain'};
                   2153:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                   2154: 
                   2155:     # build the data structure for menu generation
                   2156: my $aboutmeurl='/adm/'.$env{'user.domain'}.'/'.$env{'user.name'}.'/aboutme';
                   2157: my $role = ($env{'user.adv'} ? 'Roles' : 'Course');
1.131     raeburn  2158: my %permissions;
                   2159: if (&Apache::lonnet::usertools_access($user,$domain,'aboutme')) {
                   2160:     $permissions{'aboutme'} = 'F';
                   2161: }
1.126     droeschl 2162: my @menu=
                   2163:     ({	categorytitle=>'Personal Data',
                   2164: 	items =>[
1.141     weissno  2165: 	    {	linktext => 'Personal Information Page',
1.126     droeschl 2166: 		url => $aboutmeurl,
1.131     raeburn  2167: 		permission => $permissions{'aboutme'},
1.126     droeschl 2168: 		#help => 'Prefs_About_Me',
                   2169: 		icon => 'system-users.png',
                   2170: 		linktitle => 'Edit information about yourself that should be displayed on your public profile.'
                   2171: 	    },
                   2172: 	    {	linktext => 'Screen Name',
                   2173: 		url => '/adm/preferences?action=changescreenname',
                   2174: 		permission => 'F',
                   2175: 		#help => 'Prefs_Screen_Name_Nickname',
                   2176: 		icon => 'preferences-desktop-font.png',
                   2177: 		linktitle => 'Change the name that is displayed in your posts.'
                   2178: 	    },
                   2179: 		]
                   2180:     },
                   2181:     {	categorytitle=>'Content Display Settings',
                   2182: 	items =>[
                   2183: 	    {	linktext => 'Language',
                   2184: 		url => '/adm/preferences?action=changelanguages',
                   2185: 		permission => 'F',
                   2186: 		#help => 'Prefs_Language',
                   2187: 		icon => 'preferences-desktop-locale.png',
1.127     droeschl 2188: 		linktitle => 'Choose the default language for this user.'
1.126     droeschl 2189: 	    },
1.128     droeschl 2190: 	    {	linktext => $role.' Page',
1.126     droeschl 2191: 		url => '/adm/preferences?action=changerolespref',
                   2192: 		permission => 'F',
                   2193: 		#help => '',
1.189     wenzelju 2194: 		icon => 'role_hotlist.png',
1.126     droeschl 2195: 		linktitle => 'Configure the roles hotlist.'
                   2196: 	    },
1.177     raeburn  2197: 	    {	linktext => 'Math display settings',
1.126     droeschl 2198: 		url => '/adm/preferences?action=changetexenginepref',
                   2199: 		permission => 'F',
                   2200: 		#help => '',
1.188     wenzelju 2201: 		icon => 'dismath.png',
1.177     raeburn  2202: 		linktitle => 'Change how math is displayed.'
1.126     droeschl 2203: 	    },
                   2204: 		]
                   2205:     },
1.185     droeschl 2206:     {	categorytitle=>'Page Display Settings',
                   2207: 	items =>[
                   2208: 	    {	linktext => 'Color Scheme',
                   2209: 		url => '/adm/preferences?action=changecolors',
                   2210: 		permission => 'F',
                   2211: 		#help => 'Change_Colors',
                   2212: 		icon => 'preferences-desktop-theme.png',
                   2213: 		linktitle => 'Change LON-CAPA default colors.'
                   2214: 	    },
1.192     raeburn  2215:             {   linktext => 'Menu Display',
                   2216:                 url => '/adm/preferences?action=changeicons',
                   2217:                 permission => 'F',
                   2218:                 #help => '',
                   2219:                 icon => 'preferences-system-windows.png',
                   2220:                 linktitle => 'Change whether the menus are displayed with icons or icons and text.'
                   2221:             }
1.185     droeschl 2222: 		]
                   2223:     },
1.178     bisitz   2224:     {	categorytitle=>'Messages &amp; Notifications',
1.128     droeschl 2225: 	items =>[
1.153     www      2226: 	    {	linktext => 'Messages &amp; Notifications',
1.128     droeschl 2227: 		url => '/adm/preferences?action=changemsgforward',
                   2228: 		permission => 'F',
                   2229: 		#help => 'Prefs_Messages',
                   2230: 		icon => 'mail-reply-all.png',
                   2231: 		linktitle => 'Change messageforwarding or notifications settings.'
                   2232: 	    },
                   2233: 	    {	linktext => 'Discussion Display',
                   2234: 		url => '/adm/preferences?action=changediscussions',
                   2235: 		permission => 'F',
                   2236: 		#help => 'Change_Discussion_Display',
1.191     riegler  2237: 		icon => 'chat.png',
1.135     schafran 2238: 		linktitle => 'Set display preferences for discussion posts for both discussion boards and individual resources in all your courses.'
1.128     droeschl 2239: 	    },
                   2240: 		]
                   2241:     },
1.126     droeschl 2242:     {	categorytitle=>'Other',
                   2243: 	items =>[
1.153     www      2244: 	    {	linktext => 'Register Response Devices (&quot;Clickers&quot;)',
1.126     droeschl 2245: 		url => '/adm/preferences?action=changeclicker',
                   2246: 		permission => 'F',
                   2247: 		#help => '',
                   2248: 		icon => 'network-workgroup.png',
                   2249: 		linktitle => 'Register your clicker.'
                   2250: 	    },
                   2251: 		]
                   2252:     },
                   2253:     );
                   2254: 
                   2255:     if ($currentauth =~ /^(unix|internal):/) {
                   2256: push(@{ $menu[0]->{items} }, {
                   2257: 	linktext => 'Password',
                   2258: 	url => '/adm/preferences?action=changepass',
                   2259: 	permission => 'F',
                   2260: 	#help => 'Change_Password',
                   2261: 	icon => 'emblem-readonly.png',
                   2262: 	linktitle => 'Change your password.',
                   2263: 	});
                   2264:     }
1.186     raeburn  2265: 
                   2266:     if (&can_toggle_namelocking()) {
                   2267:         push(@{ $menu[0]->{items} }, {
                   2268:         linktext => 'Automatic name changes',
                   2269:         url => '/adm/preferences?action=changelockednames',
                   2270:         permission => 'F',
                   2271:         #help => '',
                   2272:         icon => 'system-lock-screen.png',
                   2273:         linktitle => 'Allow/disallow propagation of name changes from institutional directory service',
                   2274:         });
                   2275:     }
                   2276: 
1.126     droeschl 2277:     my %author_roles = &Apache::lonnet::get_my_roles($user,$domain,'userroles','',['au']);
                   2278:     if (keys(%author_roles) > 0) {
                   2279: push(@{ $menu[4]->{items} }, {
                   2280: 	linktext => 'Restrict Domain Coordinator Access',
                   2281: 	url => '/adm/preferences?action=changedomcoord',
                   2282: 	permission => 'F',
                   2283: 	#help => '',
                   2284: 	icon => 'system-lock-screen.png',
                   2285: 	linktitle => 'Restrict domain coordinator access.',
                   2286: 	});
                   2287:     }
                   2288: 
                   2289:     if (&Apache::lonnet::allowed('whn',$env{'request.course.id'})
                   2290: 	|| &Apache::lonnet::allowed('whn',$env{'request.course.id'}.'/'
                   2291: 				    .$env{'request.course.sec'})) {
                   2292: push(@{ $menu[4]->{items} }, {
1.128     droeschl 2293: 	linktext => 'Course Initialization',
1.126     droeschl 2294: 	url => '/adm/preferences?action=changecourseinit',
                   2295: 	permission => 'F',
                   2296: 	#help => '',
1.189     wenzelju 2297: 	icon => 'course_ini.png',
1.126     droeschl 2298: 	linktitle => 'Set the default page to be displayed when you select a course role.',
                   2299: 	});
                   2300: 
                   2301:     }
1.215     golterma 2302: 
1.222     raeburn  2303:     my %author_coauthor_roles = &Apache::lonnet::get_my_roles($user,$domain,'userroles','',['au','ca','aa']);
                   2304:     if (keys(%author_coauthor_roles) > 0) {
1.215     golterma 2305:         push(@{ $menu[4]->{items} }, {
                   2306:             linktext => 'Authoring Space Configuration',
                   2307:             url => '/adm/preferences?action=authorsettings',
                   2308:             permission => 'F',
1.224     raeburn  2309:             icon => 'codemirror.png',
1.215     golterma 2310:             linktitle => 'Settings for your authoring space.',
                   2311:         });
                   2312:     }
                   2313: 
1.174     raeburn  2314:     if (&can_toggle_debug()) {
1.126     droeschl 2315: push(@{ $menu[4]->{items} }, {
1.174     raeburn  2316: 	linktext => 'Toggle Debug Messages (Currently '.($env{'user.debug'} ? 'on)' : 'off)'),
1.126     droeschl 2317: 	url => '/adm/preferences?action=debugtoggle',
                   2318: 	permission => 'F',
                   2319: 	#help => '',
                   2320: 	icon => 'blog.png',
                   2321: 	linktitle => 'Toggle Debug Messages.',
                   2322: 	});
1.186     raeburn  2323:     }
1.126     droeschl 2324: 
1.147     schafran 2325:     $r->print(&Apache::loncommon::start_page('My Space'));
1.126     droeschl 2326:     $r->print(Apache::lonhtmlcommon::breadcrumbs('Change Preferences'));
                   2327:     $r->print($message);
                   2328:     $r->print(Apache::lonhtmlcommon::generate_menu(@menu));
                   2329:     $r->print(Apache::loncommon::end_page());
                   2330: }
1.63      raeburn  2331: 
1.4       matthew  2332: ######################################################
                   2333: #            other handler subroutines               #
                   2334: ######################################################
                   2335: 
1.3       matthew  2336: ################################################################
                   2337: #                          Main handler                        #
                   2338: ################################################################
1.126     droeschl 2339: sub handler {    
                   2340:     my $r = shift;
                   2341:     Apache::loncommon::content_type($r,'text/html');
                   2342:     # Some pages contain DES keys and should not be cached.
                   2343:     Apache::loncommon::no_cache($r);
                   2344:     $r->send_http_header;
                   2345:     return OK if $r->header_only;
                   2346:     #
                   2347:     Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                   2348:                                    ['action','wysiwyg','returnurl','refpage']);
                   2349:     #
                   2350:     Apache::lonhtmlcommon::clear_breadcrumbs();
1.226     raeburn  2351:     my ($brlink,$brtxt,$brhelp,$ended);
1.198     raeburn  2352:     if (($env{'form.action'} eq 'changerolespref') && ($env{'form.returnurl'} eq '/adm/roles')) {
                   2353:         $brlink ='/adm/roles';
                   2354:         $brtxt = 'User Roles';
1.225     raeburn  2355:     } elsif ((($env{'form.action'} eq 'changedomcoord') ||
                   2356:               ($env{'form.action'} eq 'authorsettings')) &&
                   2357:              (($env{'form.returnurl'} =~ m{^/(priv/|res($|/))}) ||
                   2358:               ($env{'form.returnurl'} eq '/adm/createuser'))) {
                   2359:         $brlink = $env{'form.returnurl'};
                   2360:         if ($env{'form.returnurl'} eq '/adm/createuser') {
                   2361:             $brtxt = 'User Management';
                   2362:         } elsif ($env{'form.returnurl'} =~ m{^/res($\/)}) {
                   2363:             $brtxt = 'Browse published resources';
                   2364:         } else {
                   2365:             $brtxt = 'Authoring Space';
                   2366:         }
1.198     raeburn  2367:     } else {
                   2368:         $brlink ='/adm/preferences';
                   2369:         $brtxt = 'Set User Preferences';
                   2370:         $brhelp = 'Prefs_About_Me,Prefs_Language,Prefs_Screen_Name_Nickname,Change_Colors,Change_Password,Prefs_Messages,Change_Discussion_Display';   
                   2371:     }
1.126     droeschl 2372:     Apache::lonhtmlcommon::add_breadcrumb
1.198     raeburn  2373:         ({href => $brlink,
                   2374:           text => $brtxt,
                   2375:           help => $brhelp,});
1.126     droeschl 2376:     if(!exists $env{'form.action'}) {
1.225     raeburn  2377: 	&print_main_menu($r);
1.226     raeburn  2378:         $ended = 1;
1.126     droeschl 2379:     }elsif($env{'form.action'} eq 'changepass'){
                   2380:         &passwordchanger($r);
                   2381:     }elsif($env{'form.action'} eq 'verify_and_change_pass'){
1.227     raeburn  2382:         &verify_and_change_password($r,'preferences','',\$ended);
1.126     droeschl 2383:     }elsif($env{'form.action'} eq 'changescreenname'){
                   2384:         &screennamechanger($r);
                   2385:     }elsif($env{'form.action'} eq 'verify_and_change_screenname'){
                   2386:         &verify_and_change_screenname($r);
1.226     raeburn  2387:         $ended = 1;
1.126     droeschl 2388:     }elsif($env{'form.action'} eq 'changemsgforward'){
                   2389:         &msgforwardchanger($r);
                   2390:     }elsif($env{'form.action'} eq 'verify_and_change_msgforward'){
                   2391:         &verify_and_change_msgforward($r);
                   2392:     }elsif($env{'form.action'} eq 'changecolors'){
                   2393:         &colorschanger($r);
                   2394:     }elsif($env{'form.action'} eq 'verify_and_change_colors'){
                   2395:         &verify_and_change_colors($r);
1.226     raeburn  2396:         $ended = 1;
1.126     droeschl 2397:     }elsif($env{'form.action'} eq 'changelanguages'){
                   2398:         &languagechanger($r);
                   2399:     }elsif($env{'form.action'} eq 'verify_and_change_languages'){
                   2400:         &verify_and_change_languages($r);
1.226     raeburn  2401:         $ended = 1;
1.126     droeschl 2402:     }elsif($env{'form.action'} eq 'changewysiwyg'){
                   2403:         &wysiwygchanger($r);
                   2404:     }elsif($env{'form.action'} eq 'set_wysiwyg'){
                   2405:         &verify_and_change_wysiwyg($r);
1.227     raeburn  2406:         $ended = 1;
1.126     droeschl 2407:     }elsif($env{'form.action'} eq 'changediscussions'){
                   2408:         &discussionchanger($r);
                   2409:     }elsif($env{'form.action'} eq 'verify_and_change_discussion'){
                   2410:         &verify_and_change_discussion($r);
1.226     raeburn  2411:         $ended = 1;
1.126     droeschl 2412:     }elsif($env{'form.action'} eq 'changerolespref'){
                   2413:         &rolesprefchanger($r);
                   2414:     }elsif($env{'form.action'} eq 'verify_and_change_rolespref'){
                   2415:         &verify_and_change_rolespref($r);
1.226     raeburn  2416:         $ended = 1;
1.126     droeschl 2417:     }elsif($env{'form.action'} eq 'changetexenginepref'){
                   2418:         &texenginechanger($r);
                   2419:     }elsif($env{'form.action'} eq 'verify_and_change_texengine'){
                   2420:         &verify_and_change_texengine($r);
1.227     raeburn  2421:         $ended = 1;
1.192     raeburn  2422:     }elsif($env{'form.action'} eq 'changeicons'){
                   2423:         &iconchanger($r);
                   2424:     }elsif($env{'form.action'} eq 'verify_and_change_icons'){
                   2425:         &verify_and_change_icons($r);
1.226     raeburn  2426:         $ended = 1;
1.126     droeschl 2427:     }elsif($env{'form.action'} eq 'changeclicker'){
                   2428:         &clickerchanger($r);
                   2429:     }elsif($env{'form.action'} eq 'verify_and_change_clicker'){
                   2430:         &verify_and_change_clicker($r);
1.227     raeburn  2431:         $ended = 1;
1.126     droeschl 2432:     }elsif($env{'form.action'} eq 'changedomcoord'){
                   2433:         &domcoordchanger($r);
                   2434:     }elsif($env{'form.action'} eq 'verify_and_change_domcoord'){
                   2435:         &verify_and_change_domcoord($r);
1.226     raeburn  2436:         $ended = 1;
1.126     droeschl 2437:     }elsif($env{'form.action'} eq 'lockwarning'){
                   2438:         &lockwarning($r);
                   2439:     }elsif($env{'form.action'} eq 'verify_and_change_locks'){
                   2440:         &verify_and_change_lockwarning($r);
                   2441:     }elsif($env{'form.action'} eq 'changecourseinit'){
                   2442:         &coursedisplaychanger($r);
                   2443:     }elsif($env{'form.action'} eq 'verify_and_change_coursepage'){
                   2444:         &verify_and_change_coursepage($r);
1.226     raeburn  2445:         $ended = 1;
1.215     golterma 2446:     }elsif($env{'form.action'} eq 'authorsettings'){
                   2447:         &author_space_settings($r);
                   2448:     }elsif($env{'form.action'} eq 'change_authoring_settings'){
                   2449:         &change_authoring_settings($r);
1.227     raeburn  2450:         $ended = 1;
1.126     droeschl 2451:     }elsif($env{'form.action'} eq 'debugtoggle'){
1.174     raeburn  2452:         if (&can_toggle_debug()) {
                   2453:             &toggle_debug();
                   2454:         }
1.154     www      2455: 	&print_main_menu($r);
1.226     raeburn  2456:         $ended = 1;
1.186     raeburn  2457:     } elsif ($env{'form.action'} eq 'changelockednames') {
                   2458:         &lockednameschanger($r);
                   2459:     } elsif ($env{'form.action'} eq 'verify_and_change_lockednames') {
                   2460:         &verify_and_change_lockednames($r);
1.226     raeburn  2461:         $ended = 1;
1.126     droeschl 2462:     }
                   2463: 
1.165     bisitz   2464:     # Properly end the HTML page of all preference pages
                   2465:     # started in each sub routine
                   2466:     # Exception: print_main_menu has its own end_page call
1.226     raeburn  2467:     unless ($ended) {
1.165     bisitz   2468:         $r->print(&Apache::loncommon::end_page());
                   2469:     }
                   2470: 
1.126     droeschl 2471:     return OK;
1.35      matthew  2472: }
                   2473: 
                   2474: sub toggle_debug {
1.59      albertel 2475:     if ($env{'user.debug'}) {
1.139     raeburn  2476:         &Apache::lonnet::delenv('user.debug');
1.35      matthew  2477:     } else {
1.116     raeburn  2478:         &Apache::lonnet::appenv({'user.debug' => 1});
1.35      matthew  2479:     }
1.13      www      2480: }
1.1       www      2481: 
1.174     raeburn  2482: sub can_toggle_debug {
                   2483:     my $can_toggle = 0;
                   2484:     my $page = 'toggledebug';
                   2485:     if (&LONCAPA::lonauthcgi::can_view($page)) {
                   2486:         $can_toggle = 1;
                   2487:     } elsif (&LONCAPA::lonauthcgi::check_ipbased_access($page)) {
                   2488:         $can_toggle = 1;
                   2489:     }
                   2490:     return $can_toggle;
                   2491: }
                   2492: 
1.186     raeburn  2493: sub can_toggle_namelocking {
                   2494:     my $lockablenames;
                   2495:     my %domconfig =
                   2496:         &Apache::lonnet::get_dom('configuration',['autoupdate'],$env{'user.domain'});
                   2497:     if (ref($domconfig{'autoupdate'}) eq 'HASH') {
                   2498:         if ($domconfig{'autoupdate'}{'run'}) {
                   2499:             my @inststatuses = split(':',$env{'environment.inststatus'});
                   2500:             unless (@inststatuses) {
                   2501:                 @inststatuses = ('default');
                   2502:             }
                   2503:             my %updateable = &updateable_userinfo($domconfig{'autoupdate'},\@inststatuses);
                   2504:             if ($updateable{'lastname'} || $updateable{'firstname'} ||
                   2505:                 $updateable{'middlename'}) { 
                   2506:                 if (ref($domconfig{'autoupdate'}{'lockablenames'}) eq 'ARRAY') {
                   2507:                     unless (@inststatuses) {
                   2508:                         @inststatuses = ('default');
                   2509:                     }
                   2510:                     foreach my $status (@inststatuses) {
                   2511:                         if (grep(/^\Q$status\E$/,@{$domconfig{'autoupdate'}{'lockablenames'}})) {
                   2512:                             $lockablenames = 1;
                   2513:                             last;
                   2514:                         }
                   2515:                     }
                   2516:                 }
                   2517:             }
                   2518:         }
                   2519:     }
                   2520:     return $lockablenames;
                   2521: }
                   2522: 
                   2523: sub updateable_userinfo {
                   2524:     my ($autoupdate,$inststatuses) = @_;
                   2525:     my %updateable;
                   2526:     return %updateable unless ((ref($autoupdate) eq 'HASH') && 
                   2527:                                (ref($inststatuses) eq 'ARRAY'));
                   2528:     if (ref($autoupdate->{'fields'}) eq 'HASH') {
                   2529:         foreach my $status (@{$inststatuses}) {
                   2530:             if (ref($autoupdate->{'fields'}{$status}) eq 'ARRAY') {
                   2531:                 foreach my $field (@{$autoupdate->{'fields'}{$status}}) {
                   2532:                     $updateable{$field} = 1;
                   2533:                 }
                   2534:             }
                   2535:         }
                   2536:     }
                   2537:     return %updateable;
                   2538: }
                   2539: 
1.225     raeburn  2540: sub do_redirect {
                   2541:     my ($r,$url,$msg) = @_;
                   2542:     $r->print(
                   2543:         &Apache::loncommon::start_page('Switching Server ...',undef,
                   2544:                                        {'redirect'       => [0.5,$url]}).
                   2545:         '<div style="padding:0;clear:both;margin:0;border:0"></div>'."\n".
                   2546:         "$msg\n".
                   2547:         &Apache::loncommon::end_page());
                   2548:     return;
                   2549: }
                   2550: 
1.1       www      2551: 1;
                   2552: __END__

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