Annotation of loncom/interface/lonpreferences.pm, revision 1.100
1.1 www 1: # The LearningOnline Network
2: # Preferences
3: #
1.100 ! www 4: # $Id: lonpreferences.pm,v 1.99 2007/04/17 18:28:44 www Exp $
1.2 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.3 matthew 28: # This package uses the "londes.js" javascript code.
29: #
30: # TODOs that have to be completed:
31: # interface with lonnet to change the password
32:
1.1 www 33: package Apache::lonpreferences;
34:
35: use strict;
1.86 albertel 36: use LONCAPA;
1.1 www 37: use Apache::Constants qw(:common);
1.3 matthew 38: use Apache::File;
39: use Crypt::DES;
40: use DynaLoader; # for Crypt::DES version
1.4 matthew 41: use Apache::loncommon();
1.23 matthew 42: use Apache::lonhtmlcommon();
1.32 www 43: use Apache::lonlocal;
1.59 albertel 44: use Apache::lonnet;
1.95 albertel 45: use LONCAPA();
1.3 matthew 46:
47: #
48: # Write lonnet::passwd to do the call below.
49: # Use:
50: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
51: #
52: ##################################################
53: # password associated functions #
54: ##################################################
55: sub des_keys {
1.4 matthew 56: # Make a new key for DES encryption.
1.36 www 57: # Each key has two parts which are returned separately.
1.4 matthew 58: # Please note: Each key must be passed through the &hex function
59: # before it is output to the web browser. The hex versions cannot
60: # be used to decrypt.
1.3 matthew 61: my @hexstr=('0','1','2','3','4','5','6','7',
62: '8','9','a','b','c','d','e','f');
63: my $lkey='';
64: for (0..7) {
65: $lkey.=$hexstr[rand(15)];
66: }
67: my $ukey='';
68: for (0..7) {
69: $ukey.=$hexstr[rand(15)];
70: }
71: return ($lkey,$ukey);
72: }
73:
74: sub des_decrypt {
75: my ($key,$cyphertext) = @_;
76: my $keybin=pack("H16",$key);
77: my $cypher;
78: if ($Crypt::DES::VERSION>=2.03) {
79: $cypher=new Crypt::DES $keybin;
80: } else {
81: $cypher=new DES $keybin;
82: }
83: my $plaintext=
84: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
85: $plaintext.=
86: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
1.4 matthew 87: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
1.3 matthew 88: return $plaintext;
89: }
90:
1.4 matthew 91: ################################################################
92: # Handler subroutines #
93: ################################################################
1.9 matthew 94:
95: ################################################################
1.28 www 96: # Language Change Subroutines #
97: ################################################################
1.44 www 98:
99: sub wysiwygchanger {
100: my $r = shift;
101: my %userenv = &Apache::lonnet::get
102: ('environment',['wysiwygeditor']);
1.78 albertel 103: my $onselect='checked="checked"';
1.44 www 104: my $offselect='';
1.77 albertel 105: if ($userenv{'wysiwygeditor'} eq 'on') {
1.44 www 106: $onselect='';
1.78 albertel 107: $offselect='checked="checked"';
1.44 www 108: }
109: my $switchoff=&mt('Disable WYSIWYG editor');
110: my $switchon=&mt('Enable WYSIWYG editor');
111: $r->print(<<ENDLSCREEN);
1.88 albertel 112: <form name="prefs" action="/adm/preferences" method="post">
1.44 www 113: <input type="hidden" name="action" value="set_wysiwyg" />
114: <br />
1.65 albertel 115: <label><input type="radio" name="wysiwyg" value="off" $onselect /> $switchoff</label><br />
116: <label><input type="radio" name="wysiwyg" value="on" $offselect /> $switchon</label>
1.44 www 117: ENDLSCREEN
118: $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
119: }
120:
121:
122: sub verify_and_change_wysiwyg {
123: my $r = shift;
1.59 albertel 124: my $newsetting=$env{'form.wysiwyg'};
1.44 www 125: &Apache::lonnet::put('environment',{'wysiwygeditor' => $newsetting});
126: &Apache::lonnet::appenv('environment.wysiwygeditor' => $newsetting);
127: $r->print('<p>'.&mt('Setting WYSIWYG editor to:').' '.&mt($newsetting).'</p>');
128: }
129:
130: ################################################################
131: # Language Change Subroutines #
132: ################################################################
1.28 www 133: sub languagechanger {
134: my $r = shift;
1.59 albertel 135: my $user = $env{'user.name'};
136: my $domain = $env{'user.domain'};
1.28 www 137: my %userenv = &Apache::lonnet::get
1.32 www 138: ('environment',['languages']);
1.29 www 139: my $language=$userenv{'languages'};
1.32 www 140:
1.33 www 141: my $pref=&mt('Preferred language');
142: my %langchoices=('' => 'No language preference');
143: foreach (&Apache::loncommon::languageids()) {
144: if (&Apache::loncommon::supportedlanguagecode($_)) {
145: $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
146: = &Apache::loncommon::plainlanguagedescription($_);
147: }
148: }
149: my $selectionbox=&Apache::loncommon::select_form($language,'language',
150: %langchoices);
1.28 www 151: $r->print(<<ENDLSCREEN);
1.88 albertel 152: <form name="prefs" action="/adm/preferences" method="post">
1.28 www 153: <input type="hidden" name="action" value="verify_and_change_languages" />
1.33 www 154: <br />$pref: $selectionbox
1.28 www 155: ENDLSCREEN
1.35 matthew 156: $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
1.28 www 157: }
158:
159:
160: sub verify_and_change_languages {
161: my $r = shift;
1.59 albertel 162: my $user = $env{'user.name'};
163: my $domain = $env{'user.domain'};
1.28 www 164: # Screenname
1.59 albertel 165: my $newlanguage = $env{'form.language'};
1.28 www 166: $newlanguage=~s/[^\-\w]//g;
167: my $message='';
168: if ($newlanguage) {
1.29 www 169: &Apache::lonnet::put('environment',{'languages' => $newlanguage});
170: &Apache::lonnet::appenv('environment.languages' => $newlanguage);
171: $message='Set new preferred languages to '.$newlanguage;
1.28 www 172: } else {
1.29 www 173: &Apache::lonnet::del('environment',['languages']);
174: &Apache::lonnet::delenv('environment\.languages');
1.28 www 175: $message='Reset preferred language';
176: }
177: $r->print(<<ENDVCSCREEN);
178: $message
179: ENDVCSCREEN
180: }
181:
1.50 albertel 182: ################################################################
1.54 albertel 183: # Tex Engine Change Subroutines #
184: ################################################################
185: sub texenginechanger {
186: my $r = shift;
1.59 albertel 187: my $user = $env{'user.name'};
188: my $domain = $env{'user.domain'};
1.54 albertel 189: my %userenv = &Apache::lonnet::get('environment',['texengine']);
190: my $texengine=$userenv{'texengine'};
191:
192: my $pref=&mt('Preferred method to display Math');
1.69 albertel 193: my %mathchoices=('' => 'Default',
1.54 albertel 194: 'tth' => 'TeX to HTML',
1.64 albertel 195: #'ttm' => 'TeX to MathML',
1.54 albertel 196: 'jsMath' => 'jsMath',
1.57 albertel 197: 'mimetex' => 'Convert to Images'
1.54 albertel 198: );
199: my $selectionbox=&Apache::loncommon::select_form($texengine,'texengine',
200: %mathchoices);
1.67 albertel 201: my $jsMath_start=&Apache::lontexconvert::jsMath_header();
1.54 albertel 202: my $change=&mt('Change');
203: $r->print(<<ENDLSCREEN);
1.67 albertel 204: <br />
205:
1.88 albertel 206: <form name="prefs" action="/adm/preferences" method="post">
1.54 albertel 207: <input type="hidden" name="action" value="verify_and_change_texengine" />
208: <p>$pref: $selectionbox</p>
209: <p><input type="submit" value="$change" /></p>
210: </form>
211: Examples:
1.67 albertel 212: <p> TeX to HTML <br />
1.79 albertel 213: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=tth" width="400" hieght="200"></iframe>
1.67 albertel 214: </p>
1.54 albertel 215: <p>jsMath <br />
1.67 albertel 216: $jsMath_start
1.57 albertel 217: <script type="text/javascript">
1.54 albertel 218: if (jsMath.nofonts == 1) {
219: document.writeln
220: ('<center><div style="padding: 10; border-style: solid; border-width:3;'
221: +' border-color: #DD0000; background-color: #FFF8F8; width: 75%; text-align: left">'
222: +'<small><font color="#AA0000"><b>Warning:</b> '
223: +'It looks like you don\\\'t have the TeX math fonts installed. '
224: +'The jsMath example on this page may not look right without them. '
225: +'The <a href="http://www.math.union.edu/locate/jsMath/" target="_blank"> '
226: +'jsMath Home Page</a> has information on how to download the '
227: +'needed fonts. In the meantime, jsMath will do the best it can '
228: +'with the fonts you have, but it may not be pretty and some equations '
229: +'may not be rendered correctly. '
230: +'</font></small></div></center>');
231: }
232: </script>
1.79 albertel 233: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=jsMath" width="400" hieght="200"></iframe>
1.54 albertel 234:
1.67 albertel 235: </p>
236: <p> Convert to Images <br />
237: <br />
1.79 albertel 238: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=mimetex" width="400" hieght="200"></iframe>
1.67 albertel 239: </p>
1.54 albertel 240: ENDLSCREEN
1.59 albertel 241: if ($env{'environment.texengine'} ne 'jsMath') {
1.55 albertel 242: $r->print('<script type="text/javascript">jsMath.Process()</script>');
243: }
1.54 albertel 244: }
245:
246:
247: sub verify_and_change_texengine {
248: my $r = shift;
1.59 albertel 249: my $user = $env{'user.name'};
250: my $domain = $env{'user.domain'};
1.54 albertel 251: # Screenname
1.59 albertel 252: my $newtexengine = $env{'form.texengine'};
1.54 albertel 253: $newtexengine=~s/[^\-\w]//g;
1.56 albertel 254: if ($newtexengine eq 'ttm') {
255: &Apache::lonnet::appenv('browser.mathml' => 1);
256: } else {
1.59 albertel 257: if ($env{'environment.texengine'} eq 'ttm') {
1.56 albertel 258: &Apache::lonnet::appenv('browser.mathml' => 0);
259: }
260: }
1.54 albertel 261: my $message='';
262: if ($newtexengine) {
263: &Apache::lonnet::put('environment',{'texengine' => $newtexengine});
264: &Apache::lonnet::appenv('environment.texengine' => $newtexengine);
265: $message='Set new preferred math display to '.$newtexengine;
266: } else {
267: &Apache::lonnet::del('environment',['texengine']);
268: &Apache::lonnet::delenv('environment\.texengine');
269: $message='Reset preferred math display.';
270: }
1.56 albertel 271:
272:
1.54 albertel 273: $r->print(<<ENDVCSCREEN);
274: $message
275: ENDVCSCREEN
276: }
277:
278: ################################################################
1.50 albertel 279: # Roles Page Preference Change Subroutines #
280: ################################################################
281: sub rolesprefchanger {
282: my $r = shift;
1.96 albertel 283: my $role = ($env{'user.adv'} ? 'Role' : 'Course');
284: my $lc_role = ($env{'user.adv'} ? 'role' : 'course');
1.59 albertel 285: my $user = $env{'user.name'};
286: my $domain = $env{'user.domain'};
1.50 albertel 287: my %userenv = &Apache::lonnet::get
288: ('environment',['recentroles','recentrolesn']);
289: my $hotlist_flag=$userenv{'recentroles'};
290: my $hotlist_n=$userenv{'recentrolesn'};
291: my $checked;
292: if ($hotlist_flag) {
293: $checked = 'checked="checked"';
294: }
295:
296: if (!$hotlist_n) { $hotlist_n=3; }
297: my $options;
298: for (my $i=1; $i<10; $i++) {
299: my $select;
300: if ($hotlist_n == $i) { $select = 'selected="selected"'; }
301: $options .= "<option $select>$i</option>\n";
302: }
303:
1.89 albertel 304: # Get list of recent roles and display with checkbox in front
305: my $roles_check_list = '';
306: my $role_key='';
307: if ($env{'environment.recentroles'}) {
308: my %recent_roles =
309: &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.91 albertel 310: my %frozen_roles =
311: &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.89 albertel 312:
1.93 albertel 313: my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
1.92 albertel 314: my @sorted_roles = sort {$role_text{$a} cmp $role_text{$b}} keys(%role_text);
315:
1.89 albertel 316: $roles_check_list .=
317: &Apache::loncommon::start_data_table().
318: &Apache::loncommon::start_data_table_header_row().
1.96 albertel 319: "<th>".&mt('Freeze '.$role)."</th>".
320: "<th>".&mt($role)."</td>".
1.89 albertel 321: &Apache::loncommon::end_data_table_header_row().
322: "\n";
323: my $count;
1.92 albertel 324: foreach $role_key (@sorted_roles) {
1.89 albertel 325: my $checked = "";
326: my $value = $recent_roles{$role_key};
1.91 albertel 327: if ($frozen_roles{$role_key}) {
1.89 albertel 328: $checked = "checked=\"checked\"";
329: }
330: $count++;
331: $roles_check_list .=
332: &Apache::loncommon::start_data_table_row().
333: '<td class="LC_table_cell_checkbox">'.
334: "<input type=\"checkbox\" $checked name=\"freezeroles\"".
335: " id=\"freezeroles$count\" value=\"$role_key\" /></td>".
336: "<td><label for=\"freezeroles$count\">".
1.92 albertel 337: "$role_text{$role_key}</label></td>".
1.89 albertel 338: &Apache::loncommon::end_data_table_row(). "\n";
339: }
340: $roles_check_list .= "</table>\n";
341: }
342:
343: $r->print('
1.96 albertel 344: <p>'.&mt('Some LON-CAPA users have a long list of '.$lc_role.'s. The Recent '.$role.'s Hotlist feature keeps track of the last N '.$lc_role.'s which have been visited and places a table of these at the top of the '.$lc_role.'s page. People with very few '.$lc_role.'s should leave this feature disabled.').'
1.50 albertel 345: </p>
1.89 albertel 346: <form name="prefs" action="/adm/preferences" method="POST">
1.50 albertel 347: <input type="hidden" name="action" value="verify_and_change_rolespref" />
1.96 albertel 348: <br /><label>'.&mt('Enable Recent '.$role.'s Hotlist:').'
1.89 albertel 349: <input type="checkbox" '.$checked.' name="recentroles" value="true" /></label>
1.96 albertel 350: <br />'.&mt('Number of '.$role.'s in Hotlist:').'
1.50 albertel 351: <select name="recentrolesn" size="1">
1.89 albertel 352: '.$options.'
1.50 albertel 353: </select>
1.96 albertel 354: <p>'.&mt('This list below can be used to <q>freeze</q> '.$lc_role.'s on your screen. Those marked as frozen will not be removed from the list, even if they have not been used recently.').'
1.89 albertel 355: </p>
356: '.$roles_check_list.'
1.50 albertel 357: <br />
1.89 albertel 358: <input type="submit" value="'.&mt('Change').'" />
359: </form>');
1.50 albertel 360: }
361:
1.92 albertel 362: sub rolespref_get_role_text {
363: # Get a line of text for each role
364: my ($roles) = @_;
365: my %roletext = ();
366:
367: foreach my $item (@$roles) {
368: # get course information
369: my ($role,$rest) = split(/\./, $item);
1.93 albertel 370: my $trole = "";
371: $trole = &Apache::lonnet::plaintext($role);
1.92 albertel 372: my ($tdomain,$other,$tsection)= split(/\//,Apache::lonnet::declutter($rest));
373: my $tother = '-';
1.93 albertel 374: if ($role =~ /^(cc|st|in|ta|ep|cr)/ ) {
1.92 albertel 375: my %newhash=&Apache::lonnet::coursedescription($tdomain."_".$other);
376: $tother = " - ".$newhash{'description'};
377: } elsif ($role =~ /dc/) {
378: $tother = "";
379: } else {
380: $tother = " - $other";
381: }
382:
383: my $section="";
384: if ($tsection) {
385: $section = " - Section/Group: $tsection";
386: }
387: $roletext{$item} = $tdomain." - ".$trole.$tother.$section;
388: }
389: return %roletext;
390: }
391:
1.50 albertel 392: sub verify_and_change_rolespref {
393: my $r = shift;
1.96 albertel 394: my $role = ($env{'user.adv'} ? 'Role' : 'Course');
1.59 albertel 395: my $user = $env{'user.name'};
396: my $domain = $env{'user.domain'};
1.50 albertel 397: # Recent Roles Hotlist Flag
1.59 albertel 398: my $hotlist_flag = $env{'form.recentroles'};
399: my $hotlist_n = $env{'form.recentrolesn'};
1.89 albertel 400: my $message='<hr />';
1.50 albertel 401: if ($hotlist_flag) {
402: &Apache::lonnet::put('environment',{'recentroles' => $hotlist_flag});
403: &Apache::lonnet::appenv('environment.recentroles' => $hotlist_flag);
1.96 albertel 404: $message=&mt('Recent '.$role.'s Hotlist is Enabled');
1.50 albertel 405: } else {
406: &Apache::lonnet::del('environment',['recentroles']);
407: &Apache::lonnet::delenv('environment\.recentroles');
1.96 albertel 408: $message=&mt('Recent '.$role.'s Hotlist is Disabled');
1.50 albertel 409: }
410: if ($hotlist_n) {
411: &Apache::lonnet::put('environment',{'recentrolesn' => $hotlist_n});
412: &Apache::lonnet::appenv('environment.recentrolesn' => $hotlist_n);
413: if ($hotlist_flag) {
1.90 albertel 414: $message.="<br />".
1.96 albertel 415: &mt('Display [_1] Most Recent '.$role.'s',$hotlist_n)."\n";
1.89 albertel 416: }
417: }
418:
419: # Get list of froze roles and list of recent roles
420: my @freeze_list = &Apache::loncommon::get_env_multiple('form.freezeroles');
421: my %freeze = ();
1.92 albertel 422: my %roletext = ();
423:
1.89 albertel 424: foreach my $key (@freeze_list) {
1.91 albertel 425: $freeze{$key}='1';
1.89 albertel 426: }
1.92 albertel 427:
1.89 albertel 428: my %recent_roles =
429: &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.91 albertel 430: my %frozen_roles =
431: &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.92 albertel 432: my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
1.89 albertel 433:
434: # Unset any roles that were previously frozen but aren't in list
435: foreach my $role_key (sort(keys(%recent_roles))) {
1.91 albertel 436: if (($frozen_roles{$role_key}) && (!exists($freeze{$role_key}))) {
1.96 albertel 437: $message .= "<br />".&mt('Unfreezing '.$role.': [_1]',$role_text{$role_key})."\n";
1.91 albertel 438: &Apache::lonhtmlcommon::store_recent('roles',$role_key,' ',0);
1.89 albertel 439: }
440: }
441:
442: # Freeze selected roles
443: foreach my $role_key (@freeze_list) {
1.91 albertel 444: if (!$frozen_roles{$role_key}) {
1.96 albertel 445: $message .= "<br />".&mt('Freezing '.$role.': [_1]',$role_text{$role_key})."\n";
1.89 albertel 446: &Apache::lonhtmlcommon::store_recent('roles',
1.91 albertel 447: $role_key,' ',1);
1.50 albertel 448: }
449: }
1.89 albertel 450: $message .= "<hr /><br />\n";
1.50 albertel 451:
452: $r->print(<<ENDRPSCREEN);
453: $message
454: ENDRPSCREEN
455: }
456:
457:
1.28 www 458:
459: ################################################################
1.9 matthew 460: # Anonymous Discussion Name Change Subroutines #
461: ################################################################
1.5 www 462: sub screennamechanger {
463: my $r = shift;
1.59 albertel 464: my $user = $env{'user.name'};
465: my $domain = $env{'user.domain'};
1.14 www 466: my %userenv = &Apache::lonnet::get
467: ('environment',['screenname','nickname']);
1.6 www 468: my $screenname=$userenv{'screenname'};
1.14 www 469: my $nickname=$userenv{'nickname'};
1.5 www 470: $r->print(<<ENDSCREEN);
1.88 albertel 471: <form name="prefs" action="/adm/preferences" method="post">
1.6 www 472: <input type="hidden" name="action" value="verify_and_change_screenname" />
1.14 www 473: <br />New screenname (shown if you post anonymously):
1.6 www 474: <input type="text" size="20" value="$screenname" name="screenname" />
1.14 www 475: <br />New nickname (shown if you post non-anonymously):
476: <input type="text" size="20" value="$nickname" name="nickname" />
1.6 www 477: <input type="submit" value="Change" />
478: </form>
1.5 www 479: ENDSCREEN
480: }
1.6 www 481:
482: sub verify_and_change_screenname {
483: my $r = shift;
1.59 albertel 484: my $user = $env{'user.name'};
485: my $domain = $env{'user.domain'};
1.14 www 486: # Screenname
1.59 albertel 487: my $newscreen = $env{'form.screenname'};
1.14 www 488: $newscreen=~s/[^ \w]//g;
1.6 www 489: my $message='';
490: if ($newscreen) {
1.7 www 491: &Apache::lonnet::put('environment',{'screenname' => $newscreen});
492: &Apache::lonnet::appenv('environment.screenname' => $newscreen);
1.6 www 493: $message='Set new screenname to '.$newscreen;
494: } else {
495: &Apache::lonnet::del('environment',['screenname']);
1.7 www 496: &Apache::lonnet::delenv('environment\.screenname');
1.6 www 497: $message='Reset screenname';
498: }
1.14 www 499: # Nickname
500: $message.='<br />';
1.59 albertel 501: $newscreen = $env{'form.nickname'};
1.14 www 502: $newscreen=~s/[^ \w]//g;
503: if ($newscreen) {
504: &Apache::lonnet::put('environment',{'nickname' => $newscreen});
505: &Apache::lonnet::appenv('environment.nickname' => $newscreen);
506: $message.='Set new nickname to '.$newscreen;
507: } else {
508: &Apache::lonnet::del('environment',['nickname']);
509: &Apache::lonnet::delenv('environment\.nickname');
510: $message.='Reset nickname';
511: }
1.68 www 512: &Apache::lonnet::devalidate_cache_new('namescache',$user.':'.$domain);
1.6 www 513: $r->print(<<ENDVCSCREEN);
514: $message
515: ENDVCSCREEN
1.20 www 516: }
517:
518: ################################################################
1.98 www 519: # Icon Subroutines #
520: ################################################################
521: sub iconchanger {
522: my $r = shift;
523: my $user = $env{'user.name'};
524: my $domain = $env{'user.domain'};
525: my %userenv = &Apache::lonnet::get
526: ('environment',['icons']);
527: my $iconic='checked="checked"';
528: my $classic='';
1.100 ! www 529: my $onlyicon='';
1.98 www 530: if ($userenv{'icons'} eq 'classic') {
531: $classic='checked="checked"';
532: $iconic='';
533: }
1.100 ! www 534: if ($userenv{'icons'} eq 'iconsonly') {
! 535: $onlyicon='checked="checked"';
! 536: $iconic='';
! 537: }
! 538: my $useicons=&mt('Use icons and text');
! 539: my $usebuttons=&mt('Use buttons and text');
! 540: my $useicononly=&mt('Use icons only');
1.98 www 541: my $change=&mt('Change');
542: $r->print(<<ENDSCREEN);
543: <form name="prefs" action="/adm/preferences" method="post">
544: <input type="hidden" name="action" value="verify_and_change_icons" />
545: <label><input type="radio" name="menumode" value="iconic" $iconic /> $useicons</label><br />
546: <label><input type="radio" name="menumode" value="classic" $classic /> $usebuttons</label><br />
1.100 ! www 547: <label><input type="radio" name="menumode" value="iconsonly" $onlyicon /> $useicononly</label><br />
1.98 www 548: <input type="submit" value="$change" />
549: </form>
550: ENDSCREEN
551: }
552:
553: sub verify_and_change_icons {
554: my $r = shift;
555: my $user = $env{'user.name'};
556: my $domain = $env{'user.domain'};
557: my $newicons = $env{'form.menumode'};
558:
559: &Apache::lonnet::put('environment',{'icons' => $newicons});
560: &Apache::lonnet::appenv('environment.icons' => $newicons);
561: $r->print(&mt('Set menu mode to [_1].',$newicons));
562: }
563:
564: ################################################################
1.20 www 565: # Message Forward #
566: ################################################################
567:
568: sub msgforwardchanger {
569: my $r = shift;
1.59 albertel 570: my $user = $env{'user.name'};
571: my $domain = $env{'user.domain'};
1.26 www 572: my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
1.20 www 573: my $msgforward=$userenv{'msgforward'};
574: my $notification=$userenv{'notification'};
575: my $critnotification=$userenv{'critnotification'};
1.25 bowersj2 576: my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
577: "What are forwarding ".
578: "and notification ".
579: "addresses");
1.27 bowersj2 580: my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
581: "What are critical messages");
582:
1.20 www 583: $r->print(<<ENDMSG);
1.25 bowersj2 584: $forwardingHelp <br />
1.88 albertel 585: <form name="prefs" action="/adm/preferences" method="post">
1.20 www 586: <input type="hidden" name="action" value="verify_and_change_msgforward" />
587: New Forwarding Address(es) (<tt>user:domain,user:domain,...</tt>):
588: <input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
589: New Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
590: <input type="text" size="40" value="$notification" name="notification" /><hr />
591: New Critical Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
1.27 bowersj2 592: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
1.20 www 593: <input type="submit" value="Change" />
594: </form>
595: ENDMSG
596: }
597:
598: sub verify_and_change_msgforward {
599: my $r = shift;
1.59 albertel 600: my $user = $env{'user.name'};
601: my $domain = $env{'user.domain'};
1.20 www 602: my $newscreen = '';
603: my $message='';
1.59 albertel 604: foreach (split(/\,/,$env{'form.msgforward'})) {
1.20 www 605: my ($msuser,$msdomain)=split(/[\@\:]/,$_);
1.95 albertel 606: $msuser = &LONCAPA::clean_username($msuser);
607: $msdomain = &LONCAPA::clean_domain($msdomain);
1.20 www 608: if (($msuser) && ($msdomain)) {
609: if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
610: $newscreen.=$msuser.':'.$msdomain.',';
611: } else {
612: $message.='No such user: '.$msuser.':'.$msdomain.'<br>';
613: }
614: }
615: }
616: $newscreen=~s/\,$//;
617: if ($newscreen) {
618: &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
619: &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
620: $message.='Set new message forwarding to '.$newscreen.'<br />';
621: } else {
622: &Apache::lonnet::del('environment',['msgforward']);
623: &Apache::lonnet::delenv('environment\.msgforward');
624: $message.='Reset message forwarding<br />';
625: }
1.59 albertel 626: my $notification=$env{'form.notification'};
1.20 www 627: $notification=~s/\s//gs;
628: if ($notification) {
629: &Apache::lonnet::put('environment',{'notification' => $notification});
630: &Apache::lonnet::appenv('environment.notification' => $notification);
631: $message.='Set message notification address to '.$notification.'<br />';
632: } else {
633: &Apache::lonnet::del('environment',['notification']);
634: &Apache::lonnet::delenv('environment\.notification');
635: $message.='Reset message notification<br />';
636: }
1.59 albertel 637: my $critnotification=$env{'form.critnotification'};
1.20 www 638: $critnotification=~s/\s//gs;
639: if ($critnotification) {
640: &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
641: &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
642: $message.='Set critical message notification address to '.$critnotification;
643: } else {
644: &Apache::lonnet::del('environment',['critnotification']);
645: &Apache::lonnet::delenv('environment\.critnotification');
646: $message.='Reset critical message notification<br />';
647: }
648: $r->print(<<ENDVCMSG);
649: $message
650: ENDVCMSG
1.6 www 651: }
652:
1.12 www 653: ################################################################
1.19 www 654: # Colors #
1.12 www 655: ################################################################
656:
1.19 www 657: sub colorschanger {
1.12 www 658: my $r = shift;
1.19 www 659: # figure out colors
1.80 albertel 660: my $function=&Apache::loncommon::get_users_function();
1.19 www 661: my $domain=&Apache::loncommon::determinedomain();
662: my %colortypes=('pgbg' => 'Page Background',
663: 'tabbg' => 'Header Background',
664: 'sidebg'=> 'Header Border',
665: 'font' => 'Font',
666: 'link' => 'Un-Visited Link',
667: 'vlink' => 'Visited Link',
668: 'alink' => 'Active Link');
1.82 albertel 669: my $start_data_table = &Apache::loncommon::start_data_table();
1.19 www 670: my $chtable='';
1.22 matthew 671: foreach my $item (sort(keys(%colortypes))) {
1.19 www 672: my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
1.82 albertel 673: $chtable.=&Apache::loncommon::start_data_table_row().
1.83 albertel 674: '<td>'.$colortypes{$item}.'</td><td style="background: '.$curcol.
1.19 www 675: '"> </td><td><input name="'.$item.
1.21 www 676: '" size="10" value="'.$curcol.
677: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19 www 678: "','".$curcol."','"
1.82 albertel 679: .$item."','parmform.pres','psub'".');">Select</a></td>'.
1.83 albertel 680: &Apache::loncommon::end_data_table_row()."\n";
1.19 www 681: }
1.82 albertel 682: my $end_data_table = &Apache::loncommon::end_data_table();
1.23 matthew 683: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19 www 684: $r->print(<<ENDCOL);
1.82 albertel 685: <script type="text/javascript">
1.19 www 686:
687: function pclose() {
688: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
689: "height=350,width=350,scrollbars=no,menubar=no");
690: parmwin.close();
691: }
692:
1.23 matthew 693: $pjump_def
1.19 www 694:
695: function psub() {
696: pclose();
697: if (document.parmform.pres_marker.value!='') {
1.21 www 698: if (document.parmform.pres_type.value!='') {
1.77 albertel 699: eval('document.prefs.'+
1.21 www 700: document.parmform.pres_marker.value+
1.19 www 701: '.value=document.parmform.pres_value.value;');
1.21 www 702: }
1.19 www 703: } else {
704: document.parmform.pres_value.value='';
705: document.parmform.pres_marker.value='';
706: }
707: }
708:
709:
710: </script>
1.21 www 711: <form name="parmform">
712: <input type="hidden" name="pres_marker" />
713: <input type="hidden" name="pres_type" />
714: <input type="hidden" name="pres_value" />
715: </form>
1.88 albertel 716: <form name="prefs" action="/adm/preferences" method="post">
1.19 www 717: <input type="hidden" name="action" value="verify_and_change_colors" />
1.82 albertel 718: $start_data_table
1.19 www 719: $chtable
1.82 albertel 720: $end_data_table
1.19 www 721: </table>
1.21 www 722: <input type="submit" value="Change Custom Colors" />
723: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12 www 724: </form>
1.19 www 725: ENDCOL
1.12 www 726: }
727:
1.19 www 728: sub verify_and_change_colors {
1.12 www 729: my $r = shift;
1.19 www 730: # figure out colors
1.80 albertel 731: my $function=&Apache::loncommon::get_users_function();
1.19 www 732: my $domain=&Apache::loncommon::determinedomain();
733: my %colortypes=('pgbg' => 'Page Background',
734: 'tabbg' => 'Header Background',
735: 'sidebg'=> 'Header Border',
736: 'font' => 'Font',
737: 'link' => 'Un-Visited Link',
738: 'vlink' => 'Visited Link',
739: 'alink' => 'Active Link');
740:
1.12 www 741: my $message='';
1.21 www 742: foreach my $item (keys %colortypes) {
1.59 albertel 743: my $color=$env{'form.'.$item};
1.21 www 744: my $entry='color.'.$function.'.'.$item;
1.59 albertel 745: if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$env{'form.resetall'})) {
1.21 www 746: &Apache::lonnet::put('environment',{$entry => $color});
747: &Apache::lonnet::appenv('environment.'.$entry => $color);
748: $message.='Set '.$colortypes{$item}.' to '.$color.'<br />';
749: } else {
750: &Apache::lonnet::del('environment',[$entry]);
751: &Apache::lonnet::delenv('environment\.'.$entry);
752: $message.='Reset '.$colortypes{$item}.'<br />';
753: }
754: }
1.84 albertel 755: my $now = time;
756: &Apache::lonnet::put('environment',{'color.timestamp' => $now});
757: &Apache::lonnet::appenv('environment.color.timestamp' => $now);
758:
1.19 www 759: $r->print(<<ENDVCCOL);
1.12 www 760: $message
1.88 albertel 761: <form name="client" action="/adm/preferences" method="post">
1.21 www 762: <input type="hidden" name="action" value="changecolors" />
763: </form>
1.19 www 764: ENDVCCOL
1.12 www 765: }
766:
1.4 matthew 767: ######################################################
768: # password handler subroutines #
769: ######################################################
1.3 matthew 770: sub passwordchanger {
1.94 raeburn 771: my ($r,$errormessage,$caller,$mailtoken) = @_;
1.4 matthew 772: # This function is a bit of a mess....
1.3 matthew 773: # Passwords are encrypted using londes.js (DES encryption)
1.4 matthew 774: $errormessage = ($errormessage || '');
1.94 raeburn 775: my ($user,$domain,$currentpass,$defdom);
776: if ((!defined($caller)) || ($caller eq 'preferences')) {
777: $user = $env{'user.name'};
778: $domain = $env{'user.domain'};
779: if (!defined($caller)) {
780: $caller = 'preferences';
781: }
782: } elsif ($caller eq 'reset_by_email') {
783: $defdom = $r->dir_config('lonDefDomain');
784: my %data = &Apache::lonnet::tmpget($mailtoken);
785: if (keys(%data) == 0) {
786: $r->print(&mt('Sorry, the URL you provided to complete the reset of your password was invalid. Either the token included in the URL has been deleted or the URL you provided was invalid. Please submit a <a href="/adm/resetpw">new request</a> for a password reset, and follow the link to the new URL included in the e-mail that will be sent to you, to allow you to enter a new password.'));
787: return;
788: }
789: if (defined($data{time})) {
790: if (time - $data{'time'} < 7200) {
791: $user = $data{'username'};
792: $domain = $data{'domain'};
793: $currentpass = $data{'temppasswd'};
794: } else {
795: $r->print(&mt('Sorry, the token generated when you requested a password reset has expired.').'<br />');
796: return;
797: }
798: } else {
799: $r->print(&mt('Sorry, the URL generated when you requested reset of your password contained incomplete information.').'<br />');
800: return;
801: }
802: } else {
803: $r->print(&mt('Page requested in unexpected context').'<br />');
804: return;
805: }
1.3 matthew 806: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
807: # Check for authentication types that allow changing of the password.
808: return if ($currentauth !~ /^(unix|internal):/);
809: #
810: # Generate keys
811: my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
812: my ($lkey_npass1,$ukey_npass1) = &des_keys();
813: my ($lkey_npass2,$ukey_npass2) = &des_keys();
1.4 matthew 814: # Store the keys in the log files
1.3 matthew 815: my $lonhost = $r->dir_config('lonHostID');
816: my $logtoken=Apache::lonnet::reply('tmpput:'
817: .$ukey_cpass . $lkey_cpass .'&'
818: .$ukey_npass1 . $lkey_npass1.'&'
819: .$ukey_npass2 . $lkey_npass2,
820: $lonhost);
1.4 matthew 821: # Hexify the keys for output as javascript variables
1.94 raeburn 822: my %hexkey;
823: $hexkey{'ukey_cpass'} = hex($ukey_cpass);
824: $hexkey{'lkey_cpass'} = hex($lkey_cpass);
825: $hexkey{'ukey_npass1'} = hex($ukey_npass1);
826: $hexkey{'lkey_npass1'} = hex($lkey_npass1);
827: $hexkey{'ukey_npass2'} = hex($ukey_npass2);
828: $hexkey{'lkey_npass2'} = hex($lkey_npass2);
1.3 matthew 829: # Output javascript to deal with passwords
1.4 matthew 830: # Output DES javascript
1.3 matthew 831: {
832: my $include = $r->dir_config('lonIncludes');
833: my $jsh=Apache::File->new($include."/londes.js");
834: $r->print(<$jsh>);
835: }
1.94 raeburn 836: $r->print(&jscript_send($caller));
1.3 matthew 837: $r->print(<<ENDFORM);
1.94 raeburn 838: $errormessage
839:
840: <p>
841: <!-- We separate the forms into 'server' and 'client' in order to
842: ensure that unencrypted passwords will not be sent out by a
843: crappy browser -->
844: ENDFORM
845: $r->print(&server_form($logtoken,$caller,$mailtoken));
846: $r->print(&client_form($caller,\%hexkey,$currentpass,$defdom));
847:
848: #
849: return;
850: }
851:
852: sub jscript_send {
853: my ($caller) = @_;
854: my $output = qq|
1.3 matthew 855: <script language="JavaScript">
856:
857: function send() {
858: uextkey=this.document.client.elements.ukey_cpass.value;
859: lextkey=this.document.client.elements.lkey_cpass.value;
860: initkeys();
861:
1.52 raeburn 862: this.document.pserver.elements.currentpass.value
1.3 matthew 863: =crypted(this.document.client.elements.currentpass.value);
864:
865: uextkey=this.document.client.elements.ukey_npass1.value;
866: lextkey=this.document.client.elements.lkey_npass1.value;
867: initkeys();
1.52 raeburn 868: this.document.pserver.elements.newpass_1.value
1.3 matthew 869: =crypted(this.document.client.elements.newpass_1.value);
870:
871: uextkey=this.document.client.elements.ukey_npass2.value;
872: lextkey=this.document.client.elements.lkey_npass2.value;
873: initkeys();
1.52 raeburn 874: this.document.pserver.elements.newpass_2.value
1.3 matthew 875: =crypted(this.document.client.elements.newpass_2.value);
1.94 raeburn 876: |;
877: if ($caller eq 'reset_by_email') {
878: $output .= qq|
879: this.document.pserver.elements.uname.value =
880: this.document.client.elements.uname.value;
881: this.document.pserver.elements.udom.value =
882: this.document.client.elements.udom.options[this.document.client.elements.udom.selectedIndex].value;
883: |;
884: }
885: $ output .= qq|
1.52 raeburn 886: this.document.pserver.submit();
1.3 matthew 887: }
888: </script>
1.94 raeburn 889: |;
890: }
1.3 matthew 891:
1.94 raeburn 892: sub client_form {
893: my ($caller,$hexkey,$currentpass,$defdom) = @_;
1.99 www 894: my %lt=&Apache::lonlocal::texthash(
895: 'email' => 'EMail Address',
896: 'username' => 'Username',
897: 'domain' => 'Domain',
898: 'currentpass' => 'Current Password',
899: 'newpass' => 'New Password',
900: 'confirmpass' => 'Confirm Password',
901: 'changepass' => 'Change Password');
902:
1.94 raeburn 903: my $output = qq|
1.3 matthew 904: <form name="client" >
905: <table>
1.94 raeburn 906: |;
907: if ($caller eq 'reset_by_email') {
908: $output .= qq|
1.99 www 909: <tr><td class="LC_preferences_labeltext"><label for="email">$lt{'email'}</label>:</td>
1.97 raeburn 910: <td><input type="text" name="email" size="30" /> </td></tr>
1.99 www 911: <tr><td class="LC_preferences_labeltext"><label for="uname">$lt{'username'}</label>:</td>
1.94 raeburn 912: <td>
1.97 raeburn 913: <input type="text" name="uname" size="15" />
1.94 raeburn 914: <input type="hidden" name="currentpass" value="$currentpass" />
915: </td></tr>
1.99 www 916: <tr><td class="LC_preferences_labeltext"><label for="udom">$lt{'udom'}</label>:</td>
1.94 raeburn 917: <td>
918: |;
919: $output .= &Apache::loncommon::select_dom_form($defdom,'udom').'
920: </td>
921: </tr>
922: ';
923: } else {
924: $output .= qq|
1.99 www 925: <tr><td class="LC_preferences_labeltext"><label for="currentpass">$lt{'currentpass'}</label></td>
1.4 matthew 926: <td><input type="password" name="currentpass" size="10"/> </td></tr>
1.94 raeburn 927: |;
928: }
929: $output .= <<"ENDFORM";
1.99 www 930: <tr><td class="LC_preferences_labeltext"><label for="newpass_1">$lt{'newpass'}</label></td>
1.4 matthew 931: <td><input type="password" name="newpass_1" size="10" /> </td></tr>
1.99 www 932: <tr><td class="LC_preferences_labeltext"><label for="newpass_2">$lt{'confirmpass'}</label></td>
1.4 matthew 933: <td><input type="password" name="newpass_2" size="10" /> </td></tr>
1.3 matthew 934: <tr><td colspan="2" align="center">
1.99 www 935: <input type="button" value="$lt{'changepass'}" onClick="send();">
1.3 matthew 936: </table>
1.94 raeburn 937: <input type="hidden" name="ukey_cpass" value="$hexkey->{'ukey_cpass'}" />
938: <input type="hidden" name="lkey_cpass" value="$hexkey->{'lkey_cpass'}" />
939: <input type="hidden" name="ukey_npass1" value="$hexkey->{'ukey_npass1'}" />
940: <input type="hidden" name="lkey_npass1" value="$hexkey->{'lkey_npass1'}" />
941: <input type="hidden" name="ukey_npass2" value="$hexkey->{'ukey_npass2'}" />
942: <input type="hidden" name="lkey_npass2" value="$hexkey->{'lkey_npass2'}" />
1.3 matthew 943: </form>
944: </p>
945: ENDFORM
1.94 raeburn 946: return $output;
947: }
948:
949: sub server_form {
950: my ($logtoken,$caller,$mailtoken) = @_;
951: my $action = '/adm/preferences';
952: if ($caller eq 'reset_by_email') {
953: $action = '/adm/resetpw';
954: }
955: my $output = qq|
956: <form name="pserver" action="$action" method="post">
957: <input type="hidden" name="logtoken" value="$logtoken" />
958: <input type="hidden" name="currentpass" value="" />
959: <input type="hidden" name="newpass_1" value="" />
960: <input type="hidden" name="newpass_2" value="" />
961: |;
962: if ($caller eq 'reset_by_email') {
963: $output .= qq|
964: <input type="hidden" name="token" value="$mailtoken" />
965: <input type="hidden" name="uname" value="" />
966: <input type="hidden" name="udom" value="" />
967:
968: |;
969: }
970: $output .= qq|
971: <input type="hidden" name="action" value="verify_and_change_pass" />
972: </form>
973: |;
974: return $output;
1.3 matthew 975: }
976:
977: sub verify_and_change_password {
1.94 raeburn 978: my ($r,$caller,$mailtoken) = @_;
979: my ($user,$domain,$homeserver);
980: if ($caller eq 'reset_by_email') {
981: $user = $env{'form.uname'};
982: $domain = $env{'form.udom'};
983: if ($user ne '' && $domain ne '') {
984: $homeserver = &Apache::lonnet::homeserver($user,$domain);
985: if ($homeserver eq 'no_host') {
1.99 www 986: &passwordchanger($r,"<p>\n<span class='LC_error'>".
987: &mt("Invalid username and/or domain")."</span>\n</p>",
1.94 raeburn 988: $caller,$mailtoken);
989: return 1;
990: }
991: } else {
1.99 www 992: &passwordchanger($r,"<p>\n<span class='LC_error'>".
993: &mt("Username and domain were blank")."</span>\n</p>",
1.94 raeburn 994: $caller,$mailtoken);
995: return 1;
996: }
997: } else {
998: $user = $env{'user.name'};
999: $domain = $env{'user.domain'};
1000: $homeserver = $env{'user.home'};
1001: }
1.3 matthew 1002: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4 matthew 1003: # Check for authentication types that allow changing of the password.
1.94 raeburn 1004: if ($currentauth !~ /^(unix|internal):/) {
1005: if ($caller eq 'reset_by_email') {
1.99 www 1006: &passwordchanger($r,"<p>\n<span class='LC_error'>".
1007: &mt("Authentication type for this user can not be changed by this mechanism").
1008: "</span>\n</p>",
1.94 raeburn 1009: $caller,$mailtoken);
1010: return 1;
1011: } else {
1012: return;
1013: }
1014: }
1.3 matthew 1015: #
1.59 albertel 1016: my $currentpass = $env{'form.currentpass'};
1017: my $newpass1 = $env{'form.newpass_1'};
1018: my $newpass2 = $env{'form.newpass_2'};
1019: my $logtoken = $env{'form.logtoken'};
1.3 matthew 1020: # Check for empty data
1.4 matthew 1021: unless (defined($currentpass) &&
1022: defined($newpass1) &&
1023: defined($newpass2) ){
1.99 www 1024: &passwordchanger($r,"<p>\n<span class='LC_error'>".
1025: &mt("One or more password fields were blank").
1026: "</span>\n</p>",$caller,$mailtoken);
1.3 matthew 1027: return;
1028: }
1.16 albertel 1029: # Get the keys
1030: my $lonhost = $r->dir_config('lonHostID');
1.3 matthew 1031: my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
1032: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4 matthew 1033: # I do not a have a better idea about how to handle this
1.94 raeburn 1034: my $tryagain_text = &mt('Please log out and try again.');
1035: if ($caller eq 'reset_by_email') {
1036: $tryagain_text = &mt('Please try again later.');
1037: }
1.99 www 1038: my $unable=&mt("Unable to retrieve stored token for password decryption");
1.3 matthew 1039: $r->print(<<ENDERROR);
1040: <p>
1.99 www 1041: <span class="LC_error">$unable. $tryagain_text</span>
1.3 matthew 1042: </p>
1043: ENDERROR
1.4 matthew 1044: # Probably should log an error here
1.75 albertel 1045: return 1;
1.3 matthew 1046: }
1047: my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4 matthew 1048: #
1.17 matthew 1049: $currentpass = &des_decrypt($ckey ,$currentpass);
1050: $newpass1 = &des_decrypt($n1key,$newpass1);
1051: $newpass2 = &des_decrypt($n2key,$newpass2);
1.94 raeburn 1052: #
1053: if ($caller eq 'reset_by_email') {
1054: my %data = &Apache::lonnet::tmpget($mailtoken);
1055: if ($currentpass ne $data{'temppasswd'}) {
1056: &passwordchanger($r,
1.99 www 1057: '<span class="LC_error">'.
1058: &mt('Could not verify current authentication').'. '.
1059: &mt('Please try again').'.</span>',$caller,$mailtoken);
1.94 raeburn 1060: return 1;
1061: }
1062: }
1.3 matthew 1063: if ($newpass1 ne $newpass2) {
1.4 matthew 1064: &passwordchanger($r,
1.99 www 1065: '<span class="LC_error">'.
1066: &mt('The new passwords you entered do not match').'. '.
1067: &mt('Please try again').'.</span>',$caller,$mailtoken);
1.75 albertel 1068: return 1;
1.4 matthew 1069: }
1070: if (length($newpass1) < 7) {
1071: &passwordchanger($r,
1.99 www 1072: '<span class="LC_error">'.
1073: &mt('Passwords must be a minimum of 7 characters long').'. '.
1074: &mt('Please try again').'</span>.',$caller,$mailtoken);
1.75 albertel 1075: return 1;
1.3 matthew 1076: }
1.4 matthew 1077: #
1078: # Check for bad characters
1079: my $badpassword = 0;
1080: foreach (split(//,$newpass1)) {
1081: $badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
1082: }
1083: if ($badpassword) {
1084: # I can't figure out how to enter bad characters on my browser.
1.99 www 1085: my $errormessage ='<span class="LC_error">'.
1086: &mt('The password you entered contained illegal characters').'.<br />'.
1087: &mt('Valid characters are').(<<"ENDERROR");
1088: : space and <br />
1.4 matthew 1089: <pre>
1090: !"\#$%&\'()*+,-./0123456789:;<=>?\@
1091: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
1.99 www 1092: </pre></span>
1.4 matthew 1093: ENDERROR
1.94 raeburn 1094: &passwordchanger($r,$errormessage,$caller,$mailtoken);
1095: return 1;
1.4 matthew 1096: }
1097: #
1098: # Change the password (finally)
1099: my $result = &Apache::lonnet::changepass
1.94 raeburn 1100: ($user,$domain,$currentpass,$newpass1,$homeserver,$caller);
1.4 matthew 1101: # Inform the user the password has (not?) been changed
1102: if ($result =~ /^ok$/) {
1.99 www 1103: $r->print("<h3>".&mt('The password for [_1] was successfully changed',$user)."</h3>");
1.4 matthew 1104: } else {
1105: # error error: run in circles, scream and shout
1.99 www 1106: $r->print("<h3><span class='LC_error'>".&mt("The password for [_1] was not changed",$user)."</span></h3>".
1107: &mt('Please make sure your old password was entered correctly').'.');
1.75 albertel 1108: return 1;
1.4 matthew 1109: }
1110: return;
1.3 matthew 1111: }
1112:
1.42 raeburn 1113: ################################################################
1114: # discussion display subroutines
1115: ################################################################
1116: sub discussionchanger {
1117: my $r = shift;
1.59 albertel 1118: my $user = $env{'user.name'};
1119: my $domain = $env{'user.domain'};
1.42 raeburn 1120: my %userenv = &Apache::lonnet::get
1.43 raeburn 1121: ('environment',['discdisplay','discmarkread']);
1122: my $discdisp = 'allposts';
1123: my $discmark = 'onmark';
1124:
1125: if (defined($userenv{'discdisplay'})) {
1126: unless ($userenv{'discdisplay'} eq '') {
1127: $discdisp = $userenv{'discdisplay'};
1128: }
1129: }
1130: if (defined($userenv{'discmarkread'})) {
1131: unless ($userenv{'discdisplay'} eq '') {
1132: $discmark = $userenv{'discmarkread'};
1133: }
1134: }
1135:
1136: my $newdisp = 'unread';
1137: my $newmark = 'ondisp';
1138:
1139: my $function = &Apache::loncommon::get_users_function();
1140: my $color = &Apache::loncommon::designparm($function.'.tabbg',
1.59 albertel 1141: $env{'user.domain'});
1.43 raeburn 1142: my %lt = &Apache::lonlocal::texthash(
1143: 'pref' => 'Display Preference',
1144: 'curr' => 'Current setting ',
1145: 'actn' => 'Action',
1146: 'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
1147: 'prca' => 'Preferences can be set that determine',
1148: 'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
1149: 'unwh' => 'Under what circumstances posts are identfied as "New"',
1150: 'allposts' => 'All posts',
1151: 'unread' => 'New posts only',
1152: 'ondisp' => 'Once displayed',
1153: 'onmark' => 'Once marked as read',
1154: 'disa' => 'Posts displayed?',
1155: 'npmr' => 'New posts cease to be identified as "New"?',
1156: 'thde' => 'The preferences you set here can be overridden within each individual discussion.',
1157: 'chgt' => 'Change to '
1158: );
1159: my $dispchange = $lt{'unread'};
1160: my $markchange = $lt{'ondisp'};
1161: my $currdisp = $lt{'allposts'};
1162: my $currmark = $lt{'onmark'};
1163:
1164: if ($discdisp eq 'unread') {
1165: $dispchange = $lt{'allposts'};
1166: $currdisp = $lt{'unread'};
1167: $newdisp = 'allposts';
1168: }
1169:
1170: if ($discmark eq 'ondisp') {
1171: $markchange = $lt{'onmark'};
1172: $currmark = $lt{'ondisp'};
1173: $newmark = 'onmark';
1.42 raeburn 1174: }
1.43 raeburn 1175:
1176: $r->print(<<"END");
1.88 albertel 1177: <form name="prefs" action="/adm/preferences" method="post">
1.42 raeburn 1178: <input type="hidden" name="action" value="verify_and_change_discussion" />
1179: <br />
1.87 albertel 1180: $lt{'sdpf'}<br /> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
1.43 raeburn 1181: <br />
1182: <br />
1.82 albertel 1183: END
1184: $r->print(&Apache::loncommon::start_data_table());
1185: $r->print(<<"END");
1186: <tr>
1187: <th>$lt{'pref'}</th>
1188: <th>$lt{'curr'}</th>
1189: <th>$lt{'actn'}?</th>
1.43 raeburn 1190: </tr>
1.82 albertel 1191: END
1192: $r->print(&Apache::loncommon::start_data_table_row());
1193: $r->print(<<"END");
1.43 raeburn 1194: <td>$lt{'disa'}</td>
1195: <td>$lt{$discdisp}</td>
1.82 albertel 1196: <td><label><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" /> $lt{'chgt'} "$dispchange"</label></td>
1197: END
1198: $r->print(&Apache::loncommon::end_data_table_row().
1199: &Apache::loncommon::start_data_table_row());
1200: $r->print(<<"END");
1.43 raeburn 1201: <td>$lt{'npmr'}</td>
1202: <td>$lt{$discmark}</td>
1.82 albertel 1203: <td><label><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" /> $lt{'chgt'} "$markchange"</label></td>
1.43 raeburn 1204: </tr>
1.82 albertel 1205: END
1206: $r->print(&Apache::loncommon::end_data_table_row().
1207: &Apache::loncommon::end_data_table());
1208: $r->print(<<"END");
1.43 raeburn 1209: <br />
1210: <br />
1211: <input type="submit" name="sub" value="Store Changes" />
1212: <br />
1213: <br />
1214: Note: $lt{'thde'}
1215: </form>
1216: END
1.42 raeburn 1217: }
1218:
1219: sub verify_and_change_discussion {
1220: my $r = shift;
1.59 albertel 1221: my $user = $env{'user.name'};
1222: my $domain = $env{'user.domain'};
1.42 raeburn 1223: my $message='';
1.59 albertel 1224: if (defined($env{'form.discdisp'}) ) {
1225: my $newdisp = $env{'form.newdisp'};
1.43 raeburn 1226: if ($newdisp eq 'unread') {
1.87 albertel 1227: $message .='In discussions: only new posts will be displayed.<br />';
1.43 raeburn 1228: &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
1229: &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
1230: } else {
1.87 albertel 1231: $message .= 'In discussions: all posts will be displayed.<br />';
1.43 raeburn 1232: &Apache::lonnet::del('environment',['discdisplay']);
1233: &Apache::lonnet::delenv('environment\.discdisplay');
1234: }
1235: }
1.59 albertel 1236: if (defined($env{'form.discmark'}) ) {
1237: my $newmark = $env{'form.newmark'};
1.43 raeburn 1238: if ($newmark eq 'ondisp') {
1.87 albertel 1239: $message.='In discussions: new posts will be cease to be identified as "new" after display.<br />';
1.43 raeburn 1240: &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
1241: &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
1242: } else {
1.87 albertel 1243: $message.='In discussions: posts will be identified as "new" until marked as read by the reader.<br />';
1.43 raeburn 1244: &Apache::lonnet::del('environment',['discmarkread']);
1245: &Apache::lonnet::delenv('environment\.discmarkread');
1246: }
1.42 raeburn 1247: }
1248: $r->print(<<ENDVCSCREEN);
1249: $message
1250: ENDVCSCREEN
1251: }
1252:
1.63 raeburn 1253: ################################################################
1254: # Subroutines for page display on course access (Course Coordinators)
1255: ################################################################
1256: sub coursedisplaychanger {
1257: my $r = shift;
1258: my $user = $env{'user.name'};
1259: my $domain = $env{'user.domain'};
1.66 albertel 1260: my %userenv = &Apache::lonnet::get('environment',['course_init_display']);
1.71 raeburn 1261: my $currvalue = 'whatsnew';
1.73 albertel 1262: my $firstselect = '';
1263: my $whatsnewselect = 'checked="checked"';
1.71 raeburn 1264: if (exists($userenv{'course_init_display'})) {
1265: if ($userenv{'course_init_display'} eq 'firstres') {
1266: $currvalue = 'firstres';
1.73 albertel 1267: $firstselect = 'checked="checked"';
1268: $whatsnewselect = '';
1.71 raeburn 1269: }
1.63 raeburn 1270: }
1.71 raeburn 1271: my %pagenames = (
1272: firstres => 'First resource',
1273: whatsnew => "What's new page",
1274: );
1.70 raeburn 1275: my $whatsnew_off=&mt('Display the [_1] in the course.','<b>first resource</b>');
1276: my $whatsnew_on=&mt('Display the "[_1]" page - a summary of items in the course which require attention.',"<b>What's New</b>");
1.63 raeburn 1277:
1.71 raeburn 1278: $r->print('<br /><b>'.&mt('Set the default page to be displayed when you select a course role').'</b> '.&mt('(Currently: [_1])',$pagenames{$currvalue}).'<br />'.&mt('The global user preference you set for your courses can be overridden in an individual course by setting a course specific setting via the "[_1]" page in the course',"<i>What's New</i>").'<br /><br />');
1.63 raeburn 1279: $r->print(<<ENDLSCREEN);
1.88 albertel 1280: <form name="prefs" action="/adm/preferences" method="post">
1.63 raeburn 1281: <input type="hidden" name="action" value="verify_and_change_coursepage" />
1.72 albertel 1282: <br />
1.65 albertel 1283: <label><input type="radio" name="newdisp" value="firstres" $firstselect /> $whatsnew_off</label><br />
1.70 raeburn 1284: <label><input type="radio" name="newdisp" value="whatsnew" $whatsnewselect /> $whatsnew_on</label><input type="hidden" name="refpage" value="$env{'form.refpage'}" />
1.63 raeburn 1285: ENDLSCREEN
1.70 raeburn 1286: $r->print('<br /><br /><input type="submit" value="'.&mt('Change').'" />
1.63 raeburn 1287: </form>');
1288: }
1289:
1290: sub verify_and_change_coursepage {
1291: my $r = shift;
1292: my $message='';
1293: my %lt = &Apache::lonlocal::texthash(
1.70 raeburn 1294: 'defs' => 'Default now set',
1.71 raeburn 1295: 'when' => 'when you select a course role from the roles screen',
1.63 raeburn 1296: 'ywbt' => 'you will be taken to the start of the course.',
1297: 'apwb' => 'a page will be displayed that lists items in the course that may require action from you.',
1298: 'gtts' => 'Go to the start of the course',
1.70 raeburn 1299: 'dasp' => "Display the What's New page listing course action items",
1.63 raeburn 1300: );
1301: my $newdisp = $env{'form.newdisp'};
1.70 raeburn 1302: $message = '<b>'.$lt{'defs'}.'</b>: '.$lt{'when'}.', ';
1.63 raeburn 1303: if ($newdisp eq 'firstres') {
1.87 albertel 1304: $message .= $lt{'ywbt'}.'<br />';
1.63 raeburn 1305: &Apache::lonnet::put('environment',{'course_init_display' => $newdisp});
1306: &Apache::lonnet::appenv('environment.course_init_display' => $newdisp);
1307: } else {
1.87 albertel 1308: $message .= $lt{'apwb'}.'<br />';
1.63 raeburn 1309: &Apache::lonnet::del('environment',['course_init_display']);
1310: &Apache::lonnet::delenv('environment\.course_init_display');
1311: }
1.70 raeburn 1312: my $refpage = $env{'form.refpage'};
1.63 raeburn 1313: if (($env{'request.course.fn'}) && ($env{'request.course.id'})) {
1314: if ($newdisp eq 'firstres') {
1315: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1316: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1317: my ($furl,$ferr)=
1318: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
1319: $message .= '<br /><font size="+1"><a href="'.$furl.'">'.$lt{'gtts'}.' <i>'.&mt('now').'</i></a></font>';
1320: } else {
1.70 raeburn 1321: $message .= '<br /><font size="+1"><a href="/adm/whatsnew?refpage='.
1322: $refpage.'">'.$lt{'dasp'}.'</a></font>';
1.63 raeburn 1323: }
1324: }
1325: $r->print(<<ENDVCSCREEN);
1326: $message
1327: <br /><br />
1328: ENDVCSCREEN
1329: }
1330:
1331:
1.4 matthew 1332: ######################################################
1333: # other handler subroutines #
1334: ######################################################
1335:
1.3 matthew 1336: ################################################################
1337: # Main handler #
1338: ################################################################
1.1 www 1339: sub handler {
1340: my $r = shift;
1.59 albertel 1341: my $user = $env{'user.name'};
1342: my $domain = $env{'user.domain'};
1.31 www 1343: &Apache::loncommon::content_type($r,'text/html');
1.4 matthew 1344: # Some pages contain DES keys and should not be cached.
1345: &Apache::loncommon::no_cache($r);
1.1 www 1346: $r->send_http_header;
1347: return OK if $r->header_only;
1.9 matthew 1348: #
1.35 matthew 1349: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.70 raeburn 1350: ['action','wysiwyg','returnurl','refpage']);
1.35 matthew 1351: #
1352: &Apache::lonhtmlcommon::clear_breadcrumbs();
1353: &Apache::lonhtmlcommon::add_breadcrumb
1354: ({href => '/adm/preferences',
1355: text => 'Set User Preferences'});
1356:
1357: my @Options;
1358: # Determine current authentication method
1359: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1360: if ($currentauth =~ /^(unix|internal):/) {
1361: push (@Options,({ action => 'changepass',
1.40 www 1362: linktext => 'Change Password',
1.35 matthew 1363: href => '/adm/preferences',
1364: help => 'Change_Password',
1365: subroutine => \&passwordchanger,
1366: breadcrumb =>
1367: { href => '/adm/preferences?action=changepass',
1368: text => 'Change Password'},
1369: },
1370: { action => 'verify_and_change_pass',
1371: subroutine => \&verify_and_change_password,
1372: breadcrumb =>
1373: { href =>'/adm/preferences?action=changepass',
1374: text => 'Change Password'},
1.75 albertel 1375: printmenu => 'not_on_error',
1.35 matthew 1376: }));
1377: }
1378: push (@Options,({ action => 'changescreenname',
1379: linktext => 'Change Screen Name',
1380: href => '/adm/preferences',
1381: help => 'Prefs_Screen_Name_Nickname',
1382: subroutine => \&screennamechanger,
1383: breadcrumb =>
1384: { href => '/adm/preferences?action=changescreenname',
1385: text => 'Change Screen Name'},
1386: },
1387: { action => 'verify_and_change_screenname',
1388: subroutine => \&verify_and_change_screenname,
1389: breadcrumb =>
1390: { href => '/adm/preferences?action=changescreenname',
1391: text => 'Change Screen Name'},
1392: printmenu => 'yes',
1393: }));
1394:
1395: push (@Options,({ action => 'changemsgforward',
1.97 raeburn 1396: linktext => 'Change Message Forwarding and Notification Email Addresses',
1.35 matthew 1397: href => '/adm/preferences',
1398: help => 'Prefs_Forwarding',
1399: breadcrumb =>
1400: { href => '/adm/preferences?action=changemsgforward',
1401: text => 'Change Message Forwarding'},
1402: subroutine => \&msgforwardchanger,
1403: },
1404: { action => 'verify_and_change_msgforward',
1405: breadcrumb =>
1406: { href => '/adm/preferences?action=changemsgforward',
1407: text => 'Change Message Forwarding'},
1408: printmenu => 'yes',
1409: subroutine => \&verify_and_change_msgforward }));
1410: my $aboutmeaction=
1.59 albertel 1411: '/adm/'.$env{'user.domain'}.'/'.$env{'user.name'}.'/aboutme';
1.35 matthew 1412: push (@Options,{ action => 'none',
1413: linktext =>
1.41 www 1414: q{Edit the 'About Me' Personal Information Screen},
1.45 www 1415: help => 'Prefs_About_Me',
1.35 matthew 1416: href => $aboutmeaction});
1417: push (@Options,({ action => 'changecolors',
1418: linktext => 'Change Color Scheme',
1419: href => '/adm/preferences',
1420: help => 'Change_Colors',
1421: breadcrumb =>
1422: { href => '/adm/preferences?action=changecolors',
1423: text => 'Change Colors'},
1424: subroutine => \&colorschanger,
1425: },
1426: { action => 'verify_and_change_colors',
1427: breadcrumb =>
1428: { href => '/adm/preferences?action=changecolors',
1429: text => 'Change Colors'},
1430: printmenu => 'yes',
1431: subroutine => \&verify_and_change_colors,
1432: }));
1433: push (@Options,({ action => 'changelanguages',
1.39 www 1434: linktext => 'Change Language Preferences',
1.35 matthew 1435: href => '/adm/preferences',
1.45 www 1436: help => 'Prefs_Language',
1.35 matthew 1437: breadcrumb=>
1438: { href => '/adm/preferences?action=changelanguages',
1439: text => 'Change Language'},
1440: subroutine => \&languagechanger,
1441: },
1442: { action => 'verify_and_change_languages',
1443: breadcrumb=>
1444: {href => '/adm/preferences?action=changelanguages',
1445: text => 'Change Language'},
1446: printmenu => 'yes',
1447: subroutine=>\&verify_and_change_languages, }
1448: ));
1.44 www 1449: push (@Options,({ action => 'changewysiwyg',
1450: linktext => 'Change WYSIWYG Editor Preferences',
1451: href => '/adm/preferences',
1452: breadcrumb =>
1453: { href => '/adm/preferences?action=changewysiwyg',
1454: text => 'Change WYSIWYG Preferences'},
1455: subroutine => \&wysiwygchanger,
1456: },
1457: { action => 'set_wysiwyg',
1458: breadcrumb =>
1459: { href => '/adm/preferences?action=changewysiwyg',
1460: text => 'Change WYSIWYG Preferences'},
1461: printmenu => 'yes',
1462: subroutine => \&verify_and_change_wysiwyg, }
1463: ));
1.42 raeburn 1464: push (@Options,({ action => 'changediscussions',
1465: linktext => 'Change Discussion Display Preferences',
1466: href => '/adm/preferences',
1.46 raeburn 1467: help => 'Change_Discussion_Display',
1.42 raeburn 1468: breadcrumb =>
1469: { href => '/adm/preferences?action=changediscussions',
1.43 raeburn 1470: text => 'Change Discussion Preferences'},
1.42 raeburn 1471: subroutine => \&discussionchanger,
1472: },
1473: { action => 'verify_and_change_discussion',
1474: breadcrumb =>
1475: { href => '/adm/preferences?action=changediscussions',
1.43 raeburn 1476: text => 'Change Discussion Preferences'},
1.42 raeburn 1477: printmenu => 'yes',
1478: subroutine => \&verify_and_change_discussion, }
1479: ));
1.96 albertel 1480:
1481: my $role = ($env{'user.adv'} ? 'Roles' : 'Course');
1.50 albertel 1482: push (@Options,({ action => 'changerolespref',
1.96 albertel 1483: linktext => 'Change '.$role.' Page Preferences',
1.50 albertel 1484: href => '/adm/preferences',
1485: subroutine => \&rolesprefchanger,
1486: breadcrumb =>
1487: { href => '/adm/preferences?action=changerolespref',
1.96 albertel 1488: text => 'Change '.$role.' Page Pref'},
1.50 albertel 1489: },
1490: { action => 'verify_and_change_rolespref',
1491: subroutine => \&verify_and_change_rolespref,
1492: breadcrumb =>
1493: { href => '/adm/preferences?action=changerolespref',
1.96 albertel 1494: text => 'Change '.$role.' Page Preferences'},
1.50 albertel 1495: printmenu => 'yes',
1496: }));
1497:
1.54 albertel 1498: push (@Options,({ action => 'changetexenginepref',
1499: linktext => 'Change How Math Equations Are Displayed',
1500: href => '/adm/preferences',
1501: subroutine => \&texenginechanger,
1502: breadcrumb =>
1503: { href => '/adm/preferences?action=changetexenginepref',
1504: text => 'Change Math Pref'},
1505: },
1506: { action => 'verify_and_change_texengine',
1507: subroutine => \&verify_and_change_texengine,
1508: breadcrumb =>
1509: { href => '/adm/preferences?action=changetexenginepref',
1510: text => 'Change Math Preferences'},
1511: printmenu => 'yes',
1512: }));
1.85 albertel 1513:
1514: if ($env{'environment.remote'} eq 'off') {
1515: push (@Options,({ action => 'launch',
1516: linktext => 'Launch Remote Control',
1517: href => '/adm/remote?url=/adm/preferences',
1518: }));
1519: } else {
1520: push (@Options,({ action => 'collapse',
1521: linktext => 'Collapse Remote Control',
1522: href => '/adm/remote?url=/adm/preferences',
1523: }));
1524: }
1525:
1.98 www 1526: push (@Options,({ action => 'changeicons',
1.100 ! www 1527: linktext => 'Change How Menus are Displayed',
1.98 www 1528: href => '/adm/preferences',
1529: subroutine => \&iconchanger,
1530: breadcrumb =>
1531: { href => '/adm/preferences?action=changeicons',
1532: text => 'Change Main Menu'},
1533: },
1534: { action => 'verify_and_change_icons',
1535: subroutine => \&verify_and_change_icons,
1536: breadcrumb =>
1537: { href => '/adm/preferences?action=changeicons',
1538: text => 'Change Main Menu'},
1539: printmenu => 'yes',
1540: }));
1541:
1.74 albertel 1542: if (&Apache::lonnet::allowed('whn',$env{'request.course.id'})
1543: || &Apache::lonnet::allowed('whn',$env{'request.course.id'}.'/'
1544: .$env{'request.course.sec'})) {
1.63 raeburn 1545: push (@Options,({ action => 'changecourseinit',
1546: linktext => 'Change Course Initialization Preference',
1547: href => '/adm/preferences',
1548: subroutine => \&coursedisplaychanger,
1549: breadcrumb =>
1550: { href => '/adm/preferences?action=changecourseinit',
1551: text => 'Change Course Init. Pref.'},
1552: },
1553: { action => 'verify_and_change_coursepage',
1554: breadcrumb =>
1555: { href => '/adm/preferences?action=changecourseinit', text => 'Change Course Initialization Preference'},
1556: printmenu => 'yes',
1557: subroutine => \&verify_and_change_coursepage,
1558: }));
1559: }
1.50 albertel 1560:
1.62 raeburn 1561: if ($env{'user.name'} =~ /^(albertel|fox|foxr|koretemey|korte|hallmat3|turtle|raeburn)$/) {
1.35 matthew 1562: push (@Options,({ action => 'debugtoggle',
1563: printmenu => 'yes',
1564: subroutine => \&toggle_debug,
1565: }));
1566: }
1.76 albertel 1567:
1568: $r->print(&Apache::loncommon::start_page('Change Preferences'));
1569:
1.35 matthew 1570: my $call = undef;
1.48 albertel 1571: my $help = undef;
1.35 matthew 1572: my $printmenu = 'yes';
1573: foreach my $option (@Options) {
1.59 albertel 1574: if ($option->{'action'} eq $env{'form.action'}) {
1.35 matthew 1575: $call = $option->{'subroutine'};
1576: $printmenu = $option->{'printmenu'};
1577: if (exists($option->{'breadcrumb'})) {
1578: &Apache::lonhtmlcommon::add_breadcrumb
1579: ($option->{'breadcrumb'});
1580: }
1.48 albertel 1581: $help=$option->{'help'};
1.35 matthew 1582: }
1583: }
1.81 albertel 1584: $r->print(&Apache::lonhtmlcommon::breadcrumbs('Change Preferences',$help));
1.75 albertel 1585: my $error;
1.35 matthew 1586: if (defined($call)) {
1.75 albertel 1587: $error = $call->($r);
1.35 matthew 1588: }
1.75 albertel 1589: if ( ( ($printmenu eq 'yes')
1590: || ($printmenu eq 'not_on_error' && !$error) )
1591: && (!$env{'form.returnurl'})) {
1.35 matthew 1592: my $optionlist = '<table cellpadding="5">';
1.59 albertel 1593: if ($env{'user.name'} =~
1.62 raeburn 1594: /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle|raeburn)$/
1.35 matthew 1595: ) {
1596: push (@Options,({ action => 'debugtoggle',
1597: linktext => 'Toggle Debug Messages',
1598: text => 'Current Debug status is -'.
1.59 albertel 1599: $env{'user.debug'}.'-.',
1.35 matthew 1600: href => '/adm/preferences',
1601: printmenu => 'yes',
1602: subroutine => \&toggle_debug,
1603: }));
1604: }
1605: foreach my $option(@Options) {
1606: my $optiontext = '';
1607: if (exists($option->{'href'})) {
1.85 albertel 1608: $option->{'href_args'}{'action'}=$option->{'action'};
1609: $optiontext .=
1610: '<a href="'.&add_get_param($option->{'href'},
1611: $option->{'href_args'}).'">'.
1.47 albertel 1612: &mt($option->{'linktext'}).'</a>';
1.35 matthew 1613: }
1614: if (exists($option->{'text'})) {
1.47 albertel 1615: $optiontext .= ' '.&mt($option->{'text'});
1.35 matthew 1616: }
1617: if ($optiontext ne '') {
1618: $optiontext = '<font size="+1">'.$optiontext.'</font>';
1619: my $helplink = ' ';
1620: if (exists($option->{'help'})) {
1621: $helplink = &Apache::loncommon::help_open_topic
1622: ($option->{'help'});
1623: }
1624: $optionlist .= '<tr>'.
1625: '<td>'.$helplink.'</td>'.
1626: '<td>'.$optiontext.'</td>'.
1627: '</tr>';
1628: }
1.13 www 1629: }
1.35 matthew 1630: $optionlist .= '</table>';
1631: $r->print($optionlist);
1.59 albertel 1632: } elsif ($env{'form.returnurl'}) {
1633: $r->print('<br /><a href="'.$env{'form.returnurl'}.'"><font size="+1">'.
1.44 www 1634: &mt('Return').'</font></a>');
1.3 matthew 1635: }
1.76 albertel 1636: $r->print(&Apache::loncommon::end_page());
1.1 www 1637: return OK;
1.35 matthew 1638: }
1639:
1640: sub toggle_debug {
1.59 albertel 1641: if ($env{'user.debug'}) {
1.35 matthew 1642: &Apache::lonnet::delenv('user\.debug');
1643: } else {
1644: &Apache::lonnet::appenv('user.debug' => 1);
1645: }
1.13 www 1646: }
1.1 www 1647:
1648: 1;
1649: __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