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

1.1       www         1: # The LearningOnline Network
                      2: # Preferences
                      3: #
1.53    ! albertel    4: # $Id: lonpreferences.pm,v 1.52 2005/01/20 21:32:55 raeburn Exp $
1.2       albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.3       matthew    28: # This package uses the "londes.js" javascript code. 
                     29: #
                     30: # TODOs that have to be completed:
                     31: #    interface with lonnet to change the password
                     32:  
1.1       www        33: package Apache::lonpreferences;
                     34: 
                     35: use strict;
                     36: use Apache::Constants qw(:common);
1.3       matthew    37: use Apache::File;
                     38: use Crypt::DES;
                     39: use DynaLoader; # for Crypt::DES version
1.4       matthew    40: use Apache::loncommon();
1.23      matthew    41: use Apache::lonhtmlcommon();
1.32      www        42: use Apache::lonlocal;
1.3       matthew    43: 
                     44: #
                     45: # Write lonnet::passwd to do the call below.
                     46: # Use:
                     47: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                     48: #
                     49: ##################################################
                     50: #          password associated functions         #
                     51: ##################################################
                     52: sub des_keys {
1.4       matthew    53:     # Make a new key for DES encryption.
1.36      www        54:     # Each key has two parts which are returned separately.
1.4       matthew    55:     # Please note:  Each key must be passed through the &hex function
                     56:     # before it is output to the web browser.  The hex versions cannot
                     57:     # be used to decrypt.
1.3       matthew    58:     my @hexstr=('0','1','2','3','4','5','6','7',
                     59:                 '8','9','a','b','c','d','e','f');
                     60:     my $lkey='';
                     61:     for (0..7) {
                     62:         $lkey.=$hexstr[rand(15)];
                     63:     }
                     64:     my $ukey='';
                     65:     for (0..7) {
                     66:         $ukey.=$hexstr[rand(15)];
                     67:     }
                     68:     return ($lkey,$ukey);
                     69: }
                     70: 
                     71: sub des_decrypt {
                     72:     my ($key,$cyphertext) = @_;
                     73:     my $keybin=pack("H16",$key);
                     74:     my $cypher;
                     75:     if ($Crypt::DES::VERSION>=2.03) {
                     76:         $cypher=new Crypt::DES $keybin;
                     77:     } else {
                     78:         $cypher=new DES $keybin;
                     79:     }
                     80:     my $plaintext=
                     81: 	$cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                     82:     $plaintext.=
                     83: 	$cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
1.4       matthew    84:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
1.3       matthew    85:     return $plaintext;
                     86: }
                     87: 
1.4       matthew    88: ################################################################
                     89: #                       Handler subroutines                    #
                     90: ################################################################
1.9       matthew    91: 
                     92: ################################################################
1.28      www        93: #         Language Change Subroutines                          #
                     94: ################################################################
1.44      www        95: 
                     96: sub wysiwygchanger {
                     97:     my $r = shift;
                     98:     my %userenv = &Apache::lonnet::get
                     99:         ('environment',['wysiwygeditor']);
                    100:     my $offselect='';
                    101:     my $onselect='checked="1"';
                    102:     if ($userenv{'wysiwygeditor'}) {
                    103: 	$onselect='';
                    104: 	$offselect='checked="1"';
                    105:     }
                    106:     my $switchoff=&mt('Disable WYSIWYG editor');
                    107:     my $switchon=&mt('Enable WYSIWYG editor');
                    108:     $r->print(<<ENDLSCREEN);
                    109: <form name="server" action="/adm/preferences" method="post">
                    110: <input type="hidden" name="action" value="set_wysiwyg" />
                    111: <br />
                    112: <input type="radio" name="wysiwyg" value="off" $onselect /> $switchoff<br />
                    113: <input type="radio" name="wysiwyg" value="on" $offselect /> $switchon
                    114: ENDLSCREEN
                    115:     $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
                    116: }
                    117: 
                    118: 
                    119: sub verify_and_change_wysiwyg {
                    120:     my $r = shift;
                    121:     my $newsetting=$ENV{'form.wysiwyg'};
                    122:     &Apache::lonnet::put('environment',{'wysiwygeditor' => $newsetting});
                    123:     &Apache::lonnet::appenv('environment.wysiwygeditor' => $newsetting);
                    124:     $r->print('<p>'.&mt('Setting WYSIWYG editor to:').' '.&mt($newsetting).'</p>');
                    125: }
                    126: 
                    127: ################################################################
                    128: #         Language Change Subroutines                          #
                    129: ################################################################
1.28      www       130: sub languagechanger {
                    131:     my $r = shift;
                    132:     my $user       = $ENV{'user.name'};
                    133:     my $domain     = $ENV{'user.domain'};
                    134:     my %userenv = &Apache::lonnet::get
1.32      www       135:         ('environment',['languages']);
1.29      www       136:     my $language=$userenv{'languages'};
1.32      www       137: 
1.33      www       138:     my $pref=&mt('Preferred language');
                    139:     my %langchoices=('' => 'No language preference');
                    140:     foreach (&Apache::loncommon::languageids()) {
                    141: 	if (&Apache::loncommon::supportedlanguagecode($_)) {
                    142: 	    $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
                    143: 	               = &Apache::loncommon::plainlanguagedescription($_);
                    144: 	}
                    145:     }
                    146:     my $selectionbox=&Apache::loncommon::select_form($language,'language',
                    147: 						     %langchoices);
1.28      www       148:     $r->print(<<ENDLSCREEN);
                    149: <form name="server" action="/adm/preferences" method="post">
                    150: <input type="hidden" name="action" value="verify_and_change_languages" />
1.33      www       151: <br />$pref: $selectionbox
1.28      www       152: ENDLSCREEN
1.35      matthew   153:     $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
1.28      www       154: }
                    155: 
                    156: 
                    157: sub verify_and_change_languages {
                    158:     my $r = shift;
                    159:     my $user       = $ENV{'user.name'};
                    160:     my $domain     = $ENV{'user.domain'};
                    161: # Screenname
                    162:     my $newlanguage  = $ENV{'form.language'};
                    163:     $newlanguage=~s/[^\-\w]//g;
                    164:     my $message='';
                    165:     if ($newlanguage) {
1.29      www       166:         &Apache::lonnet::put('environment',{'languages' => $newlanguage});
                    167:         &Apache::lonnet::appenv('environment.languages' => $newlanguage);
                    168:         $message='Set new preferred languages to '.$newlanguage;
1.28      www       169:     } else {
1.29      www       170:         &Apache::lonnet::del('environment',['languages']);
                    171:         &Apache::lonnet::delenv('environment\.languages');
1.28      www       172:         $message='Reset preferred language';
                    173:     }
                    174:     $r->print(<<ENDVCSCREEN);
                    175: </p>
                    176: $message
                    177: ENDVCSCREEN
                    178: }
                    179: 
