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

1.1       www         1: # The LearningOnline Network
                      2: # Preferences
                      3: #
1.96    ! albertel    4: # $Id: lonpreferences.pm,v 1.95 2006/12/06 22:22:37 albertel 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);
                    171:         $message='Set new preferred languages to '.$newlanguage;
1.28      www       172:     } else {
1.29      www       173:         &Apache::lonnet::del('environment',['languages']);
                    174:         &Apache::lonnet::delenv('environment\.languages');
1.28      www       175:         $message='Reset preferred language';
                    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);
                    265:         $message='Set new preferred math display to '.$newtexengine;
                    266:     } else {
                    267:         &Apache::lonnet::del('environment',['texengine']);
                    268:         &Apache::lonnet::delenv('environment\.texengine');
                    269:         $message='Reset preferred math display.';
                    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.5       www       470:     $r->print(<<ENDSCREEN);
1.88      albertel  471: <form name="prefs" action="/adm/preferences" method="post">
1.6       www       472: <input type="hidden" name="action" value="verify_and_change_screenname" />
1.14      www       473: <br />New screenname (shown if you post anonymously):
1.6       www       474: <input type="text" size="20" value="$screenname" name="screenname" />
1.14      www       475: <br />New nickname (shown if you post non-anonymously):
                    476: <input type="text" size="20" value="$nickname" name="nickname" />
1.6       www       477: <input type="submit" value="Change" />
                    478: </form>
1.5       www       479: ENDSCREEN
                    480: }
1.6       www       481: 
                    482: sub verify_and_change_screenname {
                    483:     my $r = shift;
1.59      albertel  484:     my $user       = $env{'user.name'};
                    485:     my $domain     = $env{'user.domain'};
1.14      www       486: # Screenname
1.59      albertel  487:     my $newscreen  = $env{'form.screenname'};
1.14      www       488:     $newscreen=~s/[^ \w]//g;
1.6       www       489:     my $message='';
                    490:     if ($newscreen) {
1.7       www       491:         &Apache::lonnet::put('environment',{'screenname' => $newscreen});
                    492:         &Apache::lonnet::appenv('environment.screenname' => $newscreen);
1.6       www       493:         $message='Set new screenname to '.$newscreen;
                    494:     } else {
                    495:         &Apache::lonnet::del('environment',['screenname']);
1.7       www       496:         &Apache::lonnet::delenv('environment\.screenname');
1.6       www       497:         $message='Reset screenname';
                    498:     }
1.14      www       499: # Nickname
                    500:     $message.='<br />';
1.59      albertel  501:     $newscreen  = $env{'form.nickname'};
1.14      www       502:     $newscreen=~s/[^ \w]//g;
                    503:     if ($newscreen) {
                    504:         &Apache::lonnet::put('environment',{'nickname' => $newscreen});
                    505:         &Apache::lonnet::appenv('environment.nickname' => $newscreen);
                    506:         $message.='Set new nickname to '.$newscreen;
                    507:     } else {
                    508:         &Apache::lonnet::del('environment',['nickname']);
                    509:         &Apache::lonnet::delenv('environment\.nickname');
                    510:         $message.='Reset nickname';
                    511:     }
1.68      www       512:     &Apache::lonnet::devalidate_cache_new('namescache',$user.':'.$domain);
1.6       www       513:     $r->print(<<ENDVCSCREEN);
                    514: $message
                    515: ENDVCSCREEN
1.20      www       516: }
                    517: 
                    518: ################################################################
                    519: #         Message Forward                                      #
                    520: ################################################################
                    521: 
                    522: sub msgforwardchanger {
                    523:     my $r = shift;
1.59      albertel  524:     my $user       = $env{'user.name'};
                    525:     my $domain     = $env{'user.domain'};
1.26      www       526:     my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
1.20      www       527:     my $msgforward=$userenv{'msgforward'};
                    528:     my $notification=$userenv{'notification'};
                    529:     my $critnotification=$userenv{'critnotification'};
1.25      bowersj2  530:     my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
                    531: 							    "What are forwarding ".
                    532: 							    "and notification ".
                    533: 							    "addresses");
1.27      bowersj2  534:     my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
                    535: 								 "What are critical messages");
                    536: 
1.20      www       537:     $r->print(<<ENDMSG);
1.25      bowersj2  538: $forwardingHelp <br />
1.88      albertel  539: <form name="prefs" action="/adm/preferences" method="post">
1.20      www       540: <input type="hidden" name="action" value="verify_and_change_msgforward" />
                    541: New Forwarding Address(es) (<tt>user:domain,user:domain,...</tt>):
                    542: <input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
                    543: New Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
                    544: <input type="text" size="40" value="$notification" name="notification" /><hr />
                    545: New Critical Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
1.27      bowersj2  546: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
1.20      www       547: <input type="submit" value="Change" />
                    548: </form>
                    549: ENDMSG
                    550: }
                    551: 
                    552: sub verify_and_change_msgforward {
                    553:     my $r = shift;
1.59      albertel  554:     my $user       = $env{'user.name'};
                    555:     my $domain     = $env{'user.domain'};
1.20      www       556:     my $newscreen  = '';
                    557:     my $message='';
1.59      albertel  558:     foreach (split(/\,/,$env{'form.msgforward'})) {
1.20      www       559: 	my ($msuser,$msdomain)=split(/[\@\:]/,$_);
1.95      albertel  560:         $msuser = &LONCAPA::clean_username($msuser);
                    561:         $msdomain = &LONCAPA::clean_domain($msdomain);
1.20      www       562:         if (($msuser) && ($msdomain)) {
                    563: 	    if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
                    564:                $newscreen.=$msuser.':'.$msdomain.',';
                    565: 	   } else {
                    566:                $message.='No such user: '.$msuser.':'.$msdomain.'<br>';
                    567:            }
                    568:         }
                    569:     }
                    570:     $newscreen=~s/\,$//;
                    571:     if ($newscreen) {
                    572:         &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
                    573:         &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
                    574:         $message.='Set new message forwarding to '.$newscreen.'<br />';
                    575:     } else {
                    576:         &Apache::lonnet::del('environment',['msgforward']);
                    577:         &Apache::lonnet::delenv('environment\.msgforward');
                    578:         $message.='Reset message forwarding<br />';
                    579:     }
1.59      albertel  580:     my $notification=$env{'form.notification'};
1.20      www       581:     $notification=~s/\s//gs;
                    582:     if ($notification) {
                    583:         &Apache::lonnet::put('environment',{'notification' => $notification});
                    584:         &Apache::lonnet::appenv('environment.notification' => $notification);
                    585:         $message.='Set message notification address to '.$notification.'<br />';
                    586:     } else {
                    587:         &Apache::lonnet::del('environment',['notification']);
                    588:         &Apache::lonnet::delenv('environment\.notification');
                    589:         $message.='Reset message notification<br />';
                    590:     }
1.59      albertel  591:     my $critnotification=$env{'form.critnotification'};
1.20      www       592:     $critnotification=~s/\s//gs;
                    593:     if ($critnotification) {
                    594:         &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
                    595:         &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
                    596:         $message.='Set critical message notification address to '.$critnotification;
                    597:     } else {
                    598:         &Apache::lonnet::del('environment',['critnotification']);
                    599:         &Apache::lonnet::delenv('environment\.critnotification');
                    600:         $message.='Reset critical message notification<br />';
                    601:     }
                    602:     $r->print(<<ENDVCMSG);
                    603: $message
                    604: ENDVCMSG
