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

1.1       www         1: # The LearningOnline Network
                      2: # Preferences
                      3: #
1.95    ! albertel    4: # $Id: lonpreferences.pm,v 1.94 2006/10/23 21:22:51 raeburn Exp $
1.2       albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.3       matthew    28: # This package uses the "londes.js" javascript code. 
                     29: #
                     30: # TODOs that have to be completed:
                     31: #    interface with lonnet to change the password
                     32:  
1.1       www        33: package Apache::lonpreferences;
                     34: 
                     35: use strict;
1.86      albertel   36: use LONCAPA;
1.1       www        37: use Apache::Constants qw(:common);
1.3       matthew    38: use Apache::File;
                     39: use Crypt::DES;
                     40: use DynaLoader; # for Crypt::DES version
1.4       matthew    41: use Apache::loncommon();
1.23      matthew    42: use Apache::lonhtmlcommon();
1.32      www        43: use Apache::lonlocal;
1.59      albertel   44: use Apache::lonnet;
1.95    ! albertel   45: use LONCAPA();
1.3       matthew    46: 
                     47: #
                     48: # Write lonnet::passwd to do the call below.
                     49: # Use:
                     50: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                     51: #
                     52: ##################################################
                     53: #          password associated functions         #
                     54: ##################################################
                     55: sub des_keys {
1.4       matthew    56:     # Make a new key for DES encryption.
1.36      www        57:     # Each key has two parts which are returned separately.
1.4       matthew    58:     # Please note:  Each key must be passed through the &hex function
                     59:     # before it is output to the web browser.  The hex versions cannot
                     60:     # be used to decrypt.
1.3       matthew    61:     my @hexstr=('0','1','2','3','4','5','6','7',
                     62:                 '8','9','a','b','c','d','e','f');
                     63:     my $lkey='';
                     64:     for (0..7) {
                     65:         $lkey.=$hexstr[rand(15)];
                     66:     }
                     67:     my $ukey='';
                     68:     for (0..7) {
                     69:         $ukey.=$hexstr[rand(15)];
                     70:     }
                     71:     return ($lkey,$ukey);
                     72: }
                     73: 
                     74: sub des_decrypt {
                     75:     my ($key,$cyphertext) = @_;
                     76:     my $keybin=pack("H16",$key);
                     77:     my $cypher;
                     78:     if ($Crypt::DES::VERSION>=2.03) {
                     79:         $cypher=new Crypt::DES $keybin;
                     80:     } else {
                     81:         $cypher=new DES $keybin;
                     82:     }
                     83:     my $plaintext=
                     84: 	$cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                     85:     $plaintext.=
                     86: 	$cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
1.4       matthew    87:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
1.3       matthew    88:     return $plaintext;
                     89: }
                     90: 
1.4       matthew    91: ################################################################
                     92: #                       Handler subroutines                    #
                     93: ################################################################
1.9       matthew    94: 
                     95: ################################################################
1.28      www        96: #         Language Change Subroutines                          #
                     97: ################################################################
1.44      www        98: 
                     99: sub wysiwygchanger {
                    100:     my $r = shift;
                    101:     my %userenv = &Apache::lonnet::get
                    102:         ('environment',['wysiwygeditor']);
1.78      albertel  103:     my $onselect='checked="checked"';
1.44      www       104:     my $offselect='';
1.77      albertel  105:     if ($userenv{'wysiwygeditor'} eq 'on') {
1.44      www       106: 	$onselect='';
1.78      albertel  107: 	$offselect='checked="checked"';
1.44      www       108:     }
                    109:     my $switchoff=&mt('Disable WYSIWYG editor');
                    110:     my $switchon=&mt('Enable WYSIWYG editor');
                    111:     $r->print(<<ENDLSCREEN);
1.88      albertel  112: <form name="prefs" action="/adm/preferences" method="post">
1.44      www       113: <input type="hidden" name="action" value="set_wysiwyg" />
                    114: <br />
1.65      albertel  115: <label><input type="radio" name="wysiwyg" value="off" $onselect /> $switchoff</label><br />
                    116: <label><input type="radio" name="wysiwyg" value="on" $offselect /> $switchon</label>
1.44      www       117: ENDLSCREEN
                    118:     $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
                    119: }
                    120: 
                    121: 
                    122: sub verify_and_change_wysiwyg {
                    123:     my $r = shift;
1.59      albertel  124:     my $newsetting=$env{'form.wysiwyg'};
1.44      www       125:     &Apache::lonnet::put('environment',{'wysiwygeditor' => $newsetting});
                    126:     &Apache::lonnet::appenv('environment.wysiwygeditor' => $newsetting);
                    127:     $r->print('<p>'.&mt('Setting WYSIWYG editor to:').' '.&mt($newsetting).'</p>');
                    128: }
                    129: 
                    130: ################################################################
                    131: #         Language Change Subroutines                          #
                    132: ################################################################
