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

1.1       www         1: # The LearningOnline Network
                      2: # Preferences
                      3: #
1.125.8.3! raeburn     4: # $Id: lonpreferences.pm,v 1.125.8.2 2009/09/23 15:32:00 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;
1.125.8.3! raeburn  1293:         this.document.pserver.elements.email.value =
        !          1294:                    this.document.client.elements.email.value;
1.94      raeburn  1295: |;
                   1296:     }
                   1297:     $ output .= qq|
1.52      raeburn  1298:         this.document.pserver.submit();
1.3       matthew  1299:     }
                   1300: </script>
1.94      raeburn  1301: |;
                   1302: }
1.3       matthew  1303: 
1.94      raeburn  1304: sub client_form {
                   1305:     my ($caller,$hexkey,$currentpass,$defdom) = @_;
1.99      www      1306:     my %lt=&Apache::lonlocal::texthash(
1.115     raeburn  1307:                 'email' => 'E-mail Address',
1.99      www      1308:                 'username' => 'Username',
                   1309:                 'domain' => 'Domain',
                   1310:                 'currentpass' => 'Current Password',
                   1311:                 'newpass' => 'New Password',
                   1312:                 'confirmpass' => 'Confirm Password',
1.125.8.1  gci      1313:                 'changepass' => 'Save');
                   1314:     my $output = '<form name="client">'
                   1315:                 .&Apache::lonhtmlcommon::start_pick_box();
1.94      raeburn  1316:     if ($caller eq 'reset_by_email') {
1.125.8.1  gci      1317:         $output .= &Apache::lonhtmlcommon::row_title(
                   1318:                        '<label for="email">'.$lt{'email'}.'</label>')
                   1319:                   .'<input type="text" name="email" size="30" />'
                   1320:                   .&Apache::lonhtmlcommon::row_closure()
                   1321:                   .&Apache::lonhtmlcommon::row_title(
                   1322:                        '<label for="uname">'.$lt{'username'}.'</label>')
                   1323:                   .'<input type="text" name="uname" size="15" />'
                   1324:                   .'<input type="hidden" name="currentpass" value="'.$currentpass.'" />'
                   1325:                   .&Apache::lonhtmlcommon::row_closure()
                   1326:                   .&Apache::lonhtmlcommon::row_title(
                   1327:                        '<label for="udom">'.$lt{'domain'}.'</label>')
                   1328:                   .&Apache::loncommon::select_dom_form($defdom,'udom')
                   1329:                   .&Apache::lonhtmlcommon::row_closure();
1.94      raeburn  1330:     } else {
1.125.8.1  gci      1331:         $output .= &Apache::lonhtmlcommon::row_title(
                   1332:                        '<label for="currentpass">'.$lt{'currentpass'}.'</label>')
                   1333:                   .'<input type="password" name="currentpass" size="10"/>'
                   1334:                   .&Apache::lonhtmlcommon::row_closure();
                   1335:     }
                   1336:     $output .= &Apache::lonhtmlcommon::row_title(
                   1337:                    '<label for="newpass_1">'.$lt{'newpass'}.'</label>')
                   1338:               .'<input type="password" name="newpass_1" size="10" />'
                   1339:               .&Apache::lonhtmlcommon::row_closure()
                   1340:               .&Apache::lonhtmlcommon::row_title(
                   1341:                    '<label for="newpass_2">'.$lt{'confirmpass'}.'</label>')
                   1342:               .'<input type="password" name="newpass_2" size="10" />'
                   1343:               .&Apache::lonhtmlcommon::row_closure(1)
                   1344:               .&Apache::lonhtmlcommon::end_pick_box();
                   1345:     $output .= '<p><input type="button" value="'.$lt{'changepass'}.'" onClick="send();" /></p>'
                   1346:                .qq|
1.94      raeburn  1347: <input type="hidden" name="ukey_cpass"  value="$hexkey->{'ukey_cpass'}" />
                   1348: <input type="hidden" name="lkey_cpass"  value="$hexkey->{'lkey_cpass'}" />
                   1349: <input type="hidden" name="ukey_npass1" value="$hexkey->{'ukey_npass1'}" />
                   1350: <input type="hidden" name="lkey_npass1" value="$hexkey->{'lkey_npass1'}" />
                   1351: <input type="hidden" name="ukey_npass2" value="$hexkey->{'ukey_npass2'}" />
                   1352: <input type="hidden" name="lkey_npass2" value="$hexkey->{'lkey_npass2'}" />
1.3       matthew  1353: </form>
                   1354: </p>
1.125.8.1  gci      1355: |;
1.94      raeburn  1356:     return $output;
                   1357: }
                   1358: 
                   1359: sub server_form {
                   1360:     my ($logtoken,$caller,$mailtoken) = @_;
                   1361:     my $action = '/adm/preferences';
                   1362:     if ($caller eq 'reset_by_email') {
                   1363:         $action = '/adm/resetpw';
                   1364:     }
                   1365:     my $output = qq|
                   1366: <form name="pserver" action="$action" method="post">
                   1367: <input type="hidden" name="logtoken"    value="$logtoken" />
                   1368: <input type="hidden" name="currentpass" value="" />
                   1369: <input type="hidden" name="newpass_1"   value="" />
                   1370: <input type="hidden" name="newpass_2"   value="" />
                   1371:     |;
                   1372:     if ($caller eq 'reset_by_email') {
                   1373:         $output .=  qq|
                   1374: <input type="hidden" name="token"   value="$mailtoken" />
                   1375: <input type="hidden" name="uname"   value="" />
                   1376: <input type="hidden" name="udom"   value="" />
1.125.8.3! raeburn  1377: <input type="hidden" name="email"   value="" />
1.94      raeburn  1378: 
                   1379: |;
                   1380:     }
                   1381:     $output .= qq|
                   1382: <input type="hidden" name="action" value="verify_and_change_pass" />
                   1383: </form>
                   1384: |;
                   1385:     return $output;
1.3       matthew  1386: }
                   1387: 
                   1388: sub verify_and_change_password {
1.94      raeburn  1389:     my ($r,$caller,$mailtoken) = @_;
                   1390:     my ($user,$domain,$homeserver);
                   1391:     if ($caller eq 'reset_by_email') {
                   1392:         $user       = $env{'form.uname'};
                   1393:         $domain     = $env{'form.udom'};
                   1394:         if ($user ne '' && $domain ne '') {
                   1395:             $homeserver = &Apache::lonnet::homeserver($user,$domain);
                   1396:             if ($homeserver eq 'no_host') {
1.99      www      1397:         &passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1398:                          &mt("Invalid username and/or domain")."</span>\n</p>",
1.94      raeburn  1399:                          $caller,$mailtoken);
                   1400:                 return 1;
                   1401:             }
                   1402:         } else {
1.99      www      1403:             &passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1404:                              &mt("Username and domain were blank")."</span>\n</p>",
1.94      raeburn  1405:                              $caller,$mailtoken);
                   1406:             return 1;
                   1407:         }
                   1408:     } else {
                   1409:         $user       = $env{'user.name'};
                   1410:         $domain     = $env{'user.domain'};
                   1411:         $homeserver = $env{'user.home'};
                   1412:     }