1.6       www       605: }
                    606: 
1.12      www       607: ################################################################
1.19      www       608: #         Colors                                               #
1.12      www       609: ################################################################
                    610: 
1.19      www       611: sub colorschanger {
1.12      www       612:     my $r = shift;
1.19      www       613: # figure out colors
1.80      albertel  614:     my $function=&Apache::loncommon::get_users_function();
1.19      www       615:     my $domain=&Apache::loncommon::determinedomain();
                    616:     my %colortypes=('pgbg'  => 'Page Background',
                    617:                     'tabbg' => 'Header Background',
                    618:                     'sidebg'=> 'Header Border',
                    619:                     'font'  => 'Font',
                    620:                     'link'  => 'Un-Visited Link',
                    621:                     'vlink' => 'Visited Link',
                    622:                     'alink' => 'Active Link');
1.82      albertel  623:     my $start_data_table = &Apache::loncommon::start_data_table();
1.19      www       624:     my $chtable='';
1.22      matthew   625:     foreach my $item (sort(keys(%colortypes))) {
1.19      www       626:        my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
1.82      albertel  627:        $chtable.=&Apache::loncommon::start_data_table_row().
1.83      albertel  628: 	   '<td>'.$colortypes{$item}.'</td><td style="background: '.$curcol.
1.19      www       629:         '">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td><td><input name="'.$item.
1.21      www       630:         '" size="10" value="'.$curcol.
                    631: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19      www       632: "','".$curcol."','"
1.82      albertel  633: 	    .$item."','parmform.pres','psub'".');">Select</a></td>'.
1.83      albertel  634: 	    &Apache::loncommon::end_data_table_row()."\n";
1.19      www       635:     }
1.82      albertel  636:     my $end_data_table = &Apache::loncommon::end_data_table();
1.23      matthew   637:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19      www       638:     $r->print(<<ENDCOL);
1.82      albertel  639: <script type="text/javascript">
1.19      www       640: 
                    641:     function pclose() {
                    642:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    643:                  "height=350,width=350,scrollbars=no,menubar=no");
                    644:         parmwin.close();
                    645:     }
                    646: 
1.23      matthew   647:     $pjump_def
1.19      www       648: 
                    649:     function psub() {
                    650:         pclose();
                    651:         if (document.parmform.pres_marker.value!='') {
1.21      www       652:             if (document.parmform.pres_type.value!='') {
1.77      albertel  653:                 eval('document.prefs.'+
1.21      www       654:                      document.parmform.pres_marker.value+
1.19      www       655: 		     '.value=document.parmform.pres_value.value;');
1.21      www       656: 	    }
1.19      www       657:         } else {
                    658:             document.parmform.pres_value.value='';
                    659:             document.parmform.pres_marker.value='';
                    660:         }
                    661:     }
                    662: 
                    663: 
                    664: </script>
1.21      www       665: <form name="parmform">
                    666: <input type="hidden" name="pres_marker" />
                    667: <input type="hidden" name="pres_type" />
                    668: <input type="hidden" name="pres_value" />
                    669: </form>
1.88      albertel  670: <form name="prefs" action="/adm/preferences" method="post">
1.19      www       671: <input type="hidden" name="action" value="verify_and_change_colors" />
1.82      albertel  672: $start_data_table
1.19      www       673: $chtable
1.82      albertel  674: $end_data_table
1.19      www       675: </table>
1.21      www       676: <input type="submit" value="Change Custom Colors" />
                    677: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12      www       678: </form>
1.19      www       679: ENDCOL
1.12      www       680: }
                    681: 
1.19      www       682: sub verify_and_change_colors {
1.12      www       683:     my $r = shift;
1.19      www       684: # figure out colors
1.80      albertel  685:     my $function=&Apache::loncommon::get_users_function();
1.19      www       686:     my $domain=&Apache::loncommon::determinedomain();
                    687:     my %colortypes=('pgbg'  => 'Page Background',
                    688:                     'tabbg' => 'Header Background',
                    689:                     'sidebg'=> 'Header Border',
                    690:                     'font'  => 'Font',
                    691:                     'link'  => 'Un-Visited Link',
                    692:                     'vlink' => 'Visited Link',
                    693:                     'alink' => 'Active Link');
                    694: 
1.12      www       695:     my $message='';
1.21      www       696:     foreach my $item (keys %colortypes) {
1.59      albertel  697:         my $color=$env{'form.'.$item};
1.21      www       698:         my $entry='color.'.$function.'.'.$item;
1.59      albertel  699: 	if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$env{'form.resetall'})) {
1.21      www       700: 	    &Apache::lonnet::put('environment',{$entry => $color});
                    701: 	    &Apache::lonnet::appenv('environment.'.$entry => $color);
                    702: 	    $message.='Set '.$colortypes{$item}.' to '.$color.'<br />';
                    703: 	} else {
                    704: 	    &Apache::lonnet::del('environment',[$entry]);
                    705: 	    &Apache::lonnet::delenv('environment\.'.$entry);
                    706: 	    $message.='Reset '.$colortypes{$item}.'<br />';
                    707: 	}
                    708:     }
1.84      albertel  709:     my $now = time;
                    710:     &Apache::lonnet::put('environment',{'color.timestamp' => $now});
                    711:     &Apache::lonnet::appenv('environment.color.timestamp' => $now);
                    712: 
1.19      www       713:     $r->print(<<ENDVCCOL);
1.12      www       714: $message
1.88      albertel  715: <form name="client" action="/adm/preferences" method="post">
1.21      www       716: <input type="hidden" name="action" value="changecolors" />
                    717: </form>
1.19      www       718: ENDVCCOL
1.12      www       719: }
                    720: 
1.4       matthew   721: ######################################################
                    722: #            password handler subroutines            #
                    723: ######################################################
