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

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

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