1.28      www       133: sub languagechanger {
                    134:     my $r = shift;
1.59      albertel  135:     my $user       = $env{'user.name'};
                    136:     my $domain     = $env{'user.domain'};
1.28      www       137:     my %userenv = &Apache::lonnet::get
1.32      www       138:         ('environment',['languages']);
1.29      www       139:     my $language=$userenv{'languages'};
1.32      www       140: 
1.33      www       141:     my $pref=&mt('Preferred language');
                    142:     my %langchoices=('' => 'No language preference');
                    143:     foreach (&Apache::loncommon::languageids()) {
                    144: 	if (&Apache::loncommon::supportedlanguagecode($_)) {
                    145: 	    $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
                    146: 	               = &Apache::loncommon::plainlanguagedescription($_);
                    147: 	}
                    148:     }
                    149:     my $selectionbox=&Apache::loncommon::select_form($language,'language',
                    150: 						     %langchoices);
1.28      www       151:     $r->print(<<ENDLSCREEN);
1.88      albertel  152: <form name="prefs" action="/adm/preferences" method="post">
1.28      www       153: <input type="hidden" name="action" value="verify_and_change_languages" />
1.33      www       154: <br />$pref: $selectionbox
1.28      www       155: ENDLSCREEN
1.35      matthew   156:     $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
1.28      www       157: }
                    158: 
                    159: 
                    160: sub verify_and_change_languages {
                    161:     my $r = shift;
1.59      albertel  162:     my $user       = $env{'user.name'};
                    163:     my $domain     = $env{'user.domain'};
1.28      www       164: # Screenname
1.59      albertel  165:     my $newlanguage  = $env{'form.language'};
1.28      www       166:     $newlanguage=~s/[^\-\w]//g;
                    167:     my $message='';
                    168:     if ($newlanguage) {
1.29      www       169:         &Apache::lonnet::put('environment',{'languages' => $newlanguage});
                    170:         &Apache::lonnet::appenv('environment.languages' => $newlanguage);
                    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.59      albertel  283:     my $user       = $env{'user.name'};
                    284:     my $domain     = $env{'user.domain'};
1.50      albertel  285:     my %userenv = &Apache::lonnet::get
                    286:         ('environment',['recentroles','recentrolesn']);
                    287:     my $hotlist_flag=$userenv{'recentroles'};
                    288:     my $hotlist_n=$userenv{'recentrolesn'};
                    289:     my $checked;
                    290:     if ($hotlist_flag) {
                    291: 	$checked = 'checked="checked"';
                    292:     }
                    293:     
                    294:     if (!$hotlist_n) { $hotlist_n=3; }
                    295:     my $options;
                    296:     for (my $i=1; $i<10; $i++) {
                    297: 	my $select;
                    298: 	if ($hotlist_n == $i) { $select = 'selected="selected"'; }
                    299: 	$options .= "<option $select>$i</option>\n";
                    300:     }
                    301: 
1.89      albertel  302: # Get list of recent roles and display with checkbox in front
                    303:     my $roles_check_list = '';
                    304:     my $role_key='';
                    305:     if ($env{'environment.recentroles'}) {
                    306:         my %recent_roles =
                    307:                &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.91      albertel  308:         my %frozen_roles =
                    309:                &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.89      albertel  310:         
1.93      albertel  311:         my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
1.92      albertel  312:         my @sorted_roles = sort {$role_text{$a} cmp $role_text{$b}} keys(%role_text);
                    313: 
1.89      albertel  314:         $roles_check_list .=
                    315: 	    &Apache::loncommon::start_data_table().
                    316: 	    &Apache::loncommon::start_data_table_header_row().
                    317: 	    "<th>".&mt('Freeze Role')."</th>".
                    318: 	    "<th>".&mt('Role')."</td>".
                    319: 	    &Apache::loncommon::end_data_table_header_row().
                    320: 	    "\n";
                    321: 	my $count;
1.92      albertel  322:         foreach $role_key (@sorted_roles) {
1.89      albertel  323:             my $checked = "";
                    324:             my $value = $recent_roles{$role_key};
1.91      albertel  325:             if ($frozen_roles{$role_key}) {
1.89      albertel  326:                 $checked = "checked=\"checked\"";
                    327:             }
                    328: 	    $count++;
                    329:             $roles_check_list .=
                    330: 		&Apache::loncommon::start_data_table_row().
                    331: 		'<td class="LC_table_cell_checkbox">'.
                    332: 		"<input type=\"checkbox\" $checked name=\"freezeroles\"".
                    333: 		" id=\"freezeroles$count\" value=\"$role_key\" /></td>".
                    334: 		"<td><label for=\"freezeroles$count\">".
1.92      albertel  335: 		"$role_text{$role_key}</label></td>".
1.89      albertel  336: 		&Apache::loncommon::end_data_table_row(). "\n";
                    337:         }
                    338:         $roles_check_list .= "</table>\n";
                    339:     }
                    340: 
                    341:     $r->print('
                    342: <p>'.&mt('Some LON-CAPA users have a long list of roles. The Recent Roles Hotlist feature keeps track of the last N roles which have been visited and places a table of these at the top of the roles page. People with very few roles should leave this feature disabled.').'
1.50      albertel  343: </p>
1.89      albertel  344: <form name="prefs" action="/adm/preferences" method="POST">
1.50      albertel  345: <input type="hidden" name="action" value="verify_and_change_rolespref" />
1.89      albertel  346: <br /><label>'.&mt('Enable Recent Roles Hotlist:').'
                    347: <input type="checkbox" '.$checked.' name="recentroles" value="true" /></label>
                    348: <br />'.&mt('Number of roles in Hotlist:').'
1.50      albertel  349: <select name="recentrolesn" size="1">
1.89      albertel  350: '.$options.'
1.50      albertel  351: </select>
1.89      albertel  352: <p>'.&mt('This list below can be used to <q>freeze</q> roles on your screen. Those marked as frozen will not be removed from the list, even if they have not been used recently.').'
                    353: </p>
                    354: '.$roles_check_list.'
1.50      albertel  355: <br />
1.89      albertel  356: <input type="submit" value="'.&mt('Change').'" />
                    357: </form>');
1.50      albertel  358: }
                    359: 
1.92      albertel  360: sub rolespref_get_role_text {
                    361: # Get a line of text for each role
                    362:     my ($roles) = @_;
                    363:     my %roletext = ();
                    364: 
                    365:     foreach my $item (@$roles) {
                    366: # get course information
                    367:         my ($role,$rest) = split(/\./, $item);
1.93      albertel  368:         my $trole = "";
                    369:         $trole = &Apache::lonnet::plaintext($role);
1.92      albertel  370:         my ($tdomain,$other,$tsection)= split(/\//,Apache::lonnet::declutter($rest));
                    371:         my $tother = '-';
1.93      albertel  372:         if ($role =~ /^(cc|st|in|ta|ep|cr)/ ) {
1.92      albertel  373:             my %newhash=&Apache::lonnet::coursedescription($tdomain."_".$other);
                    374:             $tother = " - ".$newhash{'description'};
                    375:         } elsif ($role =~ /dc/) {
                    376:             $tother = "";
                    377:         } else {
                    378:             $tother = " - $other";
                    379:         }
                    380:  
                    381:         my $section="";
                    382:         if ($tsection) {
                    383:             $section = " - Section/Group: $tsection";
                    384:         }
                    385:         $roletext{$item} = $tdomain." - ".$trole.$tother.$section;
                    386:     }
                    387:     return %roletext;
                    388: }
                    389: 
1.50      albertel  390: sub verify_and_change_rolespref {
                    391:     my $r = shift;
1.59      albertel  392:     my $user       = $env{'user.name'};
                    393:     my $domain     = $env{'user.domain'};
1.50      albertel  394: # Recent Roles Hotlist Flag
1.59      albertel  395:     my $hotlist_flag  = $env{'form.recentroles'};
                    396:     my $hotlist_n  = $env{'form.recentrolesn'};
1.89      albertel  397:     my $message='<hr />';
1.50      albertel  398:     if ($hotlist_flag) {
                    399:         &Apache::lonnet::put('environment',{'recentroles' => $hotlist_flag});
                    400:         &Apache::lonnet::appenv('environment.recentroles' => $hotlist_flag);
1.89      albertel  401:         $message=&mt('Recent Roles Hotlist is Enabled');
1.50      albertel  402:     } else {
                    403:         &Apache::lonnet::del('environment',['recentroles']);
                    404:         &Apache::lonnet::delenv('environment\.recentroles');
1.89      albertel  405:         $message=&mt('Recent Roles Hotlist is Disabled');
1.50      albertel  406:     }
                    407:     if ($hotlist_n) {
                    408:         &Apache::lonnet::put('environment',{'recentrolesn' => $hotlist_n});
                    409:         &Apache::lonnet::appenv('environment.recentrolesn' => $hotlist_n);
                    410:         if ($hotlist_flag) {
1.90      albertel  411:             $message.="<br />".
                    412: 		&mt('Display [_1] Most Recent Roles',$hotlist_n)."\n";
1.89      albertel  413:         }
                    414:     }
                    415: 
                    416: # Get list of froze roles and list of recent roles
                    417:     my @freeze_list = &Apache::loncommon::get_env_multiple('form.freezeroles');
                    418:     my %freeze = ();
1.92      albertel  419:     my %roletext = ();
                    420: 
1.89      albertel  421:     foreach my $key (@freeze_list) {
1.91      albertel  422:         $freeze{$key}='1';
1.89      albertel  423:     }
1.92      albertel  424: 
1.89      albertel  425:     my %recent_roles =
                    426:         &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.91      albertel  427:     my %frozen_roles =
                    428:         &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.92      albertel  429:     my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
1.89      albertel  430: 
                    431: # Unset any roles that were previously frozen but aren't in list
                    432:     foreach my $role_key (sort(keys(%recent_roles))) {
1.91      albertel  433:         if (($frozen_roles{$role_key}) && (!exists($freeze{$role_key}))) {
1.92      albertel  434: 	    $message .= "<br />".&mt('Unfreezing Role: [_1]',$role_text{$role_key})."\n";
1.91      albertel  435: 	    &Apache::lonhtmlcommon::store_recent('roles',$role_key,' ',0);
1.89      albertel  436:         }
                    437:     }
                    438: 
                    439: # Freeze selected roles
                    440:     foreach my $role_key (@freeze_list) {
1.91      albertel  441:         if (!$frozen_roles{$role_key}) {
1.92      albertel  442:              $message .= "<br />".&mt('Freezing Role: [_1]',$role_text{$role_key})."\n";
1.89      albertel  443:              &Apache::lonhtmlcommon::store_recent('roles',
1.91      albertel  444:                                           $role_key,' ',1);
1.50      albertel  445:         }
                    446:     }
1.89      albertel  447:     $message .= "<hr /><br />\n";
1.50      albertel  448: 
                    449:     $r->print(<<ENDRPSCREEN);
                    450: $message
                    451: ENDRPSCREEN
                    452: }
                    453: 
                    454: 
1.28      www       455: 
                    456: ################################################################
1.9       matthew   457: #         Anonymous Discussion Name Change Subroutines         #
                    458: ################################################################
1.5       www       459: sub screennamechanger {
                    460:     my $r = shift;
1.59      albertel  461:     my $user       = $env{'user.name'};
                    462:     my $domain     = $env{'user.domain'};
1.14      www       463:     my %userenv = &Apache::lonnet::get
                    464:         ('environment',['screenname','nickname']);
1.6       www       465:     my $screenname=$userenv{'screenname'};
1.14      www       466:     my $nickname=$userenv{'nickname'};
1.5       www       467:     $r->print(<<ENDSCREEN);
1.88      albertel  468: <form name="prefs" action="/adm/preferences" method="post">
1.6       www       469: <input type="hidden" name="action" value="verify_and_change_screenname" />
1.14      www       470: <br />New screenname (shown if you post anonymously):
1.6       www       471: <input type="text" size="20" value="$screenname" name="screenname" />
1.14      www       472: <br />New nickname (shown if you post non-anonymously):
                    473: <input type="text" size="20" value="$nickname" name="nickname" />
1.6       www       474: <input type="submit" value="Change" />
                    475: </form>
1.5       www       476: ENDSCREEN
                    477: }
1.6       www       478: 
                    479: sub verify_and_change_screenname {
                    480:     my $r = shift;
1.59      albertel  481:     my $user       = $env{'user.name'};
                    482:     my $domain     = $env{'user.domain'};
1.14      www       483: # Screenname
1.59      albertel  484:     my $newscreen  = $env{'form.screenname'};
1.14      www       485:     $newscreen=~s/[^ \w]//g;
1.6       www       486:     my $message='';
                    487:     if ($newscreen) {
1.7       www       488:         &Apache::lonnet::put('environment',{'screenname' => $newscreen});
                    489:         &Apache::lonnet::appenv('environment.screenname' => $newscreen);
1.6       www       490:         $message='Set new screenname to '.$newscreen;
                    491:     } else {
                    492:         &Apache::lonnet::del('environment',['screenname']);
1.7       www       493:         &Apache::lonnet::delenv('environment\.screenname');
1.6       www       494:         $message='Reset screenname';
                    495:     }
1.14      www       496: # Nickname
                    497:     $message.='<br />';
1.59      albertel  498:     $newscreen  = $env{'form.nickname'};
1.14      www       499:     $newscreen=~s/[^ \w]//g;
                    500:     if ($newscreen) {
                    501:         &Apache::lonnet::put('environment',{'nickname' => $newscreen});
                    502:         &Apache::lonnet::appenv('environment.nickname' => $newscreen);
                    503:         $message.='Set new nickname to '.$newscreen;
                    504:     } else {
                    505:         &Apache::lonnet::del('environment',['nickname']);
                    506:         &Apache::lonnet::delenv('environment\.nickname');
                    507:         $message.='Reset nickname';
                    508:     }
1.68      www       509:     &Apache::lonnet::devalidate_cache_new('namescache',$user.':'.$domain);
1.6       www       510:     $r->print(<<ENDVCSCREEN);
                    511: $message
                    512: ENDVCSCREEN
1.20      www       513: }
                    514: 
                    515: ################################################################
                    516: #         Message Forward                                      #
                    517: ################################################################
                    518: 
                    519: sub msgforwardchanger {
                    520:     my $r = shift;
1.59      albertel  521:     my $user       = $env{'user.name'};
                    522:     my $domain     = $env{'user.domain'};
1.26      www       523:     my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
1.20      www       524:     my $msgforward=$userenv{'msgforward'};
                    525:     my $notification=$userenv{'notification'};
                    526:     my $critnotification=$userenv{'critnotification'};
1.25      bowersj2  527:     my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
                    528: 							    "What are forwarding ".
                    529: 							    "and notification ".
                    530: 							    "addresses");
1.27      bowersj2  531:     my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
                    532: 								 "What are critical messages");
                    533: 
1.20      www       534:     $r->print(<<ENDMSG);
1.25      bowersj2  535: $forwardingHelp <br />
1.88      albertel  536: <form name="prefs" action="/adm/preferences" method="post">
1.20      www       537: <input type="hidden" name="action" value="verify_and_change_msgforward" />
                    538: New Forwarding Address(es) (<tt>user:domain,user:domain,...</tt>):
                    539: <input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
                    540: New Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
                    541: <input type="text" size="40" value="$notification" name="notification" /><hr />
                    542: New Critical Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
1.27      bowersj2  543: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
1.20      www       544: <input type="submit" value="Change" />
                    545: </form>
                    546: ENDMSG
                    547: }
                    548: 
                    549: sub verify_and_change_msgforward {
                    550:     my $r = shift;
1.59      albertel  551:     my $user       = $env{'user.name'};
                    552:     my $domain     = $env{'user.domain'};
1.20      www       553:     my $newscreen  = '';
                    554:     my $message='';
1.59      albertel  555:     foreach (split(/\,/,$env{'form.msgforward'})) {
1.20      www       556: 	my ($msuser,$msdomain)=split(/[\@\:]/,$_);
1.95    ! albertel  557:         $msuser = &LONCAPA::clean_username($msuser);
        !           558:         $msdomain = &LONCAPA::clean_domain($msdomain);
1.20      www       559:         if (($msuser) && ($msdomain)) {
                    560: 	    if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
                    561:                $newscreen.=$msuser.':'.$msdomain.',';
                    562: 	   } else {
                    563:                $message.='No such user: '.$msuser.':'.$msdomain.'<br>';
                    564:            }
                    565:         }
                    566:     }
                    567:     $newscreen=~s/\,$//;
                    568:     if ($newscreen) {
                    569:         &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
                    570:         &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
                    571:         $message.='Set new message forwarding to '.$newscreen.'<br />';
                    572:     } else {
                    573:         &Apache::lonnet::del('environment',['msgforward']);
                    574:         &Apache::lonnet::delenv('environment\.msgforward');
                    575:         $message.='Reset message forwarding<br />';
                    576:     }
1.59      albertel  577:     my $notification=$env{'form.notification'};
1.20      www       578:     $notification=~s/\s//gs;
                    579:     if ($notification) {
                    580:         &Apache::lonnet::put('environment',{'notification' => $notification});
                    581:         &Apache::lonnet::appenv('environment.notification' => $notification);
                    582:         $message.='Set message notification address to '.$notification.'<br />';
                    583:     } else {
                    584:         &Apache::lonnet::del('environment',['notification']);
                    585:         &Apache::lonnet::delenv('environment\.notification');
                    586:         $message.='Reset message notification<br />';
                    587:     }
1.59      albertel  588:     my $critnotification=$env{'form.critnotification'};
1.20      www       589:     $critnotification=~s/\s//gs;
                    590:     if ($critnotification) {
                    591:         &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
                    592:         &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
                    593:         $message.='Set critical message notification address to '.$critnotification;
                    594:     } else {
                    595:         &Apache::lonnet::del('environment',['critnotification']);
                    596:         &Apache::lonnet::delenv('environment\.critnotification');
                    597:         $message.='Reset critical message notification<br />';
                    598:     }
                    599:     $r->print(<<ENDVCMSG);
                    600: $message
                    601: ENDVCMSG
1.6       www       602: }
                    603: 