1.3       matthew  1413:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4       matthew  1414:     # Check for authentication types that allow changing of the password.
1.94      raeburn  1415:     if ($currentauth !~ /^(unix|internal):/) {
                   1416:         if ($caller eq 'reset_by_email') {
1.99      www      1417:             &passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1418:                              &mt("Authentication type for this user can not be changed by this mechanism").
                   1419:                              "</span>\n</p>",
1.94      raeburn  1420:                               $caller,$mailtoken);
                   1421:             return 1;
                   1422:         } else {
                   1423:             return;
                   1424:         }
                   1425:     }
1.3       matthew  1426:     #
1.59      albertel 1427:     my $currentpass = $env{'form.currentpass'}; 
                   1428:     my $newpass1    = $env{'form.newpass_1'}; 
                   1429:     my $newpass2    = $env{'form.newpass_2'};
                   1430:     my $logtoken    = $env{'form.logtoken'};
1.3       matthew  1431:     # Check for empty data 
1.4       matthew  1432:     unless (defined($currentpass) && 
                   1433: 	    defined($newpass1)    && 
                   1434: 	    defined($newpass2)    ){
1.99      www      1435: 	&passwordchanger($r,"<p>\n<span class='LC_error'>".
                   1436: 			 &mt("One or more password fields were blank").
                   1437:                          "</span>\n</p>",$caller,$mailtoken);
1.3       matthew  1438: 	return;
                   1439:     }
1.16      albertel 1440:     # Get the keys
                   1441:     my $lonhost = $r->dir_config('lonHostID');
1.3       matthew  1442:     my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
                   1443:     if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4       matthew  1444:         # I do not a have a better idea about how to handle this
1.94      raeburn  1445:         my $tryagain_text = &mt('Please log out and try again.');
                   1446:         if ($caller eq 'reset_by_email') {
                   1447:             $tryagain_text = &mt('Please try again later.');
                   1448:         }
1.101     albertel 1449:         my $unable=&mt("Unable to retrieve saved token for password decryption");
1.3       matthew  1450: 	$r->print(<<ENDERROR);
                   1451: <p>
1.99      www      1452: <span class="LC_error">$unable.  $tryagain_text</span>
1.3       matthew  1453: </p>
                   1454: ENDERROR
1.4       matthew  1455:         # Probably should log an error here
1.75      albertel 1456:         return 1;
1.3       matthew  1457:     }
                   1458:     my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4       matthew  1459:     # 
1.17      matthew  1460:     $currentpass = &des_decrypt($ckey ,$currentpass);
                   1461:     $newpass1    = &des_decrypt($n1key,$newpass1);
                   1462:     $newpass2    = &des_decrypt($n2key,$newpass2);
1.94      raeburn  1463:     #
                   1464:     if ($caller eq 'reset_by_email') {
                   1465:         my %data = &Apache::lonnet::tmpget($mailtoken);
1.117     raeburn  1466:         if (keys(%data) == 0) {
                   1467:             &passwordchanger($r,
                   1468:                          '<span class="LC_error">'.
                   1469:                          &mt('Could not verify current authentication.').'  '.
                   1470:                          &mt('Please try again.').'</span>',$caller,$mailtoken);
                   1471:             return 1;
                   1472:         }
1.94      raeburn  1473:         if ($currentpass ne $data{'temppasswd'}) {
                   1474:             &passwordchanger($r,
1.99      www      1475:                          '<span class="LC_error">'.
1.110     bisitz   1476:                          &mt('Could not verify current authentication.').'  '.
                   1477:                          &mt('Please try again.').'</span>',$caller,$mailtoken);
1.94      raeburn  1478:             return 1;
                   1479:         }
                   1480:     } 
