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

1.1       www         1: # The LearningOnline Network
                      2: # Preferences
                      3: #
1.112   ! raeburn     4: # $Id: lonpreferences.pm,v 1.111 2008/01/20 22:34:40 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: # TODOs that have to be completed:
                     31: #    interface with lonnet to change the password
                     32:  
1.1       www        33: package Apache::lonpreferences;
                     34: 
                     35: use strict;
1.86      albertel   36: use LONCAPA;
1.1       www        37: use Apache::Constants qw(:common);
1.3       matthew    38: use Apache::File;
                     39: use Crypt::DES;
                     40: use DynaLoader; # for Crypt::DES version
1.4       matthew    41: use Apache::loncommon();
1.23      matthew    42: use Apache::lonhtmlcommon();
1.32      www        43: use Apache::lonlocal;
1.59      albertel   44: use Apache::lonnet;
1.95      albertel   45: use LONCAPA();
1.3       matthew    46: 
                     47: #
                     48: # Write lonnet::passwd to do the call below.
                     49: # Use:
                     50: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                     51: #
                     52: ##################################################
                     53: #          password associated functions         #
                     54: ##################################################
                     55: sub des_keys {
1.4       matthew    56:     # Make a new key for DES encryption.
1.36      www        57:     # Each key has two parts which are returned separately.
1.4       matthew    58:     # Please note:  Each key must be passed through the &hex function
                     59:     # before it is output to the web browser.  The hex versions cannot
                     60:     # be used to decrypt.
1.3       matthew    61:     my @hexstr=('0','1','2','3','4','5','6','7',
                     62:                 '8','9','a','b','c','d','e','f');
                     63:     my $lkey='';
                     64:     for (0..7) {
                     65:         $lkey.=$hexstr[rand(15)];
                     66:     }
                     67:     my $ukey='';
                     68:     for (0..7) {
                     69:         $ukey.=$hexstr[rand(15)];
                     70:     }
                     71:     return ($lkey,$ukey);
                     72: }
                     73: 
                     74: sub des_decrypt {
                     75:     my ($key,$cyphertext) = @_;
                     76:     my $keybin=pack("H16",$key);
                     77:     my $cypher;
                     78:     if ($Crypt::DES::VERSION>=2.03) {
                     79:         $cypher=new Crypt::DES $keybin;
                     80:     } else {
                     81:         $cypher=new DES $keybin;
                     82:     }
                     83:     my $plaintext=
                     84: 	$cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                     85:     $plaintext.=
                     86: 	$cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
1.4       matthew    87:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
1.3       matthew    88:     return $plaintext;
                     89: }
                     90: 
1.4       matthew    91: ################################################################
                     92: #                       Handler subroutines                    #
                     93: ################################################################
1.9       matthew    94: 
                     95: ################################################################
1.28      www        96: #         Language Change Subroutines                          #
                     97: ################################################################
1.44      www        98: 
                     99: sub wysiwygchanger {
                    100:     my $r = shift;
                    101:     my %userenv = &Apache::lonnet::get
                    102:         ('environment',['wysiwygeditor']);
1.78      albertel  103:     my $onselect='checked="checked"';
1.44      www       104:     my $offselect='';
1.77      albertel  105:     if ($userenv{'wysiwygeditor'} eq 'on') {
1.44      www       106: 	$onselect='';
1.78      albertel  107: 	$offselect='checked="checked"';
1.44      www       108:     }
                    109:     my $switchoff=&mt('Disable WYSIWYG editor');
                    110:     my $switchon=&mt('Enable WYSIWYG editor');
                    111:     $r->print(<<ENDLSCREEN);
1.88      albertel  112: <form name="prefs" action="/adm/preferences" method="post">
1.44      www       113: <input type="hidden" name="action" value="set_wysiwyg" />
                    114: <br />
1.65      albertel  115: <label><input type="radio" name="wysiwyg" value="off" $onselect /> $switchoff</label><br />
                    116: <label><input type="radio" name="wysiwyg" value="on" $offselect /> $switchon</label>
1.44      www       117: ENDLSCREEN
                    118:     $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
                    119: }
                    120: 
                    121: 
                    122: sub verify_and_change_wysiwyg {
                    123:     my $r = shift;
1.59      albertel  124:     my $newsetting=$env{'form.wysiwyg'};
1.44      www       125:     &Apache::lonnet::put('environment',{'wysiwygeditor' => $newsetting});
                    126:     &Apache::lonnet::appenv('environment.wysiwygeditor' => $newsetting);
                    127:     $r->print('<p>'.&mt('Setting WYSIWYG editor to:').' '.&mt($newsetting).'</p>');
                    128: }
                    129: 
                    130: ################################################################
                    131: #         Language Change Subroutines                          #
                    132: ################################################################
1.28      www       133: sub languagechanger {
                    134:     my $r = shift;
1.59      albertel  135:     my $user       = $env{'user.name'};
                    136:     my $domain     = $env{'user.domain'};
1.28      www       137:     my %userenv = &Apache::lonnet::get
1.32      www       138:         ('environment',['languages']);
1.29      www       139:     my $language=$userenv{'languages'};
1.32      www       140: 
1.33      www       141:     my $pref=&mt('Preferred language');
                    142:     my %langchoices=('' => 'No language preference');
                    143:     foreach (&Apache::loncommon::languageids()) {
                    144: 	if (&Apache::loncommon::supportedlanguagecode($_)) {
                    145: 	    $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
                    146: 	               = &Apache::loncommon::plainlanguagedescription($_);
                    147: 	}
                    148:     }
                    149:     my $selectionbox=&Apache::loncommon::select_form($language,'language',
                    150: 						     %langchoices);
1.28      www       151:     $r->print(<<ENDLSCREEN);
1.88      albertel  152: <form name="prefs" action="/adm/preferences" method="post">
1.28      www       153: <input type="hidden" name="action" value="verify_and_change_languages" />
1.33      www       154: <br />$pref: $selectionbox
1.28      www       155: ENDLSCREEN
1.35      matthew   156:     $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
1.28      www       157: }
                    158: 
                    159: 
                    160: sub verify_and_change_languages {
                    161:     my $r = shift;
1.59      albertel  162:     my $user       = $env{'user.name'};
                    163:     my $domain     = $env{'user.domain'};
1.28      www       164: # Screenname
1.59      albertel  165:     my $newlanguage  = $env{'form.language'};
1.28      www       166:     $newlanguage=~s/[^\-\w]//g;
                    167:     my $message='';
                    168:     if ($newlanguage) {
1.29      www       169:         &Apache::lonnet::put('environment',{'languages' => $newlanguage});
                    170:         &Apache::lonnet::appenv('environment.languages' => $newlanguage);
1.110     bisitz    171:         $message=&mt('Set new preferred languages to ').'<tt>"'.$newlanguage.'"</tt>.';
1.28      www       172:     } else {
1.29      www       173:         &Apache::lonnet::del('environment',['languages']);
                    174:         &Apache::lonnet::delenv('environment\.languages');
1.110     bisitz    175:         $message=&mt('Reset preferred language.');
1.28      www       176:     }
                    177:     $r->print(<<ENDVCSCREEN);
                    178: $message
                    179: ENDVCSCREEN
                    180: }
                    181: 
1.50      albertel  182: ################################################################
1.54      albertel  183: #         Tex Engine Change Subroutines                        #
                    184: ################################################################
                    185: sub texenginechanger {
                    186:     my $r = shift;
1.59      albertel  187:     my $user       = $env{'user.name'};
                    188:     my $domain     = $env{'user.domain'};
1.54      albertel  189:     my %userenv = &Apache::lonnet::get('environment',['texengine']);
                    190:     my $texengine=$userenv{'texengine'};
                    191: 
                    192:     my $pref=&mt('Preferred method to display Math');
1.69      albertel  193:     my %mathchoices=('' => 'Default',
1.54      albertel  194: 		     'tth' => 'TeX to HTML',
1.64      albertel  195: 		     #'ttm' => 'TeX to MathML',
1.54      albertel  196: 		     'jsMath' => 'jsMath',
1.57      albertel  197: 		     'mimetex' => 'Convert to Images'
1.54      albertel  198:                      );
                    199:     my $selectionbox=&Apache::loncommon::select_form($texengine,'texengine',
                    200: 						     %mathchoices);
1.67      albertel  201:     my $jsMath_start=&Apache::lontexconvert::jsMath_header();
1.54      albertel  202:     my $change=&mt('Change');
                    203:     $r->print(<<ENDLSCREEN);
1.67      albertel  204: <br />
                    205: 
1.88      albertel  206: <form name="prefs" action="/adm/preferences" method="post">
1.54      albertel  207: <input type="hidden" name="action" value="verify_and_change_texengine" />
                    208: <p>$pref: $selectionbox</p>
                    209: <p><input type="submit" value="$change" /></p>
                    210: </form>
                    211: Examples:
1.67      albertel  212: <p> TeX to HTML <br /> 
1.79      albertel  213: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=tth" width="400" hieght="200"></iframe>
1.67      albertel  214: </p>
1.54      albertel  215: <p>jsMath <br /> 
1.67      albertel  216: $jsMath_start
1.57      albertel  217: <script type="text/javascript">
1.54      albertel  218: if (jsMath.nofonts == 1) {
                    219:     document.writeln
                    220:         ('<center><div style="padding: 10; border-style: solid; border-width:3;'
                    221: 	 +' border-color: #DD0000; background-color: #FFF8F8; width: 75%; text-align: left">'
                    222: 	 +'<small><font color="#AA0000"><b>Warning:</b> '
                    223: 	 +'It looks like you don\\\'t have the TeX math fonts installed. '
                    224: 	 +'The jsMath example on this page may not look right without them. '
                    225: 	 +'The <a href="http://www.math.union.edu/locate/jsMath/" target="_blank"> '
                    226: 	 +'jsMath Home Page</a> has information on how to download the '
                    227: 	 +'needed fonts.  In the meantime, jsMath will do the best it can '
                    228: 	 +'with the fonts you have, but it may not be pretty and some equations '
                    229: 	 +'may not be rendered correctly. '
                    230: 	 +'</font></small></div></center>');
                    231: }
                    232: </script>
1.79      albertel  233: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=jsMath" width="400" hieght="200"></iframe>
1.54      albertel  234: 
1.67      albertel  235: </p>
                    236: <p> Convert to Images <br />
                    237: <br />
1.79      albertel  238: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=mimetex" width="400" hieght="200"></iframe>
1.67      albertel  239: </p>
1.54      albertel  240: ENDLSCREEN
1.59      albertel  241:     if ($env{'environment.texengine'} ne 'jsMath') {
1.55      albertel  242: 	$r->print('<script type="text/javascript">jsMath.Process()</script>');
                    243:     }
1.54      albertel  244: }
                    245: 
                    246: 
                    247: sub verify_and_change_texengine {
                    248:     my $r = shift;
1.59      albertel  249:     my $user       = $env{'user.name'};
                    250:     my $domain     = $env{'user.domain'};
1.54      albertel  251: # Screenname
1.59      albertel  252:     my $newtexengine  = $env{'form.texengine'};
1.54      albertel  253:     $newtexengine=~s/[^\-\w]//g;
1.56      albertel  254:     if ($newtexengine eq 'ttm') {
                    255: 	&Apache::lonnet::appenv('browser.mathml' => 1);
                    256:     } else {
1.59      albertel  257: 	if ($env{'environment.texengine'} eq 'ttm') {
1.56      albertel  258: 	    &Apache::lonnet::appenv('browser.mathml' => 0);
                    259: 	}
                    260:     }
1.54      albertel  261:     my $message='';
                    262:     if ($newtexengine) {
                    263:         &Apache::lonnet::put('environment',{'texengine' => $newtexengine});
                    264:         &Apache::lonnet::appenv('environment.texengine' => $newtexengine);
1.110     bisitz    265:         $message=&mt('Set new preferred math display to ').'<tt>"'.$newtexengine.'"</tt>.';
1.54      albertel  266:     } else {
                    267:         &Apache::lonnet::del('environment',['texengine']);
                    268:         &Apache::lonnet::delenv('environment\.texengine');
1.110     bisitz    269:         $message=&mt('Reset preferred math display.');
1.54      albertel  270:     }
1.56      albertel  271: 
                    272: 
1.54      albertel  273:     $r->print(<<ENDVCSCREEN);
                    274: $message
                    275: ENDVCSCREEN
                    276: }
                    277: 
                    278: ################################################################