1.12      www       604: ################################################################
1.19      www       605: #         Colors                                               #
1.12      www       606: ################################################################
                    607: 
1.19      www       608: sub colorschanger {
1.12      www       609:     my $r = shift;
1.19      www       610: # figure out colors
1.80      albertel  611:     my $function=&Apache::loncommon::get_users_function();
1.19      www       612:     my $domain=&Apache::loncommon::determinedomain();
                    613:     my %colortypes=('pgbg'  => 'Page Background',
                    614:                     'tabbg' => 'Header Background',
                    615:                     'sidebg'=> 'Header Border',
                    616:                     'font'  => 'Font',
                    617:                     'link'  => 'Un-Visited Link',
                    618:                     'vlink' => 'Visited Link',
                    619:                     'alink' => 'Active Link');
1.82      albertel  620:     my $start_data_table = &Apache::loncommon::start_data_table();
1.19      www       621:     my $chtable='';
1.22      matthew   622:     foreach my $item (sort(keys(%colortypes))) {
1.19      www       623:        my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
1.82      albertel  624:        $chtable.=&Apache::loncommon::start_data_table_row().
1.83      albertel  625: 	   '<td>'.$colortypes{$item}.'</td><td style="background: '.$curcol.
1.19      www       626:         '">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td><td><input name="'.$item.
1.21      www       627:         '" size="10" value="'.$curcol.
                    628: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19      www       629: "','".$curcol."','"
1.82      albertel  630: 	    .$item."','parmform.pres','psub'".');">Select</a></td>'.
1.83      albertel  631: 	    &Apache::loncommon::end_data_table_row()."\n";
1.19      www       632:     }
1.82      albertel  633:     my $end_data_table = &Apache::loncommon::end_data_table();
1.23      matthew   634:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19      www       635:     $r->print(<<ENDCOL);
1.82      albertel  636: <script type="text/javascript">
1.19      www       637: 
                    638:     function pclose() {
                    639:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    640:                  "height=350,width=350,scrollbars=no,menubar=no");
                    641:         parmwin.close();
                    642:     }
                    643: 
1.23      matthew   644:     $pjump_def
1.19      www       645: 
                    646:     function psub() {
                    647:         pclose();
                    648:         if (document.parmform.pres_marker.value!='') {
1.21      www       649:             if (document.parmform.pres_type.value!='') {
1.77      albertel  650:                 eval('document.prefs.'+
1.21      www       651:                      document.parmform.pres_marker.value+
1.19      www       652: 		     '.value=document.parmform.pres_value.value;');
1.21      www       653: 	    }
1.19      www       654:         } else {
                    655:             document.parmform.pres_value.value='';
                    656:             document.parmform.pres_marker.value='';
                    657:         }
                    658:     }
                    659: 
                    660: 
                    661: </script>
1.21      www       662: <form name="parmform">
                    663: <input type="hidden" name="pres_marker" />
                    664: <input type="hidden" name="pres_type" />
                    665: <input type="hidden" name="pres_value" />
                    666: </form>
1.88      albertel  667: <form name="prefs" action="/adm/preferences" method="post">
1.19      www       668: <input type="hidden" name="action" value="verify_and_change_colors" />
1.82      albertel  669: $start_data_table
1.19      www       670: $chtable
1.82      albertel  671: $end_data_table
1.19      www       672: </table>
1.21      www       673: <input type="submit" value="Change Custom Colors" />
                    674: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12      www       675: </form>
1.19      www       676: ENDCOL
1.12      www       677: }
                    678: 
1.19      www       679: sub verify_and_change_colors {
1.12      www       680:     my $r = shift;
1.19      www       681: # figure out colors
1.80      albertel  682:     my $function=&Apache::loncommon::get_users_function();
1.19      www       683:     my $domain=&Apache::loncommon::determinedomain();
                    684:     my %colortypes=('pgbg'  => 'Page Background',
                    685:                     'tabbg' => 'Header Background',
                    686:                     'sidebg'=> 'Header Border',
                    687:                     'font'  => 'Font',
                    688:                     'link'  => 'Un-Visited Link',
                    689:                     'vlink' => 'Visited Link',
                    690:                     'alink' => 'Active Link');
                    691: 
1.12      www       692:     my $message='';
1.21      www       693:     foreach my $item (keys %colortypes) {
1.59      albertel  694:         my $color=$env{'form.'.$item};
1.21      www       695:         my $entry='color.'.$function.'.'.$item;
1.59      albertel  696: 	if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$env{'form.resetall'})) {
1.21      www       697: 	    &Apache::lonnet::put('environment',{$entry => $color});
                    698: 	    &Apache::lonnet::appenv('environment.'.$entry => $color);
                    699: 	    $message.='Set '.$colortypes{$item}.' to '.$color.'<br />';
                    700: 	} else {
                    701: 	    &Apache::lonnet::del('environment',[$entry]);
                    702: 	    &Apache::lonnet::delenv('environment\.'.$entry);
                    703: 	    $message.='Reset '.$colortypes{$item}.'<br />';
                    704: 	}
                    705:     }