1.3       matthew  1481:     if ($newpass1 ne $newpass2) {
1.4       matthew  1482: 	&passwordchanger($r,
1.99      www      1483: 			 '<span class="LC_error">'.
1.110     bisitz   1484: 			 &mt('The new passwords you entered do not match.').'  '.
                   1485: 			 &mt('Please try again.').'</span>',$caller,$mailtoken);
1.75      albertel 1486: 	return 1;
1.4       matthew  1487:     }
                   1488:     if (length($newpass1) < 7) {
                   1489: 	&passwordchanger($r,
1.99      www      1490: 			 '<span class="LC_error">'.
1.110     bisitz   1491: 			 &mt('Passwords must be a minimum of 7 characters long.').'  '.
                   1492: 			 &mt('Please try again.').'</span>',$caller,$mailtoken);
1.75      albertel 1493: 	return 1;
1.3       matthew  1494:     }
1.4       matthew  1495:     #
                   1496:     # Check for bad characters
                   1497:     my $badpassword = 0;
                   1498:     foreach (split(//,$newpass1)) {
                   1499: 	$badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
                   1500:     }
                   1501:     if ($badpassword) {
                   1502: 	# I can't figure out how to enter bad characters on my browser.
1.99      www      1503: 	my $errormessage ='<span class="LC_error">'.
1.110     bisitz   1504:            &mt('The password you entered contained illegal characters.').'<br />'.
1.99      www      1505:            &mt('Valid characters are').(<<"ENDERROR");
                   1506: : space and <br />
1.4       matthew  1507: <pre>
                   1508: !&quot;\#$%&amp;\'()*+,-./0123456789:;&lt;=&gt;?\@
                   1509: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
1.99      www      1510: </pre></span>
1.4       matthew  1511: ENDERROR
1.94      raeburn  1512:         &passwordchanger($r,$errormessage,$caller,$mailtoken);
                   1513:         return 1;
1.4       matthew  1514:     }
                   1515:     # 
                   1516:     # Change the password (finally)
                   1517:     my $result = &Apache::lonnet::changepass
1.94      raeburn  1518: 	($user,$domain,$currentpass,$newpass1,$homeserver,$caller);
1.4       matthew  1519:     # Inform the user the password has (not?) been changed
1.125.8.1  gci      1520:     my $message;
1.4       matthew  1521:     if ($result =~ /^ok$/) {
1.125.8.1  gci      1522:         $message = &Apache::lonhtmlcommon::confirm_success(&mt('The password for user [_1] was successfully changed.','<i>'.$user.'</i>'));
                   1523:         if ($caller eq 'reset_by_email') {
                   1524:             $r->print($message.'<br />');
                   1525:         } else {
                   1526:             $r->print(&Apache::loncommon::confirmwrapper($message));
                   1527:         }
1.4       matthew  1528:     } else {
                   1529: 	# error error: run in circles, scream and shout
1.125.8.1  gci      1530:         if ($caller eq 'reset_by_email') {
1.125.8.3! raeburn  1531:             if (!$result) {
        !          1532:                 return 1;
        !          1533:             } else {
        !          1534:                 return $result;
        !          1535:             }
1.125.8.1  gci      1536:         } else {
1.125.8.3! raeburn  1537:             $message = &Apache::lonhtmlcommon::confirm_success(
        !          1538:                 &mt("The password for user [_1] was not changed.",'<i>'.$user.'</i>').' '.&mt('Please make sure your old password was entered correctly.'),1);
1.125.8.1  gci      1539:             $r->print(&Apache::loncommon::confirmwrapper($message));
                   1540:         }
1.4       matthew  1541:     }
                   1542:     return;
1.3       matthew  1543: }
                   1544: 
