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

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

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