1.84      albertel  706:     my $now = time;
                    707:     &Apache::lonnet::put('environment',{'color.timestamp' => $now});
                    708:     &Apache::lonnet::appenv('environment.color.timestamp' => $now);
                    709: 
1.19      www       710:     $r->print(<<ENDVCCOL);
1.12      www       711: $message
1.88      albertel  712: <form name="client" action="/adm/preferences" method="post">
1.21      www       713: <input type="hidden" name="action" value="changecolors" />
                    714: </form>
1.19      www       715: ENDVCCOL
1.12      www       716: }
                    717: 
1.4       matthew   718: ######################################################
                    719: #            password handler subroutines            #
                    720: ######################################################
1.3       matthew   721: sub passwordchanger {
1.94      raeburn   722:     my ($r,$errormessage,$caller,$mailtoken) = @_;
1.4       matthew   723:     # This function is a bit of a mess....
1.3       matthew   724:     # Passwords are encrypted using londes.js (DES encryption)
1.4       matthew   725:     $errormessage = ($errormessage || '');
1.94      raeburn   726:     my ($user,$domain,$currentpass,$defdom);
                    727:     if ((!defined($caller)) || ($caller eq 'preferences')) {
                    728:         $user = $env{'user.name'};
                    729:         $domain = $env{'user.domain'};
                    730:         if (!defined($caller)) {
                    731:             $caller = 'preferences';
                    732:         }
                    733:     } elsif ($caller eq 'reset_by_email') {
                    734:             $defdom = $r->dir_config('lonDefDomain');
                    735:             my %data = &Apache::lonnet::tmpget($mailtoken);
                    736:             if (keys(%data) == 0) {
                    737:                 $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.'));
                    738:                 return;
                    739:             }
                    740:             if (defined($data{time})) {
                    741:                 if (time - $data{'time'} < 7200) {
                    742:                     $user = $data{'username'};
                    743:                     $domain = $data{'domain'};
                    744:                     $currentpass = $data{'temppasswd'};
                    745:                 } else {
                    746:                     $r->print(&mt('Sorry, the token generated when you requested a password reset has expired.').'<br />');
                    747:                     return;
                    748:                 }
                    749:             } else {
                    750:                 $r->print(&mt('Sorry, the URL generated when you requested reset of your password contained incomplete information.').'<br />');
                    751:                 return;
                    752:             }
                    753:    } else {
                    754:         $r->print(&mt('Page requested in unexpected context').'<br />');
                    755:         return;
                    756:     }
1.3       matthew   757:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                    758:     # Check for authentication types that allow changing of the password.
                    759:     return if ($currentauth !~ /^(unix|internal):/);
                    760:     #
                    761:     # Generate keys
                    762:     my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
                    763:     my ($lkey_npass1,$ukey_npass1) = &des_keys();
                    764:     my ($lkey_npass2,$ukey_npass2) = &des_keys();
1.4       matthew   765:     # Store the keys in the log files
1.3       matthew   766:     my $lonhost = $r->dir_config('lonHostID');
                    767:     my $logtoken=Apache::lonnet::reply('tmpput:'
                    768: 				       .$ukey_cpass  . $lkey_cpass .'&'
                    769: 				       .$ukey_npass1 . $lkey_npass1.'&'
                    770: 				       .$ukey_npass2 . $lkey_npass2,
                    771: 				       $lonhost);
1.4       matthew   772:     # Hexify the keys for output as javascript variables
1.94      raeburn   773:     my %hexkey;
                    774:     $hexkey{'ukey_cpass'}  = hex($ukey_cpass);
                    775:     $hexkey{'lkey_cpass'}  = hex($lkey_cpass);
                    776:     $hexkey{'ukey_npass1'} = hex($ukey_npass1);
                    777:     $hexkey{'lkey_npass1'} = hex($lkey_npass1);
                    778:     $hexkey{'ukey_npass2'} = hex($ukey_npass2);
                    779:     $hexkey{'lkey_npass2'} = hex($lkey_npass2);
1.3       matthew   780:     # Output javascript to deal with passwords
1.4       matthew   781:     # Output DES javascript
1.3       matthew   782:     {
                    783: 	my $include = $r->dir_config('lonIncludes');
                    784: 	my $jsh=Apache::File->new($include."/londes.js");
                    785: 	$r->print(<$jsh>);
                    786:     }
1.94      raeburn   787:     $r->print(&jscript_send($caller));
1.3       matthew   788:     $r->print(<<ENDFORM);
1.94      raeburn   789: $errormessage
                    790: 
                    791: <p>
                    792: <!-- We separate the forms into 'server' and 'client' in order to
                    793:      ensure that unencrypted passwords will not be sent out by a
                    794:      crappy browser -->
                    795: ENDFORM
                    796:     $r->print(&server_form($logtoken,$caller,$mailtoken));
                    797:     $r->print(&client_form($caller,\%hexkey,$currentpass,$defdom));
                    798: 
                    799:     #
                    800:     return;
                    801: }
                    802: 
                    803: sub jscript_send {
                    804:     my ($caller) = @_;
                    805:     my $output = qq|
1.3       matthew   806: <script language="JavaScript">
                    807: 
                    808:     function send() {
                    809:         uextkey=this.document.client.elements.ukey_cpass.value;
                    810:         lextkey=this.document.client.elements.lkey_cpass.value;
                    811:         initkeys();
                    812: 
1.52      raeburn   813:         this.document.pserver.elements.currentpass.value
1.3       matthew   814:             =crypted(this.document.client.elements.currentpass.value);
                    815: 
                    816:         uextkey=this.document.client.elements.ukey_npass1.value;
                    817:         lextkey=this.document.client.elements.lkey_npass1.value;
                    818:         initkeys();
1.52      raeburn   819:         this.document.pserver.elements.newpass_1.value
1.3       matthew   820:             =crypted(this.document.client.elements.newpass_1.value);
                    821: 
                    822:         uextkey=this.document.client.elements.ukey_npass2.value;
                    823:         lextkey=this.document.client.elements.lkey_npass2.value;
                    824:         initkeys();
1.52      raeburn   825:         this.document.pserver.elements.newpass_2.value
1.3       matthew   826:             =crypted(this.document.client.elements.newpass_2.value);
1.94      raeburn   827: |;
                    828:     if ($caller eq 'reset_by_email') {
                    829:         $output .= qq|
                    830:         this.document.pserver.elements.uname.value =
                    831:                    this.document.client.elements.uname.value;
                    832:         this.document.pserver.elements.udom.value =
                    833:                    this.document.client.elements.udom.options[this.document.client.elements.udom.selectedIndex].value;
                    834: |;
                    835:     }
                    836:     $ output .= qq|
1.52      raeburn   837:         this.document.pserver.submit();
1.3       matthew   838:     }
                    839: </script>
1.94      raeburn   840: |;
                    841: }