1.50      albertel  279: #         Roles Page Preference Change Subroutines         #
                    280: ################################################################
                    281: sub rolesprefchanger {
                    282:     my $r = shift;
1.96      albertel  283:     my $role    = ($env{'user.adv'} ? 'Role' : 'Course');
                    284:     my $lc_role = ($env{'user.adv'} ? 'role' : 'course');
1.59      albertel  285:     my $user       = $env{'user.name'};
                    286:     my $domain     = $env{'user.domain'};
1.50      albertel  287:     my %userenv = &Apache::lonnet::get
                    288:         ('environment',['recentroles','recentrolesn']);
                    289:     my $hotlist_flag=$userenv{'recentroles'};
                    290:     my $hotlist_n=$userenv{'recentrolesn'};
                    291:     my $checked;
                    292:     if ($hotlist_flag) {
                    293: 	$checked = 'checked="checked"';
                    294:     }
                    295:     
                    296:     if (!$hotlist_n) { $hotlist_n=3; }
                    297:     my $options;
                    298:     for (my $i=1; $i<10; $i++) {
                    299: 	my $select;
                    300: 	if ($hotlist_n == $i) { $select = 'selected="selected"'; }
                    301: 	$options .= "<option $select>$i</option>\n";
                    302:     }
                    303: 
1.89      albertel  304: # Get list of recent roles and display with checkbox in front
                    305:     my $roles_check_list = '';
                    306:     my $role_key='';
                    307:     if ($env{'environment.recentroles'}) {
                    308:         my %recent_roles =
                    309:                &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.91      albertel  310:         my %frozen_roles =
                    311:                &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.89      albertel  312:         
1.93      albertel  313:         my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
1.92      albertel  314:         my @sorted_roles = sort {$role_text{$a} cmp $role_text{$b}} keys(%role_text);
                    315: 
1.89      albertel  316:         $roles_check_list .=
                    317: 	    &Apache::loncommon::start_data_table().
                    318: 	    &Apache::loncommon::start_data_table_header_row().
1.96      albertel  319: 	    "<th>".&mt('Freeze '.$role)."</th>".
                    320: 	    "<th>".&mt($role)."</td>".
1.89      albertel  321: 	    &Apache::loncommon::end_data_table_header_row().
                    322: 	    "\n";
                    323: 	my $count;
1.92      albertel  324:         foreach $role_key (@sorted_roles) {
1.89      albertel  325:             my $checked = "";
                    326:             my $value = $recent_roles{$role_key};
1.91      albertel  327:             if ($frozen_roles{$role_key}) {
1.89      albertel  328:                 $checked = "checked=\"checked\"";
                    329:             }
                    330: 	    $count++;
                    331:             $roles_check_list .=
                    332: 		&Apache::loncommon::start_data_table_row().
                    333: 		'<td class="LC_table_cell_checkbox">'.
                    334: 		"<input type=\"checkbox\" $checked name=\"freezeroles\"".
                    335: 		" id=\"freezeroles$count\" value=\"$role_key\" /></td>".
                    336: 		"<td><label for=\"freezeroles$count\">".
1.92      albertel  337: 		"$role_text{$role_key}</label></td>".
1.89      albertel  338: 		&Apache::loncommon::end_data_table_row(). "\n";
                    339:         }
                    340:         $roles_check_list .= "</table>\n";
                    341:     }
                    342: 
                    343:     $r->print('
1.96      albertel  344: <p>'.&mt('Some LON-CAPA users have a long list of '.$lc_role.'s. The Recent '.$role.'s Hotlist feature keeps track of the last N '.$lc_role.'s which have been visited and places a table of these at the top of the '.$lc_role.'s page. People with very few '.$lc_role.'s should leave this feature disabled.').'
1.50      albertel  345: </p>
1.89      albertel  346: <form name="prefs" action="/adm/preferences" method="POST">
1.50      albertel  347: <input type="hidden" name="action" value="verify_and_change_rolespref" />
1.96      albertel  348: <br /><label>'.&mt('Enable Recent '.$role.'s Hotlist:').'
1.89      albertel  349: <input type="checkbox" '.$checked.' name="recentroles" value="true" /></label>
1.96      albertel  350: <br />'.&mt('Number of '.$role.'s in Hotlist:').'
1.50      albertel  351: <select name="recentrolesn" size="1">
1.89      albertel  352: '.$options.'
1.50      albertel  353: </select>
1.96      albertel  354: <p>'.&mt('This list below can be used to <q>freeze</q> '.$lc_role.'s on your screen. Those marked as frozen will not be removed from the list, even if they have not been used recently.').'
1.89      albertel  355: </p>
                    356: '.$roles_check_list.'
1.50      albertel  357: <br />
1.89      albertel  358: <input type="submit" value="'.&mt('Change').'" />
                    359: </form>');
1.50      albertel  360: }
                    361: 
1.92      albertel  362: sub rolespref_get_role_text {
                    363: # Get a line of text for each role
                    364:     my ($roles) = @_;
                    365:     my %roletext = ();
                    366: 
                    367:     foreach my $item (@$roles) {
                    368: # get course information
                    369:         my ($role,$rest) = split(/\./, $item);
1.93      albertel  370:         my $trole = "";
                    371:         $trole = &Apache::lonnet::plaintext($role);
1.92      albertel  372:         my ($tdomain,$other,$tsection)= split(/\//,Apache::lonnet::declutter($rest));
                    373:         my $tother = '-';
1.93      albertel  374:         if ($role =~ /^(cc|st|in|ta|ep|cr)/ ) {
1.92      albertel  375:             my %newhash=&Apache::lonnet::coursedescription($tdomain."_".$other);
                    376:             $tother = " - ".$newhash{'description'};
                    377:         } elsif ($role =~ /dc/) {
                    378:             $tother = "";
                    379:         } else {
                    380:             $tother = " - $other";
                    381:         }
                    382:  
                    383:         my $section="";
                    384:         if ($tsection) {
                    385:             $section = " - Section/Group: $tsection";
                    386:         }
                    387:         $roletext{$item} = $tdomain." - ".$trole.$tother.$section;
                    388:     }
                    389:     return %roletext;
                    390: }
                    391: 
1.50      albertel  392: sub verify_and_change_rolespref {
                    393:     my $r = shift;
1.96      albertel  394:     my $role = ($env{'user.adv'} ? 'Role' : 'Course');
1.59      albertel  395:     my $user       = $env{'user.name'};
                    396:     my $domain     = $env{'user.domain'};
1.50      albertel  397: # Recent Roles Hotlist Flag
1.59      albertel  398:     my $hotlist_flag  = $env{'form.recentroles'};
                    399:     my $hotlist_n  = $env{'form.recentrolesn'};
1.89      albertel  400:     my $message='<hr />';
1.50      albertel  401:     if ($hotlist_flag) {
                    402:         &Apache::lonnet::put('environment',{'recentroles' => $hotlist_flag});
                    403:         &Apache::lonnet::appenv('environment.recentroles' => $hotlist_flag);
1.96      albertel  404:         $message=&mt('Recent '.$role.'s Hotlist is Enabled');
1.50      albertel  405:     } else {
                    406:         &Apache::lonnet::del('environment',['recentroles']);
                    407:         &Apache::lonnet::delenv('environment\.recentroles');
1.96      albertel  408:         $message=&mt('Recent '.$role.'s Hotlist is Disabled');
1.50      albertel  409:     }
                    410:     if ($hotlist_n) {
                    411:         &Apache::lonnet::put('environment',{'recentrolesn' => $hotlist_n});
                    412:         &Apache::lonnet::appenv('environment.recentrolesn' => $hotlist_n);
                    413:         if ($hotlist_flag) {
1.90      albertel  414:             $message.="<br />".
1.96      albertel  415: 		&mt('Display [_1] Most Recent '.$role.'s',$hotlist_n)."\n";
1.89      albertel  416:         }
                    417:     }
                    418: 
                    419: # Get list of froze roles and list of recent roles
                    420:     my @freeze_list = &Apache::loncommon::get_env_multiple('form.freezeroles');
                    421:     my %freeze = ();
1.92      albertel  422:     my %roletext = ();
                    423: 
1.89      albertel  424:     foreach my $key (@freeze_list) {
1.91      albertel  425:         $freeze{$key}='1';
1.89      albertel  426:     }
1.92      albertel  427: 
1.89      albertel  428:     my %recent_roles =
                    429:         &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.91      albertel  430:     my %frozen_roles =
                    431:         &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.92      albertel  432:     my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
1.89      albertel  433: 
                    434: # Unset any roles that were previously frozen but aren't in list
                    435:     foreach my $role_key (sort(keys(%recent_roles))) {
1.91      albertel  436:         if (($frozen_roles{$role_key}) && (!exists($freeze{$role_key}))) {
1.96      albertel  437: 	    $message .= "<br />".&mt('Unfreezing '.$role.': [_1]',$role_text{$role_key})."\n";
1.91      albertel  438: 	    &Apache::lonhtmlcommon::store_recent('roles',$role_key,' ',0);
1.89      albertel  439:         }
                    440:     }
                    441: 
                    442: # Freeze selected roles
                    443:     foreach my $role_key (@freeze_list) {
1.91      albertel  444:         if (!$frozen_roles{$role_key}) {
1.96      albertel  445:              $message .= "<br />".&mt('Freezing '.$role.': [_1]',$role_text{$role_key})."\n";
1.89      albertel  446:              &Apache::lonhtmlcommon::store_recent('roles',
1.91      albertel  447:                                           $role_key,' ',1);
1.50      albertel  448:         }
                    449:     }
1.89      albertel  450:     $message .= "<hr /><br />\n";
1.50      albertel  451: 
                    452:     $r->print(<<ENDRPSCREEN);
                    453: $message
                    454: ENDRPSCREEN
                    455: }
                    456: 
                    457: 
1.28      www       458: 
                    459: ################################################################
1.9       matthew   460: #         Anonymous Discussion Name Change Subroutines         #
                    461: ################################################################
1.5       www       462: sub screennamechanger {
                    463:     my $r = shift;
1.59      albertel  464:     my $user       = $env{'user.name'};
                    465:     my $domain     = $env{'user.domain'};
1.14      www       466:     my %userenv = &Apache::lonnet::get
                    467:         ('environment',['screenname','nickname']);
1.6       www       468:     my $screenname=$userenv{'screenname'};
1.14      www       469:     my $nickname=$userenv{'nickname'};
1.110     bisitz    470:     my %lt = &Apache::lonlocal::texthash(
                    471:                                           text_screenname  => 'New screenname (shown if you post anonymously):',
                    472:                                           text_nickname  => 'New nickname (shown if you post non-anonymously):',
                    473:                                           text_submit => 'Change',
                    474:                                         );
1.5       www       475:     $r->print(<<ENDSCREEN);
1.88      albertel  476: <form name="prefs" action="/adm/preferences" method="post">
1.6       www       477: <input type="hidden" name="action" value="verify_and_change_screenname" />
1.110     bisitz    478: <br />$lt{'text_screenname'}
1.6       www       479: <input type="text" size="20" value="$screenname" name="screenname" />
1.110     bisitz    480: <br />$lt{'text_nickname'}
1.14      www       481: <input type="text" size="20" value="$nickname" name="nickname" />
1.110     bisitz    482: <br />
                    483: <input type="submit" value="$lt{'text_submit'}" />
1.6       www       484: </form>
1.5       www       485: ENDSCREEN
                    486: }
1.6       www       487: 
                    488: sub verify_and_change_screenname {
                    489:     my $r = shift;
1.59      albertel  490:     my $user       = $env{'user.name'};
                    491:     my $domain     = $env{'user.domain'};
1.14      www       492: # Screenname
1.59      albertel  493:     my $newscreen  = $env{'form.screenname'};
1.14      www       494:     $newscreen=~s/[^ \w]//g;
1.6       www       495:     my $message='';
                    496:     if ($newscreen) {
1.7       www       497:         &Apache::lonnet::put('environment',{'screenname' => $newscreen});
                    498:         &Apache::lonnet::appenv('environment.screenname' => $newscreen);
1.110     bisitz    499:         $message=&mt('Set new screenname to ').'<tt>"'.$newscreen.'."</tt>.';
1.6       www       500:     } else {
                    501:         &Apache::lonnet::del('environment',['screenname']);
1.7       www       502:         &Apache::lonnet::delenv('environment\.screenname');
1.110     bisitz    503:         $message=&mt('Reset screenname.');
1.6       www       504:     }
1.14      www       505: # Nickname
                    506:     $message.='<br />';
1.59      albertel  507:     $newscreen  = $env{'form.nickname'};
1.14      www       508:     $newscreen=~s/[^ \w]//g;
                    509:     if ($newscreen) {
                    510:         &Apache::lonnet::put('environment',{'nickname' => $newscreen});
                    511:         &Apache::lonnet::appenv('environment.nickname' => $newscreen);
1.110     bisitz    512:         $message.=&mt('Set new nickname to ').'<tt>"'.$newscreen.'"</tt>.';
1.14      www       513:     } else {
                    514:         &Apache::lonnet::del('environment',['nickname']);
                    515:         &Apache::lonnet::delenv('environment\.nickname');
1.110     bisitz    516:         $message.=&mt('Reset nickname.');
1.14      www       517:     }
1.68      www       518:     &Apache::lonnet::devalidate_cache_new('namescache',$user.':'.$domain);
1.6       www       519:     $r->print(<<ENDVCSCREEN);
                    520: $message
                    521: ENDVCSCREEN
1.20      www       522: }
                    523: 
                    524: ################################################################
1.98      www       525: #                     Icon Subroutines                         #
                    526: ################################################################
                    527: sub iconchanger {
                    528:     my $r = shift;
                    529:     my $user       = $env{'user.name'};
                    530:     my $domain     = $env{'user.domain'};
                    531:     my %userenv = &Apache::lonnet::get
                    532:         ('environment',['icons']);
                    533:     my $iconic='checked="checked"';
                    534:     my $classic='';
1.100     www       535:     my $onlyicon='';
1.98      www       536:     if ($userenv{'icons'} eq 'classic') {
                    537:        $classic='checked="checked"';
                    538:        $iconic='';
                    539:     }
1.100     www       540:     if ($userenv{'icons'} eq 'iconsonly') {
                    541:        $onlyicon='checked="checked"';
                    542:        $iconic='';
                    543:     }
                    544:     my $useicons=&mt('Use icons and text');
                    545:     my $usebuttons=&mt('Use buttons and text');
                    546:     my $useicononly=&mt('Use icons only');
1.98      www       547:     my $change=&mt('Change');
                    548:     $r->print(<<ENDSCREEN);
                    549: <form name="prefs" action="/adm/preferences" method="post">
                    550: <input type="hidden" name="action" value="verify_and_change_icons" />
                    551: <label><input type="radio" name="menumode" value="iconic" $iconic /> $useicons</label><br />
                    552: <label><input type="radio" name="menumode" value="classic" $classic /> $usebuttons</label><br />
1.100     www       553: <label><input type="radio" name="menumode" value="iconsonly" $onlyicon /> $useicononly</label><br />
1.98      www       554: <input type="submit" value="$change" />
                    555: </form>
                    556: ENDSCREEN
                    557: }
                    558: 
                    559: sub verify_and_change_icons {
                    560:     my $r = shift;
                    561:     my $user       = $env{'user.name'};
                    562:     my $domain     = $env{'user.domain'};
                    563:     my $newicons  = $env{'form.menumode'};
                    564: 
                    565:     &Apache::lonnet::put('environment',{'icons' => $newicons});
                    566:     &Apache::lonnet::appenv('environment.icons' => $newicons);
                    567:     $r->print(&mt('Set menu mode to [_1].',$newicons));
                    568: }
                    569: 
                    570: ################################################################
1.105     www       571: #                     Clicker Subroutines                      #
                    572: ################################################################
                    573: 
                    574: sub clickerchanger {
                    575:     my $r = shift;
                    576:     my $user       = $env{'user.name'};
                    577:     my $domain     = $env{'user.domain'};
                    578:     my %userenv = &Apache::lonnet::get
                    579:         ('environment',['clickers']);
                    580:     my $clickers=$userenv{'clickers'};
                    581:     $clickers=~s/\,/\n/gs;
                    582:     my $text=&mt('Enter response device ("clicker") numbers');
                    583:     my $change=&mt('Register');
1.107     www       584:     my $helplink=&Apache::loncommon::help_open_topic('Clicker_Registration', 'Locating your clicker ID');
1.105     www       585:     $r->print(<<ENDSCREEN);
                    586: <form name="prefs" action="/adm/preferences" method="post">
                    587: <input type="hidden" name="action" value="verify_and_change_clicker" />
1.107     www       588: <label>$text $helplink<br />
1.108     www       589: <textarea name="clickers" rows="5" cols="20">$clickers</textarea>
1.105     www       590: </label>
                    591: <input type="submit" value="$change" />
                    592: </form>
                    593: ENDSCREEN
                    594: }
                    595: 
                    596: sub verify_and_change_clicker {
                    597:     my $r = shift;
                    598:     my $user       = $env{'user.name'};
                    599:     my $domain     = $env{'user.domain'};
                    600:     my $newclickers  = $env{'form.clickers'};
1.108     www       601:     $newclickers=~s/[^\w\:\-]+/\,/gs;
1.105     www       602:     $newclickers=~tr/a-z/A-Z/;
1.108     www       603:     $newclickers=~s/[\:\-]+/\-/g;
                    604:     $newclickers=~s/\,+/\,/g;
1.105     www       605:     $newclickers=~s/^\,//;
                    606:     $newclickers=~s/\,$//;
                    607:     &Apache::lonnet::put('environment',{'clickers' => $newclickers});
                    608:     &Apache::lonnet::appenv('environment.clickers' => $newclickers);
                    609:     $r->print(&mt('Registering clickers: [_1]',$newclickers));
                    610: }
                    611: 
                    612: ################################################################
1.20      www       613: #         Message Forward                                      #
                    614: ################################################################
                    615: 
                    616: sub msgforwardchanger {
1.102     raeburn   617:     my ($r,$message) = @_;
1.59      albertel  618:     my $user       = $env{'user.name'};
                    619:     my $domain     = $env{'user.domain'};
1.102     raeburn   620:     my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification','notifywithhtml']);
1.20      www       621:     my $msgforward=$userenv{'msgforward'};
1.102     raeburn   622:     my %lt = &Apache::lonlocal::texthash(
                    623:                                           all   => 'All',
                    624:                                           crit  => 'Critical only',
                    625:                                           reg   => 'Non-critical only',
                    626:                                           foad  => 'Forwarding Address(es)',
1.110     bisitz    627:                                           foad_exmpl => 'e.g. <tt>userA:domain1,userB:domain2,...</tt>',
                    628:                                           mnot  => 'Email Address(es) which should be notified about new LON-CAPA messages', # old: 'Message Notification Email Address(es)',
                    629:                                           mnot_exmpl => 'e.g. <tt>joe@doe.com</tt>',
1.102     raeburn   630:                                           chg   => 'Change',
1.104     raeburn   631:                                           email => 'The e-mail address entered in row ',
1.102     raeburn   632:                                           notv => 'is not a valid e-mail address',
1.103     raeburn   633:                                           toen => "To enter multiple addresses, enter one address at a time, click 'Change' and then add the next one", 
1.102     raeburn   634:                                           prme => 'Back to preferences menu',
                    635:                                         );
1.25      bowersj2  636:     my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
1.110     bisitz    637: 							    &mt("What are forwarding and notification addresses?"));
1.27      bowersj2  638:     my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
1.110     bisitz    639: 								 &mt("What are critical messages?"));
1.102     raeburn   640:     my @allow_html = split(/,/,$userenv{'notifywithhtml'});
                    641:     my %allnot = &get_notifications(\%userenv);
                    642:     my $validatescript = &Apache::lonhtmlcommon::javascript_valid_email();
                    643:     my $jscript = qq|
                    644: <script type="text/javascript">
                    645: function validate() {
                    646:     for (var i=0; i<document.prefs.numnotify.value; i++) {
1.104     raeburn   647:         var checkaddress = 0;
1.102     raeburn   648:         var addr = document.prefs.elements['address_'+i].value;
1.104     raeburn   649:         var rownum = i+1;
1.102     raeburn   650:         if (i < document.prefs.numnotify.value-1) {
1.104     raeburn   651:             if (document.prefs.elements['modify_notify_'+i].checked) {
1.102     raeburn   652:                 checkaddress = 1;
1.104     raeburn   653:             }
1.102     raeburn   654:         } else {
                    655:             if (document.prefs.elements['add_notify_'+i].checked == true) { 
                    656:                 checkaddress = 1;
                    657:             }
                    658:         }
1.104     raeburn   659:         if (checkaddress == 1)  {
1.102     raeburn   660:             var addr = document.prefs.elements['address_'+i].value;
                    661:             if (validmail(document.prefs.elements['address_'+i]) == false) {
1.104     raeburn   662:                 var multimsg = '';
                    663:                 if (addr.indexOf(",") >= 0) {
                    664:                     multimsg = "\\n($lt{'toen'}).";
                    665:                 }
1.110     bisitz    666:                 alert("$lt{'email'} "+rownum+" ('"+addr+"') $lt{'notv'}."+multimsg);
1.102     raeburn   667:                 return;
                    668:             }
                    669:         }
                    670:     }
                    671:     document.prefs.submit();
                    672: }
1.104     raeburn   673: 
                    674: function address_changes (adnum) {
                    675:      if (!document.prefs.elements['del_notify_'+adnum].checked) { 
                    676:          document.prefs.elements['modify_notify_'+adnum].checked = true;
                    677:      }   
                    678: }
                    679: 
                    680: function new_address(adnum) {
                    681:      document.prefs.elements['add_notify_'+adnum].checked = true;
                    682: }
                    683: 
                    684: function delete_address(adnum) {
                    685:      if (document.prefs.elements['del_notify_'+adnum].checked) {
                    686:           document.prefs.elements['modify_notify_'+adnum].checked = false;
                    687:      }
                    688: }
                    689: 
                    690: function modify_address(adnum) {
                    691:     if (document.prefs.elements['modify_notify_'+adnum].checked) {
                    692:         document.prefs.elements['del_notify_'+adnum].checked = false;
                    693:     }
                    694: } 
                    695: 
1.102     raeburn   696: $validatescript
                    697: </script>
                    698: |;
1.20      www       699:     $r->print(<<ENDMSG);
1.102     raeburn   700: $jscript
                    701: $message
                    702: $forwardingHelp
1.88      albertel  703: <form name="prefs" action="/adm/preferences" method="post">
1.20      www       704: <input type="hidden" name="action" value="verify_and_change_msgforward" />
1.110     bisitz    705: $lt{'foad'} ($lt{'foad_exmpl'}):
1.20      www       706: <input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
1.102     raeburn   707: $criticalMessageHelp
1.110     bisitz    708: $lt{'mnot'} ($lt{'mnot_exmpl'}):<br />
1.102     raeburn   709: ENDMSG
                    710:     my @sortforwards = sort (keys(%allnot));
                    711:     my $output = &Apache::loncommon::start_data_table().
                    712:                  &Apache::loncommon::start_data_table_header_row().
1.104     raeburn   713:                  '<th>&nbsp;</th>'.
1.102     raeburn   714:                  '<th>'.&mt('Action').'</th>'.
                    715:                  '<th>'.&mt('Notification address').'</th><th>'.
1.112   ! raeburn   716:                  &mt('Types of message for which notification is sent').'</th><th>'.
1.104     raeburn   717:                  &mt('Excerpt retains HTML tags in message').'</th>'.
1.102     raeburn   718:                  &Apache::loncommon::end_data_table_header_row();
                    719:     my $num = 0;
1.104     raeburn   720:     my $counter = 1;
1.102     raeburn   721:     foreach my $item (@sortforwards) {
                    722:         $output .= &Apache::loncommon::start_data_table_row().
1.104     raeburn   723:                    '<td><b>'.$counter.'</b></td>'.
                    724:                    '<td><span class="LC_nobreak"><label>'.
                    725:                    '<input type="checkbox" name="modify_notify_'.
                    726:                    $num.'" onclick="javscript:modify_address('."'$num'".')" />'.
                    727:                    &mt('Modify').'</label></span>&nbsp;&nbsp; '.
                    728:                    '<span class="LC_nobreak"><label>'.
                    729:                    '<input type="checkbox" name="del_notify_'.$num.
                    730:                    '" onclick="javscript:delete_address('."'$num'".')" />'.
                    731:                    &mt('Delete').'</label></span></td>'.
1.102     raeburn   732:                    '<td><input type="text" value="'.$item.'" name="address_'.
1.104     raeburn   733:                    $num.'" onFocus="javascript:address_changes('."'$num'".
                    734:                    ')" /></td><td>';
1.102     raeburn   735:         my %chk;
                    736:         if (defined($allnot{$item}{'crit'})) {
                    737:             if (defined($allnot{$item}{'reg'})) {
                    738:                 $chk{'all'} = 'checked="checked" ';
                    739:             } else {
                    740:                 $chk{'crit'} = 'checked="checked" ';
                    741:             }
                    742:         } else {
                    743:             $chk{'reg'} = 'checked="checked" ';
                    744:         }
                    745:         foreach my $type ('all','crit','reg') {
                    746:             $output .= '<span class="LC_nobreak"><label>'.
                    747:                        '<input type="radio" name="notify_type_'.$num. 
1.104     raeburn   748:                        '" value="'.$type.'" '.$chk{$type}.
                    749:                        ' onchange="javascript:address_changes('."'$num'".')" />'.
                    750:                        $lt{$type}.'</label></span>&nbsp;';
1.102     raeburn   751:         }
                    752:         my $htmlon = '';
                    753:         my $htmloff = '';
                    754:         if (grep/^\Q$item\E/,@allow_html) {
                    755:             $htmlon = 'checked="checked" '; 
                    756:         } else {
                    757:             $htmloff = 'checked="checked" ';
                    758:         }
                    759:         $output .= '</td><td><label><input type="radio" name="html_'.$num.
1.104     raeburn   760:                    '" value="1" '.$htmlon.
                    761:                    ' onchange="javascript:address_changes('."'$num'".')" />'.
                    762:                    &mt('Yes').'</label>&nbsp;'.
1.102     raeburn   763:                    '<label><input type="radio" name="html_'.$num.'" value="0" '.
1.104     raeburn   764:                    $htmloff. ' onchange="javascript:address_changes('."'$num'".
                    765: ')" />'.
                    766:                    &mt('No').'</label></td>'.
1.102     raeburn   767:                    &Apache::loncommon::end_data_table_row();
                    768:         $num ++;
1.104     raeburn   769:         $counter ++;
1.102     raeburn   770:     }
                    771:     my %defchk = (
                    772:                    all => 'checked="checked" ',
                    773:                    crit => '',
                    774:                    reg => '',
                    775:                  );
                    776:     $output .= &Apache::loncommon::start_data_table_row().
1.104     raeburn   777:                '<td><b>'.$counter.'</b></td>'.
                    778:                '<td><span class="LC_nobreak"><label>'.
                    779:                '<input type="checkbox" name="add_notify_'.$num.
                    780:                '" value="1" />'.&mt('Add new address').'</label></span></td>'.
1.102     raeburn   781:                '<td><input type="text" value="" name="address_'.$num.
1.104     raeburn   782:                '" onFocus="javascript:new_address('."'$num'".')" /></td><td>';
1.102     raeburn   783:     foreach my $type ('all','crit','reg') {
                    784:         $output .= '<span class="LC_nobreak"><label>'.
                    785:                    '<input type="radio" name="notify_type_'.$num.
                    786:                    '" value="'.$type.'" '.$defchk{$type}.'/>'.
                    787:                    $lt{$type}.'</label></span>&nbsp;';
                    788:     }
                    789:     $output .= '</td><td><label><input type="radio" name="html_'.$num.
                    790:                '" value="1" />'.&mt('Yes').'</label>&nbsp;'.
                    791:                '<label><input type="radio" name="html_'.$num.'" value="0" '.
                    792:                ' checked="checked" />'.
                    793:                &mt('No').'</label></td>'.
                    794:                &Apache::loncommon::end_data_table_row().
                    795:                &Apache::loncommon::end_data_table();
                    796:     $num ++;
                    797:     $r->print($output);
                    798:     $r->print(qq|
                    799: <hr />
                    800: <input type="hidden" name="numnotify" value="$num" />
                    801: <input type="button" value="$lt{'chg'}" onclick="javascript:validate()" />
                    802: <input type="button" value="$lt{'prme'}" onclick="location.href='/adm/preferences'" />
1.20      www       803: </form>
1.102     raeburn   804: |);
                    805: 
                    806: }
                    807: 
                    808: sub get_notifications {
                    809:     my ($userenv) = @_;
                    810:     my %allnot;
                    811:     my @critnot = split(/,/,$userenv->{'critnotification'});
                    812:     my @regnot = split(/,/,$userenv->{'notification'});
                    813:     foreach my $item (@critnot) {
                    814:         $allnot{$item}{crit} = 1;
                    815:     }
                    816:     foreach my $item (@regnot) {
                    817:         $allnot{$item}{reg} = 1;
                    818:     }
                    819:     return %allnot;
1.20      www       820: }
                    821: 
                    822: sub verify_and_change_msgforward {
                    823:     my $r = shift;
1.59      albertel  824:     my $user       = $env{'user.name'};
                    825:     my $domain     = $env{'user.domain'};
1.20      www       826:     my $newscreen  = '';
                    827:     my $message='';
1.59      albertel  828:     foreach (split(/\,/,$env{'form.msgforward'})) {
1.20      www       829: 	my ($msuser,$msdomain)=split(/[\@\:]/,$_);
1.95      albertel  830:         $msuser = &LONCAPA::clean_username($msuser);
                    831:         $msdomain = &LONCAPA::clean_domain($msdomain);
1.20      www       832:         if (($msuser) && ($msdomain)) {
                    833: 	    if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
                    834:                $newscreen.=$msuser.':'.$msdomain.',';
                    835: 	   } else {
1.110     bisitz    836:                $message.= &mt('No such user: ').'<tt>'.$msuser.':'.$msdomain.'</tt><br>';
1.20      www       837:            }
                    838:         }
                    839:     }
                    840:     $newscreen=~s/\,$//;
                    841:     if ($newscreen) {
                    842:         &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
                    843:         &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
1.110     bisitz    844:         $message .= &mt('Set message forwarding to ').'<tt>"'.$newscreen.'"</tt>.'
                    845:                     .'<br />';
1.20      www       846:     } else {
                    847:         &Apache::lonnet::del('environment',['msgforward']);
                    848:         &Apache::lonnet::delenv('environment\.msgforward');
1.102     raeburn   849:         $message.= &mt("Set message forwarding to 'off'.").'<br />';
1.20      www       850:     }
1.102     raeburn   851:     my $critnotification;
                    852:     my $notification;
                    853:     my $notify_with_html;
                    854:     my $lastnotify = $env{'form.numnotify'}-1;