1.3       matthew   724: sub passwordchanger {
1.94      raeburn   725:     my ($r,$errormessage,$caller,$mailtoken) = @_;
1.4       matthew   726:     # This function is a bit of a mess....
1.3       matthew   727:     # Passwords are encrypted using londes.js (DES encryption)
1.4       matthew   728:     $errormessage = ($errormessage || '');
1.94      raeburn   729:     my ($user,$domain,$currentpass,$defdom);
                    730:     if ((!defined($caller)) || ($caller eq 'preferences')) {
                    731:         $user = $env{'user.name'};
                    732:         $domain = $env{'user.domain'};
                    733:         if (!defined($caller)) {
                    734:             $caller = 'preferences';
                    735:         }
                    736:     } elsif ($caller eq 'reset_by_email') {
                    737:             $defdom = $r->dir_config('lonDefDomain');
                    738:             my %data = &Apache::lonnet::tmpget($mailtoken);
                    739:             if (keys(%data) == 0) {
                    740:                 $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.'));
                    741:                 return;
                    742:             }
                    743:             if (defined($data{time})) {
                    744:                 if (time - $data{'time'} < 7200) {
                    745:                     $user = $data{'username'};
                    746:                     $domain = $data{'domain'};
                    747:                     $currentpass = $data{'temppasswd'};
                    748:                 } else {
                    749:                     $r->print(&mt('Sorry, the token generated when you requested a password reset has expired.').'<br />');
                    750:                     return;
                    751:                 }
                    752:             } else {
                    753:                 $r->print(&mt('Sorry, the URL generated when you requested reset of your password contained incomplete information.').'<br />');
                    754:                 return;
                    755:             }
                    756:    } else {
                    757:         $r->print(&mt('Page requested in unexpected context').'<br />');
                    758:         return;
                    759:     }
1.3       matthew   760:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                    761:     # Check for authentication types that allow changing of the password.
                    762:     return if ($currentauth !~ /^(unix|internal):/);
                    763:     #
                    764:     # Generate keys
                    765:     my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
                    766:     my ($lkey_npass1,$ukey_npass1) = &des_keys();
                    767:     my ($lkey_npass2,$ukey_npass2) = &des_keys();
1.4       matthew   768:     # Store the keys in the log files
1.3       matthew   769:     my $lonhost = $r->dir_config('lonHostID');
                    770:     my $logtoken=Apache::lonnet::reply('tmpput:'
                    771: 				       .$ukey_cpass  . $lkey_cpass .'&'
                    772: 				       .$ukey_npass1 . $lkey_npass1.'&'
                    773: 				       .$ukey_npass2 . $lkey_npass2,
                    774: 				       $lonhost);
1.4       matthew   775:     # Hexify the keys for output as javascript variables
1.94      raeburn   776:     my %hexkey;
                    777:     $hexkey{'ukey_cpass'}  = hex($ukey_cpass);
                    778:     $hexkey{'lkey_cpass'}  = hex($lkey_cpass);
                    779:     $hexkey{'ukey_npass1'} = hex($ukey_npass1);
                    780:     $hexkey{'lkey_npass1'} = hex($lkey_npass1);
                    781:     $hexkey{'ukey_npass2'} = hex($ukey_npass2);
                    782:     $hexkey{'lkey_npass2'} = hex($lkey_npass2);
1.3       matthew   783:     # Output javascript to deal with passwords
1.4       matthew   784:     # Output DES javascript
1.3       matthew   785:     {
                    786: 	my $include = $r->dir_config('lonIncludes');
                    787: 	my $jsh=Apache::File->new($include."/londes.js");
                    788: 	$r->print(<$jsh>);
                    789:     }
1.94      raeburn   790:     $r->print(&jscript_send($caller));
1.3       matthew   791:     $r->print(<<ENDFORM);
1.94      raeburn   792: $errormessage
                    793: 
                    794: <p>
                    795: <!-- We separate the forms into 'server' and 'client' in order to
                    796:      ensure that unencrypted passwords will not be sent out by a
                    797:      crappy browser -->
                    798: ENDFORM
                    799:     $r->print(&server_form($logtoken,$caller,$mailtoken));
                    800:     $r->print(&client_form($caller,\%hexkey,$currentpass,$defdom));
                    801: 
                    802:     #
                    803:     return;
                    804: }
                    805: 
                    806: sub jscript_send {
                    807:     my ($caller) = @_;
                    808:     my $output = qq|
1.3       matthew   809: <script language="JavaScript">
                    810: 
                    811:     function send() {
                    812:         uextkey=this.document.client.elements.ukey_cpass.value;
                    813:         lextkey=this.document.client.elements.lkey_cpass.value;
                    814:         initkeys();
                    815: 
1.52      raeburn   816:         this.document.pserver.elements.currentpass.value
1.3       matthew   817:             =crypted(this.document.client.elements.currentpass.value);
                    818: 
                    819:         uextkey=this.document.client.elements.ukey_npass1.value;
                    820:         lextkey=this.document.client.elements.lkey_npass1.value;
                    821:         initkeys();
1.52      raeburn   822:         this.document.pserver.elements.newpass_1.value
1.3       matthew   823:             =crypted(this.document.client.elements.newpass_1.value);
                    824: 
                    825:         uextkey=this.document.client.elements.ukey_npass2.value;
                    826:         lextkey=this.document.client.elements.lkey_npass2.value;
                    827:         initkeys();
1.52      raeburn   828:         this.document.pserver.elements.newpass_2.value
1.3       matthew   829:             =crypted(this.document.client.elements.newpass_2.value);
1.94      raeburn   830: |;
                    831:     if ($caller eq 'reset_by_email') {
                    832:         $output .= qq|
                    833:         this.document.pserver.elements.uname.value =
                    834:                    this.document.client.elements.uname.value;
                    835:         this.document.pserver.elements.udom.value =
                    836:                    this.document.client.elements.udom.options[this.document.client.elements.udom.selectedIndex].value;
                    837: |;
                    838:     }
                    839:     $ output .= qq|
1.52      raeburn   840:         this.document.pserver.submit();
1.3       matthew   841:     }
                    842: </script>
1.94      raeburn   843: |;
                    844: }