1.50      albertel  180: ################################################################
                    181: #         Roles Page Preference Change Subroutines         #
                    182: ################################################################
                    183: sub rolesprefchanger {
                    184:     my $r = shift;
                    185:     my $user       = $ENV{'user.name'};
                    186:     my $domain     = $ENV{'user.domain'};
                    187:     my %userenv = &Apache::lonnet::get
                    188:         ('environment',['recentroles','recentrolesn']);
                    189:     my $hotlist_flag=$userenv{'recentroles'};
                    190:     my $hotlist_n=$userenv{'recentrolesn'};
                    191:     my $checked;
                    192:     if ($hotlist_flag) {
                    193: 	$checked = 'checked="checked"';
                    194:     }
                    195:     
                    196:     if (!$hotlist_n) { $hotlist_n=3; }
                    197:     my $options;
                    198:     for (my $i=1; $i<10; $i++) {
                    199: 	my $select;
                    200: 	if ($hotlist_n == $i) { $select = 'selected="selected"'; }
                    201: 	$options .= "<option $select>$i</option>\n";
                    202:     }
                    203: 
                    204:     $r->print(<<ENDSCREEN);
                    205: <p>Some LON-CAPA users have a long list of roles. The Recent Roles Hotlist
                    206: feature keeps track of the last N roles which have been
                    207: visited and places a table of these at the top of the roles page.
                    208: People with very few roles should leave this feature disabled.
                    209: </p>
                    210: 
                    211: <form name="server" action="/adm/preferences" method="post">
                    212: <input type="hidden" name="action" value="verify_and_change_rolespref" />
                    213: <br />Enable Recent Roles Hotlist:
                    214: <input type="checkbox" $checked name="recentroles" value="true" />
                    215: <br />Number of roles in Hotlist:
                    216: <select name="recentrolesn" size="1">
                    217: $options
                    218: </select>
                    219: <br />
                    220: <input type="submit" value="Change" />
                    221: </form>
                    222: ENDSCREEN
                    223: }
                    224: 
                    225: sub verify_and_change_rolespref {
                    226:     my $r = shift;
                    227:     my $user       = $ENV{'user.name'};
                    228:     my $domain     = $ENV{'user.domain'};
                    229: # Recent Roles Hotlist Flag
                    230:     my $hotlist_flag  = $ENV{'form.recentroles'};
                    231:     my $hotlist_n  = $ENV{'form.recentrolesn'};
                    232:     my $message='';
                    233:     if ($hotlist_flag) {
                    234:         &Apache::lonnet::put('environment',{'recentroles' => $hotlist_flag});
                    235:         &Apache::lonnet::appenv('environment.recentroles' => $hotlist_flag);
                    236:         $message='Recent Roles Hotlist is Enabled';
                    237:     } else {
                    238:         &Apache::lonnet::del('environment',['recentroles']);
                    239:         &Apache::lonnet::delenv('environment\.recentroles');
                    240:         $message='Recent Roles Hotlist is Disabled';
                    241:     }
                    242:     if ($hotlist_n) {
                    243:         &Apache::lonnet::put('environment',{'recentrolesn' => $hotlist_n});
                    244:         &Apache::lonnet::appenv('environment.recentrolesn' => $hotlist_n);
                    245:         if ($hotlist_flag) {
                    246:             $message.="<br />Display $hotlist_n Most Recent Roles\n";
                    247:         }
                    248:     }
                    249: 
                    250:     $r->print(<<ENDRPSCREEN);
                    251: </p>
                    252: $message
                    253: ENDRPSCREEN
                    254: }
                    255: 
                    256: 
1.28      www       257: 
                    258: ################################################################
1.9       matthew   259: #         Anonymous Discussion Name Change Subroutines         #
                    260: ################################################################
1.5       www       261: sub screennamechanger {
                    262:     my $r = shift;
                    263:     my $user       = $ENV{'user.name'};
                    264:     my $domain     = $ENV{'user.domain'};
1.14      www       265:     my %userenv = &Apache::lonnet::get
                    266:         ('environment',['screenname','nickname']);
1.6       www       267:     my $screenname=$userenv{'screenname'};
1.14      www       268:     my $nickname=$userenv{'nickname'};
1.5       www       269:     $r->print(<<ENDSCREEN);
1.6       www       270: <form name="server" action="/adm/preferences" method="post">
                    271: <input type="hidden" name="action" value="verify_and_change_screenname" />
1.14      www       272: <br />New screenname (shown if you post anonymously):
1.6       www       273: <input type="text" size="20" value="$screenname" name="screenname" />
1.14      www       274: <br />New nickname (shown if you post non-anonymously):
                    275: <input type="text" size="20" value="$nickname" name="nickname" />
1.6       www       276: <input type="submit" value="Change" />
                    277: </form>
1.5       www       278: ENDSCREEN
                    279: }
1.6       www       280: 
                    281: sub verify_and_change_screenname {
                    282:     my $r = shift;
                    283:     my $user       = $ENV{'user.name'};
                    284:     my $domain     = $ENV{'user.domain'};
1.14      www       285: # Screenname
1.6       www       286:     my $newscreen  = $ENV{'form.screenname'};
1.14      www       287:     $newscreen=~s/[^ \w]//g;
1.6       www       288:     my $message='';
                    289:     if ($newscreen) {
1.7       www       290:         &Apache::lonnet::put('environment',{'screenname' => $newscreen});
                    291:         &Apache::lonnet::appenv('environment.screenname' => $newscreen);
1.6       www       292:         $message='Set new screenname to '.$newscreen;
                    293:     } else {
                    294:         &Apache::lonnet::del('environment',['screenname']);
1.7       www       295:         &Apache::lonnet::delenv('environment\.screenname');
1.6       www       296:         $message='Reset screenname';
                    297:     }
1.14      www       298: # Nickname
                    299:     $message.='<br />';
1.17      matthew   300:     $newscreen  = $ENV{'form.nickname'};
1.14      www       301:     $newscreen=~s/[^ \w]//g;
                    302:     if ($newscreen) {
                    303:         &Apache::lonnet::put('environment',{'nickname' => $newscreen});
                    304:         &Apache::lonnet::appenv('environment.nickname' => $newscreen);
                    305:         $message.='Set new nickname to '.$newscreen;
                    306:     } else {
                    307:         &Apache::lonnet::del('environment',['nickname']);
                    308:         &Apache::lonnet::delenv('environment\.nickname');
                    309:         $message.='Reset nickname';
                    310:     }
                    311: 
1.6       www       312:     $r->print(<<ENDVCSCREEN);
                    313: </p>
                    314: $message
                    315: ENDVCSCREEN
1.20      www       316: }
                    317: 
                    318: ################################################################
                    319: #         Message Forward                                      #
                    320: ################################################################
                    321: 
                    322: sub msgforwardchanger {
                    323:     my $r = shift;
                    324:     my $user       = $ENV{'user.name'};
                    325:     my $domain     = $ENV{'user.domain'};
1.26      www       326:     my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
1.20      www       327:     my $msgforward=$userenv{'msgforward'};
                    328:     my $notification=$userenv{'notification'};
                    329:     my $critnotification=$userenv{'critnotification'};
1.25      bowersj2  330:     my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
                    331: 							    "What are forwarding ".
                    332: 							    "and notification ".
                    333: 							    "addresses");
