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

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

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