1.104     raeburn   855:     my $totaladdresses = 0;
1.102     raeburn   856:     for (my $i=0; $i<$env{'form.numnotify'}; $i++) {
                    857:         if ((!defined($env{'form.del_notify_'.$i})) &&  
1.104     raeburn   858:            ((($i==$lastnotify) && ($env{'form.add_notify_'.$lastnotify} == 1)) ||
1.102     raeburn   859:             ($i<$lastnotify))) {
                    860:             if (defined($env{'form.address_'.$i})) {
                    861:                 if ($env{'form.notify_type_'.$i} eq 'all') {
                    862:                     $critnotification .= $env{'form.address_'.$i}.',';
                    863:                     $notification .= $env{'form.address_'.$i}.',';
                    864:                 } elsif ($env{'form.notify_type_'.$i} eq 'crit') {
                    865:                     $critnotification .= $env{'form.address_'.$i}.',';
                    866:                 } elsif ($env{'form.notify_type_'.$i} eq 'reg') {
                    867:                     $notification .= $env{'form.address_'.$i}.','; 
                    868:                 }
                    869:                 if ($env{'form.html_'.$i} eq '1') {
                    870: 		    $notify_with_html .= $env{'form.address_'.$i}.',';       	
                    871:                 }
1.104     raeburn   872:                 $totaladdresses ++;
1.102     raeburn   873:             }
                    874:         }
                    875:     }
                    876:     $critnotification =~ s/,$//;
                    877:     $critnotification=~s/\s//gs;
                    878:     $notification =~ s/,$//;