1.3       matthew   842: 
1.94      raeburn   843: sub client_form {
                    844:     my ($caller,$hexkey,$currentpass,$defdom) = @_;
                    845:     my $output = qq|
1.3       matthew   846: <form name="client" >
                    847: <table>
1.94      raeburn   848: |;
                    849:     if ($caller eq 'reset_by_email') {
                    850:         $output .= qq|
                    851: <tr><td align="right"> E-mail address:                        </td>
                    852:     <td><input type="text" name="email" size="15" /> </td></tr>
                    853: <tr><td align="right"> Username:                        </td>
                    854:     <td>
                    855:      <input type="text" name="uname" size="10" />
                    856:      <input type="hidden" name="currentpass" value="$currentpass" />
                    857:     </td></tr>
                    858: <tr><td align="right"> Domain:                               </td>
                    859:     <td>
                    860: |;
                    861:         $output .= &Apache::loncommon::select_dom_form($defdom,'udom').'
                    862:    </td>
                    863: </tr>
                    864: ';
                    865:     } else {
                    866:         $output .= qq|
1.4       matthew   867: <tr><td align="right"> Current password:                      </td>
                    868:     <td><input type="password" name="currentpass" size="10"/> </td></tr>
1.94      raeburn   869: |;
                    870:     }
                    871:     $output .= <<"ENDFORM";
1.4       matthew   872: <tr><td align="right"> New password:                          </td>
                    873:     <td><input type="password" name="newpass_1" size="10"  /> </td></tr>
                    874: <tr><td align="right"> Confirm password:                      </td>
                    875:     <td><input type="password" name="newpass_2" size="10"  /> </td></tr>
1.3       matthew   876: <tr><td colspan="2" align="center">
                    877:     <input type="button" value="Change Password" onClick="send();">
                    878: </table>
1.94      raeburn   879: <input type="hidden" name="ukey_cpass"  value="$hexkey->{'ukey_cpass'}" />
                    880: <input type="hidden" name="lkey_cpass"  value="$hexkey->{'lkey_cpass'}" />
                    881: <input type="hidden" name="ukey_npass1" value="$hexkey->{'ukey_npass1'}" />
                    882: <input type="hidden" name="lkey_npass1" value="$hexkey->{'lkey_npass1'}" />
                    883: <input type="hidden" name="ukey_npass2" value="$hexkey->{'ukey_npass2'}" />
                    884: <input type="hidden" name="lkey_npass2" value="$hexkey->{'lkey_npass2'}" />
1.3       matthew   885: </form>
                    886: </p>
                    887: ENDFORM
1.94      raeburn   888:     return $output;
                    889: }
                    890: 
                    891: sub server_form {
                    892:     my ($logtoken,$caller,$mailtoken) = @_;
                    893:     my $action = '/adm/preferences';
                    894:     if ($caller eq 'reset_by_email') {
                    895:         $action = '/adm/resetpw';
                    896:     }
                    897:     my $output = qq|
                    898: <form name="pserver" action="$action" method="post">
                    899: <input type="hidden" name="logtoken"    value="$logtoken" />
                    900: <input type="hidden" name="currentpass" value="" />
                    901: <input type="hidden" name="newpass_1"   value="" />
                    902: <input type="hidden" name="newpass_2"   value="" />
                    903:     |;
                    904:     if ($caller eq 'reset_by_email') {
                    905:         $output .=  qq|
                    906: <input type="hidden" name="token"   value="$mailtoken" />
                    907: <input type="hidden" name="uname"   value="" />
                    908: <input type="hidden" name="udom"   value="" />
                    909: 
                    910: |;
                    911:     }
                    912:     $output .= qq|
                    913: <input type="hidden" name="action" value="verify_and_change_pass" />
                    914: </form>
                    915: |;
                    916:     return $output;
1.3       matthew   917: }
                    918: 
                    919: sub verify_and_change_password {
1.94      raeburn   920:     my ($r,$caller,$mailtoken) = @_;
                    921:     my ($user,$domain,$homeserver);
                    922:     if ($caller eq 'reset_by_email') {
                    923:         $user       = $env{'form.uname'};
                    924:         $domain     = $env{'form.udom'};
                    925:         if ($user ne '' && $domain ne '') {
                    926:             $homeserver = &Apache::lonnet::homeserver($user,$domain);
                    927:             if ($homeserver eq 'no_host') {
                    928:         &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
                    929:                          "Invalid username and/or domain .\n</p>",
                    930:                          $caller,$mailtoken);
                    931:                 return 1;
                    932:             }
                    933:         } else {
                    934:             &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
                    935:                              "Username and Domain were blank.\n</p>",
                    936:                              $caller,$mailtoken);
                    937:             return 1;
                    938:         }
                    939:     } else {
                    940:         $user       = $env{'user.name'};
                    941:         $domain     = $env{'user.domain'};
                    942:         $homeserver = $env{'user.home'};
                    943:     }
1.3       matthew   944:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4       matthew   945:     # Check for authentication types that allow changing of the password.
1.94      raeburn   946:     if ($currentauth !~ /^(unix|internal):/) {
                    947:         if ($caller eq 'reset_by_email') {
                    948:             &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
                    949:                              "Authentication type for this user can not be changed by this mechanism..\n</p>",
                    950:                               $caller,$mailtoken);
                    951:             return 1;
                    952:         } else {
                    953:             return;
                    954:         }
                    955:     }
1.3       matthew   956:     #
1.59      albertel  957:     my $currentpass = $env{'form.currentpass'}; 
                    958:     my $newpass1    = $env{'form.newpass_1'}; 
                    959:     my $newpass2    = $env{'form.newpass_2'};
                    960:     my $logtoken    = $env{'form.logtoken'};
1.3       matthew   961:     # Check for empty data 
1.4       matthew   962:     unless (defined($currentpass) && 
                    963: 	    defined($newpass1)    && 
                    964: 	    defined($newpass2)    ){
                    965: 	&passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
1.94      raeburn   966: 			 "One or more password fields were blank.\n</p>",$caller,$mailtoken);
1.3       matthew   967: 	return;
                    968:     }
1.16      albertel  969:     # Get the keys
                    970:     my $lonhost = $r->dir_config('lonHostID');
1.3       matthew   971:     my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
                    972:     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4       matthew   973:         # I do not a have a better idea about how to handle this
1.94      raeburn   974:         my $tryagain_text = &mt('Please log out and try again.');
                    975:         if ($caller eq 'reset_by_email') {
                    976:             $tryagain_text = &mt('Please try again later.');
                    977:         }
1.3       matthew   978: 	$r->print(<<ENDERROR);
                    979: <p>
                    980: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
1.94      raeburn   981: password decryption.  $tryagain_text
1.3       matthew   982: </p>
                    983: ENDERROR
1.4       matthew   984:         # Probably should log an error here
1.75      albertel  985:         return 1;
1.3       matthew   986:     }
                    987:     my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4       matthew   988:     # 
1.17      matthew   989:     $currentpass = &des_decrypt($ckey ,$currentpass);
                    990:     $newpass1    = &des_decrypt($n1key,$newpass1);
                    991:     $newpass2    = &des_decrypt($n2key,$newpass2);
1.94      raeburn   992:     #
                    993:     if ($caller eq 'reset_by_email') {
                    994:         my %data = &Apache::lonnet::tmpget($mailtoken);
                    995:         if ($currentpass ne $data{'temppasswd'}) {
                    996:             &passwordchanger($r,
                    997:                          '<font color="#ff0000">ERROR:</font>'.
                    998:                          'Could not verify current authentication.  '.
                    999:                          'Please try again.',$caller,$mailtoken);
                   1000:             return 1;
                   1001:         }
                   1002:     } 
1.3       matthew  1003:     if ($newpass1 ne $newpass2) {
1.4       matthew  1004: 	&passwordchanger($r,
                   1005: 			 '<font color="#ff0000">ERROR:</font>'.
                   1006: 			 'The new passwords you entered do not match.  '.
1.94      raeburn  1007: 			 'Please try again.',$caller,$mailtoken);
1.75      albertel 1008: 	return 1;
1.4       matthew  1009:     }
                   1010:     if (length($newpass1) < 7) {
                   1011: 	&passwordchanger($r,
                   1012: 			 '<font color="#ff0000">ERROR:</font>'.
                   1013: 			 'Passwords must be a minimum of 7 characters long.  '.
1.94      raeburn  1014: 			 'Please try again.',$caller,$mailtoken);
1.75      albertel 1015: 	return 1;
1.3       matthew  1016:     }
1.4       matthew  1017:     #
                   1018:     # Check for bad characters
                   1019:     my $badpassword = 0;
                   1020:     foreach (split(//,$newpass1)) {
                   1021: 	$badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
                   1022:     }
                   1023:     if ($badpassword) {
                   1024: 	# I can't figure out how to enter bad characters on my browser.
1.94      raeburn  1025: 	my $errormessage = <<"ENDERROR";
1.4       matthew  1026: <font color="#ff0000">ERROR:</font>
                   1027: The password you entered contained illegal characters.<br />
                   1028: Valid characters are: space and <br />
                   1029: <pre>
                   1030: !&quot;\#$%&amp;\'()*+,-./0123456789:;&lt;=&gt;?\@
                   1031: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
                   1032: </pre>
                   1033: ENDERROR
1.94      raeburn  1034:         &passwordchanger($r,$errormessage,$caller,$mailtoken);
                   1035:         return 1;
1.4       matthew  1036:     }
                   1037:     # 
                   1038:     # Change the password (finally)
                   1039:     my $result = &Apache::lonnet::changepass
1.94      raeburn  1040: 	($user,$domain,$currentpass,$newpass1,$homeserver,$caller);
1.4       matthew  1041:     # Inform the user the password has (not?) been changed
                   1042:     if ($result =~ /^ok$/) {
                   1043: 	$r->print(<<"ENDTEXT");
1.94      raeburn  1044: <h3>The password for $user was successfully changed</h3>
1.4       matthew  1045: ENDTEXT
                   1046:     } else {
                   1047: 	# error error: run in circles, scream and shout
                   1048:         $r->print(<<ENDERROR);
1.94      raeburn  1049: <h3><font color="#ff0000">The password for $user was not changed</font></h3>
1.8       matthew  1050: Please make sure your old password was entered correctly.
1.4       matthew  1051: ENDERROR
1.75      albertel 1052:         return 1;
1.4       matthew  1053:     }
                   1054:     return;
1.3       matthew  1055: }
                   1056: 