1.3       matthew   845: 
1.94      raeburn   846: sub client_form {
                    847:     my ($caller,$hexkey,$currentpass,$defdom) = @_;
                    848:     my $output = qq|
1.3       matthew   849: <form name="client" >
                    850: <table>
1.94      raeburn   851: |;
                    852:     if ($caller eq 'reset_by_email') {
                    853:         $output .= qq|
                    854: <tr><td align="right"> E-mail address:                        </td>
                    855:     <td><input type="text" name="email" size="15" /> </td></tr>
                    856: <tr><td align="right"> Username:                        </td>
                    857:     <td>
                    858:      <input type="text" name="uname" size="10" />
                    859:      <input type="hidden" name="currentpass" value="$currentpass" />
                    860:     </td></tr>
                    861: <tr><td align="right"> Domain:                               </td>
                    862:     <td>
                    863: |;
                    864:         $output .= &Apache::loncommon::select_dom_form($defdom,'udom').'
                    865:    </td>
                    866: </tr>
                    867: ';
                    868:     } else {
                    869:         $output .= qq|
1.4       matthew   870: <tr><td align="right"> Current password:                      </td>
                    871:     <td><input type="password" name="currentpass" size="10"/> </td></tr>
1.94      raeburn   872: |;
                    873:     }
                    874:     $output .= <<"ENDFORM";
1.4       matthew   875: <tr><td align="right"> New password:                          </td>
                    876:     <td><input type="password" name="newpass_1" size="10"  /> </td></tr>
                    877: <tr><td align="right"> Confirm password:                      </td>
                    878:     <td><input type="password" name="newpass_2" size="10"  /> </td></tr>
1.3       matthew   879: <tr><td colspan="2" align="center">
                    880:     <input type="button" value="Change Password" onClick="send();">
                    881: </table>
1.94      raeburn   882: <input type="hidden" name="ukey_cpass"  value="$hexkey->{'ukey_cpass'}" />
                    883: <input type="hidden" name="lkey_cpass"  value="$hexkey->{'lkey_cpass'}" />
                    884: <input type="hidden" name="ukey_npass1" value="$hexkey->{'ukey_npass1'}" />
                    885: <input type="hidden" name="lkey_npass1" value="$hexkey->{'lkey_npass1'}" />
                    886: <input type="hidden" name="ukey_npass2" value="$hexkey->{'ukey_npass2'}" />
                    887: <input type="hidden" name="lkey_npass2" value="$hexkey->{'lkey_npass2'}" />
1.3       matthew   888: </form>
                    889: </p>
                    890: ENDFORM
1.94      raeburn   891:     return $output;
                    892: }
                    893: 
                    894: sub server_form {
                    895:     my ($logtoken,$caller,$mailtoken) = @_;
                    896:     my $action = '/adm/preferences';
                    897:     if ($caller eq 'reset_by_email') {
                    898:         $action = '/adm/resetpw';
                    899:     }
                    900:     my $output = qq|
                    901: <form name="pserver" action="$action" method="post">
                    902: <input type="hidden" name="logtoken"    value="$logtoken" />
                    903: <input type="hidden" name="currentpass" value="" />
                    904: <input type="hidden" name="newpass_1"   value="" />
                    905: <input type="hidden" name="newpass_2"   value="" />
                    906:     |;
                    907:     if ($caller eq 'reset_by_email') {
                    908:         $output .=  qq|
                    909: <input type="hidden" name="token"   value="$mailtoken" />
                    910: <input type="hidden" name="uname"   value="" />
                    911: <input type="hidden" name="udom"   value="" />
                    912: 
                    913: |;
                    914:     }
                    915:     $output .= qq|
                    916: <input type="hidden" name="action" value="verify_and_change_pass" />
                    917: </form>
                    918: |;
                    919:     return $output;
1.3       matthew   920: }
                    921: 
                    922: sub verify_and_change_password {
1.94      raeburn   923:     my ($r,$caller,$mailtoken) = @_;
                    924:     my ($user,$domain,$homeserver);
                    925:     if ($caller eq 'reset_by_email') {
                    926:         $user       = $env{'form.uname'};
                    927:         $domain     = $env{'form.udom'};
                    928:         if ($user ne '' && $domain ne '') {
                    929:             $homeserver = &Apache::lonnet::homeserver($user,$domain);
                    930:             if ($homeserver eq 'no_host') {
                    931:         &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
                    932:                          "Invalid username and/or domain .\n</p>",
                    933:                          $caller,$mailtoken);
                    934:                 return 1;
                    935:             }
                    936:         } else {
                    937:             &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
                    938:                              "Username and Domain were blank.\n</p>",
                    939:                              $caller,$mailtoken);
                    940:             return 1;
                    941:         }
                    942:     } else {
                    943:         $user       = $env{'user.name'};
                    944:         $domain     = $env{'user.domain'};
                    945:         $homeserver = $env{'user.home'};
                    946:     }
1.3       matthew   947:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4       matthew   948:     # Check for authentication types that allow changing of the password.
1.94      raeburn   949:     if ($currentauth !~ /^(unix|internal):/) {
                    950:         if ($caller eq 'reset_by_email') {
                    951:             &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
                    952:                              "Authentication type for this user can not be changed by this mechanism..\n</p>",
                    953:                               $caller,$mailtoken);
                    954:             return 1;
                    955:         } else {
                    956:             return;
                    957:         }
                    958:     }
1.3       matthew   959:     #
1.59      albertel  960:     my $currentpass = $env{'form.currentpass'}; 
                    961:     my $newpass1    = $env{'form.newpass_1'}; 
                    962:     my $newpass2    = $env{'form.newpass_2'};
                    963:     my $logtoken    = $env{'form.logtoken'};
1.3       matthew   964:     # Check for empty data 
1.4       matthew   965:     unless (defined($currentpass) && 
                    966: 	    defined($newpass1)    && 
                    967: 	    defined($newpass2)    ){
                    968: 	&passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
1.94      raeburn   969: 			 "One or more password fields were blank.\n</p>",$caller,$mailtoken);
1.3       matthew   970: 	return;
                    971:     }
1.16      albertel  972:     # Get the keys
                    973:     my $lonhost = $r->dir_config('lonHostID');
1.3       matthew   974:     my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
                    975:     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4       matthew   976:         # I do not a have a better idea about how to handle this
1.94      raeburn   977:         my $tryagain_text = &mt('Please log out and try again.');
                    978:         if ($caller eq 'reset_by_email') {
                    979:             $tryagain_text = &mt('Please try again later.');
                    980:         }
1.3       matthew   981: 	$r->print(<<ENDERROR);
                    982: <p>
                    983: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
1.94      raeburn   984: password decryption.  $tryagain_text
1.3       matthew   985: </p>
                    986: ENDERROR
1.4       matthew   987:         # Probably should log an error here
1.75      albertel  988:         return 1;
1.3       matthew   989:     }
                    990:     my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4       matthew   991:     # 
1.17      matthew   992:     $currentpass = &des_decrypt($ckey ,$currentpass);
                    993:     $newpass1    = &des_decrypt($n1key,$newpass1);
                    994:     $newpass2    = &des_decrypt($n2key,$newpass2);
1.94      raeburn   995:     #
                    996:     if ($caller eq 'reset_by_email') {
                    997:         my %data = &Apache::lonnet::tmpget($mailtoken);
                    998:         if ($currentpass ne $data{'temppasswd'}) {
                    999:             &passwordchanger($r,
                   1000:                          '<font color="#ff0000">ERROR:</font>'.
                   1001:                          'Could not verify current authentication.  '.
                   1002:                          'Please try again.',$caller,$mailtoken);
                   1003:             return 1;
                   1004:         }
                   1005:     } 
1.3       matthew  1006:     if ($newpass1 ne $newpass2) {
1.4       matthew  1007: 	&passwordchanger($r,
                   1008: 			 '<font color="#ff0000">ERROR:</font>'.
                   1009: 			 'The new passwords you entered do not match.  '.
1.94      raeburn  1010: 			 'Please try again.',$caller,$mailtoken);
1.75      albertel 1011: 	return 1;
1.4       matthew  1012:     }
                   1013:     if (length($newpass1) < 7) {
                   1014: 	&passwordchanger($r,
                   1015: 			 '<font color="#ff0000">ERROR:</font>'.
                   1016: 			 'Passwords must be a minimum of 7 characters long.  '.
1.94      raeburn  1017: 			 'Please try again.',$caller,$mailtoken);
1.75      albertel 1018: 	return 1;
1.3       matthew  1019:     }
1.4       matthew  1020:     #
                   1021:     # Check for bad characters
                   1022:     my $badpassword = 0;
                   1023:     foreach (split(//,$newpass1)) {
                   1024: 	$badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
                   1025:     }
                   1026:     if ($badpassword) {
                   1027: 	# I can't figure out how to enter bad characters on my browser.
1.94      raeburn  1028: 	my $errormessage = <<"ENDERROR";
1.4       matthew  1029: <font color="#ff0000">ERROR:</font>
                   1030: The password you entered contained illegal characters.<br />
                   1031: Valid characters are: space and <br />
                   1032: <pre>
                   1033: !&quot;\#$%&amp;\'()*+,-./0123456789:;&lt;=&gt;?\@
                   1034: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
                   1035: </pre>
                   1036: ENDERROR
1.94      raeburn  1037:         &passwordchanger($r,$errormessage,$caller,$mailtoken);
                   1038:         return 1;
1.4       matthew  1039:     }
                   1040:     # 
                   1041:     # Change the password (finally)
                   1042:     my $result = &Apache::lonnet::changepass
1.94      raeburn  1043: 	($user,$domain,$currentpass,$newpass1,$homeserver,$caller);
1.4       matthew  1044:     # Inform the user the password has (not?) been changed
                   1045:     if ($result =~ /^ok$/) {
                   1046: 	$r->print(<<"ENDTEXT");
1.94      raeburn  1047: <h3>The password for $user was successfully changed</h3>
1.4       matthew  1048: ENDTEXT
                   1049:     } else {
                   1050: 	# error error: run in circles, scream and shout
                   1051:         $r->print(<<ENDERROR);
1.94      raeburn  1052: <h3><font color="#ff0000">The password for $user was not changed</font></h3>
1.8       matthew  1053: Please make sure your old password was entered correctly.
1.4       matthew  1054: ENDERROR
1.75      albertel 1055:         return 1;
1.4       matthew  1056:     }
                   1057:     return;
1.3       matthew  1058: }
                   1059: 