1.20      www       879:     $notification=~s/\s//gs;
1.102     raeburn   880:     $notify_with_html =~ s/,$//;
                    881:     $notify_with_html =~ s/\s//gs;
1.20      www       882:     if ($notification) {
                    883:         &Apache::lonnet::put('environment',{'notification' => $notification});
                    884:         &Apache::lonnet::appenv('environment.notification' => $notification);
1.110     bisitz    885:         $message.=&mt('Set non-critical message notification address(es) to ').'<tt>"'.$notification.'"</tt>.<br />';
1.20      www       886:     } else {
                    887:         &Apache::lonnet::del('environment',['notification']);
                    888:         &Apache::lonnet::delenv('environment\.notification');
1.110     bisitz    889:         $message.=&mt("Set non-critical message notification to 'off'.").'<br />';
1.20      www       890:     }
                    891:     if ($critnotification) {
                    892:         &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
                    893:         &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
1.110     bisitz    894:         $message.=&mt('Set critical message notification address(es) to ').'<tt>"'.$critnotification.'"</tt>.<br />';
1.20      www       895:     } else {
                    896:         &Apache::lonnet::del('environment',['critnotification']);
                    897:         &Apache::lonnet::delenv('environment\.critnotification');
1.110     bisitz    898:         $message.=&mt("Set critical message notification to 'off'.").'<br />';
1.102     raeburn   899:     }
                    900:     if ($critnotification || $notification) {
                    901:         if ($notify_with_html) {
                    902:             &Apache::lonnet::put('environment',{'notifywithhtml' => $notify_with_html});
                    903:             &Apache::lonnet::appenv('environment.notifywithhtml' => $notify_with_html);
1.110     bisitz    904:             $message.=&mt('Set address(es) to receive excerpts with html retained ').'<tt>"'.$notify_with_html.'"</tt>.';
1.102     raeburn   905:         } else {
                    906:             &Apache::lonnet::del('environment',['notifywithhtml']);
                    907:             &Apache::lonnet::delenv('environment\.notifywithhtml');
1.104     raeburn   908:             if ($totaladdresses == 1) {
                    909:                 $message.=&mt("Set notification address to receive excerpts with html stripped.");
                    910:             } else {
                    911:                 $message.=&mt("Set all notification addresses to receive excerpts with html stripped.");
                    912:             }
1.102     raeburn   913:         }
                    914:     } else {
                    915:         &Apache::lonnet::del('environment',['notifywithhtml']);
                    916:         &Apache::lonnet::delenv('environment\.notifywithhtml');
                    917:     }
                    918:     if ($message) {
                    919:         $message .= '<br /><hr />';
1.20      www       920:     }
1.109     albertel  921:     &Apache::loncommon::flush_email_cache($user,$domain);
1.102     raeburn   922:     &msgforwardchanger($r,$message);
1.6       www       923: }
                    924: 
1.12      www       925: ################################################################
1.19      www       926: #         Colors                                               #
1.12      www       927: ################################################################
                    928: 
1.19      www       929: sub colorschanger {
1.12      www       930:     my $r = shift;
1.19      www       931: # figure out colors
1.80      albertel  932:     my $function=&Apache::loncommon::get_users_function();
1.19      www       933:     my $domain=&Apache::loncommon::determinedomain();
                    934:     my %colortypes=('pgbg'  => 'Page Background',
                    935:                     'tabbg' => 'Header Background',
                    936:                     'sidebg'=> 'Header Border',
                    937:                     'font'  => 'Font',
                    938:                     'link'  => 'Un-Visited Link',
                    939:                     'vlink' => 'Visited Link',
                    940:                     'alink' => 'Active Link');
1.82      albertel  941:     my $start_data_table = &Apache::loncommon::start_data_table();
1.19      www       942:     my $chtable='';
1.22      matthew   943:     foreach my $item (sort(keys(%colortypes))) {
1.19      www       944:        my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
1.82      albertel  945:        $chtable.=&Apache::loncommon::start_data_table_row().
1.83      albertel  946: 	   '<td>'.$colortypes{$item}.'</td><td style="background: '.$curcol.
1.19      www       947:         '">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td><td><input name="'.$item.
1.21      www       948:         '" size="10" value="'.$curcol.
                    949: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19      www       950: "','".$curcol."','"
1.82      albertel  951: 	    .$item."','parmform.pres','psub'".');">Select</a></td>'.
1.83      albertel  952: 	    &Apache::loncommon::end_data_table_row()."\n";
1.19      www       953:     }
1.82      albertel  954:     my $end_data_table = &Apache::loncommon::end_data_table();
1.23      matthew   955:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19      www       956:     $r->print(<<ENDCOL);
1.82      albertel  957: <script type="text/javascript">
1.19      www       958: 
                    959:     function pclose() {
                    960:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    961:                  "height=350,width=350,scrollbars=no,menubar=no");
                    962:         parmwin.close();
                    963:     }
                    964: 
1.23      matthew   965:     $pjump_def
1.19      www       966: 
                    967:     function psub() {
                    968:         pclose();
                    969:         if (document.parmform.pres_marker.value!='') {
1.21      www       970:             if (document.parmform.pres_type.value!='') {
1.77      albertel  971:                 eval('document.prefs.'+
1.21      www       972:                      document.parmform.pres_marker.value+
1.19      www       973: 		     '.value=document.parmform.pres_value.value;');
1.21      www       974: 	    }
1.19      www       975:         } else {
                    976:             document.parmform.pres_value.value='';
                    977:             document.parmform.pres_marker.value='';
                    978:         }
                    979:     }
                    980: 
                    981: 
                    982: </script>
1.21      www       983: <form name="parmform">
                    984: <input type="hidden" name="pres_marker" />
                    985: <input type="hidden" name="pres_type" />
                    986: <input type="hidden" name="pres_value" />
                    987: </form>
1.88      albertel  988: <form name="prefs" action="/adm/preferences" method="post">
1.19      www       989: <input type="hidden" name="action" value="verify_and_change_colors" />
1.82      albertel  990: $start_data_table
1.19      www       991: $chtable
1.82      albertel  992: $end_data_table
1.19      www       993: </table>
1.21      www       994: <input type="submit" value="Change Custom Colors" />
                    995: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12      www       996: </form>