1.42      raeburn  1057: ################################################################
                   1058: #            discussion display subroutines 
                   1059: ################################################################
                   1060: sub discussionchanger {
                   1061:     my $r = shift;
1.59      albertel 1062:     my $user       = $env{'user.name'};
                   1063:     my $domain     = $env{'user.domain'};
1.42      raeburn  1064:     my %userenv = &Apache::lonnet::get
1.43      raeburn  1065:         ('environment',['discdisplay','discmarkread']);
                   1066:     my $discdisp = 'allposts';
                   1067:     my $discmark = 'onmark';
                   1068: 
                   1069:     if (defined($userenv{'discdisplay'})) {
                   1070:         unless ($userenv{'discdisplay'} eq '') { 
                   1071:             $discdisp = $userenv{'discdisplay'};
                   1072:         }
                   1073:     }
                   1074:     if (defined($userenv{'discmarkread'})) {
                   1075:         unless ($userenv{'discdisplay'} eq '') { 
                   1076:             $discmark = $userenv{'discmarkread'};
                   1077:         }
                   1078:     }
                   1079: 
                   1080:     my $newdisp = 'unread';
                   1081:     my $newmark = 'ondisp';
                   1082: 
                   1083:     my $function = &Apache::loncommon::get_users_function();
                   1084:     my $color = &Apache::loncommon::designparm($function.'.tabbg',
1.59      albertel 1085:                                                     $env{'user.domain'});
1.43      raeburn  1086:     my %lt = &Apache::lonlocal::texthash(
                   1087:         'pref' => 'Display Preference',
                   1088:         'curr' => 'Current setting ',
                   1089:         'actn' => 'Action',
                   1090:         'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
                   1091:         'prca' => 'Preferences can be set that determine',
                   1092:         'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
                   1093:         'unwh' => 'Under what circumstances posts are identfied as "New"',
                   1094:         'allposts' => 'All posts',
                   1095:         'unread' => 'New posts only',
                   1096:         'ondisp' => 'Once displayed',
                   1097:         'onmark' => 'Once marked as read',
                   1098:         'disa' => 'Posts displayed?',
                   1099:         'npmr' => 'New posts cease to be identified as "New"?',
                   1100:         'thde'  => 'The preferences you set here can be overridden within each individual discussion.',
                   1101:         'chgt' => 'Change to '
                   1102:     );
                   1103:     my $dispchange = $lt{'unread'};
                   1104:     my $markchange = $lt{'ondisp'};
                   1105:     my $currdisp = $lt{'allposts'};
                   1106:     my $currmark = $lt{'onmark'};
                   1107: 
                   1108:     if ($discdisp eq 'unread') {
                   1109:         $dispchange = $lt{'allposts'};
                   1110:         $currdisp = $lt{'unread'};
                   1111:         $newdisp = 'allposts';
                   1112:     }
                   1113: 
                   1114:     if ($discmark eq 'ondisp') {
                   1115:         $markchange = $lt{'onmark'};
                   1116:         $currmark = $lt{'ondisp'};
                   1117:         $newmark = 'onmark';
1.42      raeburn  1118:     }
1.43      raeburn  1119:     
                   1120:     $r->print(<<"END");
1.88      albertel 1121: <form name="prefs" action="/adm/preferences" method="post">
1.42      raeburn  1122: <input type="hidden" name="action" value="verify_and_change_discussion" />
                   1123: <br />
1.87      albertel 1124: $lt{'sdpf'}<br /> $lt{'prca'}  <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol> 
1.43      raeburn  1125: <br />
                   1126: <br />
1.82      albertel 1127: END
                   1128:     $r->print(&Apache::loncommon::start_data_table());
                   1129:     $r->print(<<"END");
                   1130:        <tr>
                   1131:         <th>$lt{'pref'}</th>
                   1132:         <th>$lt{'curr'}</th>
                   1133:         <th>$lt{'actn'}?</th>
1.43      raeburn  1134:        </tr>
1.82      albertel 1135: END
                   1136:     $r->print(&Apache::loncommon::start_data_table_row());
                   1137:     $r->print(<<"END");
1.43      raeburn  1138:        <td>$lt{'disa'}</td>
                   1139:        <td>$lt{$discdisp}</td>
1.82      albertel 1140:        <td><label><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" />&nbsp;$lt{'chgt'} "$dispchange"</label></td>
                   1141: END
                   1142:     $r->print(&Apache::loncommon::end_data_table_row().
                   1143: 	      &Apache::loncommon::start_data_table_row());
                   1144:     $r->print(<<"END");
1.43      raeburn  1145:        <td>$lt{'npmr'}</td>
                   1146:        <td>$lt{$discmark}</td>
1.82      albertel 1147:        <td><label><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" />&nbsp;$lt{'chgt'} "$markchange"</label></td>
1.43      raeburn  1148:       </tr>
1.82      albertel 1149: END
                   1150:     $r->print(&Apache::loncommon::end_data_table_row().
                   1151: 	      &Apache::loncommon::end_data_table());
                   1152:     $r->print(<<"END");
1.43      raeburn  1153: <br />
                   1154: <br />
                   1155: <input type="submit" name="sub" value="Store Changes" />
                   1156: <br />
                   1157: <br />
                   1158: Note: $lt{'thde'}
                   1159: </form>
                   1160: END
1.42      raeburn  1161: }
                   1162:                                                                                                                 
                   1163: sub verify_and_change_discussion {
                   1164:     my $r = shift;
1.59      albertel 1165:     my $user     = $env{'user.name'};
                   1166:     my $domain   = $env{'user.domain'};
1.42      raeburn  1167:     my $message='';
1.59      albertel 1168:     if (defined($env{'form.discdisp'}) ) {
                   1169:         my $newdisp  = $env{'form.newdisp'};
1.43      raeburn  1170:         if ($newdisp eq 'unread') {
1.87      albertel 1171:             $message .='In discussions: only new posts will be displayed.<br />';
1.43      raeburn  1172:             &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
                   1173:             &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
                   1174:         } else {
1.87      albertel 1175:             $message .= 'In discussions: all posts will be displayed.<br />';
1.43      raeburn  1176:             &Apache::lonnet::del('environment',['discdisplay']);
                   1177:             &Apache::lonnet::delenv('environment\.discdisplay');
                   1178:         }
                   1179:     }
1.59      albertel 1180:     if (defined($env{'form.discmark'}) ) {
                   1181:         my $newmark = $env{'form.newmark'};
1.43      raeburn  1182:         if ($newmark eq 'ondisp') {
1.87      albertel 1183:            $message.='In discussions: new posts will be cease to be identified as "new" after display.<br />';
1.43      raeburn  1184:             &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
                   1185:             &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
                   1186:         } else {
1.87      albertel 1187:             $message.='In discussions: posts will be identified as "new" until marked as read by the reader.<br />';
1.43      raeburn  1188:             &Apache::lonnet::del('environment',['discmarkread']);
                   1189:             &Apache::lonnet::delenv('environment\.discmarkread');
                   1190:         }
1.42      raeburn  1191:     }
                   1192:     $r->print(<<ENDVCSCREEN);
                   1193: $message
                   1194: ENDVCSCREEN
                   1195: }
                   1196: 