1.27      bowersj2  334:     my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
                    335: 								 "What are critical messages");
                    336: 
1.20      www       337:     $r->print(<<ENDMSG);
1.25      bowersj2  338: $forwardingHelp <br />
1.20      www       339: <form name="server" action="/adm/preferences" method="post">
                    340: <input type="hidden" name="action" value="verify_and_change_msgforward" />
                    341: New Forwarding Address(es) (<tt>user:domain,user:domain,...</tt>):
                    342: <input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
                    343: New Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
                    344: <input type="text" size="40" value="$notification" name="notification" /><hr />
                    345: New Critical Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
1.27      bowersj2  346: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
1.20      www       347: <input type="submit" value="Change" />
                    348: </form>
                    349: ENDMSG
                    350: }
                    351: 
                    352: sub verify_and_change_msgforward {
                    353:     my $r = shift;
                    354:     my $user       = $ENV{'user.name'};
                    355:     my $domain     = $ENV{'user.domain'};
                    356:     my $newscreen  = '';
                    357:     my $message='';
                    358:     foreach (split(/\,/,$ENV{'form.msgforward'})) {
                    359: 	my ($msuser,$msdomain)=split(/[\@\:]/,$_);
                    360:         $msuser=~s/\W//g;
                    361:         $msdomain=~s/\W//g;
                    362:         if (($msuser) && ($msdomain)) {
                    363: 	    if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
                    364:                $newscreen.=$msuser.':'.$msdomain.',';
                    365: 	   } else {
                    366:                $message.='No such user: '.$msuser.':'.$msdomain.'<br>';
                    367:            }
                    368:         }
                    369:     }
                    370:     $newscreen=~s/\,$//;
                    371:     if ($newscreen) {
                    372:         &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
                    373:         &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
                    374:         $message.='Set new message forwarding to '.$newscreen.'<br />';
                    375:     } else {
                    376:         &Apache::lonnet::del('environment',['msgforward']);
                    377:         &Apache::lonnet::delenv('environment\.msgforward');
                    378:         $message.='Reset message forwarding<br />';
                    379:     }
                    380:     my $notification=$ENV{'form.notification'};
                    381:     $notification=~s/\s//gs;
                    382:     if ($notification) {
                    383:         &Apache::lonnet::put('environment',{'notification' => $notification});
                    384:         &Apache::lonnet::appenv('environment.notification' => $notification);
                    385:         $message.='Set message notification address to '.$notification.'<br />';
                    386:     } else {
                    387:         &Apache::lonnet::del('environment',['notification']);
                    388:         &Apache::lonnet::delenv('environment\.notification');
                    389:         $message.='Reset message notification<br />';
                    390:     }
                    391:     my $critnotification=$ENV{'form.critnotification'};
                    392:     $critnotification=~s/\s//gs;
                    393:     if ($critnotification) {
                    394:         &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
                    395:         &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
                    396:         $message.='Set critical message notification address to '.$critnotification;
                    397:     } else {
                    398:         &Apache::lonnet::del('environment',['critnotification']);
                    399:         &Apache::lonnet::delenv('environment\.critnotification');
                    400:         $message.='Reset critical message notification<br />';
                    401:     }
                    402:     $r->print(<<ENDVCMSG);
                    403: </p>
                    404: $message
                    405: ENDVCMSG
1.6       www       406: }
                    407: 
1.12      www       408: ################################################################
1.19      www       409: #         Colors                                               #
1.12      www       410: ################################################################
                    411: 
1.19      www       412: sub colorschanger {
1.12      www       413:     my $r = shift;
1.19      www       414: # figure out colors
                    415:     my $function='student';
                    416:     if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
                    417: 	$function='coordinator';
                    418:     }
                    419:     if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
                    420: 	$function='admin';
                    421:     }
                    422:     if (($ENV{'request.role'}=~/^(au|ca)/) ||
                    423: 	($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
                    424: 	$function='author';
                    425:     }
                    426:     my $domain=&Apache::loncommon::determinedomain();
                    427:     my %colortypes=('pgbg'  => 'Page Background',
                    428:                     'tabbg' => 'Header Background',
                    429:                     'sidebg'=> 'Header Border',
                    430:                     'font'  => 'Font',
                    431:                     'link'  => 'Un-Visited Link',
                    432:                     'vlink' => 'Visited Link',
                    433:                     'alink' => 'Active Link');
                    434:     my $chtable='';
1.22      matthew   435:     foreach my $item (sort(keys(%colortypes))) {
1.19      www       436:        my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
                    437:        $chtable.='<tr><td>'.$colortypes{$item}.'</td><td bgcolor="'.$curcol.
                    438:         '">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td><td><input name="'.$item.
1.21      www       439:         '" size="10" value="'.$curcol.
                    440: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19      www       441: "','".$curcol."','"
1.21      www       442: 	    .$item."','parmform.pres','psub'".');">Select</a></td></tr>';
1.19      www       443:     }
1.23      matthew   444:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19      www       445:     $r->print(<<ENDCOL);
                    446: <script>
                    447: 
                    448:     function pclose() {
                    449:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    450:                  "height=350,width=350,scrollbars=no,menubar=no");
                    451:         parmwin.close();
                    452:     }
                    453: 
1.23      matthew   454:     $pjump_def
1.19      www       455: 
                    456:     function psub() {
                    457:         pclose();
                    458:         if (document.parmform.pres_marker.value!='') {
1.21      www       459:             if (document.parmform.pres_type.value!='') {
                    460:                 eval('document.server.'+
                    461:                      document.parmform.pres_marker.value+
1.19      www       462: 		     '.value=document.parmform.pres_value.value;');
1.21      www       463: 	    }
1.19      www       464:         } else {
                    465:             document.parmform.pres_value.value='';
                    466:             document.parmform.pres_marker.value='';
                    467:         }
                    468:     }
                    469: 
                    470: 
                    471: </script>
