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

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

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