1.63      raeburn  1197: ################################################################
                   1198: # Subroutines for page display on course access (Course Coordinators)
                   1199: ################################################################
                   1200: sub coursedisplaychanger {
                   1201:     my $r = shift;
                   1202:     my $user       = $env{'user.name'};
                   1203:     my $domain     = $env{'user.domain'};
1.66      albertel 1204:     my %userenv = &Apache::lonnet::get('environment',['course_init_display']);
1.71      raeburn  1205:     my $currvalue = 'whatsnew';
1.73      albertel 1206:     my $firstselect = '';
                   1207:     my $whatsnewselect = 'checked="checked"';
1.71      raeburn  1208:     if (exists($userenv{'course_init_display'})) {
                   1209:         if ($userenv{'course_init_display'} eq 'firstres') {
                   1210:             $currvalue = 'firstres';
1.73      albertel 1211:             $firstselect = 'checked="checked"';
                   1212: 	    $whatsnewselect = '';
1.71      raeburn  1213:         }
1.63      raeburn  1214:     }
1.71      raeburn  1215:     my %pagenames = (
                   1216:                        firstres => 'First resource',
                   1217:                        whatsnew => "What's new page",
                   1218:                     );
1.70      raeburn  1219:     my $whatsnew_off=&mt('Display the [_1] in the course.','<b>first resource</b>');
                   1220:     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  1221: 
1.71      raeburn  1222:     $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  1223:     $r->print(<<ENDLSCREEN);
1.88      albertel 1224: <form name="prefs" action="/adm/preferences" method="post">
1.63      raeburn  1225: <input type="hidden" name="action" value="verify_and_change_coursepage" />
1.72      albertel 1226: <br />
1.65      albertel 1227: <label><input type="radio" name="newdisp" value="firstres" $firstselect /> $whatsnew_off</label><br />
1.70      raeburn  1228: <label><input type="radio" name="newdisp" value="whatsnew" $whatsnewselect /> $whatsnew_on</label><input type="hidden" name="refpage" value="$env{'form.refpage'}" />
1.63      raeburn  1229: ENDLSCREEN
1.70      raeburn  1230:     $r->print('<br /><br /><input type="submit" value="'.&mt('Change').'" />
1.63      raeburn  1231: </form>');
                   1232: }
                   1233: 
                   1234: sub verify_and_change_coursepage {
                   1235:     my $r = shift;
                   1236:     my $message='';
                   1237:     my %lt = &Apache::lonlocal::texthash(
1.70      raeburn  1238:         'defs' => 'Default now set',
1.71      raeburn  1239:         'when' => 'when you select a course role from the roles screen',
1.63      raeburn  1240:         'ywbt' => 'you will be taken to the start of the course.',
                   1241:         'apwb' => 'a page will be displayed that lists items in the course that may require action from you.',
                   1242:         'gtts' => 'Go to the start of the course',
1.70      raeburn  1243:         'dasp' => "Display the What's New page listing course action items", 
1.63      raeburn  1244:     );
                   1245:     my $newdisp  = $env{'form.newdisp'};
1.70      raeburn  1246:     $message = '<b>'.$lt{'defs'}.'</b>: '.$lt{'when'}.', ';
1.63      raeburn  1247:     if ($newdisp eq 'firstres') {
1.87      albertel 1248:         $message .= $lt{'ywbt'}.'<br />';
1.63      raeburn  1249:         &Apache::lonnet::put('environment',{'course_init_display' => $newdisp});
                   1250:         &Apache::lonnet::appenv('environment.course_init_display' => $newdisp);
                   1251:     } else {
1.87      albertel 1252:         $message .= $lt{'apwb'}.'<br />';
1.63      raeburn  1253:         &Apache::lonnet::del('environment',['course_init_display']);
                   1254:         &Apache::lonnet::delenv('environment\.course_init_display');
                   1255:     }
1.70      raeburn  1256:     my $refpage = $env{'form.refpage'};
1.63      raeburn  1257:     if (($env{'request.course.fn'}) && ($env{'request.course.id'})) {
                   1258:         if ($newdisp eq 'firstres') {
                   1259:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1260:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 
                   1261:             my ($furl,$ferr)=
                   1262:                 &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
                   1263:             $message .= '<br /><font size="+1"><a href="'.$furl.'">'.$lt{'gtts'}.' <i>'.&mt('now').'</i></a></font>';
                   1264:         } else {
1.70      raeburn  1265:             $message .= '<br /><font size="+1"><a href="/adm/whatsnew?refpage='.
                   1266:                         $refpage.'">'.$lt{'dasp'}.'</a></font>';
1.63      raeburn  1267:         }
                   1268:     }
                   1269:     $r->print(<<ENDVCSCREEN);
                   1270: $message
                   1271: <br /><br />
                   1272: ENDVCSCREEN
                   1273: }
                   1274: 
                   1275: 
1.4       matthew  1276: ######################################################
                   1277: #            other handler subroutines               #
                   1278: ######################################################
                   1279: 
1.3       matthew  1280: ################################################################
                   1281: #                          Main handler                        #
                   1282: ################################################################
1.1       www      1283: sub handler {
                   1284:     my $r = shift;
1.59      albertel 1285:     my $user = $env{'user.name'};
                   1286:     my $domain = $env{'user.domain'};
1.31      www      1287:     &Apache::loncommon::content_type($r,'text/html');
1.4       matthew  1288:     # Some pages contain DES keys and should not be cached.
                   1289:     &Apache::loncommon::no_cache($r);
1.1       www      1290:     $r->send_http_header;
                   1291:     return OK if $r->header_only;
1.9       matthew  1292:     #
1.35      matthew  1293:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.70      raeburn  1294:                                    ['action','wysiwyg','returnurl','refpage']);
1.35      matthew  1295:     #
                   1296:     &Apache::lonhtmlcommon::clear_breadcrumbs();
                   1297:     &Apache::lonhtmlcommon::add_breadcrumb
                   1298:         ({href => '/adm/preferences',
                   1299:           text => 'Set User Preferences'});
                   1300: 
                   1301:     my @Options;
                   1302:     # Determine current authentication method
                   1303:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                   1304:     if ($currentauth =~ /^(unix|internal):/) {
                   1305:         push (@Options,({ action   => 'changepass',
1.40      www      1306:                           linktext => 'Change Password',
1.35      matthew  1307:                           href     => '/adm/preferences',
                   1308:                           help     => 'Change_Password',
                   1309:                           subroutine => \&passwordchanger,
                   1310:                           breadcrumb => 
                   1311:                               { href => '/adm/preferences?action=changepass',
                   1312:                                 text => 'Change Password'},
                   1313:                           },
                   1314:                         { action => 'verify_and_change_pass',
                   1315:                           subroutine => \&verify_and_change_password,
                   1316:                           breadcrumb => 
                   1317:                               { href =>'/adm/preferences?action=changepass',
                   1318:                                 text => 'Change Password'},
1.75      albertel 1319:                           printmenu => 'not_on_error',
1.35      matthew  1320:                           }));
                   1321:     }
                   1322:     push (@Options,({ action   => 'changescreenname',
                   1323:                       linktext => 'Change Screen Name',
                   1324:                       href     => '/adm/preferences',
                   1325:                       help     => 'Prefs_Screen_Name_Nickname',
                   1326:                       subroutine => \&screennamechanger,
                   1327:                       breadcrumb => 
                   1328:                           { href => '/adm/preferences?action=changescreenname',
                   1329:                             text => 'Change Screen Name'},
                   1330:                       },
                   1331:                     { action   => 'verify_and_change_screenname',
                   1332:                       subroutine => \&verify_and_change_screenname,
                   1333:                       breadcrumb => 
                   1334:                           { href => '/adm/preferences?action=changescreenname',
                   1335:                             text => 'Change Screen Name'},
                   1336:                       printmenu => 'yes',
                   1337:                       }));
                   1338: 
                   1339:     push (@Options,({ action   => 'changemsgforward',
1.49      albertel 1340:                       linktext => 'Change Message Forwarding and Notification Addresses',
1.35      matthew  1341:                       href     => '/adm/preferences',
                   1342:                       help     => 'Prefs_Forwarding',
                   1343:                       breadcrumb => 
                   1344:                           { href => '/adm/preferences?action=changemsgforward',
                   1345:                             text => 'Change Message Forwarding'},
                   1346:                       subroutine => \&msgforwardchanger,
                   1347:                       },
                   1348:                     { action => 'verify_and_change_msgforward',
                   1349:                       breadcrumb => 
                   1350:                           { href => '/adm/preferences?action=changemsgforward',
                   1351:                             text => 'Change Message Forwarding'},
                   1352:                       printmenu => 'yes',
                   1353:                       subroutine => \&verify_and_change_msgforward }));
                   1354:     my $aboutmeaction=
1.59      albertel 1355:         '/adm/'.$env{'user.domain'}.'/'.$env{'user.name'}.'/aboutme';
1.35      matthew  1356:     push (@Options,{ action => 'none', 
                   1357:                      linktext =>
1.41      www      1358:                          q{Edit the 'About Me' Personal Information Screen},
1.45      www      1359: 		     help => 'Prefs_About_Me',
1.35      matthew  1360:                      href => $aboutmeaction});
                   1361:     push (@Options,({ action => 'changecolors',
                   1362:                       linktext => 'Change Color Scheme',
                   1363:                       href => '/adm/preferences',
                   1364:                       help => 'Change_Colors',
                   1365:                       breadcrumb => 
                   1366:                           { href => '/adm/preferences?action=changecolors',
                   1367:                             text => 'Change Colors'},
                   1368:                       subroutine => \&colorschanger,
                   1369:                   },
                   1370:                     { action => 'verify_and_change_colors',
                   1371:                       breadcrumb => 
                   1372:                           { href => '/adm/preferences?action=changecolors',
                   1373:                             text => 'Change Colors'},
                   1374:                       printmenu => 'yes',
                   1375:                       subroutine => \&verify_and_change_colors,
                   1376:                       }));
                   1377:     push (@Options,({ action => 'changelanguages',
1.39      www      1378:                       linktext => 'Change Language Preferences',
1.35      matthew  1379:                       href => '/adm/preferences',
1.45      www      1380: 		      help => 'Prefs_Language',
1.35      matthew  1381:                       breadcrumb=>
                   1382:                           { href => '/adm/preferences?action=changelanguages',
                   1383:                             text => 'Change Language'},
                   1384:                       subroutine =>  \&languagechanger,
                   1385:                   },
                   1386:                     { action => 'verify_and_change_languages',
                   1387:                       breadcrumb=>
                   1388:                           {href => '/adm/preferences?action=changelanguages',
                   1389:                            text => 'Change Language'},
                   1390:                       printmenu => 'yes',
                   1391:                       subroutine=>\&verify_and_change_languages, }
                   1392:                     ));
1.44      www      1393:     push (@Options,({ action => 'changewysiwyg',
                   1394:                       linktext => 'Change WYSIWYG Editor Preferences',
                   1395:                       href => '/adm/preferences',
                   1396:                       breadcrumb => 
                   1397:                             { href => '/adm/preferences?action=changewysiwyg',
                   1398:                               text => 'Change WYSIWYG Preferences'},
                   1399:                       subroutine => \&wysiwygchanger,
                   1400:                   },
                   1401:                     { action => 'set_wysiwyg',
                   1402:                       breadcrumb =>
                   1403:                           { href => '/adm/preferences?action=changewysiwyg',
                   1404:                             text => 'Change WYSIWYG Preferences'},
                   1405:                       printmenu => 'yes',
                   1406:                       subroutine => \&verify_and_change_wysiwyg, }
                   1407:                     ));
1.42      raeburn  1408:     push (@Options,({ action => 'changediscussions',
                   1409:                       linktext => 'Change Discussion Display Preferences',
                   1410:                       href => '/adm/preferences',
1.46      raeburn  1411:                       help => 'Change_Discussion_Display',
1.42      raeburn  1412:                       breadcrumb => 
                   1413:                             { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1414:                               text => 'Change Discussion Preferences'},
1.42      raeburn  1415:                       subroutine => \&discussionchanger,
                   1416:                   },
                   1417:                     { action => 'verify_and_change_discussion',
                   1418:                       breadcrumb =>
                   1419:                           { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1420:                             text => 'Change Discussion Preferences'},
1.42      raeburn  1421:                       printmenu => 'yes',
                   1422:                       subroutine => \&verify_and_change_discussion, }
                   1423:                     ));
                   1424:                        
1.50      albertel 1425:     push (@Options,({ action   => 'changerolespref',
                   1426:                       linktext => 'Change Roles Page Preferences',
                   1427:                       href     => '/adm/preferences',
                   1428:                       subroutine => \&rolesprefchanger,
                   1429:                       breadcrumb =>
                   1430:                           { href => '/adm/preferences?action=changerolespref',
                   1431:                             text => 'Change Roles Pref'},
                   1432:                       },
                   1433:                     { action   => 'verify_and_change_rolespref',
                   1434:                       subroutine => \&verify_and_change_rolespref,
                   1435:                       breadcrumb =>
                   1436:                           { href => '/adm/preferences?action=changerolespref',
                   1437:                             text => 'Change Roles Preferences'},
                   1438:                       printmenu => 'yes',
                   1439:                       }));
                   1440: 
1.54      albertel 1441:     push (@Options,({ action   => 'changetexenginepref',
                   1442:                       linktext => 'Change How Math Equations Are Displayed',
                   1443:                       href     => '/adm/preferences',
                   1444:                       subroutine => \&texenginechanger,
                   1445:                       breadcrumb =>
                   1446:                           { href => '/adm/preferences?action=changetexenginepref',
                   1447:                             text => 'Change Math Pref'},
                   1448:                       },
                   1449:                     { action   => 'verify_and_change_texengine',
                   1450:                       subroutine => \&verify_and_change_texengine,
                   1451:                       breadcrumb =>
                   1452:                           { href => '/adm/preferences?action=changetexenginepref',
                   1453:                             text => 'Change Math Preferences'},
                   1454:                       printmenu => 'yes',
                   1455:                       }));
1.85      albertel 1456: 
                   1457:     if ($env{'environment.remote'} eq 'off') {
                   1458: 	push (@Options,({ action => 'launch',
                   1459: 			  linktext => 'Launch Remote Control',
                   1460: 			  href => '/adm/remote?url=/adm/preferences',
                   1461: 		      }));
                   1462:     } else {
                   1463: 	push (@Options,({ action => 'collapse',
                   1464: 			  linktext => 'Collapse Remote Control',
                   1465: 			  href => '/adm/remote?url=/adm/preferences',
                   1466: 		      }));
                   1467:     }
                   1468: 
1.74      albertel 1469:     if (&Apache::lonnet::allowed('whn',$env{'request.course.id'})
                   1470: 	|| &Apache::lonnet::allowed('whn',$env{'request.course.id'}.'/'
                   1471: 				    .$env{'request.course.sec'})) {
1.63      raeburn  1472:         push (@Options,({ action => 'changecourseinit',
                   1473:                           linktext => 'Change Course Initialization Preference',
                   1474:                           href => '/adm/preferences',
                   1475:                           subroutine => \&coursedisplaychanger,
                   1476:                           breadcrumb =>
                   1477:                               { href => '/adm/preferences?action=changecourseinit',
                   1478:                                 text => 'Change Course Init. Pref.'},
                   1479:                           },
                   1480:                         { action => 'verify_and_change_coursepage',
                   1481:                           breadcrumb =>
                   1482:                           { href => '/adm/preferences?action=changecourseinit',                               text => 'Change Course Initialization Preference'},
                   1483:                         printmenu => 'yes',
                   1484:                         subroutine => \&verify_and_change_coursepage,
                   1485:                        }));
                   1486:     }
1.50      albertel 1487: 
1.62      raeburn  1488:     if ($env{'user.name'} =~ /^(albertel|fox|foxr|koretemey|korte|hallmat3|turtle|raeburn)$/) {
1.35      matthew  1489:         push (@Options,({ action => 'debugtoggle',
                   1490:                           printmenu => 'yes',
                   1491:                           subroutine => \&toggle_debug,
                   1492:                           }));
                   1493:     }
1.76      albertel 1494: 
                   1495:     $r->print(&Apache::loncommon::start_page('Change Preferences'));
                   1496: 
1.35      matthew  1497:     my $call = undef;
1.48      albertel 1498:     my $help = undef;
1.35      matthew  1499:     my $printmenu = 'yes';
                   1500:     foreach my $option (@Options) {
1.59      albertel 1501:         if ($option->{'action'} eq $env{'form.action'}) {
1.35      matthew  1502:             $call = $option->{'subroutine'};
                   1503:             $printmenu = $option->{'printmenu'};
                   1504:             if (exists($option->{'breadcrumb'})) {
                   1505:                 &Apache::lonhtmlcommon::add_breadcrumb
                   1506:                     ($option->{'breadcrumb'});
                   1507:             }
1.48      albertel 1508: 	    $help=$option->{'help'};
1.35      matthew  1509:         }
                   1510:     }
1.81      albertel 1511:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Change Preferences',$help));
1.75      albertel 1512:     my $error;
1.35      matthew  1513:     if (defined($call)) {
1.75      albertel 1514:         $error = $call->($r);
1.35      matthew  1515:     }
1.75      albertel 1516:     if ( ( ($printmenu eq 'yes')
                   1517: 	   || ($printmenu eq 'not_on_error' && !$error) )
                   1518: 	 && (!$env{'form.returnurl'})) {
1.35      matthew  1519:         my $optionlist = '<table cellpadding="5">';
1.59      albertel 1520:         if ($env{'user.name'} =~ 
1.62      raeburn  1521:                          /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle|raeburn)$/
1.35      matthew  1522:             ) {
                   1523:             push (@Options,({ action => 'debugtoggle',
                   1524:                               linktext => 'Toggle Debug Messages',
                   1525:                               text => 'Current Debug status is -'.
1.59      albertel 1526:                                   $env{'user.debug'}.'-.',
1.35      matthew  1527:                               href => '/adm/preferences',
                   1528:                               printmenu => 'yes',
                   1529:                               subroutine => \&toggle_debug,
                   1530:                               }));
                   1531:         }
                   1532:         foreach my $option(@Options) {
                   1533:             my $optiontext = '';
                   1534:             if (exists($option->{'href'})) {
1.85      albertel 1535: 		$option->{'href_args'}{'action'}=$option->{'action'};
                   1536: 		$optiontext .= 
                   1537:                     '<a href="'.&add_get_param($option->{'href'},
                   1538: 					       $option->{'href_args'}).'">'.
1.47      albertel 1539:                     &mt($option->{'linktext'}).'</a>';
1.35      matthew  1540:             }
                   1541:             if (exists($option->{'text'})) {
1.47      albertel 1542:                 $optiontext .= ' '.&mt($option->{'text'});
1.35      matthew  1543:             }
                   1544:             if ($optiontext ne '') {
                   1545:                 $optiontext = '<font size="+1">'.$optiontext.'</font>'; 
                   1546:                 my $helplink = '&nbsp;';
                   1547:                 if (exists($option->{'help'})) {
                   1548:                     $helplink = &Apache::loncommon::help_open_topic
                   1549:                                                     ($option->{'help'});
                   1550:                 }
                   1551:                 $optionlist .= '<tr>'.
                   1552:                     '<td>'.$helplink.'</td>'.
                   1553:                     '<td>'.$optiontext.'</td>'.
                   1554:                     '</tr>';
                   1555:             }
1.13      www      1556:         }
1.35      matthew  1557:         $optionlist .= '</table>';
                   1558:         $r->print($optionlist);
1.59      albertel 1559:     } elsif ($env{'form.returnurl'}) {
                   1560: 	$r->print('<br /><a href="'.$env{'form.returnurl'}.'"><font size="+1">'.
1.44      www      1561: 		  &mt('Return').'</font></a>');
1.3       matthew  1562:     }
1.76      albertel 1563:     $r->print(&Apache::loncommon::end_page());
1.1       www      1564:     return OK;
1.35      matthew  1565: }
                   1566: 
                   1567: sub toggle_debug {
1.59      albertel 1568:     if ($env{'user.debug'}) {
1.35      matthew  1569:         &Apache::lonnet::delenv('user\.debug');
                   1570:     } else {
                   1571:         &Apache::lonnet::appenv('user.debug' => 1);
                   1572:     }
1.13      www      1573: }
1.1       www      1574: 
                   1575: 1;
                   1576: __END__

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