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

1.1       www         1: # The LearningOnline Network
                      2: # Preferences
                      3: #
1.125.8.2! gci         4: # $Id: lonpreferences.pm,v 1.125.8.1 2009/09/23 15:12:54 gci 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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       691:     my $status='';
                    692:     if ($domcoord{'domcoord.author'} eq 'blocked') {
                    693:         $status=&mt('on');
                    694:     } else {
                    695:         $status=&mt('off');
                    696:     }
                    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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci       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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      1311:                 'changepass' => 'Save');
                   1312:     my $output = '<form name="client">'
                   1313:                 .&Apache::lonhtmlcommon::start_pick_box();
1.94      raeburn  1314:     if ($caller eq 'reset_by_email') {
1.125.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      1517:     my $message;
1.4       matthew  1518:     if ($result =~ /^ok$/) {
1.125.8.1  gci      1519:         $message = &Apache::lonhtmlcommon::confirm_success(&mt('The password for user [_1] was successfully changed.','<i>'.$user.'</i>'));
                   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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      1665:             &Apache::lonnet::delenv('environment.discmarkread');
1.43      raeburn  1666:         }
1.42      raeburn  1667:     }
1.125.8.1  gci      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.8.1  gci      1694:                        whatsnew => "What's New Page",
1.71      raeburn  1695:                     );
1.125.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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.8.1  gci      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:                       }));
1.125.8.2! gci      1860:     if ($env{'user.adv'}) {
        !          1861:         push (@Options,({ action => 'changelanguages',
        !          1862:                           linktext => 'Change Language Preferences',
        !          1863:                           href => '/adm/preferences',
        !          1864: 	    	          help => 'Prefs_Language',
        !          1865:                           breadcrumb=>
        !          1866:                               { href => '/adm/preferences?action=changelanguages',
        !          1867:                                 text => 'Change Language'},
        !          1868:                           subroutine =>  \&languagechanger,
        !          1869:                       },
        !          1870:                         { action => 'verify_and_change_languages',
        !          1871:                           breadcrumb=>
        !          1872:                               {href => '/adm/preferences?action=changelanguages',
        !          1873:                                text => 'Change Language'},
        !          1874:                           printmenu => 'yes',
        !          1875:                           subroutine=>\&verify_and_change_languages, }
1.35      matthew  1876:                     ));
1.125.8.2! gci      1877:     }
1.44      www      1878:     push (@Options,({ action => 'changewysiwyg',
                   1879:                       linktext => 'Change WYSIWYG Editor Preferences',
                   1880:                       href => '/adm/preferences',
                   1881:                       breadcrumb => 
                   1882:                             { href => '/adm/preferences?action=changewysiwyg',
                   1883:                               text => 'Change WYSIWYG Preferences'},
                   1884:                       subroutine => \&wysiwygchanger,
                   1885:                   },
                   1886:                     { action => 'set_wysiwyg',
                   1887:                       breadcrumb =>
                   1888:                           { href => '/adm/preferences?action=changewysiwyg',
                   1889:                             text => 'Change WYSIWYG Preferences'},
                   1890:                       printmenu => 'yes',
                   1891:                       subroutine => \&verify_and_change_wysiwyg, }
                   1892:                     ));
1.42      raeburn  1893:     push (@Options,({ action => 'changediscussions',
                   1894:                       linktext => 'Change Discussion Display Preferences',
                   1895:                       href => '/adm/preferences',
1.46      raeburn  1896:                       help => 'Change_Discussion_Display',
1.42      raeburn  1897:                       breadcrumb => 
                   1898:                             { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1899:                               text => 'Change Discussion Preferences'},
1.42      raeburn  1900:                       subroutine => \&discussionchanger,
                   1901:                   },
                   1902:                     { action => 'verify_and_change_discussion',
                   1903:                       breadcrumb =>
                   1904:                           { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1905:                             text => 'Change Discussion Preferences'},
1.42      raeburn  1906:                       printmenu => 'yes',
                   1907:                       subroutine => \&verify_and_change_discussion, }
                   1908:                     ));