1.19      www       997: ENDCOL
1.12      www       998: }
                    999: 
1.19      www      1000: sub verify_and_change_colors {
1.12      www      1001:     my $r = shift;
1.19      www      1002: # figure out colors
1.80      albertel 1003:     my $function=&Apache::loncommon::get_users_function();
1.19      www      1004:     my $domain=&Apache::loncommon::determinedomain();
                   1005:     my %colortypes=('pgbg'  => 'Page Background',
                   1006:                     'tabbg' => 'Header Background',
                   1007:                     'sidebg'=> 'Header Border',
                   1008:                     'font'  => 'Font',
                   1009:                     'link'  => 'Un-Visited Link',
                   1010:                     'vlink' => 'Visited Link',
                   1011:                     'alink' => 'Active Link');
                   1012: 
1.12      www      1013:     my $message='';
1.21      www      1014:     foreach my $item (keys %colortypes) {
1.59      albertel 1015:         my $color=$env{'form.'.$item};
1.21      www      1016:         my $entry='color.'.$function.'.'.$item;
1.59      albertel 1017: 	if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$env{'form.resetall'})) {
1.21      www      1018: 	    &Apache::lonnet::put('environment',{$entry => $color});
                   1019: 	    &Apache::lonnet::appenv('environment.'.$entry => $color);
1.110     bisitz   1020: 	    $message.=&mt('Set '.$colortypes{$item}.' to ').'<tt>"'.$color.'"</tt>.<br />';
1.21      www      1021: 	} else {
                   1022: 	    &Apache::lonnet::del('environment',[$entry]);
                   1023: 	    &Apache::lonnet::delenv('environment\.'.$entry);
1.110     bisitz   1024: 	    $message.=&mt('Reset '.$colortypes{$item}.'.').'<br />';
1.21      www      1025: 	}
                   1026:     }
1.84      albertel 1027:     my $now = time;
                   1028:     &Apache::lonnet::put('environment',{'color.timestamp' => $now});
                   1029:     &Apache::lonnet::appenv('environment.color.timestamp' => $now);
                   1030: 
1.19      www      1031:     $r->print(<<ENDVCCOL);
1.12      www      1032: $message
1.88      albertel 1033: <form name="client" action="/adm/preferences" method="post">
1.21      www      1034: <input type="hidden" name="action" value="changecolors" />
                   1035: </form>
1.19      www      1036: ENDVCCOL
1.12      www      1037: }
                   1038: 
1.4       matthew  1039: ######################################################
                   1040: #            password handler subroutines            #
                   1041: ######################################################
1.3       matthew  1042: sub passwordchanger {
1.94      raeburn  1043:     my ($r,$errormessage,$caller,$mailtoken) = @_;
1.4       matthew  1044:     # This function is a bit of a mess....
1.3       matthew  1045:     # Passwords are encrypted using londes.js (DES encryption)
1.4       matthew  1046:     $errormessage = ($errormessage || '');
1.94      raeburn  1047:     my ($user,$domain,$currentpass,$defdom);
                   1048:     if ((!defined($caller)) || ($caller eq 'preferences')) {
                   1049:         $user = $env{'user.name'};
                   1050:         $domain = $env{'user.domain'};
                   1051:         if (!defined($caller)) {
                   1052:             $caller = 'preferences';
                   1053:         }
                   1054:     } elsif ($caller eq 'reset_by_email') {
                   1055:             $defdom = $r->dir_config('lonDefDomain');
                   1056:             my %data = &Apache::lonnet::tmpget($mailtoken);
                   1057:             if (keys(%data) == 0) {
1.110     bisitz   1058:                 $r->print(&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 <a href="/adm/resetpw">new request</a> 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.'));
1.94      raeburn  1059:                 return;
                   1060:             }
                   1061:             if (defined($data{time})) {
                   1062:                 if (time - $data{'time'} < 7200) {
                   1063:                     $user = $data{'username'};
                   1064:                     $domain = $data{'domain'};
                   1065:                     $currentpass = $data{'temppasswd'};
                   1066:                 } else {
                   1067:                     $r->print(&mt('Sorry, the token generated when you requested a password reset has expired.').'<br />');
                   1068:                     return;
                   1069:                 }
                   1070:             } else {
                   1071:                 $r->print(&mt('Sorry, the URL generated when you requested reset of your password contained incomplete information.').'<br />');
                   1072:                 return;
                   1073:             }
                   1074:    } else {
                   1075:         $r->print(&mt('Page requested in unexpected context').'<br />');
                   1076:         return;
                   1077:     }
1.3       matthew  1078:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                   1079:     # Check for authentication types that allow changing of the password.
                   1080:     return if ($currentauth !~ /^(unix|internal):/);
                   1081:     #
                   1082:     # Generate keys
                   1083:     my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
                   1084:     my ($lkey_npass1,$ukey_npass1) = &des_keys();
                   1085:     my ($lkey_npass2,$ukey_npass2) = &des_keys();
1.4       matthew  1086:     # Store the keys in the log files
1.3       matthew  1087:     my $lonhost = $r->dir_config('lonHostID');
                   1088:     my $logtoken=Apache::lonnet::reply('tmpput:'
                   1089: 				       .$ukey_cpass  . $lkey_cpass .'&'
                   1090: 				       .$ukey_npass1 . $lkey_npass1.'&'
                   1091: 				       .$ukey_npass2 . $lkey_npass2,
                   1092: 				       $lonhost);
1.4       matthew  1093:     # Hexify the keys for output as javascript variables
1.94      raeburn  1094:     my %hexkey;
                   1095:     $hexkey{'ukey_cpass'}  = hex($ukey_cpass);
                   1096:     $hexkey{'lkey_cpass'}  = hex($lkey_cpass);
                   1097:     $hexkey{'ukey_npass1'} = hex($ukey_npass1);
                   1098:     $hexkey{'lkey_npass1'} = hex($lkey_npass1);
                   1099:     $hexkey{'ukey_npass2'} = hex($ukey_npass2);
                   1100:     $hexkey{'lkey_npass2'} = hex($lkey_npass2);
1.3       matthew  1101:     # Output javascript to deal with passwords
1.4       matthew  1102:     # Output DES javascript
1.3       matthew  1103:     {
                   1104: 	my $include = $r->dir_config('lonIncludes');
                   1105: 	my $jsh=Apache::File->new($include."/londes.js");
                   1106: 	$r->print(<$jsh>);
                   1107:     }
1.94      raeburn  1108:     $r->print(&jscript_send($caller));
1.3       matthew  1109:     $r->print(<<ENDFORM);
1.94      raeburn  1110: $errormessage
                   1111: 
                   1112: <p>
                   1113: <!-- We separate the forms into 'server' and 'client' in order to
                   1114:      ensure that unencrypted passwords will not be sent out by a
                   1115:      crappy browser -->
                   1116: ENDFORM
                   1117:     $r->print(&server_form($logtoken,$caller,$mailtoken));
                   1118:     $r->print(&client_form($caller,\%hexkey,$currentpass,$defdom));
                   1119: 
                   1120:     #
                   1121:     return;
                   1122: }
                   1123: 
                   1124: sub jscript_send {
                   1125:     my ($caller) = @_;
                   1126:     my $output = qq|
1.3       matthew  1127: <script language="JavaScript">
                   1128: 
                   1129:     function send() {
                   1130:         uextkey=this.document.client.elements.ukey_cpass.value;
                   1131:         lextkey=this.document.client.elements.lkey_cpass.value;
                   1132:         initkeys();
                   1133: 
1.52      raeburn  1134:         this.document.pserver.elements.currentpass.value
1.3       matthew  1135:             =crypted(this.document.client.elements.currentpass.value);
                   1136: 
                   1137:         uextkey=this.document.client.elements.ukey_npass1.value;
                   1138:         lextkey=this.document.client.elements.lkey_npass1.value;
                   1139:         initkeys();
1.52      raeburn  1140:         this.document.pserver.elements.newpass_1.value
1.3       matthew  1141:             =crypted(this.document.client.elements.newpass_1.value);
                   1142: 
                   1143:         uextkey=this.document.client.elements.ukey_npass2.value;
                   1144:         lextkey=this.document.client.elements.lkey_npass2.value;
                   1145:         initkeys();
1.52      raeburn  1146:         this.document.pserver.elements.newpass_2.value
1.3       matthew  1147:             =crypted(this.document.client.elements.newpass_2.value);
1.94      raeburn  1148: |;
                   1149:     if ($caller eq 'reset_by_email') {
                   1150:         $output .= qq|
                   1151:         this.document.pserver.elements.uname.value =
                   1152:                    this.document.client.elements.uname.value;
                   1153:         this.document.pserver.elements.udom.value =
                   1154:                    this.document.client.elements.udom.options[this.document.client.elements.udom.selectedIndex].value;
                   1155: |;
                   1156:     }
                   1157:     $ output .= qq|
1.52      raeburn  1158:         this.document.pserver.submit();
1.3       matthew  1159:     }
                   1160: </script>
1.94      raeburn  1161: |;
                   1162: }
1.3       matthew  1163: 
1.94      raeburn  1164: sub client_form {
                   1165:     my ($caller,$hexkey,$currentpass,$defdom) = @_;
1.99      www      1166:     my %lt=&Apache::lonlocal::texthash(
                   1167:                 'email' => 'EMail Address',
                   1168:                 'username' => 'Username',
                   1169:                 'domain' => 'Domain',
                   1170:                 'currentpass' => 'Current Password',
                   1171:                 'newpass' => 'New Password',
                   1172:                 'confirmpass' => 'Confirm Password',
                   1173:                 'changepass' => 'Change Password');
                   1174: 
1.94      raeburn  1175:     my $output = qq|
1.3       matthew  1176: <form name="client" >
                   1177: <table>
1.94      raeburn  1178: |;
                   1179:     if ($caller eq 'reset_by_email') {
                   1180:         $output .= qq|
1.99      www      1181: <tr><td class="LC_preferences_labeltext"><label for="email">$lt{'email'}</label>:</td>
1.97      raeburn  1182:     <td><input type="text" name="email" size="30" /> </td></tr>
1.99      www      1183: <tr><td class="LC_preferences_labeltext"><label for="uname">$lt{'username'}</label>:</td>
1.94      raeburn  1184:     <td>
1.97      raeburn  1185:      <input type="text" name="uname" size="15" />
1.94      raeburn  1186:      <input type="hidden" name="currentpass" value="$currentpass" />
                   1187:     </td></tr>
1.99      www      1188: <tr><td class="LC_preferences_labeltext"><label for="udom">$lt{'udom'}</label>:</td>
1.94      raeburn  1189:     <td>
                   1190: |;
                   1191:         $output .= &Apache::loncommon::select_dom_form($defdom,'udom').'
                   1192:    </td>
                   1193: </tr>
                   1194: ';
                   1195:     } else {
                   1196:         $output .= qq|
1.99      www      1197: <tr><td class="LC_preferences_labeltext"><label for="currentpass">$lt{'currentpass'}</label></td>
1.4       matthew  1198:     <td><input type="password" name="currentpass" size="10"/> </td></tr>
1.94      raeburn  1199: |;
                   1200:     }
                   1201:     $output .= <<"ENDFORM";
1.99      www      1202: <tr><td class="LC_preferences_labeltext"><label for="newpass_1">$lt{'newpass'}</label></td>
1.4       matthew  1203:     <td><input type="password" name="newpass_1" size="10"  /> </td></tr>
1.99      www      1204: <tr><td class="LC_preferences_labeltext"><label for="newpass_2">$lt{'confirmpass'}</label></td>
1.4       matthew  1205:     <td><input type="password" name="newpass_2" size="10"  /> </td></tr>
1.3       matthew  1206: <tr><td colspan="2" align="center">
1.99      www      1207:     <input type="button" value="$lt{'changepass'}" onClick="send();">
1.3       matthew  1208: </table>
1.94      raeburn  1209: <input type="hidden" name="ukey_cpass"  value="$hexkey->{'ukey_cpass'}" />
                   1210: <input type="hidden" name="lkey_cpass"  value="$hexkey->{'lkey_cpass'}" />
                   1211: <input type="hidden" name="ukey_npass1" value="$hexkey->{'ukey_npass1'}" />
                   1212: <input type="hidden" name="lkey_npass1" value="$hexkey->{'lkey_npass1'}" />
                   1213: <input type="hidden" name="ukey_npass2" value="$hexkey->{'ukey_npass2'}" />
                   1214: <input type="hidden" name="lkey_npass2" value="$hexkey->{'lkey_npass2'}" />
1.3       matthew  1215: </form>
                   1216: </p>
                   1217: ENDFORM
1.94      raeburn  1218:     return $output;
                   1219: }
                   1220: 
                   1221: sub server_form {
                   1222:     my ($logtoken,$caller,$mailtoken) = @_;
                   1223:     my $action = '/adm/preferences';
                   1224:     if ($caller eq 'reset_by_email') {
                   1225:         $action = '/adm/resetpw';
                   1226:     }
                   1227:     my $output = qq|
                   1228: <form name="pserver" action="$action" method="post">
                   1229: <input type="hidden" name="logtoken"    value="$logtoken" />
                   1230: <input type="hidden" name="currentpass" value="" />
                   1231: <input type="hidden" name="newpass_1"   value="" />
                   1232: <input type="hidden" name="newpass_2"   value="" />
                   1233:     |;
                   1234:     if ($caller eq 'reset_by_email') {
                   1235:         $output .=  qq|
                   1236: <input type="hidden" name="token"   value="$mailtoken" />
                   1237: <input type="hidden" name="uname"   value="" />
                   1238: <input type="hidden" name="udom"   value="" />
                   1239: 
                   1240: |;
                   1241:     }
                   1242:     $output .= qq|
                   1243: <input type="hidden" name="action" value="verify_and_change_pass" />
                   1244: </form>
                   1245: |;
                   1246:     return $output;
1.3       matthew  1247: }
                   1248: 
                   1249: sub verify_and_change_password {
1.94      raeburn  1250:     my ($r,$caller,$mailtoken) = @_;
                   1251:     my ($user,$domain,$homeserver);
                   1252:     if ($caller eq 'reset_by_email') {
                   1253:         $user       = $env{'form.uname'};
                   1254:         $domain     = $env{'form.udom'};
                   1255:         if ($user ne '' && $domain ne '') {
                   1256:             $homeserver = &Apache::lonnet::homeserver($user,$domain);
                   1257:             if ($homeserver eq 'no_host') {
1.99      www      1258:         &passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1259:                          &mt("Invalid username and/or domain")."</span>\n</p>",
1.94      raeburn  1260:                          $caller,$mailtoken);
                   1261:                 return 1;
                   1262:             }
                   1263:         } else {
1.99      www      1264:             &passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1265:                              &mt("Username and domain were blank")."</span>\n</p>",
1.94      raeburn  1266:                              $caller,$mailtoken);
                   1267:             return 1;
                   1268:         }
                   1269:     } else {
                   1270:         $user       = $env{'user.name'};
                   1271:         $domain     = $env{'user.domain'};
                   1272:         $homeserver = $env{'user.home'};
                   1273:     }