1.42      raeburn  1545: ################################################################
                   1546: #            discussion display subroutines 
                   1547: ################################################################
                   1548: sub discussionchanger {
                   1549:     my $r = shift;
1.59      albertel 1550:     my $user       = $env{'user.name'};
                   1551:     my $domain     = $env{'user.domain'};
1.42      raeburn  1552:     my %userenv = &Apache::lonnet::get
1.43      raeburn  1553:         ('environment',['discdisplay','discmarkread']);
                   1554:     my $discdisp = 'allposts';
                   1555:     my $discmark = 'onmark';
                   1556: 
                   1557:     if (defined($userenv{'discdisplay'})) {
                   1558:         unless ($userenv{'discdisplay'} eq '') { 
                   1559:             $discdisp = $userenv{'discdisplay'};
                   1560:         }
                   1561:     }
                   1562:     if (defined($userenv{'discmarkread'})) {
1.125.8.1  gci      1563:         unless ($userenv{'discmarkread'} eq '') { 
1.43      raeburn  1564:             $discmark = $userenv{'discmarkread'};
                   1565:         }
                   1566:     }
                   1567: 
                   1568:     my $newdisp = 'unread';
                   1569:     my $newmark = 'ondisp';
                   1570: 
                   1571:     my $function = &Apache::loncommon::get_users_function();
                   1572:     my $color = &Apache::loncommon::designparm($function.'.tabbg',
1.59      albertel 1573:                                                     $env{'user.domain'});
1.43      raeburn  1574:     my %lt = &Apache::lonlocal::texthash(
                   1575:         'pref' => 'Display Preference',
                   1576:         'curr' => 'Current setting ',
                   1577:         'actn' => 'Action',
1.125.8.1  gci      1578:         'sdpf' => 'Set display preferences for discussion posts for both discussion boards and individual resources in all your courses.',
1.43      raeburn  1579:         'prca' => 'Preferences can be set that determine',
1.125.8.1  gci      1580:         'whpo' => 'Which posts are displayed when you display a discussion board or resource, and',
1.43      raeburn  1581:         'unwh' => 'Under what circumstances posts are identfied as "New"',
                   1582:         'allposts' => 'All posts',
                   1583:         'unread' => 'New posts only',
                   1584:         'ondisp' => 'Once displayed',
                   1585:         'onmark' => 'Once marked as read',
                   1586:         'disa' => 'Posts displayed?',
                   1587:         'npmr' => 'New posts cease to be identified as "New"?',
                   1588:         'thde'  => 'The preferences you set here can be overridden within each individual discussion.',
1.125.8.1  gci      1589:         'chgt' => 'Change to ',
1.43      raeburn  1590:     );
                   1591:     my $dispchange = $lt{'unread'};
                   1592:     my $markchange = $lt{'ondisp'};
                   1593:     my $currdisp = $lt{'allposts'};
                   1594:     my $currmark = $lt{'onmark'};
                   1595: 
                   1596:     if ($discdisp eq 'unread') {
                   1597:         $dispchange = $lt{'allposts'};
                   1598:         $currdisp = $lt{'unread'};
                   1599:         $newdisp = 'allposts';
                   1600:     }
                   1601: 
                   1602:     if ($discmark eq 'ondisp') {
                   1603:         $markchange = $lt{'onmark'};
                   1604:         $currmark = $lt{'ondisp'};
                   1605:         $newmark = 'onmark';
1.42      raeburn  1606:     }
1.43      raeburn  1607:     
                   1608:     $r->print(<<"END");
1.88      albertel 1609: <form name="prefs" action="/adm/preferences" method="post">
1.42      raeburn  1610: <input type="hidden" name="action" value="verify_and_change_discussion" />
                   1611: <br />
1.87      albertel 1612: $lt{'sdpf'}<br /> $lt{'prca'}  <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol> 
1.82      albertel 1613: END
1.125.8.1  gci      1614:     $r->print('<p class="LC_info">'.$lt{'thde'}.'</p>');
                   1615: 
1.82      albertel 1616:     $r->print(&Apache::loncommon::start_data_table());
                   1617:     $r->print(<<"END");
                   1618:        <tr>
                   1619:         <th>$lt{'pref'}</th>
                   1620:         <th>$lt{'curr'}</th>
                   1621:         <th>$lt{'actn'}?</th>
1.43      raeburn  1622:        </tr>
1.82      albertel 1623: END
                   1624:     $r->print(&Apache::loncommon::start_data_table_row());
                   1625:     $r->print(<<"END");
1.43      raeburn  1626:        <td>$lt{'disa'}</td>
                   1627:        <td>$lt{$discdisp}</td>
1.82      albertel 1628:        <td><label><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" />&nbsp;$lt{'chgt'} "$dispchange"</label></td>
                   1629: END
                   1630:     $r->print(&Apache::loncommon::end_data_table_row().
                   1631: 	      &Apache::loncommon::start_data_table_row());
                   1632:     $r->print(<<"END");
1.43      raeburn  1633:        <td>$lt{'npmr'}</td>
                   1634:        <td>$lt{$discmark}</td>
1.82      albertel 1635:        <td><label><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" />&nbsp;$lt{'chgt'} "$markchange"</label></td>
1.43      raeburn  1636:       </tr>
1.82      albertel 1637: END
                   1638:     $r->print(&Apache::loncommon::end_data_table_row().
                   1639: 	      &Apache::loncommon::end_data_table());
1.125.8.1  gci      1640:     $r->print('<br />'.
                   1641:               '<input type="submit" name="sub" value="'.&mt('Save').'" />'.
                   1642:               '</form>');
1.42      raeburn  1643: }
                   1644:                                                                                                                 
                   1645: sub verify_and_change_discussion {
                   1646:     my $r = shift;
1.59      albertel 1647:     my $user     = $env{'user.name'};
                   1648:     my $domain   = $env{'user.domain'};
1.42      raeburn  1649:     my $message='';
1.59      albertel 1650:     if (defined($env{'form.discdisp'}) ) {
                   1651:         my $newdisp  = $env{'form.newdisp'};
1.43      raeburn  1652:         if ($newdisp eq 'unread') {
1.125.8.1  gci      1653:             $message .= &Apache::lonhtmlcommon::confirm_success(&mt('In discussions: only new posts will be displayed.')).'<br />';
1.43      raeburn  1654:             &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
1.116     raeburn  1655:             &Apache::lonnet::appenv({'environment.discdisplay' => $newdisp});
1.43      raeburn  1656:         } else {
1.125.8.1  gci      1657:             $message .= &Apache::lonhtmlcommon::confirm_success(&mt('In discussions: all posts will be displayed.')).'<br />';
1.43      raeburn  1658:             &Apache::lonnet::del('environment',['discdisplay']);
1.125.8.1  gci      1659:             &Apache::lonnet::delenv('environment.discdisplay');
1.43      raeburn  1660:         }
                   1661:     }
1.59      albertel 1662:     if (defined($env{'form.discmark'}) ) {
                   1663:         my $newmark = $env{'form.newmark'};
1.43      raeburn  1664:         if ($newmark eq 'ondisp') {
1.125.8.1  gci      1665:             $message.=&Apache::lonhtmlcommon::confirm_success(&mt('In discussions: new posts will be cease to be identified as "NEW" after display.')).'<br />';
1.43      raeburn  1666:             &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
1.116     raeburn  1667:             &Apache::lonnet::appenv({'environment.discmarkread' => $newmark});
1.43      raeburn  1668:         } else {
1.125.8.1  gci      1669:             $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  1670:             &Apache::lonnet::del('environment',['discmarkread']);
1.125.8.1  gci      1671:             &Apache::lonnet::delenv('environment.discmarkread');
1.43      raeburn  1672:         }
1.42      raeburn  1673:     }
1.125.8.1  gci      1674:     $message=&Apache::loncommon::confirmwrapper($message);
1.42      raeburn  1675:     $r->print(<<ENDVCSCREEN);
                   1676: $message
                   1677: ENDVCSCREEN
                   1678: }
                   1679: 
