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