1.21      www       472: <form name="parmform">
                    473: <input type="hidden" name="pres_marker" />
                    474: <input type="hidden" name="pres_type" />
                    475: <input type="hidden" name="pres_value" />
                    476: </form>
1.12      www       477: <form name="server" action="/adm/preferences" method="post">
1.19      www       478: <input type="hidden" name="action" value="verify_and_change_colors" />
                    479: <table border="2">
                    480: $chtable
                    481: </table>
1.21      www       482: <input type="submit" value="Change Custom Colors" />
                    483: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12      www       484: </form>
1.19      www       485: ENDCOL
1.12      www       486: }
                    487: 
1.19      www       488: sub verify_and_change_colors {
1.12      www       489:     my $r = shift;
1.19      www       490: # figure out colors
                    491:     my $function='student';
                    492:     if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) {
                    493: 	$function='coordinator';
                    494:     }
                    495:     if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) {
                    496: 	$function='admin';
                    497:     }
                    498:     if (($ENV{'request.role'}=~/^(au|ca)/) ||
                    499: 	($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) {
                    500: 	$function='author';
                    501:     }
                    502:     my $domain=&Apache::loncommon::determinedomain();
                    503:     my %colortypes=('pgbg'  => 'Page Background',
                    504:                     'tabbg' => 'Header Background',
                    505:                     'sidebg'=> 'Header Border',
                    506:                     'font'  => 'Font',
                    507:                     'link'  => 'Un-Visited Link',
                    508:                     'vlink' => 'Visited Link',
                    509:                     'alink' => 'Active Link');
                    510: 
1.12      www       511:     my $message='';
1.21      www       512:     foreach my $item (keys %colortypes) {
                    513:         my $color=$ENV{'form.'.$item};
                    514:         my $entry='color.'.$function.'.'.$item;
                    515: 	if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$ENV{'form.resetall'})) {
                    516: 	    &Apache::lonnet::put('environment',{$entry => $color});
                    517: 	    &Apache::lonnet::appenv('environment.'.$entry => $color);
                    518: 	    $message.='Set '.$colortypes{$item}.' to '.$color.'<br />';
                    519: 	} else {
                    520: 	    &Apache::lonnet::del('environment',[$entry]);
                    521: 	    &Apache::lonnet::delenv('environment\.'.$entry);
                    522: 	    $message.='Reset '.$colortypes{$item}.'<br />';
                    523: 	}
                    524:     }
1.19      www       525:     $r->print(<<ENDVCCOL);
1.12      www       526: </p>
                    527: $message
1.21      www       528: <form name="client" action="/adm/preferences" method="post">
                    529: <input type="hidden" name="action" value="changecolors" />
                    530: </form>
1.19      www       531: ENDVCCOL
1.12      www       532: }
                    533: 
1.4       matthew   534: ######################################################
                    535: #            password handler subroutines            #
                    536: ######################################################