1.96      albertel 1909: 
                   1910:     my $role = ($env{'user.adv'} ? 'Roles' : 'Course');
1.50      albertel 1911:     push (@Options,({ action   => 'changerolespref',
1.96      albertel 1912:                       linktext => 'Change '.$role.' Page Preferences',
1.50      albertel 1913:                       href     => '/adm/preferences',
                   1914:                       subroutine => \&rolesprefchanger,
                   1915:                       breadcrumb =>
                   1916:                           { href => '/adm/preferences?action=changerolespref',
1.96      albertel 1917:                             text => 'Change '.$role.' Page Pref'},
1.50      albertel 1918:                       },
                   1919:                     { action   => 'verify_and_change_rolespref',
                   1920:                       subroutine => \&verify_and_change_rolespref,
                   1921:                       breadcrumb =>
                   1922:                           { href => '/adm/preferences?action=changerolespref',
1.96      albertel 1923:                             text => 'Change '.$role.' Page Preferences'},
1.50      albertel 1924:                       printmenu => 'yes',
                   1925:                       }));
                   1926: 
1.54      albertel 1927:     push (@Options,({ action   => 'changetexenginepref',
                   1928:                       linktext => 'Change How Math Equations Are Displayed',
                   1929:                       href     => '/adm/preferences',
                   1930:                       subroutine => \&texenginechanger,
                   1931:                       breadcrumb =>
                   1932:                           { href => '/adm/preferences?action=changetexenginepref',
                   1933:                             text => 'Change Math Pref'},
                   1934:                       },
                   1935:                     { action   => 'verify_and_change_texengine',
                   1936:                       subroutine => \&verify_and_change_texengine,
                   1937:                       breadcrumb =>
                   1938:                           { href => '/adm/preferences?action=changetexenginepref',
                   1939:                             text => 'Change Math Preferences'},
                   1940:                       printmenu => 'yes',
                   1941:                       }));
1.85      albertel 1942: 
                   1943:     if ($env{'environment.remote'} eq 'off') {
                   1944: 	push (@Options,({ action => 'launch',
                   1945: 			  linktext => 'Launch Remote Control',
                   1946: 			  href => '/adm/remote?url=/adm/preferences',
                   1947: 		      }));
                   1948:     } else {
                   1949: 	push (@Options,({ action => 'collapse',
                   1950: 			  linktext => 'Collapse Remote Control',
                   1951: 			  href => '/adm/remote?url=/adm/preferences',
                   1952: 		      }));
                   1953:     }
                   1954: 
1.98      www      1955:     push (@Options,({ action   => 'changeicons',
1.100     www      1956:                       linktext => 'Change How Menus are Displayed',
1.98      www      1957:                       href     => '/adm/preferences',
                   1958:                       subroutine => \&iconchanger,
                   1959:                       breadcrumb =>
                   1960:                           { href => '/adm/preferences?action=changeicons',
                   1961:                             text => 'Change Main Menu'},
                   1962:                       },
                   1963:                     { action   => 'verify_and_change_icons',
                   1964:                       subroutine => \&verify_and_change_icons,
                   1965:                       breadcrumb =>
                   1966:                           { href => '/adm/preferences?action=changeicons',
                   1967:                             text => 'Change Main Menu'},
                   1968:                       printmenu => 'yes',
                   1969:                       }));
1.125.8.2! gci      1970:     if ($env{'user.adv'}) {
        !          1971:         push (@Options,({ action   => 'changeclicker',
        !          1972:                           linktext => 'Register Response Devices (&quot;Clickers&quot;)',
        !          1973:                           href     => '/adm/preferences',
        !          1974:                           subroutine => \&clickerchanger,
        !          1975:                           breadcrumb =>
        !          1976:                               { href => '/adm/preferences?action=changeclicker',
        !          1977:                                 text => 'Register Clicker'},
        !          1978:                           },
        !          1979:                           { action   => 'verify_and_change_clicker',
        !          1980:                           subroutine => \&verify_and_change_clicker,
        !          1981:                           breadcrumb =>
        !          1982:                               { href => '/adm/preferences?action=changeclicker',
        !          1983:                                 text => 'Register Clicker'},
        !          1984:                           printmenu => 'yes',
        !          1985:                           }));
        !          1986:     }