1.42      raeburn  1060: ################################################################
                   1061: #            discussion display subroutines 
                   1062: ################################################################
                   1063: sub discussionchanger {
                   1064:     my $r = shift;
1.59      albertel 1065:     my $user       = $env{'user.name'};
                   1066:     my $domain     = $env{'user.domain'};
1.42      raeburn  1067:     my %userenv = &Apache::lonnet::get
1.43      raeburn  1068:         ('environment',['discdisplay','discmarkread']);
                   1069:     my $discdisp = 'allposts';
                   1070:     my $discmark = 'onmark';
                   1071: 
                   1072:     if (defined($userenv{'discdisplay'})) {
                   1073:         unless ($userenv{'discdisplay'} eq '') { 
                   1074:             $discdisp = $userenv{'discdisplay'};
                   1075:         }
                   1076:     }
                   1077:     if (defined($userenv{'discmarkread'})) {
                   1078:         unless ($userenv{'discdisplay'} eq '') { 
                   1079:             $discmark = $userenv{'discmarkread'};
                   1080:         }
                   1081:     }
                   1082: 
                   1083:     my $newdisp = 'unread';
                   1084:     my $newmark = 'ondisp';
                   1085: 
                   1086:     my $function = &Apache::loncommon::get_users_function();
                   1087:     my $color = &Apache::loncommon::designparm($function.'.tabbg',
1.59      albertel 1088:                                                     $env{'user.domain'});
1.43      raeburn  1089:     my %lt = &Apache::lonlocal::texthash(
                   1090:         'pref' => 'Display Preference',
                   1091:         'curr' => 'Current setting ',
                   1092:         'actn' => 'Action',
                   1093:         'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
                   1094:         'prca' => 'Preferences can be set that determine',
                   1095:         'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
                   1096:         'unwh' => 'Under what circumstances posts are identfied as "New"',
                   1097:         'allposts' => 'All posts',
                   1098:         'unread' => 'New posts only',
                   1099:         'ondisp' => 'Once displayed',
                   1100:         'onmark' => 'Once marked as read',
                   1101:         'disa' => 'Posts displayed?',
                   1102:         'npmr' => 'New posts cease to be identified as "New"?',
                   1103:         'thde'  => 'The preferences you set here can be overridden within each individual discussion.',
                   1104:         'chgt' => 'Change to '
                   1105:     );
                   1106:     my $dispchange = $lt{'unread'};
                   1107:     my $markchange = $lt{'ondisp'};
                   1108:     my $currdisp = $lt{'allposts'};
                   1109:     my $currmark = $lt{'onmark'};
                   1110: 
                   1111:     if ($discdisp eq 'unread') {
                   1112:         $dispchange = $lt{'allposts'};
                   1113:         $currdisp = $lt{'unread'};
                   1114:         $newdisp = 'allposts';
                   1115:     }
                   1116: 
                   1117:     if ($discmark eq 'ondisp') {
                   1118:         $markchange = $lt{'onmark'};
                   1119:         $currmark = $lt{'ondisp'};
                   1120:         $newmark = 'onmark';
1.42      raeburn  1121:     }
1.43      raeburn  1122:     
                   1123:     $r->print(<<"END");
1.88      albertel 1124: <form name="prefs" action="/adm/preferences" method="post">
1.42      raeburn  1125: <input type="hidden" name="action" value="verify_and_change_discussion" />
                   1126: <br />
1.87      albertel 1127: $lt{'sdpf'}<br /> $lt{'prca'}  <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol> 
1.43      raeburn  1128: <br />
                   1129: <br />
1.82      albertel 1130: END
                   1131:     $r->print(&Apache::loncommon::start_data_table());
                   1132:     $r->print(<<"END");
                   1133:        <tr>
                   1134:         <th>$lt{'pref'}</th>
                   1135:         <th>$lt{'curr'}</th>
                   1136:         <th>$lt{'actn'}?</th>
1.43      raeburn  1137:        </tr>
1.82      albertel 1138: END
                   1139:     $r->print(&Apache::loncommon::start_data_table_row());
                   1140:     $r->print(<<"END");
1.43      raeburn  1141:        <td>$lt{'disa'}</td>
                   1142:        <td>$lt{$discdisp}</td>
1.82      albertel 1143:        <td><label><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" />&nbsp;$lt{'chgt'} "$dispchange"</label></td>
                   1144: END
                   1145:     $r->print(&Apache::loncommon::end_data_table_row().
                   1146: 	      &Apache::loncommon::start_data_table_row());
                   1147:     $r->print(<<"END");
1.43      raeburn  1148:        <td>$lt{'npmr'}</td>
                   1149:        <td>$lt{$discmark}</td>
1.82      albertel 1150:        <td><label><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" />&nbsp;$lt{'chgt'} "$markchange"</label></td>
1.43      raeburn  1151:       </tr>
1.82      albertel 1152: END
                   1153:     $r->print(&Apache::loncommon::end_data_table_row().
                   1154: 	      &Apache::loncommon::end_data_table());
                   1155:     $r->print(<<"END");
1.43      raeburn  1156: <br />
                   1157: <br />
                   1158: <input type="submit" name="sub" value="Store Changes" />
                   1159: <br />
                   1160: <br />
                   1161: Note: $lt{'thde'}
                   1162: </form>
                   1163: END
1.42      raeburn  1164: }
                   1165:                                                                                                                 
                   1166: sub verify_and_change_discussion {
                   1167:     my $r = shift;
1.59      albertel 1168:     my $user     = $env{'user.name'};
                   1169:     my $domain   = $env{'user.domain'};
1.42      raeburn  1170:     my $message='';
1.59      albertel 1171:     if (defined($env{'form.discdisp'}) ) {
                   1172:         my $newdisp  = $env{'form.newdisp'};
1.43      raeburn  1173:         if ($newdisp eq 'unread') {
1.87      albertel 1174:             $message .='In discussions: only new posts will be displayed.<br />';
1.43      raeburn  1175:             &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
                   1176:             &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
                   1177:         } else {
1.87      albertel 1178:             $message .= 'In discussions: all posts will be displayed.<br />';
1.43      raeburn  1179:             &Apache::lonnet::del('environment',['discdisplay']);
                   1180:             &Apache::lonnet::delenv('environment\.discdisplay');
                   1181:         }
                   1182:     }
1.59      albertel 1183:     if (defined($env{'form.discmark'}) ) {
                   1184:         my $newmark = $env{'form.newmark'};
1.43      raeburn  1185:         if ($newmark eq 'ondisp') {
1.87      albertel 1186:            $message.='In discussions: new posts will be cease to be identified as "new" after display.<br />';
1.43      raeburn  1187:             &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
                   1188:             &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
                   1189:         } else {
1.87      albertel 1190:             $message.='In discussions: posts will be identified as "new" until marked as read by the reader.<br />';
1.43      raeburn  1191:             &Apache::lonnet::del('environment',['discmarkread']);
                   1192:             &Apache::lonnet::delenv('environment\.discmarkread');
                   1193:         }
1.42      raeburn  1194:     }
                   1195:     $r->print(<<ENDVCSCREEN);
                   1196: $message
                   1197: ENDVCSCREEN
                   1198: }
                   1199: 