1.3       matthew   537: sub passwordchanger {
1.4       matthew   538:     # This function is a bit of a mess....
1.3       matthew   539:     # Passwords are encrypted using londes.js (DES encryption)
                    540:     my $r = shift;
1.4       matthew   541:     my $errormessage = shift;
                    542:     $errormessage = ($errormessage || '');
1.3       matthew   543:     my $user       = $ENV{'user.name'};
                    544:     my $domain     = $ENV{'user.domain'};
                    545:     my $homeserver = $ENV{'user.home'};
                    546:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                    547:     # Check for authentication types that allow changing of the password.
                    548:     return if ($currentauth !~ /^(unix|internal):/);
                    549:     #
                    550:     # Generate keys
                    551:     my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
                    552:     my ($lkey_npass1,$ukey_npass1) = &des_keys();
                    553:     my ($lkey_npass2,$ukey_npass2) = &des_keys();
1.4       matthew   554:     # Store the keys in the log files
1.3       matthew   555:     my $lonhost = $r->dir_config('lonHostID');
                    556:     my $logtoken=Apache::lonnet::reply('tmpput:'
                    557: 				       .$ukey_cpass  . $lkey_cpass .'&'
                    558: 				       .$ukey_npass1 . $lkey_npass1.'&'
                    559: 				       .$ukey_npass2 . $lkey_npass2,
                    560: 				       $lonhost);
1.4       matthew   561:     # Hexify the keys for output as javascript variables
1.3       matthew   562:     $ukey_cpass = hex($ukey_cpass);
                    563:     $lkey_cpass = hex($lkey_cpass);
                    564:     $ukey_npass1= hex($ukey_npass1);
                    565:     $lkey_npass1= hex($lkey_npass1);
                    566:     $ukey_npass2= hex($ukey_npass2);
                    567:     $lkey_npass2= hex($lkey_npass2);
                    568:     # Output javascript to deal with passwords
1.4       matthew   569:     # Output DES javascript
1.53    ! albertel  570:     my $html=&Apache::lonxml::xmlbegin();
        !           571:     $r->print($html."<head>");
1.3       matthew   572:     {
                    573: 	my $include = $r->dir_config('lonIncludes');
                    574: 	my $jsh=Apache::File->new($include."/londes.js");
                    575: 	$r->print(<$jsh>);
                    576:     }
                    577:     $r->print(<<ENDFORM);
                    578: <script language="JavaScript">
                    579: 
                    580:     function send() {
                    581:         uextkey=this.document.client.elements.ukey_cpass.value;
                    582:         lextkey=this.document.client.elements.lkey_cpass.value;
                    583:         initkeys();
                    584: 
1.52      raeburn   585:         this.document.pserver.elements.currentpass.value
1.3       matthew   586:             =crypted(this.document.client.elements.currentpass.value);
                    587: 
                    588:         uextkey=this.document.client.elements.ukey_npass1.value;
                    589:         lextkey=this.document.client.elements.lkey_npass1.value;
                    590:         initkeys();
1.52      raeburn   591:         this.document.pserver.elements.newpass_1.value
1.3       matthew   592:             =crypted(this.document.client.elements.newpass_1.value);
                    593: 
                    594:         uextkey=this.document.client.elements.ukey_npass2.value;
                    595:         lextkey=this.document.client.elements.lkey_npass2.value;
                    596:         initkeys();
1.52      raeburn   597:         this.document.pserver.elements.newpass_2.value
1.3       matthew   598:             =crypted(this.document.client.elements.newpass_2.value);
                    599: 
1.52      raeburn   600:         this.document.pserver.submit();
1.3       matthew   601:     }
                    602: 
                    603: </script>
1.4       matthew   604: $errormessage
1.10      www       605: 
1.3       matthew   606: <p>
1.36      www       607: <!-- We separate the forms into 'server' and 'client' in order to
1.3       matthew   608:      ensure that unencrypted passwords will not be sent out by a
                    609:      crappy browser -->
                    610: 
1.52      raeburn   611: <form name="pserver" action="/adm/preferences" method="post">
1.3       matthew   612: <input type="hidden" name="logtoken"    value="$logtoken" />
                    613: <input type="hidden" name="action"      value="verify_and_change_pass" />
                    614: <input type="hidden" name="currentpass" value="" />
1.4       matthew   615: <input type="hidden" name="newpass_1"   value="" />
                    616: <input type="hidden" name="newpass_2"   value="" />
1.3       matthew   617: </form>
                    618: 
                    619: <form name="client" >
                    620: <table>
1.4       matthew   621: <tr><td align="right"> Current password:                      </td>
                    622:     <td><input type="password" name="currentpass" size="10"/> </td></tr>
                    623: <tr><td align="right"> New password:                          </td>
                    624:     <td><input type="password" name="newpass_1" size="10"  /> </td></tr>
                    625: <tr><td align="right"> Confirm password:                      </td>
                    626:     <td><input type="password" name="newpass_2" size="10"  /> </td></tr>
1.3       matthew   627: <tr><td colspan="2" align="center">
                    628:     <input type="button" value="Change Password" onClick="send();">
                    629: </table>
1.4       matthew   630: <input type="hidden" name="ukey_cpass"  value="$ukey_cpass" />
                    631: <input type="hidden" name="lkey_cpass"  value="$lkey_cpass" />
1.3       matthew   632: <input type="hidden" name="ukey_npass1" value="$ukey_npass1" />
                    633: <input type="hidden" name="lkey_npass1" value="$lkey_npass1" />
                    634: <input type="hidden" name="ukey_npass2" value="$ukey_npass2" />
                    635: <input type="hidden" name="lkey_npass2" value="$lkey_npass2" />
                    636: </form>
                    637: </p>
                    638: ENDFORM
                    639:     #
                    640:     return;
                    641: }
                    642: 
                    643: sub verify_and_change_password {
                    644:     my $r = shift;
                    645:     my $user       = $ENV{'user.name'};
                    646:     my $domain     = $ENV{'user.domain'};
                    647:     my $homeserver = $ENV{'user.home'};
                    648:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4       matthew   649:     # Check for authentication types that allow changing of the password.
                    650:     return if ($currentauth !~ /^(unix|internal):/);
1.3       matthew   651:     #
1.53    ! albertel  652:     my $html=&Apache::lonxml::xmlbegin();
1.4       matthew   653:     $r->print(<<ENDHEADER);
1.53    ! albertel  654: $html
1.4       matthew   655: <head>
                    656: <title>LON-CAPA Preferences:  Change password for $user</title>
                    657: </head>
                    658: ENDHEADER
1.3       matthew   659:     #
                    660:     my $currentpass = $ENV{'form.currentpass'}; 
                    661:     my $newpass1    = $ENV{'form.newpass_1'}; 
                    662:     my $newpass2    = $ENV{'form.newpass_2'};
                    663:     my $logtoken    = $ENV{'form.logtoken'};
                    664:     # Check for empty data 
1.4       matthew   665:     unless (defined($currentpass) && 
                    666: 	    defined($newpass1)    && 
                    667: 	    defined($newpass2)    ){
                    668: 	&passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
                    669: 			 "Password data was blank.\n</p>");
1.3       matthew   670: 	return;
                    671:     }
1.16      albertel  672:     # Get the keys
                    673:     my $lonhost = $r->dir_config('lonHostID');
1.3       matthew   674:     my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
                    675:     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4       matthew   676:         # I do not a have a better idea about how to handle this
1.3       matthew   677: 	$r->print(<<ENDERROR);
                    678: <p>
                    679: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
1.4       matthew   680: password decryption.  Please log out and try again.
1.3       matthew   681: </p>
                    682: ENDERROR
1.4       matthew   683:         # Probably should log an error here
1.3       matthew   684:         return;
                    685:     }
                    686:     my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4       matthew   687:     # 
1.17      matthew   688:     $currentpass = &des_decrypt($ckey ,$currentpass);
                    689:     $newpass1    = &des_decrypt($n1key,$newpass1);
                    690:     $newpass2    = &des_decrypt($n2key,$newpass2);
1.4       matthew   691:     # 
1.3       matthew   692:     if ($newpass1 ne $newpass2) {
1.4       matthew   693: 	&passwordchanger($r,
                    694: 			 '<font color="#ff0000">ERROR:</font>'.
                    695: 			 'The new passwords you entered do not match.  '.
                    696: 			 'Please try again.');
                    697: 	return;
                    698:     }
                    699:     if (length($newpass1) < 7) {
                    700: 	&passwordchanger($r,
                    701: 			 '<font color="#ff0000">ERROR:</font>'.
                    702: 			 'Passwords must be a minimum of 7 characters long.  '.
                    703: 			 'Please try again.');
1.3       matthew   704: 	return;
                    705:     }
1.4       matthew   706:     #
                    707:     # Check for bad characters
                    708:     my $badpassword = 0;
                    709:     foreach (split(//,$newpass1)) {
                    710: 	$badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
                    711:     }
                    712:     if ($badpassword) {
                    713: 	# I can't figure out how to enter bad characters on my browser.
                    714: 	&passwordchanger($r,<<ENDERROR);
                    715: <font color="#ff0000">ERROR:</font>
                    716: The password you entered contained illegal characters.<br />
                    717: Valid characters are: space and <br />
                    718: <pre>
                    719: !&quot;\#$%&amp;\'()*+,-./0123456789:;&lt;=&gt;?\@
                    720: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
                    721: </pre>
                    722: ENDERROR
                    723:     }
                    724:     # 
                    725:     # Change the password (finally)
                    726:     my $result = &Apache::lonnet::changepass
                    727: 	($user,$domain,$currentpass,$newpass1,$homeserver);
                    728:     # Inform the user the password has (not?) been changed
                    729:     if ($result =~ /^ok$/) {
                    730: 	$r->print(<<"ENDTEXT");
1.9       matthew   731: <h2>The password for $user was successfully changed</h2>
1.4       matthew   732: ENDTEXT
                    733:     } else {
                    734: 	# error error: run in circles, scream and shout
                    735:         $r->print(<<ENDERROR);
1.9       matthew   736: <h2><font color="#ff0000">The password for $user was not changed</font></h2>
1.8       matthew   737: Please make sure your old password was entered correctly.
1.4       matthew   738: ENDERROR
                    739:     }
                    740:     return;
1.3       matthew   741: }
                    742: 
