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

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

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