1.3       matthew  1274:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4       matthew  1275:     # Check for authentication types that allow changing of the password.
1.94      raeburn  1276:     if ($currentauth !~ /^(unix|internal):/) {
                   1277:         if ($caller eq 'reset_by_email') {
1.99      www      1278:             &passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1279:                              &mt("Authentication type for this user can not be changed by this mechanism").
                   1280:                              "</span>\n</p>",
1.94      raeburn  1281:                               $caller,$mailtoken);
                   1282:             return 1;
                   1283:         } else {
                   1284:             return;
                   1285:         }
                   1286:     }
1.3       matthew  1287:     #
1.59      albertel 1288:     my $currentpass = $env{'form.currentpass'}; 
                   1289:     my $newpass1    = $env{'form.newpass_1'}; 
                   1290:     my $newpass2    = $env{'form.newpass_2'};
                   1291:     my $logtoken    = $env{'form.logtoken'};
1.3       matthew  1292:     # Check for empty data 
1.4       matthew  1293:     unless (defined($currentpass) && 
                   1294: 	    defined($newpass1)    && 
                   1295: 	    defined($newpass2)    ){
1.99      www      1296: 	&passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1297: 			 &mt("One or more password fields were blank").
                   1298:                          "</span>\n</p>",$caller,$mailtoken);
1.3       matthew  1299: 	return;
                   1300:     }
1.16      albertel 1301:     # Get the keys
                   1302:     my $lonhost = $r->dir_config('lonHostID');
1.3       matthew  1303:     my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
                   1304:     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4       matthew  1305:         # I do not a have a better idea about how to handle this
1.94      raeburn  1306:         my $tryagain_text = &mt('Please log out and try again.');
                   1307:         if ($caller eq 'reset_by_email') {
                   1308:             $tryagain_text = &mt('Please try again later.');
                   1309:         }
1.101     albertel 1310:         my $unable=&mt("Unable to retrieve saved token for password decryption");
1.3       matthew  1311: 	$r->print(<<ENDERROR);
                   1312: <p>
1.99      www      1313: <span class="LC_error">$unable.  $tryagain_text</span>
1.3       matthew  1314: </p>
                   1315: ENDERROR
1.4       matthew  1316:         # Probably should log an error here
1.75      albertel 1317:         return 1;
1.3       matthew  1318:     }
                   1319:     my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4       matthew  1320:     # 
1.17      matthew  1321:     $currentpass = &des_decrypt($ckey ,$currentpass);
                   1322:     $newpass1    = &des_decrypt($n1key,$newpass1);
                   1323:     $newpass2    = &des_decrypt($n2key,$newpass2);
1.94      raeburn  1324:     #
                   1325:     if ($caller eq 'reset_by_email') {
                   1326:         my %data = &Apache::lonnet::tmpget($mailtoken);
                   1327:         if ($currentpass ne $data{'temppasswd'}) {
                   1328:             &passwordchanger($r,
1.99      www      1329:                          '<span class="LC_error">'.
1.110     bisitz   1330:                          &mt('Could not verify current authentication.').'  '.
                   1331:                          &mt('Please try again.').'</span>',$caller,$mailtoken);
1.94      raeburn  1332:             return 1;
                   1333:         }
                   1334:     } 
1.3       matthew  1335:     if ($newpass1 ne $newpass2) {
1.4       matthew  1336: 	&passwordchanger($r,
1.99      www      1337: 			 '<span class="LC_error">'.
1.110     bisitz   1338: 			 &mt('The new passwords you entered do not match.').'  '.
                   1339: 			 &mt('Please try again.').'</span>',$caller,$mailtoken);
1.75      albertel 1340: 	return 1;
1.4       matthew  1341:     }
                   1342:     if (length($newpass1) < 7) {
                   1343: 	&passwordchanger($r,
1.99      www      1344: 			 '<span class="LC_error">'.
1.110     bisitz   1345: 			 &mt('Passwords must be a minimum of 7 characters long.').'  '.
                   1346: 			 &mt('Please try again.').'</span>',$caller,$mailtoken);
1.75      albertel 1347: 	return 1;
1.3       matthew  1348:     }
1.4       matthew  1349:     #
                   1350:     # Check for bad characters
                   1351:     my $badpassword = 0;
                   1352:     foreach (split(//,$newpass1)) {
                   1353: 	$badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
                   1354:     }
                   1355:     if ($badpassword) {
                   1356: 	# I can't figure out how to enter bad characters on my browser.
1.99      www      1357: 	my $errormessage ='<span class="LC_error">'.
1.110     bisitz   1358:            &mt('The password you entered contained illegal characters.').'<br />'.
1.99      www      1359:            &mt('Valid characters are').(<<"ENDERROR");
                   1360: : space and <br />
1.4       matthew  1361: <pre>
                   1362: !&quot;\#$%&amp;\'()*+,-./0123456789:;&lt;=&gt;?\@
                   1363: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
1.99      www      1364: </pre></span>
1.4       matthew  1365: ENDERROR
1.94      raeburn  1366:         &passwordchanger($r,$errormessage,$caller,$mailtoken);
                   1367:         return 1;
1.4       matthew  1368:     }
                   1369:     # 
                   1370:     # Change the password (finally)
                   1371:     my $result = &Apache::lonnet::changepass
1.94      raeburn  1372: 	($user,$domain,$currentpass,$newpass1,$homeserver,$caller);
1.4       matthew  1373:     # Inform the user the password has (not?) been changed
                   1374:     if ($result =~ /^ok$/) {
1.99      www      1375: 	$r->print("<h3>".&mt('The password for [_1] was successfully changed',$user)."</h3>");
1.4       matthew  1376:     } else {
                   1377: 	# error error: run in circles, scream and shout
1.99      www      1378:         $r->print("<h3><span class='LC_error'>".&mt("The password for [_1] was not changed",$user)."</span></h3>".
1.110     bisitz   1379:                   &mt('Please make sure your old password was entered correctly.'));
1.75      albertel 1380:         return 1;
1.4       matthew  1381:     }
                   1382:     return;
1.3       matthew  1383: }
                   1384: 
1.42      raeburn  1385: ################################################################
                   1386: #            discussion display subroutines 
                   1387: ################################################################
                   1388: sub discussionchanger {
                   1389:     my $r = shift;
1.59      albertel 1390:     my $user       = $env{'user.name'};
                   1391:     my $domain     = $env{'user.domain'};
1.42      raeburn  1392:     my %userenv = &Apache::lonnet::get
1.43      raeburn  1393:         ('environment',['discdisplay','discmarkread']);
                   1394:     my $discdisp = 'allposts';
                   1395:     my $discmark = 'onmark';
                   1396: 
                   1397:     if (defined($userenv{'discdisplay'})) {
                   1398:         unless ($userenv{'discdisplay'} eq '') { 
                   1399:             $discdisp = $userenv{'discdisplay'};
                   1400:         }
                   1401:     }
                   1402:     if (defined($userenv{'discmarkread'})) {
                   1403:         unless ($userenv{'discdisplay'} eq '') { 
                   1404:             $discmark = $userenv{'discmarkread'};
                   1405:         }
                   1406:     }
                   1407: 
                   1408:     my $newdisp = 'unread';
                   1409:     my $newmark = 'ondisp';
                   1410: 
                   1411:     my $function = &Apache::loncommon::get_users_function();
                   1412:     my $color = &Apache::loncommon::designparm($function.'.tabbg',
1.59      albertel 1413:                                                     $env{'user.domain'});
1.43      raeburn  1414:     my %lt = &Apache::lonlocal::texthash(
                   1415:         'pref' => 'Display Preference',
                   1416:         'curr' => 'Current setting ',
                   1417:         'actn' => 'Action',
                   1418:         'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
                   1419:         'prca' => 'Preferences can be set that determine',
                   1420:         'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
                   1421:         'unwh' => 'Under what circumstances posts are identfied as "New"',
                   1422:         'allposts' => 'All posts',
                   1423:         'unread' => 'New posts only',
                   1424:         'ondisp' => 'Once displayed',
                   1425:         'onmark' => 'Once marked as read',
                   1426:         'disa' => 'Posts displayed?',
                   1427:         'npmr' => 'New posts cease to be identified as "New"?',
                   1428:         'thde'  => 'The preferences you set here can be overridden within each individual discussion.',
                   1429:         'chgt' => 'Change to '
                   1430:     );
                   1431:     my $dispchange = $lt{'unread'};
                   1432:     my $markchange = $lt{'ondisp'};
                   1433:     my $currdisp = $lt{'allposts'};
                   1434:     my $currmark = $lt{'onmark'};
                   1435: 
                   1436:     if ($discdisp eq 'unread') {
                   1437:         $dispchange = $lt{'allposts'};
                   1438:         $currdisp = $lt{'unread'};
                   1439:         $newdisp = 'allposts';
                   1440:     }
                   1441: 
                   1442:     if ($discmark eq 'ondisp') {
                   1443:         $markchange = $lt{'onmark'};
                   1444:         $currmark = $lt{'ondisp'};
                   1445:         $newmark = 'onmark';
1.42      raeburn  1446:     }
1.43      raeburn  1447:     
                   1448:     $r->print(<<"END");
1.88      albertel 1449: <form name="prefs" action="/adm/preferences" method="post">
1.42      raeburn  1450: <input type="hidden" name="action" value="verify_and_change_discussion" />
                   1451: <br />
1.87      albertel 1452: $lt{'sdpf'}<br /> $lt{'prca'}  <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol> 
1.43      raeburn  1453: <br />
                   1454: <br />
1.82      albertel 1455: END
                   1456:     $r->print(&Apache::loncommon::start_data_table());
                   1457:     $r->print(<<"END");
                   1458:        <tr>
                   1459:         <th>$lt{'pref'}</th>
                   1460:         <th>$lt{'curr'}</th>
                   1461:         <th>$lt{'actn'}?</th>
1.43      raeburn  1462:        </tr>
1.82      albertel 1463: END
                   1464:     $r->print(&Apache::loncommon::start_data_table_row());
                   1465:     $r->print(<<"END");
1.43      raeburn  1466:        <td>$lt{'disa'}</td>
                   1467:        <td>$lt{$discdisp}</td>
1.82      albertel 1468:        <td><label><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" />&nbsp;$lt{'chgt'} "$dispchange"</label></td>
                   1469: END
                   1470:     $r->print(&Apache::loncommon::end_data_table_row().
                   1471: 	      &Apache::loncommon::start_data_table_row());
                   1472:     $r->print(<<"END");
1.43      raeburn  1473:        <td>$lt{'npmr'}</td>
                   1474:        <td>$lt{$discmark}</td>
1.82      albertel 1475:        <td><label><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" />&nbsp;$lt{'chgt'} "$markchange"</label></td>
1.43      raeburn  1476:       </tr>
1.82      albertel 1477: END
                   1478:     $r->print(&Apache::loncommon::end_data_table_row().
                   1479: 	      &Apache::loncommon::end_data_table());
                   1480:     $r->print(<<"END");
1.43      raeburn  1481: <br />
                   1482: <br />
1.101     albertel 1483: <input type="submit" name="sub" value="Save Changes" />
1.43      raeburn  1484: <br />
                   1485: <br />
                   1486: Note: $lt{'thde'}
                   1487: </form>
                   1488: END
1.42      raeburn  1489: }
                   1490:                                                                                                                 
                   1491: sub verify_and_change_discussion {
                   1492:     my $r = shift;
1.59      albertel 1493:     my $user     = $env{'user.name'};
                   1494:     my $domain   = $env{'user.domain'};
1.42      raeburn  1495:     my $message='';
1.59      albertel 1496:     if (defined($env{'form.discdisp'}) ) {
                   1497:         my $newdisp  = $env{'form.newdisp'};
1.43      raeburn  1498:         if ($newdisp eq 'unread') {
1.110     bisitz   1499:             $message .=&mt('In discussions: only new posts will be displayed.').'<br />';
1.43      raeburn  1500:             &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
                   1501:             &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
                   1502:         } else {
1.110     bisitz   1503:             $message .= &mt('In discussions: all posts will be displayed.').'<br />';
1.43      raeburn  1504:             &Apache::lonnet::del('environment',['discdisplay']);
                   1505:             &Apache::lonnet::delenv('environment\.discdisplay');
                   1506:         }
                   1507:     }
1.59      albertel 1508:     if (defined($env{'form.discmark'}) ) {
                   1509:         my $newmark = $env{'form.newmark'};
1.43      raeburn  1510:         if ($newmark eq 'ondisp') {
1.110     bisitz   1511:            $message.=&mt('In discussions: new posts will be cease to be identified as "NEW" after display.').'<br />';
1.43      raeburn  1512:             &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
                   1513:             &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
                   1514:         } else {
1.110     bisitz   1515:             $message.=&mt('In discussions: posts will be identified as "NEW" until marked as read by the reader.').'<br />';
1.43      raeburn  1516:             &Apache::lonnet::del('environment',['discmarkread']);
                   1517:             &Apache::lonnet::delenv('environment\.discmarkread');
                   1518:         }
1.42      raeburn  1519:     }
                   1520:     $r->print(<<ENDVCSCREEN);
                   1521: $message
                   1522: ENDVCSCREEN
                   1523: }
                   1524: 