1.42      raeburn   743: ################################################################
                    744: #            discussion display subroutines 
                    745: ################################################################
                    746: sub discussionchanger {
                    747:     my $r = shift;
                    748:     my $user       = $ENV{'user.name'};
                    749:     my $domain     = $ENV{'user.domain'};
                    750:     my %userenv = &Apache::lonnet::get
1.43      raeburn   751:         ('environment',['discdisplay','discmarkread']);
                    752:     my $discdisp = 'allposts';
                    753:     my $discmark = 'onmark';
                    754: 
                    755:     if (defined($userenv{'discdisplay'})) {
                    756:         unless ($userenv{'discdisplay'} eq '') { 
                    757:             $discdisp = $userenv{'discdisplay'};
                    758:         }
                    759:     }
                    760:     if (defined($userenv{'discmarkread'})) {
                    761:         unless ($userenv{'discdisplay'} eq '') { 
                    762:             $discmark = $userenv{'discmarkread'};
                    763:         }
                    764:     }
                    765: 
                    766:     my $newdisp = 'unread';
                    767:     my $newmark = 'ondisp';
                    768: 
                    769:     my $function = &Apache::loncommon::get_users_function();
                    770:     my $color = &Apache::loncommon::designparm($function.'.tabbg',
                    771:                                                     $ENV{'user.domain'});
                    772:     my %lt = &Apache::lonlocal::texthash(
                    773:         'pref' => 'Display Preference',
                    774:         'curr' => 'Current setting ',
                    775:         'actn' => 'Action',
                    776:         'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
                    777:         'prca' => 'Preferences can be set that determine',
                    778:         'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
                    779:         'unwh' => 'Under what circumstances posts are identfied as "New"',
                    780:         'allposts' => 'All posts',
                    781:         'unread' => 'New posts only',
                    782:         'ondisp' => 'Once displayed',
                    783:         'onmark' => 'Once marked as read',
                    784:         'disa' => 'Posts displayed?',
                    785:         'npmr' => 'New posts cease to be identified as "New"?',
                    786:         'thde'  => 'The preferences you set here can be overridden within each individual discussion.',
                    787:         'chgt' => 'Change to '
                    788:     );
                    789:     my $dispchange = $lt{'unread'};
                    790:     my $markchange = $lt{'ondisp'};
                    791:     my $currdisp = $lt{'allposts'};
                    792:     my $currmark = $lt{'onmark'};
                    793: 
                    794:     if ($discdisp eq 'unread') {
                    795:         $dispchange = $lt{'allposts'};
                    796:         $currdisp = $lt{'unread'};
                    797:         $newdisp = 'allposts';
                    798:     }
                    799: 
                    800:     if ($discmark eq 'ondisp') {
                    801:         $markchange = $lt{'onmark'};
                    802:         $currmark = $lt{'ondisp'};
                    803:         $newmark = 'onmark';
1.42      raeburn   804:     }
1.43      raeburn   805:     
                    806:     $r->print(<<"END");
1.42      raeburn   807: <form name="server" action="/adm/preferences" method="post">
                    808: <input type="hidden" name="action" value="verify_and_change_discussion" />
                    809: <br />
1.43      raeburn   810: $lt{'sdpf'}<br/> $lt{'prca'}  <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol> 
                    811: <br />
                    812: <br />
                    813: <table border="0" cellpadding="0" cellspacing="0">
                    814:  <tr>
                    815:   <td width="100%" bgcolor="#000000">
                    816:    <table width="100%" border="0" cellpadding="1" cellspacing="0">
                    817:     <tr>
                    818:      <td width="100%" bgcolor="#000000">
                    819:       <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
                    820:        <tr bgcolor="$color">
                    821:         <td><b>$lt{'pref'}</b></td>
                    822:         <td><b>$lt{'curr'}</b></td>
                    823:         <td><b>$lt{'actn'}?</b></td>
                    824:        </tr>
                    825:        <tr bgcolor="#dddddd">
                    826:        <td>$lt{'disa'}</td>
                    827:        <td>$lt{$discdisp}</td>
                    828:        <td><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" />&nbsp;$lt{'chgt'} "$dispchange"</td>
                    829:       </tr><tr bgcolor="#eeeeee">
                    830:        <td>$lt{'npmr'}</td>
                    831:        <td>$lt{$discmark}</td>
                    832:        <td><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" />&nbsp;$lt{'chgt'} "$markchange"</td>
                    833:       </tr>
                    834:      </table>
                    835:     </td>
                    836:    </tr>
                    837:   </table>
                    838:  </td>
                    839: </tr>
                    840: </table>
                    841: <br />
                    842: <br />
                    843: <input type="submit" name="sub" value="Store Changes" />
                    844: <br />
                    845: <br />
                    846: Note: $lt{'thde'}
                    847: </form>
                    848: END
1.42      raeburn   849: }
                    850:                                                                                                                 
                    851: sub verify_and_change_discussion {
                    852:     my $r = shift;
1.43      raeburn   853:     my $user     = $ENV{'user.name'};
                    854:     my $domain   = $ENV{'user.domain'};
1.42      raeburn   855:     my $message='';
1.43      raeburn   856:     if (defined($ENV{'form.discdisp'}) ) {
                    857:         my $newdisp  = $ENV{'form.newdisp'};
                    858:         if ($newdisp eq 'unread') {
                    859:             $message .='In discussions: only new posts will be displayed.<br/>';
                    860:             &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
                    861:             &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
                    862:         } else {
                    863:             $message .= 'In discussions: all posts will be displayed.<br/>';
                    864:             &Apache::lonnet::del('environment',['discdisplay']);
                    865:             &Apache::lonnet::delenv('environment\.discdisplay');
                    866:         }
                    867:     }
                    868:     if (defined($ENV{'form.discmark'}) ) {
                    869:         my $newmark = $ENV{'form.newmark'};
                    870:         if ($newmark eq 'ondisp') {
                    871:            $message.='In discussions: new posts will be cease to be identified as "new" after display.<br/>';
                    872:             &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
                    873:             &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
                    874:         } else {
                    875:             $message.='In discussions: posts will be identified as "new" until marked as read by the reader.<br/>';
                    876:             &Apache::lonnet::del('environment',['discmarkread']);
                    877:             &Apache::lonnet::delenv('environment\.discmarkread');
                    878:         }
1.42      raeburn   879:     }
                    880:     $r->print(<<ENDVCSCREEN);
                    881: </p>
                    882: $message
                    883: ENDVCSCREEN
                    884: }
                    885: 