1.125     raeburn  1987:     my %author_roles = &Apache::lonnet::get_my_roles($user,$domain,'userroles','',['au']);
                   1988:     if (keys(%author_roles) > 0) {
1.119     www      1989:       push (@Options,({ action   => 'changedomcoord',
                   1990:                         linktext => 'Restrict Domain Coordinator Access',
                   1991:                         href     => '/adm/preferences',
                   1992:                         subroutine => \&domcoordchanger,
                   1993:                         breadcrumb =>
                   1994:                             { href => '/adm/preferences?action=changedomcoord',
                   1995:                               text => 'Restrict Domain Coordinator Access'},
                   1996:                       },
                   1997:                       { action   => 'verify_and_change_domcoord',
                   1998:                         subroutine => \&verify_and_change_domcoord,
                   1999:                         breadcrumb =>
                   2000:                             { href => '/adm/preferences?action=changedomcoord',
                   2001:                               text => 'Restrict Domain Coordinator Access'},
                   2002:                         printmenu => 'yes',
                   2003:                       }));
                   2004:     }
1.105     www      2005: 
1.118     www      2006:     push (@Options,({ action   => 'lockwarning',
                   2007:                       subroutine => \&lockwarning,
                   2008:                       breadcrumb =>
                   2009:                           { href => '/adm/preferences?action=lockwarning',
                   2010:                             text => 'Lock Warnings'},
                   2011:                       },
                   2012:                     { action   => 'verify_and_change_locks',
                   2013:                       subroutine => \&verify_and_change_lockwarning,
                   2014:                       breadcrumb =>
                   2015:                           { href => '/adm/preferences?action=lockwarning',
                   2016:                             text => 'Lockwarnings'},
                   2017:                       printmenu => 'yes',
                   2018:                       }));
                   2019: 
1.105     www      2020: 
1.74      albertel 2021:     if (&Apache::lonnet::allowed('whn',$env{'request.course.id'})
                   2022: 	|| &Apache::lonnet::allowed('whn',$env{'request.course.id'}.'/'
                   2023: 				    .$env{'request.course.sec'})) {
1.63      raeburn  2024:         push (@Options,({ action => 'changecourseinit',
                   2025:                           linktext => 'Change Course Initialization Preference',
                   2026:                           href => '/adm/preferences',
                   2027:                           subroutine => \&coursedisplaychanger,
                   2028:                           breadcrumb =>
                   2029:                               { href => '/adm/preferences?action=changecourseinit',
                   2030:                                 text => 'Change Course Init. Pref.'},
                   2031:                           },
                   2032:                         { action => 'verify_and_change_coursepage',
                   2033:                           breadcrumb =>
                   2034:                           { href => '/adm/preferences?action=changecourseinit',                               text => 'Change Course Initialization Preference'},
                   2035:                         printmenu => 'yes',
                   2036:                         subroutine => \&verify_and_change_coursepage,
                   2037:                        }));
                   2038:     }
1.50      albertel 2039: 
1.119     www      2040:     if ($env{'user.name'} =~ /^(albertel|fox|foxr|kortemey|korte|raeburn)$/) {
1.35      matthew  2041:         push (@Options,({ action => 'debugtoggle',
                   2042:                           printmenu => 'yes',
                   2043:                           subroutine => \&toggle_debug,
                   2044:                           }));
                   2045:     }
1.76      albertel 2046: 
                   2047:     $r->print(&Apache::loncommon::start_page('Change Preferences'));
                   2048: 