1.63      raeburn  1200: ################################################################
                   1201: # Subroutines for page display on course access (Course Coordinators)
                   1202: ################################################################
                   1203: sub coursedisplaychanger {
                   1204:     my $r = shift;
                   1205:     my $user       = $env{'user.name'};
                   1206:     my $domain     = $env{'user.domain'};
1.66      albertel 1207:     my %userenv = &Apache::lonnet::get('environment',['course_init_display']);
1.71      raeburn  1208:     my $currvalue = 'whatsnew';
1.73      albertel 1209:     my $firstselect = '';
                   1210:     my $whatsnewselect = 'checked="checked"';
1.71      raeburn  1211:     if (exists($userenv{'course_init_display'})) {
                   1212:         if ($userenv{'course_init_display'} eq 'firstres') {
                   1213:             $currvalue = 'firstres';
1.73      albertel 1214:             $firstselect = 'checked="checked"';
                   1215: 	    $whatsnewselect = '';
1.71      raeburn  1216:         }
1.63      raeburn  1217:     }
1.71      raeburn  1218:     my %pagenames = (
                   1219:                        firstres => 'First resource',
                   1220:                        whatsnew => "What's new page",
                   1221:                     );
1.70      raeburn  1222:     my $whatsnew_off=&mt('Display the [_1] in the course.','<b>first resource</b>');
                   1223:     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  1224: 
1.71      raeburn  1225:     $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  1226:     $r->print(<<ENDLSCREEN);
1.88      albertel 1227: <form name="prefs" action="/adm/preferences" method="post">
1.63      raeburn  1228: <input type="hidden" name="action" value="verify_and_change_coursepage" />
1.72      albertel 1229: <br />
1.65      albertel 1230: <label><input type="radio" name="newdisp" value="firstres" $firstselect /> $whatsnew_off</label><br />
1.70      raeburn  1231: <label><input type="radio" name="newdisp" value="whatsnew" $whatsnewselect /> $whatsnew_on</label><input type="hidden" name="refpage" value="$env{'form.refpage'}" />
1.63      raeburn  1232: ENDLSCREEN
1.70      raeburn  1233:     $r->print('<br /><br /><input type="submit" value="'.&mt('Change').'" />
1.63      raeburn  1234: </form>');
                   1235: }
                   1236: 
                   1237: sub verify_and_change_coursepage {
                   1238:     my $r = shift;
                   1239:     my $message='';
                   1240:     my %lt = &Apache::lonlocal::texthash(
1.70      raeburn  1241:         'defs' => 'Default now set',
1.71      raeburn  1242:         'when' => 'when you select a course role from the roles screen',
1.63      raeburn  1243:         'ywbt' => 'you will be taken to the start of the course.',
                   1244:         'apwb' => 'a page will be displayed that lists items in the course that may require action from you.',
                   1245:         'gtts' => 'Go to the start of the course',
1.70      raeburn  1246:         'dasp' => "Display the What's New page listing course action items", 
1.63      raeburn  1247:     );
                   1248:     my $newdisp  = $env{'form.newdisp'};
1.70      raeburn  1249:     $message = '<b>'.$lt{'defs'}.'</b>: '.$lt{'when'}.', ';
1.63      raeburn  1250:     if ($newdisp eq 'firstres') {
1.87      albertel 1251:         $message .= $lt{'ywbt'}.'<br />';
1.63      raeburn  1252:         &Apache::lonnet::put('environment',{'course_init_display' => $newdisp});
                   1253:         &Apache::lonnet::appenv('environment.course_init_display' => $newdisp);
                   1254:     } else {
1.87      albertel 1255:         $message .= $lt{'apwb'}.'<br />';
1.63      raeburn  1256:         &Apache::lonnet::del('environment',['course_init_display']);
                   1257:         &Apache::lonnet::delenv('environment\.course_init_display');
                   1258:     }
1.70      raeburn  1259:     my $refpage = $env{'form.refpage'};
1.63      raeburn  1260:     if (($env{'request.course.fn'}) && ($env{'request.course.id'})) {
                   1261:         if ($newdisp eq 'firstres') {
                   1262:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1263:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 
                   1264:             my ($furl,$ferr)=
                   1265:                 &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
                   1266:             $message .= '<br /><font size="+1"><a href="'.$furl.'">'.$lt{'gtts'}.' <i>'.&mt('now').'</i></a></font>';
                   1267:         } else {
1.70      raeburn  1268:             $message .= '<br /><font size="+1"><a href="/adm/whatsnew?refpage='.
                   1269:                         $refpage.'">'.$lt{'dasp'}.'</a></font>';
1.63      raeburn  1270:         }
                   1271:     }
                   1272:     $r->print(<<ENDVCSCREEN);
                   1273: $message
                   1274: <br /><br />
                   1275: ENDVCSCREEN
                   1276: }
                   1277: 
                   1278: 
1.4       matthew  1279: ######################################################
                   1280: #            other handler subroutines               #
                   1281: ######################################################
                   1282: 
1.3       matthew  1283: ################################################################
                   1284: #                          Main handler                        #
                   1285: ################################################################
1.1       www      1286: sub handler {
                   1287:     my $r = shift;
1.59      albertel 1288:     my $user = $env{'user.name'};
                   1289:     my $domain = $env{'user.domain'};
1.31      www      1290:     &Apache::loncommon::content_type($r,'text/html');
1.4       matthew  1291:     # Some pages contain DES keys and should not be cached.
                   1292:     &Apache::loncommon::no_cache($r);
1.1       www      1293:     $r->send_http_header;
                   1294:     return OK if $r->header_only;
1.9       matthew  1295:     #
1.35      matthew  1296:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.70      raeburn  1297:                                    ['action','wysiwyg','returnurl','refpage']);
1.35      matthew  1298:     #
                   1299:     &Apache::lonhtmlcommon::clear_breadcrumbs();
                   1300:     &Apache::lonhtmlcommon::add_breadcrumb
                   1301:         ({href => '/adm/preferences',
                   1302:           text => 'Set User Preferences'});
                   1303: 
                   1304:     my @Options;
                   1305:     # Determine current authentication method
                   1306:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                   1307:     if ($currentauth =~ /^(unix|internal):/) {
                   1308:         push (@Options,({ action   => 'changepass',
1.40      www      1309:                           linktext => 'Change Password',
1.35      matthew  1310:                           href     => '/adm/preferences',
                   1311:                           help     => 'Change_Password',
                   1312:                           subroutine => \&passwordchanger,
                   1313:                           breadcrumb => 
                   1314:                               { href => '/adm/preferences?action=changepass',
                   1315:                                 text => 'Change Password'},
                   1316:                           },
                   1317:                         { action => 'verify_and_change_pass',
                   1318:                           subroutine => \&verify_and_change_password,
                   1319:                           breadcrumb => 
                   1320:                               { href =>'/adm/preferences?action=changepass',
                   1321:                                 text => 'Change Password'},
1.75      albertel 1322:                           printmenu => 'not_on_error',
1.35      matthew  1323:                           }));
                   1324:     }
                   1325:     push (@Options,({ action   => 'changescreenname',
                   1326:                       linktext => 'Change Screen Name',
                   1327:                       href     => '/adm/preferences',
                   1328:                       help     => 'Prefs_Screen_Name_Nickname',
                   1329:                       subroutine => \&screennamechanger,
                   1330:                       breadcrumb => 
                   1331:                           { href => '/adm/preferences?action=changescreenname',
                   1332:                             text => 'Change Screen Name'},
                   1333:                       },
                   1334:                     { action   => 'verify_and_change_screenname',
                   1335:                       subroutine => \&verify_and_change_screenname,
                   1336:                       breadcrumb => 
                   1337:                           { href => '/adm/preferences?action=changescreenname',
                   1338:                             text => 'Change Screen Name'},
                   1339:                       printmenu => 'yes',
                   1340:                       }));
                   1341: 
                   1342:     push (@Options,({ action   => 'changemsgforward',
1.49      albertel 1343:                       linktext => 'Change Message Forwarding and Notification Addresses',
1.35      matthew  1344:                       href     => '/adm/preferences',
                   1345:                       help     => 'Prefs_Forwarding',
                   1346:                       breadcrumb => 
                   1347:                           { href => '/adm/preferences?action=changemsgforward',
                   1348:                             text => 'Change Message Forwarding'},
                   1349:                       subroutine => \&msgforwardchanger,
                   1350:                       },
                   1351:                     { action => 'verify_and_change_msgforward',
                   1352:                       breadcrumb => 
                   1353:                           { href => '/adm/preferences?action=changemsgforward',
                   1354:                             text => 'Change Message Forwarding'},
                   1355:                       printmenu => 'yes',
                   1356:                       subroutine => \&verify_and_change_msgforward }));
                   1357:     my $aboutmeaction=
1.59      albertel 1358:         '/adm/'.$env{'user.domain'}.'/'.$env{'user.name'}.'/aboutme';
1.35      matthew  1359:     push (@Options,{ action => 'none', 
                   1360:                      linktext =>
1.41      www      1361:                          q{Edit the 'About Me' Personal Information Screen},
1.45      www      1362: 		     help => 'Prefs_About_Me',
1.35      matthew  1363:                      href => $aboutmeaction});
                   1364:     push (@Options,({ action => 'changecolors',
                   1365:                       linktext => 'Change Color Scheme',
                   1366:                       href => '/adm/preferences',
                   1367:                       help => 'Change_Colors',
                   1368:                       breadcrumb => 
                   1369:                           { href => '/adm/preferences?action=changecolors',
                   1370:                             text => 'Change Colors'},
                   1371:                       subroutine => \&colorschanger,
                   1372:                   },
                   1373:                     { action => 'verify_and_change_colors',
                   1374:                       breadcrumb => 
                   1375:                           { href => '/adm/preferences?action=changecolors',
                   1376:                             text => 'Change Colors'},
                   1377:                       printmenu => 'yes',
                   1378:                       subroutine => \&verify_and_change_colors,
                   1379:                       }));
                   1380:     push (@Options,({ action => 'changelanguages',
1.39      www      1381:                       linktext => 'Change Language Preferences',
1.35      matthew  1382:                       href => '/adm/preferences',
1.45      www      1383: 		      help => 'Prefs_Language',
1.35      matthew  1384:                       breadcrumb=>
                   1385:                           { href => '/adm/preferences?action=changelanguages',
                   1386:                             text => 'Change Language'},
                   1387:                       subroutine =>  \&languagechanger,
                   1388:                   },
                   1389:                     { action => 'verify_and_change_languages',
                   1390:                       breadcrumb=>
                   1391:                           {href => '/adm/preferences?action=changelanguages',
                   1392:                            text => 'Change Language'},
                   1393:                       printmenu => 'yes',
                   1394:                       subroutine=>\&verify_and_change_languages, }
                   1395:                     ));
1.44      www      1396:     push (@Options,({ action => 'changewysiwyg',
                   1397:                       linktext => 'Change WYSIWYG Editor Preferences',
                   1398:                       href => '/adm/preferences',
                   1399:                       breadcrumb => 
                   1400:                             { href => '/adm/preferences?action=changewysiwyg',
                   1401:                               text => 'Change WYSIWYG Preferences'},
                   1402:                       subroutine => \&wysiwygchanger,
                   1403:                   },
                   1404:                     { action => 'set_wysiwyg',
                   1405:                       breadcrumb =>
                   1406:                           { href => '/adm/preferences?action=changewysiwyg',
                   1407:                             text => 'Change WYSIWYG Preferences'},
                   1408:                       printmenu => 'yes',
                   1409:                       subroutine => \&verify_and_change_wysiwyg, }
                   1410:                     ));
1.42      raeburn  1411:     push (@Options,({ action => 'changediscussions',
                   1412:                       linktext => 'Change Discussion Display Preferences',
                   1413:                       href => '/adm/preferences',
1.46      raeburn  1414:                       help => 'Change_Discussion_Display',
1.42      raeburn  1415:                       breadcrumb => 
                   1416:                             { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1417:                               text => 'Change Discussion Preferences'},
1.42      raeburn  1418:                       subroutine => \&discussionchanger,
                   1419:                   },
                   1420:                     { action => 'verify_and_change_discussion',
                   1421:                       breadcrumb =>
                   1422:                           { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1423:                             text => 'Change Discussion Preferences'},
1.42      raeburn  1424:                       printmenu => 'yes',
                   1425:                       subroutine => \&verify_and_change_discussion, }
                   1426:                     ));
1.96    ! albertel 1427: 
        !          1428:     my $role = ($env{'user.adv'} ? 'Roles' : 'Course');
1.50      albertel 1429:     push (@Options,({ action   => 'changerolespref',
1.96    ! albertel 1430:                       linktext => 'Change '.$role.' Page Preferences',
1.50      albertel 1431:                       href     => '/adm/preferences',
                   1432:                       subroutine => \&rolesprefchanger,
                   1433:                       breadcrumb =>
                   1434:                           { href => '/adm/preferences?action=changerolespref',
1.96    ! albertel 1435:                             text => 'Change '.$role.' Page Pref'},
1.50      albertel 1436:                       },
                   1437:                     { action   => 'verify_and_change_rolespref',
                   1438:                       subroutine => \&verify_and_change_rolespref,
                   1439:                       breadcrumb =>
                   1440:                           { href => '/adm/preferences?action=changerolespref',
1.96    ! albertel 1441:                             text => 'Change '.$role.' Page Preferences'},
1.50      albertel 1442:                       printmenu => 'yes',
                   1443:                       }));
                   1444: 
1.54      albertel 1445:     push (@Options,({ action   => 'changetexenginepref',
                   1446:                       linktext => 'Change How Math Equations Are Displayed',
                   1447:                       href     => '/adm/preferences',
                   1448:                       subroutine => \&texenginechanger,
                   1449:                       breadcrumb =>
                   1450:                           { href => '/adm/preferences?action=changetexenginepref',
                   1451:                             text => 'Change Math Pref'},
                   1452:                       },
                   1453:                     { action   => 'verify_and_change_texengine',
                   1454:                       subroutine => \&verify_and_change_texengine,
                   1455:                       breadcrumb =>
                   1456:                           { href => '/adm/preferences?action=changetexenginepref',
                   1457:                             text => 'Change Math Preferences'},
                   1458:                       printmenu => 'yes',
                   1459:                       }));
1.85      albertel 1460: 
                   1461:     if ($env{'environment.remote'} eq 'off') {
                   1462: 	push (@Options,({ action => 'launch',
                   1463: 			  linktext => 'Launch Remote Control',
                   1464: 			  href => '/adm/remote?url=/adm/preferences',
                   1465: 		      }));
                   1466:     } else {
                   1467: 	push (@Options,({ action => 'collapse',
                   1468: 			  linktext => 'Collapse Remote Control',
                   1469: 			  href => '/adm/remote?url=/adm/preferences',
                   1470: 		      }));
                   1471:     }
                   1472: 
1.74      albertel 1473:     if (&Apache::lonnet::allowed('whn',$env{'request.course.id'})
                   1474: 	|| &Apache::lonnet::allowed('whn',$env{'request.course.id'}.'/'
                   1475: 				    .$env{'request.course.sec'})) {
1.63      raeburn  1476:         push (@Options,({ action => 'changecourseinit',
                   1477:                           linktext => 'Change Course Initialization Preference',
                   1478:                           href => '/adm/preferences',
                   1479:                           subroutine => \&coursedisplaychanger,
                   1480:                           breadcrumb =>
                   1481:                               { href => '/adm/preferences?action=changecourseinit',
                   1482:                                 text => 'Change Course Init. Pref.'},
                   1483:                           },
                   1484:                         { action => 'verify_and_change_coursepage',
                   1485:                           breadcrumb =>
                   1486:                           { href => '/adm/preferences?action=changecourseinit',                               text => 'Change Course Initialization Preference'},
                   1487:                         printmenu => 'yes',
                   1488:                         subroutine => \&verify_and_change_coursepage,
                   1489:                        }));
                   1490:     }
1.50      albertel 1491: 
1.62      raeburn  1492:     if ($env{'user.name'} =~ /^(albertel|fox|foxr|koretemey|korte|hallmat3|turtle|raeburn)$/) {
1.35      matthew  1493:         push (@Options,({ action => 'debugtoggle',
                   1494:                           printmenu => 'yes',
                   1495:                           subroutine => \&toggle_debug,
                   1496:                           }));
                   1497:     }
1.76      albertel 1498: 
                   1499:     $r->print(&Apache::loncommon::start_page('Change Preferences'));
                   1500: 
1.35      matthew  1501:     my $call = undef;
1.48      albertel 1502:     my $help = undef;
1.35      matthew  1503:     my $printmenu = 'yes';
                   1504:     foreach my $option (@Options) {
1.59      albertel 1505:         if ($option->{'action'} eq $env{'form.action'}) {
1.35      matthew  1506:             $call = $option->{'subroutine'};
                   1507:             $printmenu = $option->{'printmenu'};
                   1508:             if (exists($option->{'breadcrumb'})) {
                   1509:                 &Apache::lonhtmlcommon::add_breadcrumb
                   1510:                     ($option->{'breadcrumb'});
                   1511:             }
1.48      albertel 1512: 	    $help=$option->{'help'};
1.35      matthew  1513:         }
                   1514:     }
1.81      albertel 1515:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Change Preferences',$help));
1.75      albertel 1516:     my $error;
1.35      matthew  1517:     if (defined($call)) {
1.75      albertel 1518:         $error = $call->($r);
1.35      matthew  1519:     }
1.75      albertel 1520:     if ( ( ($printmenu eq 'yes')
                   1521: 	   || ($printmenu eq 'not_on_error' && !$error) )
                   1522: 	 && (!$env{'form.returnurl'})) {
1.35      matthew  1523:         my $optionlist = '<table cellpadding="5">';
1.59      albertel 1524:         if ($env{'user.name'} =~ 
1.62      raeburn  1525:                          /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle|raeburn)$/
1.35      matthew  1526:             ) {
                   1527:             push (@Options,({ action => 'debugtoggle',
                   1528:                               linktext => 'Toggle Debug Messages',
                   1529:                               text => 'Current Debug status is -'.
1.59      albertel 1530:                                   $env{'user.debug'}.'-.',
1.35      matthew  1531:                               href => '/adm/preferences',
                   1532:                               printmenu => 'yes',
                   1533:                               subroutine => \&toggle_debug,
                   1534:                               }));
                   1535:         }
                   1536:         foreach my $option(@Options) {
                   1537:             my $optiontext = '';
                   1538:             if (exists($option->{'href'})) {
1.85      albertel 1539: 		$option->{'href_args'}{'action'}=$option->{'action'};
                   1540: 		$optiontext .= 
                   1541:                     '<a href="'.&add_get_param($option->{'href'},
                   1542: 					       $option->{'href_args'}).'">'.
1.47      albertel 1543:                     &mt($option->{'linktext'}).'</a>';
1.35      matthew  1544:             }
                   1545:             if (exists($option->{'text'})) {
1.47      albertel 1546:                 $optiontext .= ' '.&mt($option->{'text'});
1.35      matthew  1547:             }
                   1548:             if ($optiontext ne '') {
                   1549:                 $optiontext = '<font size="+1">'.$optiontext.'</font>'; 
                   1550:                 my $helplink = '&nbsp;';
                   1551:                 if (exists($option->{'help'})) {
                   1552:                     $helplink = &Apache::loncommon::help_open_topic
                   1553:                                                     ($option->{'help'});
                   1554:                 }
                   1555:                 $optionlist .= '<tr>'.
                   1556:                     '<td>'.$helplink.'</td>'.
                   1557:                     '<td>'.$optiontext.'</td>'.
                   1558:                     '</tr>';
                   1559:             }
1.13      www      1560:         }
1.35      matthew  1561:         $optionlist .= '</table>';
                   1562:         $r->print($optionlist);
1.59      albertel 1563:     } elsif ($env{'form.returnurl'}) {
                   1564: 	$r->print('<br /><a href="'.$env{'form.returnurl'}.'"><font size="+1">'.
1.44      www      1565: 		  &mt('Return').'</font></a>');
1.3       matthew  1566:     }
1.76      albertel 1567:     $r->print(&Apache::loncommon::end_page());
1.1       www      1568:     return OK;
1.35      matthew  1569: }
                   1570: 
                   1571: sub toggle_debug {
1.59      albertel 1572:     if ($env{'user.debug'}) {
1.35      matthew  1573:         &Apache::lonnet::delenv('user\.debug');
                   1574:     } else {
                   1575:         &Apache::lonnet::appenv('user.debug' => 1);
                   1576:     }
1.13      www      1577: }
1.1       www      1578: 
                   1579: 1;
                   1580: __END__

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