1.4       matthew   886: ######################################################
                    887: #            other handler subroutines               #
                    888: ######################################################
                    889: 
1.3       matthew   890: ################################################################
                    891: #                          Main handler                        #
                    892: ################################################################
1.1       www       893: sub handler {
                    894:     my $r = shift;
1.3       matthew   895:     my $user = $ENV{'user.name'};
                    896:     my $domain = $ENV{'user.domain'};
1.31      www       897:     &Apache::loncommon::content_type($r,'text/html');
1.4       matthew   898:     # Some pages contain DES keys and should not be cached.
                    899:     &Apache::loncommon::no_cache($r);
1.1       www       900:     $r->send_http_header;
                    901:     return OK if $r->header_only;
1.9       matthew   902:     #
1.35      matthew   903:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.44      www       904:                                             ['action','wysiwyg','returnurl']);
1.35      matthew   905:     #
                    906:     &Apache::lonhtmlcommon::clear_breadcrumbs();
                    907:     &Apache::lonhtmlcommon::add_breadcrumb
                    908:         ({href => '/adm/preferences',
                    909:           text => 'Set User Preferences'});
                    910: 
                    911:     my @Options;
                    912:     # Determine current authentication method
                    913:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                    914:     if ($currentauth =~ /^(unix|internal):/) {
                    915:         push (@Options,({ action   => 'changepass',
1.40      www       916:                           linktext => 'Change Password',
1.35      matthew   917:                           href     => '/adm/preferences',
                    918:                           help     => 'Change_Password',
                    919:                           subroutine => \&passwordchanger,
                    920:                           breadcrumb => 
                    921:                               { href => '/adm/preferences?action=changepass',
                    922:                                 text => 'Change Password'},
                    923:                           },
                    924:                         { action => 'verify_and_change_pass',
                    925:                           subroutine => \&verify_and_change_password,
                    926:                           breadcrumb => 
                    927:                               { href =>'/adm/preferences?action=changepass',
                    928:                                 text => 'Change Password'},
                    929:                           printmenu => 'yes',
                    930:                           }));
                    931:     }
                    932:     push (@Options,({ action   => 'changescreenname',
                    933:                       linktext => 'Change Screen Name',
                    934:                       href     => '/adm/preferences',
                    935:                       help     => 'Prefs_Screen_Name_Nickname',
                    936:                       subroutine => \&screennamechanger,
                    937:                       breadcrumb => 
                    938:                           { href => '/adm/preferences?action=changescreenname',
                    939:                             text => 'Change Screen Name'},
                    940:                       },
                    941:                     { action   => 'verify_and_change_screenname',
                    942:                       subroutine => \&verify_and_change_screenname,
                    943:                       breadcrumb => 
                    944:                           { href => '/adm/preferences?action=changescreenname',
                    945:                             text => 'Change Screen Name'},
                    946:                       printmenu => 'yes',
                    947:                       }));
                    948: 
                    949:     push (@Options,({ action   => 'changemsgforward',
1.49      albertel  950:                       linktext => 'Change Message Forwarding and Notification Addresses',
1.35      matthew   951:                       href     => '/adm/preferences',
                    952:                       help     => 'Prefs_Forwarding',
                    953:                       breadcrumb => 
                    954:                           { href => '/adm/preferences?action=changemsgforward',
                    955:                             text => 'Change Message Forwarding'},
                    956:                       subroutine => \&msgforwardchanger,
                    957:                       },
                    958:                     { action => 'verify_and_change_msgforward',
                    959:                       breadcrumb => 
                    960:                           { href => '/adm/preferences?action=changemsgforward',
                    961:                             text => 'Change Message Forwarding'},
                    962:                       printmenu => 'yes',
                    963:                       subroutine => \&verify_and_change_msgforward }));
                    964:     my $aboutmeaction=
                    965:         '/adm/'.$ENV{'user.domain'}.'/'.$ENV{'user.name'}.'/aboutme';
                    966:     push (@Options,{ action => 'none', 
                    967:                      linktext =>
1.41      www       968:                          q{Edit the 'About Me' Personal Information Screen},
1.45      www       969: 		     help => 'Prefs_About_Me',
1.35      matthew   970:                      href => $aboutmeaction});
                    971:     push (@Options,({ action => 'changecolors',
                    972:                       linktext => 'Change Color Scheme',
                    973:                       href => '/adm/preferences',
                    974:                       help => 'Change_Colors',
                    975:                       breadcrumb => 
                    976:                           { href => '/adm/preferences?action=changecolors',
                    977:                             text => 'Change Colors'},
                    978:                       subroutine => \&colorschanger,
                    979:                   },
                    980:                     { action => 'verify_and_change_colors',
                    981:                       breadcrumb => 
                    982:                           { href => '/adm/preferences?action=changecolors',
                    983:                             text => 'Change Colors'},
                    984:                       printmenu => 'yes',
                    985:                       subroutine => \&verify_and_change_colors,
                    986:                       }));
                    987:     push (@Options,({ action => 'changelanguages',
1.39      www       988:                       linktext => 'Change Language Preferences',
1.35      matthew   989:                       href => '/adm/preferences',
1.45      www       990: 		      help => 'Prefs_Language',
1.35      matthew   991:                       breadcrumb=>
                    992:                           { href => '/adm/preferences?action=changelanguages',
                    993:                             text => 'Change Language'},
                    994:                       subroutine =>  \&languagechanger,
                    995:                   },
                    996:                     { action => 'verify_and_change_languages',
                    997:                       breadcrumb=>
                    998:                           {href => '/adm/preferences?action=changelanguages',
                    999:                            text => 'Change Language'},
                   1000:                       printmenu => 'yes',
                   1001:                       subroutine=>\&verify_and_change_languages, }
                   1002:                     ));
1.44      www      1003:     push (@Options,({ action => 'changewysiwyg',
                   1004:                       linktext => 'Change WYSIWYG Editor Preferences',
                   1005:                       href => '/adm/preferences',
                   1006:                       breadcrumb => 
                   1007:                             { href => '/adm/preferences?action=changewysiwyg',
                   1008:                               text => 'Change WYSIWYG Preferences'},
                   1009:                       subroutine => \&wysiwygchanger,
                   1010:                   },
                   1011:                     { action => 'set_wysiwyg',
                   1012:                       breadcrumb =>
                   1013:                           { href => '/adm/preferences?action=changewysiwyg',
                   1014:                             text => 'Change WYSIWYG Preferences'},
                   1015:                       printmenu => 'yes',
                   1016:                       subroutine => \&verify_and_change_wysiwyg, }
                   1017:                     ));