1.35      matthew  2049:     my $call = undef;
1.48      albertel 2050:     my $help = undef;
1.35      matthew  2051:     my $printmenu = 'yes';
                   2052:     foreach my $option (@Options) {
1.59      albertel 2053:         if ($option->{'action'} eq $env{'form.action'}) {
1.35      matthew  2054:             $call = $option->{'subroutine'};
                   2055:             $printmenu = $option->{'printmenu'};
                   2056:             if (exists($option->{'breadcrumb'})) {
                   2057:                 &Apache::lonhtmlcommon::add_breadcrumb
                   2058:                     ($option->{'breadcrumb'});
                   2059:             }
1.48      albertel 2060: 	    $help=$option->{'help'};
1.35      matthew  2061:         }
                   2062:     }
1.81      albertel 2063:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Change Preferences',$help));
1.75      albertel 2064:     my $error;
1.35      matthew  2065:     if (defined($call)) {
1.75      albertel 2066:         $error = $call->($r);
1.35      matthew  2067:     }
1.75      albertel 2068:     if ( ( ($printmenu eq 'yes')
                   2069: 	   || ($printmenu eq 'not_on_error' && !$error) )
                   2070: 	 && (!$env{'form.returnurl'})) {
1.35      matthew  2071:         my $optionlist = '<table cellpadding="5">';
1.59      albertel 2072:         if ($env{'user.name'} =~ 
1.62      raeburn  2073:                          /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle|raeburn)$/
1.35      matthew  2074:             ) {
                   2075:             push (@Options,({ action => 'debugtoggle',
                   2076:                               linktext => 'Toggle Debug Messages',
                   2077:                               text => 'Current Debug status is -'.
1.59      albertel 2078:                                   $env{'user.debug'}.'-.',
1.35      matthew  2079:                               href => '/adm/preferences',
                   2080:                               printmenu => 'yes',
                   2081:                               subroutine => \&toggle_debug,
                   2082:                               }));
                   2083:         }
                   2084:         foreach my $option(@Options) {
                   2085:             my $optiontext = '';
                   2086:             if (exists($option->{'href'})) {
1.85      albertel 2087: 		$option->{'href_args'}{'action'}=$option->{'action'};
                   2088: 		$optiontext .= 
                   2089:                     '<a href="'.&add_get_param($option->{'href'},
                   2090: 					       $option->{'href_args'}).'">'.
1.47      albertel 2091:                     &mt($option->{'linktext'}).'</a>';
1.35      matthew  2092:             }
                   2093:             if (exists($option->{'text'})) {
1.47      albertel 2094:                 $optiontext .= ' '.&mt($option->{'text'});
1.35      matthew  2095:             }
                   2096:             if ($optiontext ne '') {
                   2097:                 $optiontext = '<font size="+1">'.$optiontext.'</font>'; 
                   2098:                 my $helplink = '&nbsp;';
                   2099:                 if (exists($option->{'help'})) {
                   2100:                     $helplink = &Apache::loncommon::help_open_topic
                   2101:                                                     ($option->{'help'});
                   2102:                 }
                   2103:                 $optionlist .= '<tr>'.
                   2104:                     '<td>'.$helplink.'</td>'.
                   2105:                     '<td>'.$optiontext.'</td>'.
                   2106:                     '</tr>';
                   2107:             }
1.13      www      2108:         }
1.35      matthew  2109:         $optionlist .= '</table>';
                   2110:         $r->print($optionlist);
1.59      albertel 2111:     } elsif ($env{'form.returnurl'}) {
                   2112: 	$r->print('<br /><a href="'.$env{'form.returnurl'}.'"><font size="+1">'.
1.44      www      2113: 		  &mt('Return').'</font></a>');
1.3       matthew  2114:     }
1.76      albertel 2115:     $r->print(&Apache::loncommon::end_page());
1.1       www      2116:     return OK;
1.35      matthew  2117: }
                   2118: 
                   2119: sub toggle_debug {
1.59      albertel 2120:     if ($env{'user.debug'}) {
1.125.8.1  gci      2121:         &Apache::lonnet::delenv('user.debug');
1.35      matthew  2122:     } else {
1.116     raeburn  2123:         &Apache::lonnet::appenv({'user.debug' => 1});
1.35      matthew  2124:     }
1.13      www      2125: }
1.1       www      2126: 
                   2127: 1;
                   2128: __END__

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