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

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

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