1.42      raeburn  1018:     push (@Options,({ action => 'changediscussions',
                   1019:                       linktext => 'Change Discussion Display Preferences',
                   1020:                       href => '/adm/preferences',
1.46      raeburn  1021:                       help => 'Change_Discussion_Display',
1.42      raeburn  1022:                       breadcrumb => 
                   1023:                             { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1024:                               text => 'Change Discussion Preferences'},
1.42      raeburn  1025:                       subroutine => \&discussionchanger,
                   1026:                   },
                   1027:                     { action => 'verify_and_change_discussion',
                   1028:                       breadcrumb =>
                   1029:                           { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1030:                             text => 'Change Discussion Preferences'},
1.42      raeburn  1031:                       printmenu => 'yes',
                   1032:                       subroutine => \&verify_and_change_discussion, }
                   1033:                     ));
                   1034:                        
1.50      albertel 1035:     push (@Options,({ action   => 'changerolespref',
                   1036:                       linktext => 'Change Roles Page Preferences',
                   1037:                       href     => '/adm/preferences',
                   1038:                       subroutine => \&rolesprefchanger,
                   1039:                       breadcrumb =>
                   1040:                           { href => '/adm/preferences?action=changerolespref',
                   1041:                             text => 'Change Roles Pref'},
                   1042:                       },
                   1043:                     { action   => 'verify_and_change_rolespref',
                   1044:                       subroutine => \&verify_and_change_rolespref,
                   1045:                       breadcrumb =>
                   1046:                           { href => '/adm/preferences?action=changerolespref',
                   1047:                             text => 'Change Roles Preferences'},
                   1048:                       printmenu => 'yes',
                   1049:                       }));
                   1050: 
                   1051: 
1.51      foxr     1052:     if ($ENV{'user.name'} =~ /^(albertel|fox|foxr|koretemey|korte|hallmat3|turtle)$/) {
1.35      matthew  1053:         push (@Options,({ action => 'debugtoggle',
                   1054:                           printmenu => 'yes',
                   1055:                           subroutine => \&toggle_debug,
                   1056:                           }));
                   1057:     }
1.53    ! albertel 1058:     my $html=&Apache::lonxml::xmlbegin();
1.35      matthew  1059:     $r->print(<<ENDHEADER);
1.53    ! albertel 1060: $html
1.1       www      1061: <head>
1.4       matthew  1062: <title>LON-CAPA Preferences</title>
1.1       www      1063: </head>
1.3       matthew  1064: ENDHEADER
1.35      matthew  1065:     my $call = undef;
1.48      albertel 1066:     my $help = undef;
1.35      matthew  1067:     my $printmenu = 'yes';
                   1068:     foreach my $option (@Options) {
                   1069:         if ($option->{'action'} eq $ENV{'form.action'}) {
                   1070:             $call = $option->{'subroutine'};
                   1071:             $printmenu = $option->{'printmenu'};
                   1072:             if (exists($option->{'breadcrumb'})) {
                   1073:                 &Apache::lonhtmlcommon::add_breadcrumb
                   1074:                     ($option->{'breadcrumb'});
                   1075:             }
1.48      albertel 1076: 	    $help=$option->{'help'};
1.35      matthew  1077:         }
                   1078:     }
                   1079:     $r->print(&Apache::loncommon::bodytag('Change Preferences'));
                   1080:     $r->print(&Apache::lonhtmlcommon::breadcrumbs
1.48      albertel 1081:               (undef,'Change Preferences',$help));
1.35      matthew  1082:     if (defined($call)) {
                   1083:         $call->($r);
                   1084:     }
1.44      www      1085:     if (($printmenu eq 'yes') && (!$ENV{'form.returnurl'})) {
1.35      matthew  1086:         my $optionlist = '<table cellpadding="5">';
                   1087:         if ($ENV{'user.name'} =~ 
1.51      foxr     1088:                          /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle)$/
1.35      matthew  1089:             ) {
                   1090:             push (@Options,({ action => 'debugtoggle',
                   1091:                               linktext => 'Toggle Debug Messages',
                   1092:                               text => 'Current Debug status is -'.
                   1093:                                   $ENV{'user.debug'}.'-.',
                   1094:                               href => '/adm/preferences',
                   1095:                               printmenu => 'yes',
                   1096:                               subroutine => \&toggle_debug,
                   1097:                               }));
                   1098:         }
                   1099:         foreach my $option(@Options) {
                   1100:             my $optiontext = '';
                   1101:             if (exists($option->{'href'})) {
                   1102:                 $optiontext .= 
                   1103:                     '<a href="'.$option->{'href'}.
                   1104:                     '?action='.$option->{'action'}.'">'.
1.47      albertel 1105:                     &mt($option->{'linktext'}).'</a>';
1.35      matthew  1106:             }
                   1107:             if (exists($option->{'text'})) {
1.47      albertel 1108:                 $optiontext .= ' '.&mt($option->{'text'});
1.35      matthew  1109:             }
                   1110:             if ($optiontext ne '') {
                   1111:                 $optiontext = '<font size="+1">'.$optiontext.'</font>'; 
                   1112:                 my $helplink = '&nbsp;';
                   1113:                 if (exists($option->{'help'})) {
                   1114:                     $helplink = &Apache::loncommon::help_open_topic
                   1115:                                                     ($option->{'help'});
                   1116:                 }
                   1117:                 $optionlist .= '<tr>'.
                   1118:                     '<td>'.$helplink.'</td>'.
                   1119:                     '<td>'.$optiontext.'</td>'.
                   1120:                     '</tr>';
                   1121:             }
1.13      www      1122:         }
1.35      matthew  1123:         $optionlist .= '</table>';
                   1124:         $r->print($optionlist);
1.44      www      1125:     } elsif ($ENV{'form.returnurl'}) {
                   1126: 	$r->print('<br /><a href="'.$ENV{'form.returnurl'}.'"><font size="+1">'.
                   1127: 		  &mt('Return').'</font></a>');
1.3       matthew  1128:     }
                   1129:     $r->print(<<ENDFOOTER);
1.1       www      1130: </body>
                   1131: </html>
1.3       matthew  1132: ENDFOOTER
1.1       www      1133:     return OK;
1.35      matthew  1134: }
                   1135: 
                   1136: sub toggle_debug {
                   1137:     if ($ENV{'user.debug'}) {
                   1138:         &Apache::lonnet::delenv('user\.debug');
                   1139:     } else {
                   1140:         &Apache::lonnet::appenv('user.debug' => 1);
                   1141:     }
1.13      www      1142: }
1.1       www      1143: 
                   1144: 1;
                   1145: __END__

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