1.63      raeburn  1680: ################################################################
                   1681: # Subroutines for page display on course access (Course Coordinators)
                   1682: ################################################################
                   1683: sub coursedisplaychanger {
                   1684:     my $r = shift;
                   1685:     my $user       = $env{'user.name'};
                   1686:     my $domain     = $env{'user.domain'};
1.66      albertel 1687:     my %userenv = &Apache::lonnet::get('environment',['course_init_display']);
1.71      raeburn  1688:     my $currvalue = 'whatsnew';
1.73      albertel 1689:     my $firstselect = '';
                   1690:     my $whatsnewselect = 'checked="checked"';
1.71      raeburn  1691:     if (exists($userenv{'course_init_display'})) {
                   1692:         if ($userenv{'course_init_display'} eq 'firstres') {
                   1693:             $currvalue = 'firstres';
1.73      albertel 1694:             $firstselect = 'checked="checked"';
                   1695: 	    $whatsnewselect = '';
1.71      raeburn  1696:         }
1.63      raeburn  1697:     }
1.71      raeburn  1698:     my %pagenames = (
                   1699:                        firstres => 'First resource',
1.125.8.1  gci      1700:                        whatsnew => "What's New Page",
1.71      raeburn  1701:                     );
1.125.8.1  gci      1702:     my $whatsnew_off=&mt('Display the [_1]first resource[_2] in the course.','<b>','</b>');
                   1703:     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  1704: 
1.125.8.1  gci      1705:     $r->print('<br /><b>'.
                   1706:               &mt('Set the default page to be displayed when you select a course role').
                   1707:               '</b>&nbsp;'.
                   1708:               &mt('(Currently: [_1])',$pagenames{$currvalue}).'<br />'.
                   1709:               &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>').
                   1710:               '<br /><br />');
1.63      raeburn  1711:     $r->print(<<ENDLSCREEN);
1.88      albertel 1712: <form name="prefs" action="/adm/preferences" method="post">
1.63      raeburn  1713: <input type="hidden" name="action" value="verify_and_change_coursepage" />
1.72      albertel 1714: <br />
1.65      albertel 1715: <label><input type="radio" name="newdisp" value="firstres" $firstselect /> $whatsnew_off</label><br />
1.70      raeburn  1716: <label><input type="radio" name="newdisp" value="whatsnew" $whatsnewselect /> $whatsnew_on</label><input type="hidden" name="refpage" value="$env{'form.refpage'}" />
1.63      raeburn  1717: ENDLSCREEN
1.125.8.1  gci      1718:     $r->print('<br /><br /><input type="submit" value="'.&mt('Save').'" />
1.63      raeburn  1719: </form>');
                   1720: }
                   1721: 
                   1722: sub verify_and_change_coursepage {
                   1723:     my $r = shift;
                   1724:     my $message='';
                   1725:     my %lt = &Apache::lonlocal::texthash(
1.70      raeburn  1726:         'defs' => 'Default now set',
1.71      raeburn  1727:         'when' => 'when you select a course role from the roles screen',
1.63      raeburn  1728:         'ywbt' => 'you will be taken to the start of the course.',
                   1729:         'apwb' => 'a page will be displayed that lists items in the course that may require action from you.',
                   1730:         'gtts' => 'Go to the start of the course',
1.125.8.1  gci      1731:         'dasp' => "Display the What's New Page", 
1.63      raeburn  1732:     );
                   1733:     my $newdisp  = $env{'form.newdisp'};
1.70      raeburn  1734:     $message = '<b>'.$lt{'defs'}.'</b>: '.$lt{'when'}.', ';
1.63      raeburn  1735:     if ($newdisp eq 'firstres') {
1.87      albertel 1736:         $message .= $lt{'ywbt'}.'<br />';
1.63      raeburn  1737:         &Apache::lonnet::put('environment',{'course_init_display' => $newdisp});
1.116     raeburn  1738:         &Apache::lonnet::appenv({'environment.course_init_display' => $newdisp});
1.63      raeburn  1739:     } else {
1.87      albertel 1740:         $message .= $lt{'apwb'}.'<br />';
1.63      raeburn  1741:         &Apache::lonnet::del('environment',['course_init_display']);
1.125.8.1  gci      1742:         &Apache::lonnet::delenv('environment.course_init_display');
1.63      raeburn  1743:     }
1.70      raeburn  1744:     my $refpage = $env{'form.refpage'};
1.63      raeburn  1745:     if (($env{'request.course.fn'}) && ($env{'request.course.id'})) {
                   1746:         if ($newdisp eq 'firstres') {
                   1747:             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1748:             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 
                   1749:             my ($furl,$ferr)=
                   1750:                 &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
                   1751:             $message .= '<br /><font size="+1"><a href="'.$furl.'">'.$lt{'gtts'}.' <i>'.&mt('now').'</i></a></font>';
                   1752:         } else {
1.70      raeburn  1753:             $message .= '<br /><font size="+1"><a href="/adm/whatsnew?refpage='.
                   1754:                         $refpage.'">'.$lt{'dasp'}.'</a></font>';
1.63      raeburn  1755:         }
                   1756:     }
1.125.8.1  gci      1757:     $message = &Apache::lonhtmlcommon::confirm_success($message);
1.63      raeburn  1758:     $r->print(<<ENDVCSCREEN);
                   1759: $message
                   1760: ENDVCSCREEN
                   1761: }
                   1762: 
                   1763: 
1.4       matthew  1764: ######################################################
                   1765: #            other handler subroutines               #
                   1766: ######################################################
                   1767: 
1.3       matthew  1768: ################################################################
                   1769: #                          Main handler                        #
                   1770: ################################################################
1.1       www      1771: sub handler {
                   1772:     my $r = shift;
1.59      albertel 1773:     my $user = $env{'user.name'};
                   1774:     my $domain = $env{'user.domain'};
1.31      www      1775:     &Apache::loncommon::content_type($r,'text/html');
1.4       matthew  1776:     # Some pages contain DES keys and should not be cached.
                   1777:     &Apache::loncommon::no_cache($r);
1.1       www      1778:     $r->send_http_header;
                   1779:     return OK if $r->header_only;
1.9       matthew  1780:     #
1.35      matthew  1781:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.70      raeburn  1782:                                    ['action','wysiwyg','returnurl','refpage']);
1.35      matthew  1783:     #
                   1784:     &Apache::lonhtmlcommon::clear_breadcrumbs();
                   1785:     &Apache::lonhtmlcommon::add_breadcrumb
                   1786:         ({href => '/adm/preferences',
                   1787:           text => 'Set User Preferences'});
                   1788: 
                   1789:     my @Options;
                   1790:     # Determine current authentication method
                   1791:     my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
                   1792:     if ($currentauth =~ /^(unix|internal):/) {
                   1793:         push (@Options,({ action   => 'changepass',
1.40      www      1794:                           linktext => 'Change Password',
1.35      matthew  1795:                           href     => '/adm/preferences',
                   1796:                           help     => 'Change_Password',
                   1797:                           subroutine => \&passwordchanger,
                   1798:                           breadcrumb => 
                   1799:                               { href => '/adm/preferences?action=changepass',
                   1800:                                 text => 'Change Password'},
                   1801:                           },
                   1802:                         { action => 'verify_and_change_pass',
                   1803:                           subroutine => \&verify_and_change_password,
                   1804:                           breadcrumb => 
                   1805:                               { href =>'/adm/preferences?action=changepass',
                   1806:                                 text => 'Change Password'},
1.75      albertel 1807:                           printmenu => 'not_on_error',
1.35      matthew  1808:                           }));
                   1809:     }
                   1810:     push (@Options,({ action   => 'changescreenname',
                   1811:                       linktext => 'Change Screen Name',
                   1812:                       href     => '/adm/preferences',
                   1813:                       help     => 'Prefs_Screen_Name_Nickname',
                   1814:                       subroutine => \&screennamechanger,
                   1815:                       breadcrumb => 
                   1816:                           { href => '/adm/preferences?action=changescreenname',
                   1817:                             text => 'Change Screen Name'},
                   1818:                       },
                   1819:                     { action   => 'verify_and_change_screenname',
                   1820:                       subroutine => \&verify_and_change_screenname,
                   1821:                       breadcrumb => 
                   1822:                           { href => '/adm/preferences?action=changescreenname',
                   1823:                             text => 'Change Screen Name'},
                   1824:                       printmenu => 'yes',
                   1825:                       }));
                   1826: 
                   1827:     push (@Options,({ action   => 'changemsgforward',
1.125.8.1  gci      1828:                       linktext => 'Messages &amp; Notifications',
1.35      matthew  1829:                       href     => '/adm/preferences',
1.113     raeburn  1830:                       help     => 'Prefs_Messages',
1.35      matthew  1831:                       breadcrumb => 
                   1832:                           { href => '/adm/preferences?action=changemsgforward',
1.113     raeburn  1833:                             text => 'Change Message Forwarding/Notification'},
1.35      matthew  1834:                       subroutine => \&msgforwardchanger,
                   1835:                       },
                   1836:                     { action => 'verify_and_change_msgforward',
1.113     raeburn  1837:                       help   => 'Prefs_Messages',
1.35      matthew  1838:                       breadcrumb => 
                   1839:                           { href => '/adm/preferences?action=changemsgforward',
1.113     raeburn  1840:                             text => 'Change Message Forwarding/Notification'},
1.102     raeburn  1841:                       printmenu => 'no',
1.35      matthew  1842:                       subroutine => \&verify_and_change_msgforward }));
1.125.8.1  gci      1843:     if (&Apache::lonnet::usertools_access($user,$domain,'aboutme')) {
                   1844:         my $aboutmeaction = '/adm/'.$domain.'/'.$user.'/aboutme';
                   1845:         push (@Options,{ action   => 'none', 
                   1846:                          linktext =>"Edit the Personal Information Page",
                   1847:                          help     => 'Prefs_About_Me',
                   1848:                          href => $aboutmeaction});
                   1849:     }
1.35      matthew  1850:     push (@Options,({ action => 'changecolors',
                   1851:                       linktext => 'Change Color Scheme',
                   1852:                       href => '/adm/preferences',
                   1853:                       help => 'Change_Colors',
                   1854:                       breadcrumb => 
                   1855:                           { href => '/adm/preferences?action=changecolors',
                   1856:                             text => 'Change Colors'},
                   1857:                       subroutine => \&colorschanger,
                   1858:                   },
                   1859:                     { action => 'verify_and_change_colors',
                   1860:                       breadcrumb => 
                   1861:                           { href => '/adm/preferences?action=changecolors',
                   1862:                             text => 'Change Colors'},
                   1863:                       printmenu => 'yes',
                   1864:                       subroutine => \&verify_and_change_colors,
                   1865:                       }));
1.125.8.2  gci      1866:     if ($env{'user.adv'}) {
                   1867:         push (@Options,({ action => 'changelanguages',
                   1868:                           linktext => 'Change Language Preferences',
                   1869:                           href => '/adm/preferences',
                   1870: 	    	          help => 'Prefs_Language',
                   1871:                           breadcrumb=>
                   1872:                               { href => '/adm/preferences?action=changelanguages',
                   1873:                                 text => 'Change Language'},
                   1874:                           subroutine =>  \&languagechanger,
                   1875:                       },
                   1876:                         { action => 'verify_and_change_languages',
                   1877:                           breadcrumb=>
                   1878:                               {href => '/adm/preferences?action=changelanguages',
                   1879:                                text => 'Change Language'},
                   1880:                           printmenu => 'yes',
                   1881:                           subroutine=>\&verify_and_change_languages, }
1.35      matthew  1882:                     ));
1.125.8.2  gci      1883:     }
1.44      www      1884:     push (@Options,({ action => 'changewysiwyg',
                   1885:                       linktext => 'Change WYSIWYG Editor Preferences',
                   1886:                       href => '/adm/preferences',
                   1887:                       breadcrumb => 
                   1888:                             { href => '/adm/preferences?action=changewysiwyg',
                   1889:                               text => 'Change WYSIWYG Preferences'},
                   1890:                       subroutine => \&wysiwygchanger,
                   1891:                   },
                   1892:                     { action => 'set_wysiwyg',
                   1893:                       breadcrumb =>
                   1894:                           { href => '/adm/preferences?action=changewysiwyg',
                   1895:                             text => 'Change WYSIWYG Preferences'},
                   1896:                       printmenu => 'yes',
                   1897:                       subroutine => \&verify_and_change_wysiwyg, }
                   1898:                     ));
1.42      raeburn  1899:     push (@Options,({ action => 'changediscussions',
                   1900:                       linktext => 'Change Discussion Display Preferences',
                   1901:                       href => '/adm/preferences',
1.46      raeburn  1902:                       help => 'Change_Discussion_Display',
1.42      raeburn  1903:                       breadcrumb => 
                   1904:                             { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1905:                               text => 'Change Discussion Preferences'},
1.42      raeburn  1906:                       subroutine => \&discussionchanger,
                   1907:                   },
                   1908:                     { action => 'verify_and_change_discussion',
                   1909:                       breadcrumb =>
                   1910:                           { href => '/adm/preferences?action=changediscussions',
1.43      raeburn  1911:                             text => 'Change Discussion Preferences'},
1.42      raeburn  1912:                       printmenu => 'yes',
                   1913:                       subroutine => \&verify_and_change_discussion, }
                   1914:                     ));
1.96      albertel 1915: 
                   1916:     my $role = ($env{'user.adv'} ? 'Roles' : 'Course');
1.50      albertel 1917:     push (@Options,({ action   => 'changerolespref',
1.96      albertel 1918:                       linktext => 'Change '.$role.' Page Preferences',
1.50      albertel 1919:                       href     => '/adm/preferences',
                   1920:                       subroutine => \&rolesprefchanger,
                   1921:                       breadcrumb =>
                   1922:                           { href => '/adm/preferences?action=changerolespref',
1.96      albertel 1923:                             text => 'Change '.$role.' Page Pref'},
1.50      albertel 1924:                       },
                   1925:                     { action   => 'verify_and_change_rolespref',
                   1926:                       subroutine => \&verify_and_change_rolespref,
                   1927:                       breadcrumb =>
                   1928:                           { href => '/adm/preferences?action=changerolespref',
1.96      albertel 1929:                             text => 'Change '.$role.' Page Preferences'},
1.50      albertel 1930:                       printmenu => 'yes',
                   1931:                       }));
                   1932: 
1.54      albertel 1933:     push (@Options,({ action   => 'changetexenginepref',
                   1934:                       linktext => 'Change How Math Equations Are Displayed',
                   1935:                       href     => '/adm/preferences',
                   1936:                       subroutine => \&texenginechanger,
                   1937:                       breadcrumb =>
                   1938:                           { href => '/adm/preferences?action=changetexenginepref',
                   1939:                             text => 'Change Math Pref'},
                   1940:                       },
                   1941:                     { action   => 'verify_and_change_texengine',
                   1942:                       subroutine => \&verify_and_change_texengine,
                   1943:                       breadcrumb =>
                   1944:                           { href => '/adm/preferences?action=changetexenginepref',
                   1945:                             text => 'Change Math Preferences'},
                   1946:                       printmenu => 'yes',
                   1947:                       }));
1.85      albertel 1948: 
                   1949:     if ($env{'environment.remote'} eq 'off') {
                   1950: 	push (@Options,({ action => 'launch',
                   1951: 			  linktext => 'Launch Remote Control',
                   1952: 			  href => '/adm/remote?url=/adm/preferences',
                   1953: 		      }));
                   1954:     } else {
                   1955: 	push (@Options,({ action => 'collapse',
                   1956: 			  linktext => 'Collapse Remote Control',
                   1957: 			  href => '/adm/remote?url=/adm/preferences',
                   1958: 		      }));
                   1959:     }
                   1960: 
1.98      www      1961:     push (@Options,({ action   => 'changeicons',
1.100     www      1962:                       linktext => 'Change How Menus are Displayed',
1.98      www      1963:                       href     => '/adm/preferences',
                   1964:                       subroutine => \&iconchanger,
                   1965:                       breadcrumb =>
                   1966:                           { href => '/adm/preferences?action=changeicons',
                   1967:                             text => 'Change Main Menu'},
                   1968:                       },
                   1969:                     { action   => 'verify_and_change_icons',
                   1970:                       subroutine => \&verify_and_change_icons,
                   1971:                       breadcrumb =>
                   1972:                           { href => '/adm/preferences?action=changeicons',
                   1973:                             text => 'Change Main Menu'},
                   1974:                       printmenu => 'yes',
                   1975:                       }));
1.125.8.2  gci      1976:     if ($env{'user.adv'}) {
                   1977:         push (@Options,({ action   => 'changeclicker',
                   1978:                           linktext => 'Register Response Devices (&quot;Clickers&quot;)',
                   1979:                           href     => '/adm/preferences',
                   1980:                           subroutine => \&clickerchanger,
                   1981:                           breadcrumb =>
                   1982:                               { href => '/adm/preferences?action=changeclicker',
                   1983:                                 text => 'Register Clicker'},
                   1984:                           },
                   1985:                           { action   => 'verify_and_change_clicker',
                   1986:                           subroutine => \&verify_and_change_clicker,
                   1987:                           breadcrumb =>
                   1988:                               { href => '/adm/preferences?action=changeclicker',
                   1989:                                 text => 'Register Clicker'},
                   1990:                           printmenu => 'yes',
                   1991:                           }));
                   1992:     }
1.125     raeburn  1993:     my %author_roles = &Apache::lonnet::get_my_roles($user,$domain,'userroles','',['au']);
                   1994:     if (keys(%author_roles) > 0) {
1.119     www      1995:       push (@Options,({ action   => 'changedomcoord',
                   1996:                         linktext => 'Restrict Domain Coordinator Access',
                   1997:                         href     => '/adm/preferences',
                   1998:                         subroutine => \&domcoordchanger,
                   1999:                         breadcrumb =>
                   2000:                             { href => '/adm/preferences?action=changedomcoord',
                   2001:                               text => 'Restrict Domain Coordinator Access'},
                   2002:                       },
                   2003:                       { action   => 'verify_and_change_domcoord',
                   2004:                         subroutine => \&verify_and_change_domcoord,
                   2005:                         breadcrumb =>
                   2006:                             { href => '/adm/preferences?action=changedomcoord',
                   2007:                               text => 'Restrict Domain Coordinator Access'},
                   2008:                         printmenu => 'yes',
                   2009:                       }));
                   2010:     }
1.105     www      2011: 
1.118     www      2012:     push (@Options,({ action   => 'lockwarning',
                   2013:                       subroutine => \&lockwarning,
                   2014:                       breadcrumb =>
                   2015:                           { href => '/adm/preferences?action=lockwarning',
                   2016:                             text => 'Lock Warnings'},
                   2017:                       },
                   2018:                     { action   => 'verify_and_change_locks',
                   2019:                       subroutine => \&verify_and_change_lockwarning,
                   2020:                       breadcrumb =>
                   2021:                           { href => '/adm/preferences?action=lockwarning',
                   2022:                             text => 'Lockwarnings'},
                   2023:                       printmenu => 'yes',
                   2024:                       }));
                   2025: 
1.105     www      2026: 
1.74      albertel 2027:     if (&Apache::lonnet::allowed('whn',$env{'request.course.id'})
                   2028: 	|| &Apache::lonnet::allowed('whn',$env{'request.course.id'}.'/'
                   2029: 				    .$env{'request.course.sec'})) {
1.63      raeburn  2030:         push (@Options,({ action => 'changecourseinit',
                   2031:                           linktext => 'Change Course Initialization Preference',
                   2032:                           href => '/adm/preferences',
                   2033:                           subroutine => \&coursedisplaychanger,
                   2034:                           breadcrumb =>
                   2035:                               { href => '/adm/preferences?action=changecourseinit',
                   2036:                                 text => 'Change Course Init. Pref.'},
                   2037:                           },
                   2038:                         { action => 'verify_and_change_coursepage',
                   2039:                           breadcrumb =>
                   2040:                           { href => '/adm/preferences?action=changecourseinit',                               text => 'Change Course Initialization Preference'},
                   2041:                         printmenu => 'yes',
                   2042:                         subroutine => \&verify_and_change_coursepage,
                   2043:                        }));
                   2044:     }
1.50      albertel 2045: 
1.119     www      2046:     if ($env{'user.name'} =~ /^(albertel|fox|foxr|kortemey|korte|raeburn)$/) {
1.35      matthew  2047:         push (@Options,({ action => 'debugtoggle',
                   2048:                           printmenu => 'yes',
                   2049:                           subroutine => \&toggle_debug,
                   2050:                           }));
                   2051:     }
1.76      albertel 2052: 
                   2053:     $r->print(&Apache::loncommon::start_page('Change Preferences'));
                   2054: 
1.35      matthew  2055:     my $call = undef;
1.48      albertel 2056:     my $help = undef;
1.35      matthew  2057:     my $printmenu = 'yes';
                   2058:     foreach my $option (@Options) {
1.59      albertel 2059:         if ($option->{'action'} eq $env{'form.action'}) {
1.35      matthew  2060:             $call = $option->{'subroutine'};
                   2061:             $printmenu = $option->{'printmenu'};
                   2062:             if (exists($option->{'breadcrumb'})) {
                   2063:                 &Apache::lonhtmlcommon::add_breadcrumb
                   2064:                     ($option->{'breadcrumb'});
                   2065:             }
1.48      albertel 2066: 	    $help=$option->{'help'};
1.35      matthew  2067:         }
                   2068:     }
1.81      albertel 2069:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Change Preferences',$help));
1.75      albertel 2070:     my $error;
1.35      matthew  2071:     if (defined($call)) {
1.75      albertel 2072:         $error = $call->($r);
1.35      matthew  2073:     }
1.75      albertel 2074:     if ( ( ($printmenu eq 'yes')
                   2075: 	   || ($printmenu eq 'not_on_error' && !$error) )
                   2076: 	 && (!$env{'form.returnurl'})) {
1.35      matthew  2077:         my $optionlist = '<table cellpadding="5">';
1.59      albertel 2078:         if ($env{'user.name'} =~ 
1.62      raeburn  2079:                          /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle|raeburn)$/
1.35      matthew  2080:             ) {
                   2081:             push (@Options,({ action => 'debugtoggle',
                   2082:                               linktext => 'Toggle Debug Messages',
                   2083:                               text => 'Current Debug status is -'.
1.59      albertel 2084:                                   $env{'user.debug'}.'-.',
1.35      matthew  2085:                               href => '/adm/preferences',
                   2086:                               printmenu => 'yes',
                   2087:                               subroutine => \&toggle_debug,
                   2088:                               }));
                   2089:         }
                   2090:         foreach my $option(@Options) {
                   2091:             my $optiontext = '';
                   2092:             if (exists($option->{'href'})) {
1.85      albertel 2093: 		$option->{'href_args'}{'action'}=$option->{'action'};
                   2094: 		$optiontext .= 
                   2095:                     '<a href="'.&add_get_param($option->{'href'},
                   2096: 					       $option->{'href_args'}).'">'.
1.47      albertel 2097:                     &mt($option->{'linktext'}).'</a>';
1.35      matthew  2098:             }
                   2099:             if (exists($option->{'text'})) {
1.47      albertel 2100:                 $optiontext .= ' '.&mt($option->{'text'});
1.35      matthew  2101:             }
                   2102:             if ($optiontext ne '') {
                   2103:                 $optiontext = '<font size="+1">'.$optiontext.'</font>'; 
                   2104:                 my $helplink = '&nbsp;';
                   2105:                 if (exists($option->{'help'})) {
                   2106:                     $helplink = &Apache::loncommon::help_open_topic
                   2107:                                                     ($option->{'help'});
                   2108:                 }
                   2109:                 $optionlist .= '<tr>'.
                   2110:                     '<td>'.$helplink.'</td>'.
                   2111:                     '<td>'.$optiontext.'</td>'.
                   2112:                     '</tr>';
                   2113:             }
1.13      www      2114:         }
1.35      matthew  2115:         $optionlist .= '</table>';
                   2116:         $r->print($optionlist);
1.59      albertel 2117:     } elsif ($env{'form.returnurl'}) {
                   2118: 	$r->print('<br /><a href="'.$env{'form.returnurl'}.'"><font size="+1">'.
1.44      www      2119: 		  &mt('Return').'</font></a>');
1.3       matthew  2120:     }
1.76      albertel 2121:     $r->print(&Apache::loncommon::end_page());
1.1       www      2122:     return OK;
1.35      matthew  2123: }
                   2124: 
                   2125: sub toggle_debug {
1.59      albertel 2126:     if ($env{'user.debug'}) {
1.125.8.1  gci      2127:         &Apache::lonnet::delenv('user.debug');
1.35      matthew  2128:     } else {
1.116     raeburn  2129:         &Apache::lonnet::appenv({'user.debug' => 1});
1.35      matthew  2130:     }
1.13      www      2131: }
1.1       www      2132: 
                   2133: 1;
                   2134: __END__

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