1.63      raeburn  1525: ################################################################
                   1526: # Subroutines for page display on course access (Course Coordinators)
                   1527: ################################################################
                   1528: sub coursedisplaychanger {
                   1529:     my $r = shift;
                   1530:     my $user       = $env{'user.name'};
                   1531:     my $domain     = $env{'user.domain'};
1.66      albertel 1532:     my %userenv = &Apache::lonnet::get('environment',['course_init_display']);
1.71      raeburn  1533:     my $currvalue = 'whatsnew';
1.73      albertel 1534:     my $firstselect = '';
                   1535:     my $whatsnewselect = 'checked="checked"';
1.71      raeburn  1536:     if (exists($userenv{'course_init_display'})) {
                   1537:         if ($userenv{'course_init_display'} eq 'firstres') {
                   1538:             $currvalue = 'firstres';
1.73      albertel 1539:             $firstselect = 'checked="checked"';
                   1540: 	    $whatsnewselect = '';
1.71      raeburn  1541:         }
1.63      raeburn  1542:     }
1.71      raeburn  1543:     my %pagenames = (
                   1544:                        firstres => 'First resource',
                   1545:                        whatsnew => "What's new page",
                   1546:                     );
1.70      raeburn  1547:     my $whatsnew_off=&mt('Display the [_1] in the course.','<b>first resource</b>');
                   1548:     my $whatsnew_on=&mt('Display the "[_1]" page - a summary of items in the course which require attention.',"<b>What's New</b>");
1.63      raeburn  1549: 
1.71      raeburn  1550:     $r->print('<br /><b>'.&mt('Set the default page to be displayed when you select a course role').'</b>&nbsp;'.&mt('(Currently: [_1])',$pagenames{$currvalue}).'<br />'.&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]" page in the course',"<i>What's New</i>").'<br /><br />');
1.63      raeburn  1551:     $r->print(<<ENDLSCREEN);
1.88      albertel 1552: <form name="prefs" action="/adm/preferences" method="post">
1.63      raeburn  1553: <input type="hidden" name="action" value="verify_and_change_coursepage" />
1.72      albertel 1554: <br />
1.65      albertel 1555: <label><input type="radio" name="newdisp" value="firstres" $firstselect /> $whatsnew_off</label><br />
1.70      raeburn  1556: <label><input type="radio" name="newdisp" value="whatsnew" $whatsnewselect /> $whatsnew_on</label><input type="hidden" name="refpage" value="$env{'form.refpage'}" />
1.63      raeburn  1557: ENDLSCREEN
1.70      raeburn  1558:     $r->print('<br /><br /><input type="submit" value="'.&mt('Change').'" />
1.63      raeburn  1559: </form>');
                   1560: }
                   1561: 
                   1562: sub verify_and_change_coursepage {
                   1563:     my $r = shift;
                   1564:     my $message='';
                   1565:     my %lt = &Apache::lonlocal::texthash(
1.70      raeburn  1566:         'defs' => 'Default now set',
1.71      raeburn  1567:         'when' => 'when you select a course role from the roles screen',
1.63      raeburn  1568:         'ywbt' => 'you will be taken to the start of the course.',
                   1569:         'apwb' => 'a page will be displayed that lists items in the course that may require action from you.',
                   1570:         'gtts' => 'Go to the start of the course',
1.70      raeburn  1571:         'dasp' => "Display the What's New page listing course action items", 
1.63      raeburn  1572:     );
                   1573:     my $newdisp  = $env{'form.newdisp'};
1.70      raeburn  1574:     $message = '<b>'.$lt{'defs'}.'</b>: '.$lt{'when'}.', ';
1.63      raeburn  1575:     if ($newdisp eq 'firstres') {
1.87      albertel 1576:         $message .= $lt{'ywbt'}.'<br />';
1.63      raeburn  1577:         &Apache::lonnet::put('environment',{'course_init_display' => $newdisp});
                   1578:         &Apache::lonnet::appenv('environment.course_init_display' => $newdisp);
                   1579:     } else {
1.87      albertel 1580:         $message .= $lt{'apwb'}.'<br />';
1.63      raeburn  1581:         &Apache::lonnet::del('environment',['course_init_display']);
                   1582:         &Apache::lonnet::delenv('environment\.course_init_display');
                   1583:     }
1.70      raeburn  1584:     my $refpage = $env{'form.refpage'};
1.63      raeburn  1585:     if (($env{'request.course.fn'}) && ($env{'request.course.id'})) {
                   1586:         if ($newdisp eq 'firstres') {
                   1587:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1588:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 
                   1589:             my ($furl,$ferr)=
                   1590:                 &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
                   1591:             $message .= '<br /><font size="+1"><a href="'.$furl.'">'.$lt{'gtts'}.' <i>'.&mt('now').'</i></a></font>';
                   1592:         } else {
1.70      raeburn  1593:             $message .= '<br /><font size="+1"><a href="/adm/whatsnew?refpage='.
                   1594:                         $refpage.'">'.$lt{'dasp'}.'</a></font>';
1.63      raeburn  1595:         }
                   1596:     }
                   1597:     $r->print(<<ENDVCSCREEN);
                   1598: $message
                   1599: <br /><br />
                   1600: ENDVCSCREEN
                   1601: }
                   1602: 
                   1603: 
1.4       matthew  1604: ######################################################
                   1605: #            other handler subroutines               #
                   1606: ######################################################
                   1607: 
1.3       matthew  1608: ################################################################
                   1609: #                          Main handler                        #
                   1610: ################################################################
1.1       www      1611: sub handler {
                   1612:     my $r = shift;
1.59      albertel 1613:     my $user = $env{'user.name'};
                   1614:     my $domain = $env{'user.domain'};
1.31      www      1615:     &Apache::loncommon::content_type($r,'text/html');
1.4       matthew  1616:     # Some pages contain DES keys and should not be cached.
                   1617:     &Apache::loncommon::no_cache($r);
1.1       www      1618:     $r->send_http_header;
                   1619:     return OK if $r->header_only;
1.9       matthew  1620:     #
1.35      matthew  1621:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.70      raeburn  1622:                                    ['action','wysiwyg','returnurl','refpage']);
1.35      matthew  1623:     #
                   1624:     &Apache::lonhtmlcommon::clear_breadcrumbs();
                   1625:     &Apache::lonhtmlcommon::add_breadcrumb
                   1626:         ({href => '/adm/preferences',
                   1627:           text => 'Set User Preferences'});
                   1628: 
                   1629:     my @Options;
                   1630:     # Determine current authentication method
                   1631:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                   1632:     if ($currentauth =~ /^(unix|internal):/) {
                   1633:         push (@Options,({ action   => 'changepass',
1.40      www      1634:                           linktext => 'Change Password',
1.35      matthew  1635:                           href     => '/adm/preferences',
                   1636:                           help     => 'Change_Password',
                   1637:                           subroutine => \&passwordchanger,
                   1638:                           breadcrumb => 
                   1639:                               { href => '/adm/preferences?action=changepass',
                   1640:                                 text => 'Change Password'},
                   1641:                           },
                   1642:                         { action => 'verify_and_change_pass',
                   1643:                           subroutine => \&verify_and_change_password,
                   1644:                           breadcrumb => 
                   1645:                               { href =>'/adm/preferences?action=changepass',
                   1646:                                 text => 'Change Password'},
1.75      albertel 1647:                           printmenu => 'not_on_error',
1.35      matthew  1648:                           }));
                   1649:     }
                   1650:     push (@Options,({ action   => 'changescreenname',
                   1651:                       linktext => 'Change Screen Name',
                   1652:                       href     => '/adm/preferences',
                   1653:                       help     => 'Prefs_Screen_Name_Nickname',
                   1654:                       subroutine => \&screennamechanger,
                   1655:                       breadcrumb => 
                   1656:                           { href => '/adm/preferences?action=changescreenname',
                   1657:                             text => 'Change Screen Name'},
                   1658:                       },
                   1659:                     { action   => 'verify_and_change_screenname',
                   1660:                       subroutine => \&verify_and_change_screenname,
                   1661:                       breadcrumb => 
                   1662:                           { href => '/adm/preferences?action=changescreenname',
                   1663:                             text => 'Change Screen Name'},
                   1664:                       printmenu => 'yes',
                   1665:                       }));
                   1666: 
                   1667:     push (@Options,({ action   => 'changemsgforward',
1.97      raeburn  1668:                       linktext => 'Change Message Forwarding and Notification Email Addresses',
1.35      matthew  1669:                       href     => '/adm/preferences',
                   1670:                       help     => 'Prefs_Forwarding',
                   1671:                       breadcrumb => 
                   1672:                           { href => '/adm/preferences?action=changemsgforward',
                   1673:                             text => 'Change Message Forwarding'},
                   1674:                       subroutine => \&msgforwardchanger,
                   1675:                       },
                   1676:                     { action => 'verify_and_change_msgforward',
                   1677:                       breadcrumb => 
                   1678:                           { href => '/adm/preferences?action=changemsgforward',
                   1679:                             text => 'Change Message Forwarding'},
1.102     raeburn  1680:                       printmenu => 'no',
1.35      matthew  1681:                       subroutine => \&verify_and_change_msgforward }));
                   1682:     my $aboutmeaction=
1.59      albertel 1683:         '/adm/'.$env{'user.domain'}.'/'.$env{'user.name'}.'/aboutme';
1.35      matthew  1684:     push (@Options,{ action => 'none', 
                   1685:                      linktext =>
1.41      www      1686:                          q{Edit the 'About Me' Personal Information Screen},
1.45      www      1687: 		     help => 'Prefs_About_Me',
1.35      matthew  1688:                      href => $aboutmeaction});
                   1689:     push (@Options,({ action => 'changecolors',
                   1690:                       linktext => 'Change Color Scheme',
                   1691:                       href => '/adm/preferences',
                   1692:                       help => 'Change_Colors',
                   1693:                       breadcrumb => 
                   1694:                           { href => '/adm/preferences?action=changecolors',
                   1695:                             text => 'Change Colors'},
                   1696:                       subroutine => \&colorschanger,
                   1697:                   },
                   1698:                     { action => 'verify_and_change_colors',
                   1699:                       breadcrumb => 
                   1700:                           { href => '/adm/preferences?action=changecolors',
                   1701:                             text => 'Change Colors'},
                   1702:                       printmenu => 'yes',
                   1703:                       subroutine => \&verify_and_change_colors,
                   1704:                       }));
                   1705:     push (@Options,({ action => 'changelanguages',
1.39      www      1706:                       linktext => 'Change Language Preferences',
1.35      matthew  1707:                       href => '/adm/preferences',
1.45      www      1708: 		      help => 'Prefs_Language',
1.35      matthew  1709:                       breadcrumb=>
                   1710:                           { href => '/adm/preferences?action=changelanguages',
                   1711:                             text => 'Change Language'},
                   1712:                       subroutine =>  \&languagechanger,
                   1713:                   },
                   1714:                     { action => 'verify_and_change_languages',
                   1715:                       breadcrumb=>
                   1716:                           {href => '/adm/preferences?action=changelanguages',
                   1717:                            text => 'Change Language'},
                   1718:                       printmenu => 'yes',
                   1719:                       subroutine=>\&verify_and_change_languages, }
                   1720:                     ));
1.44      www      1721:     push (@Options,({ action => 'changewysiwyg',
                   1722:                       linktext => 'Change WYSIWYG Editor Preferences',
                   1723:                       href => '/adm/preferences',
                   1724:                       breadcrumb => 
                   1725:                             { href => '/adm/preferences?action=changewysiwyg',
                   1726:                               text => 'Change WYSIWYG Preferences'},
                   1727:                       subroutine => \&wysiwygchanger,
                   1728:                   },
                   1729:                     { action => 'set_wysiwyg',
                   1730:                       breadcrumb =>
                   1731:                           { href => '/adm/preferences?action=changewysiwyg',
                   1732:                             text => 'Change WYSIWYG Preferences'},
                   1733:                       printmenu => 'yes',
                   1734:                       subroutine => \&verify_and_change_wysiwyg, }
                   1735:                     ));
1.42      raeburn  1736:     push (@Options,({ action => 'changediscussions',
                   1737:                       linktext => 'Change Discussion Display Preferences',
                   1738:                       href => '/adm/preferences',
1.46      raeburn  1739:                       help => 'Change_Discussion_Display',
1.42      raeburn  1740:                       breadcrumb => 
                   1741:                             { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1742:                               text => 'Change Discussion Preferences'},
1.42      raeburn  1743:                       subroutine => \&discussionchanger,
                   1744:                   },
                   1745:                     { action => 'verify_and_change_discussion',
                   1746:                       breadcrumb =>
                   1747:                           { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1748:                             text => 'Change Discussion Preferences'},
1.42      raeburn  1749:                       printmenu => 'yes',
                   1750:                       subroutine => \&verify_and_change_discussion, }
                   1751:                     ));
1.96      albertel 1752: 
                   1753:     my $role = ($env{'user.adv'} ? 'Roles' : 'Course');
1.50      albertel 1754:     push (@Options,({ action   => 'changerolespref',
1.96      albertel 1755:                       linktext => 'Change '.$role.' Page Preferences',
1.50      albertel 1756:                       href     => '/adm/preferences',
                   1757:                       subroutine => \&rolesprefchanger,
                   1758:                       breadcrumb =>
                   1759:                           { href => '/adm/preferences?action=changerolespref',
1.96      albertel 1760:                             text => 'Change '.$role.' Page Pref'},
1.50      albertel 1761:                       },
                   1762:                     { action   => 'verify_and_change_rolespref',
                   1763:                       subroutine => \&verify_and_change_rolespref,
                   1764:                       breadcrumb =>
                   1765:                           { href => '/adm/preferences?action=changerolespref',
1.96      albertel 1766:                             text => 'Change '.$role.' Page Preferences'},
1.50      albertel 1767:                       printmenu => 'yes',
                   1768:                       }));
                   1769: 
1.54      albertel 1770:     push (@Options,({ action   => 'changetexenginepref',
                   1771:                       linktext => 'Change How Math Equations Are Displayed',
                   1772:                       href     => '/adm/preferences',
                   1773:                       subroutine => \&texenginechanger,
                   1774:                       breadcrumb =>
                   1775:                           { href => '/adm/preferences?action=changetexenginepref',
                   1776:                             text => 'Change Math Pref'},
                   1777:                       },
                   1778:                     { action   => 'verify_and_change_texengine',
                   1779:                       subroutine => \&verify_and_change_texengine,
                   1780:                       breadcrumb =>
                   1781:                           { href => '/adm/preferences?action=changetexenginepref',
                   1782:                             text => 'Change Math Preferences'},
                   1783:                       printmenu => 'yes',
                   1784:                       }));
1.85      albertel 1785: 
                   1786:     if ($env{'environment.remote'} eq 'off') {
                   1787: 	push (@Options,({ action => 'launch',
                   1788: 			  linktext => 'Launch Remote Control',
                   1789: 			  href => '/adm/remote?url=/adm/preferences',
                   1790: 		      }));
                   1791:     } else {
                   1792: 	push (@Options,({ action => 'collapse',
                   1793: 			  linktext => 'Collapse Remote Control',
                   1794: 			  href => '/adm/remote?url=/adm/preferences',
                   1795: 		      }));
                   1796:     }
                   1797: 
1.98      www      1798:     push (@Options,({ action   => 'changeicons',
1.100     www      1799:                       linktext => 'Change How Menus are Displayed',
1.98      www      1800:                       href     => '/adm/preferences',
                   1801:                       subroutine => \&iconchanger,
                   1802:                       breadcrumb =>
                   1803:                           { href => '/adm/preferences?action=changeicons',
                   1804:                             text => 'Change Main Menu'},
                   1805:                       },
                   1806:                     { action   => 'verify_and_change_icons',
                   1807:                       subroutine => \&verify_and_change_icons,
                   1808:                       breadcrumb =>
                   1809:                           { href => '/adm/preferences?action=changeicons',
                   1810:                             text => 'Change Main Menu'},
                   1811:                       printmenu => 'yes',
                   1812:                       }));
                   1813: 
1.106     www      1814:     push (@Options,({ action   => 'changeclicker',
                   1815:                       linktext => 'Register Response Devices ("Clickers")',
                   1816:                       href     => '/adm/preferences',
                   1817:                       subroutine => \&clickerchanger,
                   1818:                       breadcrumb =>
                   1819:                           { href => '/adm/preferences?action=changeicons',
                   1820:                             text => 'Register Clicker'},
                   1821:                       },
                   1822:                     { action   => 'verify_and_change_clicker',
                   1823:                       subroutine => \&verify_and_change_clicker,
                   1824:                       breadcrumb =>
                   1825:                           { href => '/adm/preferences?action=changeclicker',
                   1826:                             text => 'Register Clicker'},
                   1827:                       printmenu => 'yes',
                   1828:                       }));
1.105     www      1829: 
                   1830: 
1.74      albertel 1831:     if (&Apache::lonnet::allowed('whn',$env{'request.course.id'})
                   1832: 	|| &Apache::lonnet::allowed('whn',$env{'request.course.id'}.'/'
                   1833: 				    .$env{'request.course.sec'})) {
1.63      raeburn  1834:         push (@Options,({ action => 'changecourseinit',
                   1835:                           linktext => 'Change Course Initialization Preference',
                   1836:                           href => '/adm/preferences',
                   1837:                           subroutine => \&coursedisplaychanger,
                   1838:                           breadcrumb =>
                   1839:                               { href => '/adm/preferences?action=changecourseinit',
                   1840:                                 text => 'Change Course Init. Pref.'},
                   1841:                           },
                   1842:                         { action => 'verify_and_change_coursepage',
                   1843:                           breadcrumb =>
                   1844:                           { href => '/adm/preferences?action=changecourseinit',                               text => 'Change Course Initialization Preference'},
                   1845:                         printmenu => 'yes',
                   1846:                         subroutine => \&verify_and_change_coursepage,
                   1847:                        }));
                   1848:     }
1.50      albertel 1849: 
1.62      raeburn  1850:     if ($env{'user.name'} =~ /^(albertel|fox|foxr|koretemey|korte|hallmat3|turtle|raeburn)$/) {
1.35      matthew  1851:         push (@Options,({ action => 'debugtoggle',
                   1852:                           printmenu => 'yes',
                   1853:                           subroutine => \&toggle_debug,
                   1854:                           }));
                   1855:     }
1.76      albertel 1856: 
                   1857:     $r->print(&Apache::loncommon::start_page('Change Preferences'));
                   1858: 
1.35      matthew  1859:     my $call = undef;
1.48      albertel 1860:     my $help = undef;
1.35      matthew  1861:     my $printmenu = 'yes';
                   1862:     foreach my $option (@Options) {
1.59      albertel 1863:         if ($option->{'action'} eq $env{'form.action'}) {
1.35      matthew  1864:             $call = $option->{'subroutine'};
                   1865:             $printmenu = $option->{'printmenu'};
                   1866:             if (exists($option->{'breadcrumb'})) {
                   1867:                 &Apache::lonhtmlcommon::add_breadcrumb
                   1868:                     ($option->{'breadcrumb'});
                   1869:             }
1.48      albertel 1870: 	    $help=$option->{'help'};
1.35      matthew  1871:         }
                   1872:     }
1.81      albertel 1873:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Change Preferences',$help));
1.75      albertel 1874:     my $error;
1.35      matthew  1875:     if (defined($call)) {
1.75      albertel 1876:         $error = $call->($r);
1.35      matthew  1877:     }
1.75      albertel 1878:     if ( ( ($printmenu eq 'yes')
                   1879: 	   || ($printmenu eq 'not_on_error' && !$error) )
                   1880: 	 && (!$env{'form.returnurl'})) {
1.35      matthew  1881:         my $optionlist = '<table cellpadding="5">';
1.59      albertel 1882:         if ($env{'user.name'} =~ 
1.62      raeburn  1883:                          /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle|raeburn)$/
1.35      matthew  1884:             ) {
                   1885:             push (@Options,({ action => 'debugtoggle',
                   1886:                               linktext => 'Toggle Debug Messages',
                   1887:                               text => 'Current Debug status is -'.
1.59      albertel 1888:                                   $env{'user.debug'}.'-.',
1.35      matthew  1889:                               href => '/adm/preferences',
                   1890:                               printmenu => 'yes',
                   1891:                               subroutine => \&toggle_debug,
                   1892:                               }));
                   1893:         }
                   1894:         foreach my $option(@Options) {
                   1895:             my $optiontext = '';
                   1896:             if (exists($option->{'href'})) {
1.85      albertel 1897: 		$option->{'href_args'}{'action'}=$option->{'action'};
                   1898: 		$optiontext .= 
                   1899:                     '<a href="'.&add_get_param($option->{'href'},
                   1900: 					       $option->{'href_args'}).'">'.
1.47      albertel 1901:                     &mt($option->{'linktext'}).'</a>';
1.35      matthew  1902:             }
                   1903:             if (exists($option->{'text'})) {
1.47      albertel 1904:                 $optiontext .= ' '.&mt($option->{'text'});
1.35      matthew  1905:             }
                   1906:             if ($optiontext ne '') {
                   1907:                 $optiontext = '<font size="+1">'.$optiontext.'</font>'; 
                   1908:                 my $helplink = '&nbsp;';
                   1909:                 if (exists($option->{'help'})) {
                   1910:                     $helplink = &Apache::loncommon::help_open_topic
                   1911:                                                     ($option->{'help'});
                   1912:                 }
                   1913:                 $optionlist .= '<tr>'.
                   1914:                     '<td>'.$helplink.'</td>'.
                   1915:                     '<td>'.$optiontext.'</td>'.
                   1916:                     '</tr>';
                   1917:             }
1.13      www      1918:         }
1.35      matthew  1919:         $optionlist .= '</table>';
                   1920:         $r->print($optionlist);
1.59      albertel 1921:     } elsif ($env{'form.returnurl'}) {
                   1922: 	$r->print('<br /><a href="'.$env{'form.returnurl'}.'"><font size="+1">'.
1.44      www      1923: 		  &mt('Return').'</font></a>');
1.3       matthew  1924:     }
1.76      albertel 1925:     $r->print(&Apache::loncommon::end_page());
1.1       www      1926:     return OK;
1.35      matthew  1927: }
                   1928: 
                   1929: sub toggle_debug {
1.59      albertel 1930:     if ($env{'user.debug'}) {
1.35      matthew  1931:         &Apache::lonnet::delenv('user\.debug');
                   1932:     } else {
                   1933:         &Apache::lonnet::appenv('user.debug' => 1);
                   1934:     }
1.13      www      1935: }
1.1       www      1936: 
                   1937: 1;
                   1938: __END__

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