Annotation of loncom/interface/lonpreferences.pm, revision 1.103
1.1 www 1: # The LearningOnline Network
2: # Preferences
3: #
1.103 ! raeburn 4: # $Id: lonpreferences.pm,v 1.102 2007/05/08 17:23:10 raeburn Exp $
1.2 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.3 matthew 28: # This package uses the "londes.js" javascript code.
29: #
30: # TODOs that have to be completed:
31: # interface with lonnet to change the password
32:
1.1 www 33: package Apache::lonpreferences;
34:
35: use strict;
1.86 albertel 36: use LONCAPA;
1.1 www 37: use Apache::Constants qw(:common);
1.3 matthew 38: use Apache::File;
39: use Crypt::DES;
40: use DynaLoader; # for Crypt::DES version
1.4 matthew 41: use Apache::loncommon();
1.23 matthew 42: use Apache::lonhtmlcommon();
1.32 www 43: use Apache::lonlocal;
1.59 albertel 44: use Apache::lonnet;
1.95 albertel 45: use LONCAPA();
1.3 matthew 46:
47: #
48: # Write lonnet::passwd to do the call below.
49: # Use:
50: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
51: #
52: ##################################################
53: # password associated functions #
54: ##################################################
55: sub des_keys {
1.4 matthew 56: # Make a new key for DES encryption.
1.36 www 57: # Each key has two parts which are returned separately.
1.4 matthew 58: # Please note: Each key must be passed through the &hex function
59: # before it is output to the web browser. The hex versions cannot
60: # be used to decrypt.
1.3 matthew 61: my @hexstr=('0','1','2','3','4','5','6','7',
62: '8','9','a','b','c','d','e','f');
63: my $lkey='';
64: for (0..7) {
65: $lkey.=$hexstr[rand(15)];
66: }
67: my $ukey='';
68: for (0..7) {
69: $ukey.=$hexstr[rand(15)];
70: }
71: return ($lkey,$ukey);
72: }
73:
74: sub des_decrypt {
75: my ($key,$cyphertext) = @_;
76: my $keybin=pack("H16",$key);
77: my $cypher;
78: if ($Crypt::DES::VERSION>=2.03) {
79: $cypher=new Crypt::DES $keybin;
80: } else {
81: $cypher=new DES $keybin;
82: }
83: my $plaintext=
84: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
85: $plaintext.=
86: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
1.4 matthew 87: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
1.3 matthew 88: return $plaintext;
89: }
90:
1.4 matthew 91: ################################################################
92: # Handler subroutines #
93: ################################################################
1.9 matthew 94:
95: ################################################################
1.28 www 96: # Language Change Subroutines #
97: ################################################################
1.44 www 98:
99: sub wysiwygchanger {
100: my $r = shift;
101: my %userenv = &Apache::lonnet::get
102: ('environment',['wysiwygeditor']);
1.78 albertel 103: my $onselect='checked="checked"';
1.44 www 104: my $offselect='';
1.77 albertel 105: if ($userenv{'wysiwygeditor'} eq 'on') {
1.44 www 106: $onselect='';
1.78 albertel 107: $offselect='checked="checked"';
1.44 www 108: }
109: my $switchoff=&mt('Disable WYSIWYG editor');
110: my $switchon=&mt('Enable WYSIWYG editor');
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 {
1.102 raeburn 569: my ($r,$message) = @_;
1.59 albertel 570: my $user = $env{'user.name'};
571: my $domain = $env{'user.domain'};
1.102 raeburn 572: my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification','notifywithhtml']);
1.20 www 573: my $msgforward=$userenv{'msgforward'};
1.102 raeburn 574: my %lt = &Apache::lonlocal::texthash(
575: all => 'All',
576: crit => 'Critical only',
577: reg => 'Non-critical only',
578: foad => 'Forwarding Address(es)',
579: mnot => 'Message Notification Email Address(es)',
580: chg => 'Change',
581: email => 'The e-mail address you entered',
582: notv => 'is not a valid e-mail address',
1.103 ! raeburn 583: toen => "To enter multiple addresses, enter one address at a time, click 'Change' and then add the next one",
1.102 raeburn 584: prme => 'Back to preferences menu',
585: );
1.25 bowersj2 586: my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
587: "What are forwarding ".
588: "and notification ".
589: "addresses");
1.27 bowersj2 590: my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
591: "What are critical messages");
1.102 raeburn 592: my @allow_html = split(/,/,$userenv{'notifywithhtml'});
593: my %allnot = &get_notifications(\%userenv);
594: my $validatescript = &Apache::lonhtmlcommon::javascript_valid_email();
595: my $jscript = qq|
596: <script type="text/javascript">
597: function validate() {
598: var checkaddress = 0;
599: for (var i=0; i<document.prefs.numnotify.value; i++) {
600: var addr = document.prefs.elements['address_'+i].value;
601: if (i < document.prefs.numnotify.value-1) {
602: if (document.prefs.elements['del_notify_'+i].value == false) {
603: checkaddress = 1;
604: }
605: } else {
606: if (document.prefs.elements['add_notify_'+i].checked == true) {
607: checkaddress = 1;
608: }
609: }
610: if (checkaddress== 1) {
611: var addr = document.prefs.elements['address_'+i].value;
612: if (validmail(document.prefs.elements['address_'+i]) == false) {
613: alert("$lt{'email'}: "+addr+" $lt{'notv'}.\\n($lt{'toen'}).");
614: return;
615: }
616: }
617: }
618: document.prefs.submit();
619: }
620: $validatescript
621: </script>
622: |;
1.20 www 623: $r->print(<<ENDMSG);
1.102 raeburn 624: $jscript
625: $message
626: $forwardingHelp
1.88 albertel 627: <form name="prefs" action="/adm/preferences" method="post">
1.20 www 628: <input type="hidden" name="action" value="verify_and_change_msgforward" />
1.102 raeburn 629: $lt{'foad'} (<tt>user:domain,user:domain,...</tt>):
1.20 www 630: <input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
1.102 raeburn 631: $criticalMessageHelp
632: $lt{'mnot'} (<tt>joe\@doe.com</tt>):<br />
633: ENDMSG
634: my @sortforwards = sort (keys(%allnot));
635: my $output = &Apache::loncommon::start_data_table().
636: &Apache::loncommon::start_data_table_header_row().
637: '<th>'.&mt('Action').'</th>'.
638: '<th>'.&mt('Notification address').'</th><th>'.
639: &mt('Messages to forward').'</th><th>'.
640: &mt('Excerpt retains HTML tags included in message').'</th>'.
641: &Apache::loncommon::end_data_table_header_row();
642: my $num = 0;
643: foreach my $item (@sortforwards) {
644: $output .= &Apache::loncommon::start_data_table_row().
645: '<td><input type="checkbox" name="del_notify_'.$num.'" />'.
646: &mt('Delete').'</td>'.
647: '<td><input type="text" value="'.$item.'" name="address_'.
648: $num.'" /></td><td>';
649: my %chk;
650: if (defined($allnot{$item}{'crit'})) {
651: if (defined($allnot{$item}{'reg'})) {
652: $chk{'all'} = 'checked="checked" ';
653: } else {
654: $chk{'crit'} = 'checked="checked" ';
655: }
656: } else {
657: $chk{'reg'} = 'checked="checked" ';
658: }
659: foreach my $type ('all','crit','reg') {
660: $output .= '<span class="LC_nobreak"><label>'.
661: '<input type="radio" name="notify_type_'.$num.
662: '" value="'.$type.'" '.$chk{$type}.'/>'.$lt{$type}.'</label></span> ';
663: }
664: my $htmlon = '';
665: my $htmloff = '';
666: if (grep/^\Q$item\E/,@allow_html) {
667: $htmlon = 'checked="checked" ';
668: } else {
669: $htmloff = 'checked="checked" ';
670: }
671: $output .= '</td><td><label><input type="radio" name="html_'.$num.
672: '" value="1" '.$htmlon.'/>'.&mt('Yes').'</label> '.
673: '<label><input type="radio" name="html_'.$num.'" value="0" '.
674: $htmloff.'/>'.&mt('No').'</label></td>'.
675: &Apache::loncommon::end_data_table_row();
676: $num ++;
677: }
678: my %defchk = (
679: all => 'checked="checked" ',
680: crit => '',
681: reg => '',
682: );
683: $output .= &Apache::loncommon::start_data_table_row().
684: '<td><input type="checkbox" name="add_notify_'.$num.'" />'.
685: &mt('Add').'</td>'.
686: '<td><input type="text" value="" name="address_'.$num.
687: '" /></td><td>';
688: foreach my $type ('all','crit','reg') {
689: $output .= '<span class="LC_nobreak"><label>'.
690: '<input type="radio" name="notify_type_'.$num.
691: '" value="'.$type.'" '.$defchk{$type}.'/>'.
692: $lt{$type}.'</label></span> ';
693: }
694: $output .= '</td><td><label><input type="radio" name="html_'.$num.
695: '" value="1" />'.&mt('Yes').'</label> '.
696: '<label><input type="radio" name="html_'.$num.'" value="0" '.
697: ' checked="checked" />'.
698: &mt('No').'</label></td>'.
699: &Apache::loncommon::end_data_table_row().
700: &Apache::loncommon::end_data_table();
701: $num ++;
702: $r->print($output);
703: $r->print(qq|
704: <hr />
705: <input type="hidden" name="numnotify" value="$num" />
706: <input type="button" value="$lt{'chg'}" onclick="javascript:validate()" />
707: <input type="button" value="$lt{'prme'}" onclick="location.href='/adm/preferences'" />
1.20 www 708: </form>
1.102 raeburn 709: |);
710:
711: }
712:
713: sub get_notifications {
714: my ($userenv) = @_;
715: my %allnot;
716: my @critnot = split(/,/,$userenv->{'critnotification'});
717: my @regnot = split(/,/,$userenv->{'notification'});
718: foreach my $item (@critnot) {
719: $allnot{$item}{crit} = 1;
720: }
721: foreach my $item (@regnot) {
722: $allnot{$item}{reg} = 1;
723: }
724: return %allnot;
1.20 www 725: }
726:
727: sub verify_and_change_msgforward {
728: my $r = shift;
1.59 albertel 729: my $user = $env{'user.name'};
730: my $domain = $env{'user.domain'};
1.20 www 731: my $newscreen = '';
732: my $message='';
1.59 albertel 733: foreach (split(/\,/,$env{'form.msgforward'})) {
1.20 www 734: my ($msuser,$msdomain)=split(/[\@\:]/,$_);
1.95 albertel 735: $msuser = &LONCAPA::clean_username($msuser);
736: $msdomain = &LONCAPA::clean_domain($msdomain);
1.20 www 737: if (($msuser) && ($msdomain)) {
738: if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
739: $newscreen.=$msuser.':'.$msdomain.',';
740: } else {
1.102 raeburn 741: $message.= &mt('No such user: ').$msuser.':'.$msdomain.'<br>';
1.20 www 742: }
743: }
744: }
745: $newscreen=~s/\,$//;
746: if ($newscreen) {
747: &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
748: &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
1.102 raeburn 749: $message .= &mt('Set message forwarding to: ').'<tt>'.$newscreen.
750: '</tt><br />';
1.20 www 751: } else {
752: &Apache::lonnet::del('environment',['msgforward']);
753: &Apache::lonnet::delenv('environment\.msgforward');
1.102 raeburn 754: $message.= &mt("Set message forwarding to 'off'.").'<br />';
1.20 www 755: }
1.102 raeburn 756: my $critnotification;
757: my $notification;
758: my $notify_with_html;
759: my $lastnotify = $env{'form.numnotify'}-1;
760: for (my $i=0; $i<$env{'form.numnotify'}; $i++) {
761: if ((!defined($env{'form.del_notify_'.$i})) &&
762: ((($i==$lastnotify) && (defined($env{'form.add_notify_'.$lastnotify}))) ||
763: ($i<$lastnotify))) {
764: if (defined($env{'form.address_'.$i})) {
765: if ($env{'form.notify_type_'.$i} eq 'all') {
766: $critnotification .= $env{'form.address_'.$i}.',';
767: $notification .= $env{'form.address_'.$i}.',';
768: } elsif ($env{'form.notify_type_'.$i} eq 'crit') {
769: $critnotification .= $env{'form.address_'.$i}.',';
770: } elsif ($env{'form.notify_type_'.$i} eq 'reg') {
771: $notification .= $env{'form.address_'.$i}.',';
772: }
773: if ($env{'form.html_'.$i} eq '1') {
774: $notify_with_html .= $env{'form.address_'.$i}.',';
775: }
776: }
777: }
778: }
779: $critnotification =~ s/,$//;
780: $critnotification=~s/\s//gs;
781: $notification =~ s/,$//;
1.20 www 782: $notification=~s/\s//gs;
1.102 raeburn 783: $notify_with_html =~ s/,$//;
784: $notify_with_html =~ s/\s//gs;
1.20 www 785: if ($notification) {
786: &Apache::lonnet::put('environment',{'notification' => $notification});
787: &Apache::lonnet::appenv('environment.notification' => $notification);
1.102 raeburn 788: $message.=&mt('Set non-critical message notification address(es) to: ').'<tt>'.$notification.'</tt><br />';
1.20 www 789: } else {
790: &Apache::lonnet::del('environment',['notification']);
791: &Apache::lonnet::delenv('environment\.notification');
1.102 raeburn 792: $message.=&mt("Non-critical message notification set to 'off'.").'<br />';
1.20 www 793: }
794: if ($critnotification) {
795: &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
796: &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
1.102 raeburn 797: $message.=&mt('Set critical message notification address(es) to: ').'<tt>'.$critnotification.'</tt><br />';
1.20 www 798: } else {
799: &Apache::lonnet::del('environment',['critnotification']);
800: &Apache::lonnet::delenv('environment\.critnotification');
1.102 raeburn 801: $message.=&mt('Critical message notification set to off').'<br />';
802: }
803: if ($critnotification || $notification) {
804: if ($notify_with_html) {
805: &Apache::lonnet::put('environment',{'notifywithhtml' => $notify_with_html});
806: &Apache::lonnet::appenv('environment.notifywithhtml' => $notify_with_html);
807: $message.=&mt('Set address(es) to receive excerpts with html retained: ').'<tt>'.$notify_with_html.'</tt>';
808: } else {
809: &Apache::lonnet::del('environment',['notifywithhtml']);
810: &Apache::lonnet::delenv('environment\.notifywithhtml');
811: $message.=&mt("Set all notification address(es) to receive excerpts with html stripped.").'<br />';
812: }
813: } else {
814: &Apache::lonnet::del('environment',['notifywithhtml']);
815: &Apache::lonnet::delenv('environment\.notifywithhtml');
816: }
817: if ($message) {
818: $message .= '<br /><hr />';
1.20 www 819: }
1.102 raeburn 820: &msgforwardchanger($r,$message);
1.6 www 821: }
822:
1.12 www 823: ################################################################
1.19 www 824: # Colors #
1.12 www 825: ################################################################
826:
1.19 www 827: sub colorschanger {
1.12 www 828: my $r = shift;
1.19 www 829: # figure out colors
1.80 albertel 830: my $function=&Apache::loncommon::get_users_function();
1.19 www 831: my $domain=&Apache::loncommon::determinedomain();
832: my %colortypes=('pgbg' => 'Page Background',
833: 'tabbg' => 'Header Background',
834: 'sidebg'=> 'Header Border',
835: 'font' => 'Font',
836: 'link' => 'Un-Visited Link',
837: 'vlink' => 'Visited Link',
838: 'alink' => 'Active Link');
1.82 albertel 839: my $start_data_table = &Apache::loncommon::start_data_table();
1.19 www 840: my $chtable='';
1.22 matthew 841: foreach my $item (sort(keys(%colortypes))) {
1.19 www 842: my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
1.82 albertel 843: $chtable.=&Apache::loncommon::start_data_table_row().
1.83 albertel 844: '<td>'.$colortypes{$item}.'</td><td style="background: '.$curcol.
1.19 www 845: '"> </td><td><input name="'.$item.
1.21 www 846: '" size="10" value="'.$curcol.
847: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19 www 848: "','".$curcol."','"
1.82 albertel 849: .$item."','parmform.pres','psub'".');">Select</a></td>'.
1.83 albertel 850: &Apache::loncommon::end_data_table_row()."\n";
1.19 www 851: }
1.82 albertel 852: my $end_data_table = &Apache::loncommon::end_data_table();
1.23 matthew 853: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19 www 854: $r->print(<<ENDCOL);
1.82 albertel 855: <script type="text/javascript">
1.19 www 856:
857: function pclose() {
858: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
859: "height=350,width=350,scrollbars=no,menubar=no");
860: parmwin.close();
861: }
862:
1.23 matthew 863: $pjump_def
1.19 www 864:
865: function psub() {
866: pclose();
867: if (document.parmform.pres_marker.value!='') {
1.21 www 868: if (document.parmform.pres_type.value!='') {
1.77 albertel 869: eval('document.prefs.'+
1.21 www 870: document.parmform.pres_marker.value+
1.19 www 871: '.value=document.parmform.pres_value.value;');
1.21 www 872: }
1.19 www 873: } else {
874: document.parmform.pres_value.value='';
875: document.parmform.pres_marker.value='';
876: }
877: }
878:
879:
880: </script>
1.21 www 881: <form name="parmform">
882: <input type="hidden" name="pres_marker" />
883: <input type="hidden" name="pres_type" />
884: <input type="hidden" name="pres_value" />
885: </form>
1.88 albertel 886: <form name="prefs" action="/adm/preferences" method="post">
1.19 www 887: <input type="hidden" name="action" value="verify_and_change_colors" />
1.82 albertel 888: $start_data_table
1.19 www 889: $chtable
1.82 albertel 890: $end_data_table
1.19 www 891: </table>
1.21 www 892: <input type="submit" value="Change Custom Colors" />
893: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12 www 894: </form>
1.19 www 895: ENDCOL
1.12 www 896: }
897:
1.19 www 898: sub verify_and_change_colors {
1.12 www 899: my $r = shift;
1.19 www 900: # figure out colors
1.80 albertel 901: my $function=&Apache::loncommon::get_users_function();
1.19 www 902: my $domain=&Apache::loncommon::determinedomain();
903: my %colortypes=('pgbg' => 'Page Background',
904: 'tabbg' => 'Header Background',
905: 'sidebg'=> 'Header Border',
906: 'font' => 'Font',
907: 'link' => 'Un-Visited Link',
908: 'vlink' => 'Visited Link',
909: 'alink' => 'Active Link');
910:
1.12 www 911: my $message='';
1.21 www 912: foreach my $item (keys %colortypes) {
1.59 albertel 913: my $color=$env{'form.'.$item};
1.21 www 914: my $entry='color.'.$function.'.'.$item;
1.59 albertel 915: if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$env{'form.resetall'})) {
1.21 www 916: &Apache::lonnet::put('environment',{$entry => $color});
917: &Apache::lonnet::appenv('environment.'.$entry => $color);
918: $message.='Set '.$colortypes{$item}.' to '.$color.'<br />';
919: } else {
920: &Apache::lonnet::del('environment',[$entry]);
921: &Apache::lonnet::delenv('environment\.'.$entry);
922: $message.='Reset '.$colortypes{$item}.'<br />';
923: }
924: }
1.84 albertel 925: my $now = time;
926: &Apache::lonnet::put('environment',{'color.timestamp' => $now});
927: &Apache::lonnet::appenv('environment.color.timestamp' => $now);
928:
1.19 www 929: $r->print(<<ENDVCCOL);
1.12 www 930: $message
1.88 albertel 931: <form name="client" action="/adm/preferences" method="post">
1.21 www 932: <input type="hidden" name="action" value="changecolors" />
933: </form>
1.19 www 934: ENDVCCOL
1.12 www 935: }
936:
1.4 matthew 937: ######################################################
938: # password handler subroutines #
939: ######################################################
1.3 matthew 940: sub passwordchanger {
1.94 raeburn 941: my ($r,$errormessage,$caller,$mailtoken) = @_;
1.4 matthew 942: # This function is a bit of a mess....
1.3 matthew 943: # Passwords are encrypted using londes.js (DES encryption)
1.4 matthew 944: $errormessage = ($errormessage || '');
1.94 raeburn 945: my ($user,$domain,$currentpass,$defdom);
946: if ((!defined($caller)) || ($caller eq 'preferences')) {
947: $user = $env{'user.name'};
948: $domain = $env{'user.domain'};
949: if (!defined($caller)) {
950: $caller = 'preferences';
951: }
952: } elsif ($caller eq 'reset_by_email') {
953: $defdom = $r->dir_config('lonDefDomain');
954: my %data = &Apache::lonnet::tmpget($mailtoken);
955: if (keys(%data) == 0) {
956: $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.'));
957: return;
958: }
959: if (defined($data{time})) {
960: if (time - $data{'time'} < 7200) {
961: $user = $data{'username'};
962: $domain = $data{'domain'};
963: $currentpass = $data{'temppasswd'};
964: } else {
965: $r->print(&mt('Sorry, the token generated when you requested a password reset has expired.').'<br />');
966: return;
967: }
968: } else {
969: $r->print(&mt('Sorry, the URL generated when you requested reset of your password contained incomplete information.').'<br />');
970: return;
971: }
972: } else {
973: $r->print(&mt('Page requested in unexpected context').'<br />');
974: return;
975: }
1.3 matthew 976: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
977: # Check for authentication types that allow changing of the password.
978: return if ($currentauth !~ /^(unix|internal):/);
979: #
980: # Generate keys
981: my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
982: my ($lkey_npass1,$ukey_npass1) = &des_keys();
983: my ($lkey_npass2,$ukey_npass2) = &des_keys();
1.4 matthew 984: # Store the keys in the log files
1.3 matthew 985: my $lonhost = $r->dir_config('lonHostID');
986: my $logtoken=Apache::lonnet::reply('tmpput:'
987: .$ukey_cpass . $lkey_cpass .'&'
988: .$ukey_npass1 . $lkey_npass1.'&'
989: .$ukey_npass2 . $lkey_npass2,
990: $lonhost);
1.4 matthew 991: # Hexify the keys for output as javascript variables
1.94 raeburn 992: my %hexkey;
993: $hexkey{'ukey_cpass'} = hex($ukey_cpass);
994: $hexkey{'lkey_cpass'} = hex($lkey_cpass);
995: $hexkey{'ukey_npass1'} = hex($ukey_npass1);
996: $hexkey{'lkey_npass1'} = hex($lkey_npass1);
997: $hexkey{'ukey_npass2'} = hex($ukey_npass2);
998: $hexkey{'lkey_npass2'} = hex($lkey_npass2);
1.3 matthew 999: # Output javascript to deal with passwords
1.4 matthew 1000: # Output DES javascript
1.3 matthew 1001: {
1002: my $include = $r->dir_config('lonIncludes');
1003: my $jsh=Apache::File->new($include."/londes.js");
1004: $r->print(<$jsh>);
1005: }
1.94 raeburn 1006: $r->print(&jscript_send($caller));
1.3 matthew 1007: $r->print(<<ENDFORM);
1.94 raeburn 1008: $errormessage
1009:
1010: <p>
1011: <!-- We separate the forms into 'server' and 'client' in order to
1012: ensure that unencrypted passwords will not be sent out by a
1013: crappy browser -->
1014: ENDFORM
1015: $r->print(&server_form($logtoken,$caller,$mailtoken));
1016: $r->print(&client_form($caller,\%hexkey,$currentpass,$defdom));
1017:
1018: #
1019: return;
1020: }
1021:
1022: sub jscript_send {
1023: my ($caller) = @_;
1024: my $output = qq|
1.3 matthew 1025: <script language="JavaScript">
1026:
1027: function send() {
1028: uextkey=this.document.client.elements.ukey_cpass.value;
1029: lextkey=this.document.client.elements.lkey_cpass.value;
1030: initkeys();
1031:
1.52 raeburn 1032: this.document.pserver.elements.currentpass.value
1.3 matthew 1033: =crypted(this.document.client.elements.currentpass.value);
1034:
1035: uextkey=this.document.client.elements.ukey_npass1.value;
1036: lextkey=this.document.client.elements.lkey_npass1.value;
1037: initkeys();
1.52 raeburn 1038: this.document.pserver.elements.newpass_1.value
1.3 matthew 1039: =crypted(this.document.client.elements.newpass_1.value);
1040:
1041: uextkey=this.document.client.elements.ukey_npass2.value;
1042: lextkey=this.document.client.elements.lkey_npass2.value;
1043: initkeys();
1.52 raeburn 1044: this.document.pserver.elements.newpass_2.value
1.3 matthew 1045: =crypted(this.document.client.elements.newpass_2.value);
1.94 raeburn 1046: |;
1047: if ($caller eq 'reset_by_email') {
1048: $output .= qq|
1049: this.document.pserver.elements.uname.value =
1050: this.document.client.elements.uname.value;
1051: this.document.pserver.elements.udom.value =
1052: this.document.client.elements.udom.options[this.document.client.elements.udom.selectedIndex].value;
1053: |;
1054: }
1055: $ output .= qq|
1.52 raeburn 1056: this.document.pserver.submit();
1.3 matthew 1057: }
1058: </script>
1.94 raeburn 1059: |;
1060: }
1.3 matthew 1061:
1.94 raeburn 1062: sub client_form {
1063: my ($caller,$hexkey,$currentpass,$defdom) = @_;
1.99 www 1064: my %lt=&Apache::lonlocal::texthash(
1065: 'email' => 'EMail Address',
1066: 'username' => 'Username',
1067: 'domain' => 'Domain',
1068: 'currentpass' => 'Current Password',
1069: 'newpass' => 'New Password',
1070: 'confirmpass' => 'Confirm Password',
1071: 'changepass' => 'Change Password');
1072:
1.94 raeburn 1073: my $output = qq|
1.3 matthew 1074: <form name="client" >
1075: <table>
1.94 raeburn 1076: |;
1077: if ($caller eq 'reset_by_email') {
1078: $output .= qq|
1.99 www 1079: <tr><td class="LC_preferences_labeltext"><label for="email">$lt{'email'}</label>:</td>
1.97 raeburn 1080: <td><input type="text" name="email" size="30" /> </td></tr>
1.99 www 1081: <tr><td class="LC_preferences_labeltext"><label for="uname">$lt{'username'}</label>:</td>
1.94 raeburn 1082: <td>
1.97 raeburn 1083: <input type="text" name="uname" size="15" />
1.94 raeburn 1084: <input type="hidden" name="currentpass" value="$currentpass" />
1085: </td></tr>
1.99 www 1086: <tr><td class="LC_preferences_labeltext"><label for="udom">$lt{'udom'}</label>:</td>
1.94 raeburn 1087: <td>
1088: |;
1089: $output .= &Apache::loncommon::select_dom_form($defdom,'udom').'
1090: </td>
1091: </tr>
1092: ';
1093: } else {
1094: $output .= qq|
1.99 www 1095: <tr><td class="LC_preferences_labeltext"><label for="currentpass">$lt{'currentpass'}</label></td>
1.4 matthew 1096: <td><input type="password" name="currentpass" size="10"/> </td></tr>
1.94 raeburn 1097: |;
1098: }
1099: $output .= <<"ENDFORM";
1.99 www 1100: <tr><td class="LC_preferences_labeltext"><label for="newpass_1">$lt{'newpass'}</label></td>
1.4 matthew 1101: <td><input type="password" name="newpass_1" size="10" /> </td></tr>
1.99 www 1102: <tr><td class="LC_preferences_labeltext"><label for="newpass_2">$lt{'confirmpass'}</label></td>
1.4 matthew 1103: <td><input type="password" name="newpass_2" size="10" /> </td></tr>
1.3 matthew 1104: <tr><td colspan="2" align="center">
1.99 www 1105: <input type="button" value="$lt{'changepass'}" onClick="send();">
1.3 matthew 1106: </table>
1.94 raeburn 1107: <input type="hidden" name="ukey_cpass" value="$hexkey->{'ukey_cpass'}" />
1108: <input type="hidden" name="lkey_cpass" value="$hexkey->{'lkey_cpass'}" />
1109: <input type="hidden" name="ukey_npass1" value="$hexkey->{'ukey_npass1'}" />
1110: <input type="hidden" name="lkey_npass1" value="$hexkey->{'lkey_npass1'}" />
1111: <input type="hidden" name="ukey_npass2" value="$hexkey->{'ukey_npass2'}" />
1112: <input type="hidden" name="lkey_npass2" value="$hexkey->{'lkey_npass2'}" />
1.3 matthew 1113: </form>
1114: </p>
1115: ENDFORM
1.94 raeburn 1116: return $output;
1117: }
1118:
1119: sub server_form {
1120: my ($logtoken,$caller,$mailtoken) = @_;
1121: my $action = '/adm/preferences';
1122: if ($caller eq 'reset_by_email') {
1123: $action = '/adm/resetpw';
1124: }
1125: my $output = qq|
1126: <form name="pserver" action="$action" method="post">
1127: <input type="hidden" name="logtoken" value="$logtoken" />
1128: <input type="hidden" name="currentpass" value="" />
1129: <input type="hidden" name="newpass_1" value="" />
1130: <input type="hidden" name="newpass_2" value="" />
1131: |;
1132: if ($caller eq 'reset_by_email') {
1133: $output .= qq|
1134: <input type="hidden" name="token" value="$mailtoken" />
1135: <input type="hidden" name="uname" value="" />
1136: <input type="hidden" name="udom" value="" />
1137:
1138: |;
1139: }
1140: $output .= qq|
1141: <input type="hidden" name="action" value="verify_and_change_pass" />
1142: </form>
1143: |;
1144: return $output;
1.3 matthew 1145: }
1146:
1147: sub verify_and_change_password {
1.94 raeburn 1148: my ($r,$caller,$mailtoken) = @_;
1149: my ($user,$domain,$homeserver);
1150: if ($caller eq 'reset_by_email') {
1151: $user = $env{'form.uname'};
1152: $domain = $env{'form.udom'};
1153: if ($user ne '' && $domain ne '') {
1154: $homeserver = &Apache::lonnet::homeserver($user,$domain);
1155: if ($homeserver eq 'no_host') {
1.99 www 1156: &passwordchanger($r,"<p>\n<span class='LC_error'>".
1157: &mt("Invalid username and/or domain")."</span>\n</p>",
1.94 raeburn 1158: $caller,$mailtoken);
1159: return 1;
1160: }
1161: } else {
1.99 www 1162: &passwordchanger($r,"<p>\n<span class='LC_error'>".
1163: &mt("Username and domain were blank")."</span>\n</p>",
1.94 raeburn 1164: $caller,$mailtoken);
1165: return 1;
1166: }
1167: } else {
1168: $user = $env{'user.name'};
1169: $domain = $env{'user.domain'};
1170: $homeserver = $env{'user.home'};
1171: }
1.3 matthew 1172: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4 matthew 1173: # Check for authentication types that allow changing of the password.
1.94 raeburn 1174: if ($currentauth !~ /^(unix|internal):/) {
1175: if ($caller eq 'reset_by_email') {
1.99 www 1176: &passwordchanger($r,"<p>\n<span class='LC_error'>".
1177: &mt("Authentication type for this user can not be changed by this mechanism").
1178: "</span>\n</p>",
1.94 raeburn 1179: $caller,$mailtoken);
1180: return 1;
1181: } else {
1182: return;
1183: }
1184: }
1.3 matthew 1185: #
1.59 albertel 1186: my $currentpass = $env{'form.currentpass'};
1187: my $newpass1 = $env{'form.newpass_1'};
1188: my $newpass2 = $env{'form.newpass_2'};
1189: my $logtoken = $env{'form.logtoken'};
1.3 matthew 1190: # Check for empty data
1.4 matthew 1191: unless (defined($currentpass) &&
1192: defined($newpass1) &&
1193: defined($newpass2) ){
1.99 www 1194: &passwordchanger($r,"<p>\n<span class='LC_error'>".
1195: &mt("One or more password fields were blank").
1196: "</span>\n</p>",$caller,$mailtoken);
1.3 matthew 1197: return;
1198: }
1.16 albertel 1199: # Get the keys
1200: my $lonhost = $r->dir_config('lonHostID');
1.3 matthew 1201: my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
1202: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4 matthew 1203: # I do not a have a better idea about how to handle this
1.94 raeburn 1204: my $tryagain_text = &mt('Please log out and try again.');
1205: if ($caller eq 'reset_by_email') {
1206: $tryagain_text = &mt('Please try again later.');
1207: }
1.101 albertel 1208: my $unable=&mt("Unable to retrieve saved token for password decryption");
1.3 matthew 1209: $r->print(<<ENDERROR);
1210: <p>
1.99 www 1211: <span class="LC_error">$unable. $tryagain_text</span>
1.3 matthew 1212: </p>
1213: ENDERROR
1.4 matthew 1214: # Probably should log an error here
1.75 albertel 1215: return 1;
1.3 matthew 1216: }
1217: my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4 matthew 1218: #
1.17 matthew 1219: $currentpass = &des_decrypt($ckey ,$currentpass);
1220: $newpass1 = &des_decrypt($n1key,$newpass1);
1221: $newpass2 = &des_decrypt($n2key,$newpass2);
1.94 raeburn 1222: #
1223: if ($caller eq 'reset_by_email') {
1224: my %data = &Apache::lonnet::tmpget($mailtoken);
1225: if ($currentpass ne $data{'temppasswd'}) {
1226: &passwordchanger($r,
1.99 www 1227: '<span class="LC_error">'.
1228: &mt('Could not verify current authentication').'. '.
1229: &mt('Please try again').'.</span>',$caller,$mailtoken);
1.94 raeburn 1230: return 1;
1231: }
1232: }
1.3 matthew 1233: if ($newpass1 ne $newpass2) {
1.4 matthew 1234: &passwordchanger($r,
1.99 www 1235: '<span class="LC_error">'.
1236: &mt('The new passwords you entered do not match').'. '.
1237: &mt('Please try again').'.</span>',$caller,$mailtoken);
1.75 albertel 1238: return 1;
1.4 matthew 1239: }
1240: if (length($newpass1) < 7) {
1241: &passwordchanger($r,
1.99 www 1242: '<span class="LC_error">'.
1243: &mt('Passwords must be a minimum of 7 characters long').'. '.
1244: &mt('Please try again').'</span>.',$caller,$mailtoken);
1.75 albertel 1245: return 1;
1.3 matthew 1246: }
1.4 matthew 1247: #
1248: # Check for bad characters
1249: my $badpassword = 0;
1250: foreach (split(//,$newpass1)) {
1251: $badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
1252: }
1253: if ($badpassword) {
1254: # I can't figure out how to enter bad characters on my browser.
1.99 www 1255: my $errormessage ='<span class="LC_error">'.
1256: &mt('The password you entered contained illegal characters').'.<br />'.
1257: &mt('Valid characters are').(<<"ENDERROR");
1258: : space and <br />
1.4 matthew 1259: <pre>
1260: !"\#$%&\'()*+,-./0123456789:;<=>?\@
1261: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
1.99 www 1262: </pre></span>
1.4 matthew 1263: ENDERROR
1.94 raeburn 1264: &passwordchanger($r,$errormessage,$caller,$mailtoken);
1265: return 1;
1.4 matthew 1266: }
1267: #
1268: # Change the password (finally)
1269: my $result = &Apache::lonnet::changepass
1.94 raeburn 1270: ($user,$domain,$currentpass,$newpass1,$homeserver,$caller);
1.4 matthew 1271: # Inform the user the password has (not?) been changed
1272: if ($result =~ /^ok$/) {
1.99 www 1273: $r->print("<h3>".&mt('The password for [_1] was successfully changed',$user)."</h3>");
1.4 matthew 1274: } else {
1275: # error error: run in circles, scream and shout
1.99 www 1276: $r->print("<h3><span class='LC_error'>".&mt("The password for [_1] was not changed",$user)."</span></h3>".
1277: &mt('Please make sure your old password was entered correctly').'.');
1.75 albertel 1278: return 1;
1.4 matthew 1279: }
1280: return;
1.3 matthew 1281: }
1282:
1.42 raeburn 1283: ################################################################
1284: # discussion display subroutines
1285: ################################################################
1286: sub discussionchanger {
1287: my $r = shift;
1.59 albertel 1288: my $user = $env{'user.name'};
1289: my $domain = $env{'user.domain'};
1.42 raeburn 1290: my %userenv = &Apache::lonnet::get
1.43 raeburn 1291: ('environment',['discdisplay','discmarkread']);
1292: my $discdisp = 'allposts';
1293: my $discmark = 'onmark';
1294:
1295: if (defined($userenv{'discdisplay'})) {
1296: unless ($userenv{'discdisplay'} eq '') {
1297: $discdisp = $userenv{'discdisplay'};
1298: }
1299: }
1300: if (defined($userenv{'discmarkread'})) {
1301: unless ($userenv{'discdisplay'} eq '') {
1302: $discmark = $userenv{'discmarkread'};
1303: }
1304: }
1305:
1306: my $newdisp = 'unread';
1307: my $newmark = 'ondisp';
1308:
1309: my $function = &Apache::loncommon::get_users_function();
1310: my $color = &Apache::loncommon::designparm($function.'.tabbg',
1.59 albertel 1311: $env{'user.domain'});
1.43 raeburn 1312: my %lt = &Apache::lonlocal::texthash(
1313: 'pref' => 'Display Preference',
1314: 'curr' => 'Current setting ',
1315: 'actn' => 'Action',
1316: 'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
1317: 'prca' => 'Preferences can be set that determine',
1318: 'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
1319: 'unwh' => 'Under what circumstances posts are identfied as "New"',
1320: 'allposts' => 'All posts',
1321: 'unread' => 'New posts only',
1322: 'ondisp' => 'Once displayed',
1323: 'onmark' => 'Once marked as read',
1324: 'disa' => 'Posts displayed?',
1325: 'npmr' => 'New posts cease to be identified as "New"?',
1326: 'thde' => 'The preferences you set here can be overridden within each individual discussion.',
1327: 'chgt' => 'Change to '
1328: );
1329: my $dispchange = $lt{'unread'};
1330: my $markchange = $lt{'ondisp'};
1331: my $currdisp = $lt{'allposts'};
1332: my $currmark = $lt{'onmark'};
1333:
1334: if ($discdisp eq 'unread') {
1335: $dispchange = $lt{'allposts'};
1336: $currdisp = $lt{'unread'};
1337: $newdisp = 'allposts';
1338: }
1339:
1340: if ($discmark eq 'ondisp') {
1341: $markchange = $lt{'onmark'};
1342: $currmark = $lt{'ondisp'};
1343: $newmark = 'onmark';
1.42 raeburn 1344: }
1.43 raeburn 1345:
1346: $r->print(<<"END");
1.88 albertel 1347: <form name="prefs" action="/adm/preferences" method="post">
1.42 raeburn 1348: <input type="hidden" name="action" value="verify_and_change_discussion" />
1349: <br />
1.87 albertel 1350: $lt{'sdpf'}<br /> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
1.43 raeburn 1351: <br />
1352: <br />
1.82 albertel 1353: END
1354: $r->print(&Apache::loncommon::start_data_table());
1355: $r->print(<<"END");
1356: <tr>
1357: <th>$lt{'pref'}</th>
1358: <th>$lt{'curr'}</th>
1359: <th>$lt{'actn'}?</th>
1.43 raeburn 1360: </tr>
1.82 albertel 1361: END
1362: $r->print(&Apache::loncommon::start_data_table_row());
1363: $r->print(<<"END");
1.43 raeburn 1364: <td>$lt{'disa'}</td>
1365: <td>$lt{$discdisp}</td>
1.82 albertel 1366: <td><label><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" /> $lt{'chgt'} "$dispchange"</label></td>
1367: END
1368: $r->print(&Apache::loncommon::end_data_table_row().
1369: &Apache::loncommon::start_data_table_row());
1370: $r->print(<<"END");
1.43 raeburn 1371: <td>$lt{'npmr'}</td>
1372: <td>$lt{$discmark}</td>
1.82 albertel 1373: <td><label><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" /> $lt{'chgt'} "$markchange"</label></td>
1.43 raeburn 1374: </tr>
1.82 albertel 1375: END
1376: $r->print(&Apache::loncommon::end_data_table_row().
1377: &Apache::loncommon::end_data_table());
1378: $r->print(<<"END");
1.43 raeburn 1379: <br />
1380: <br />
1.101 albertel 1381: <input type="submit" name="sub" value="Save Changes" />
1.43 raeburn 1382: <br />
1383: <br />
1384: Note: $lt{'thde'}
1385: </form>
1386: END
1.42 raeburn 1387: }
1388:
1389: sub verify_and_change_discussion {
1390: my $r = shift;
1.59 albertel 1391: my $user = $env{'user.name'};
1392: my $domain = $env{'user.domain'};
1.42 raeburn 1393: my $message='';
1.59 albertel 1394: if (defined($env{'form.discdisp'}) ) {
1395: my $newdisp = $env{'form.newdisp'};
1.43 raeburn 1396: if ($newdisp eq 'unread') {
1.87 albertel 1397: $message .='In discussions: only new posts will be displayed.<br />';
1.43 raeburn 1398: &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
1399: &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
1400: } else {
1.87 albertel 1401: $message .= 'In discussions: all posts will be displayed.<br />';
1.43 raeburn 1402: &Apache::lonnet::del('environment',['discdisplay']);
1403: &Apache::lonnet::delenv('environment\.discdisplay');
1404: }
1405: }
1.59 albertel 1406: if (defined($env{'form.discmark'}) ) {
1407: my $newmark = $env{'form.newmark'};
1.43 raeburn 1408: if ($newmark eq 'ondisp') {
1.87 albertel 1409: $message.='In discussions: new posts will be cease to be identified as "new" after display.<br />';
1.43 raeburn 1410: &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
1411: &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
1412: } else {
1.87 albertel 1413: $message.='In discussions: posts will be identified as "new" until marked as read by the reader.<br />';
1.43 raeburn 1414: &Apache::lonnet::del('environment',['discmarkread']);
1415: &Apache::lonnet::delenv('environment\.discmarkread');
1416: }
1.42 raeburn 1417: }
1418: $r->print(<<ENDVCSCREEN);
1419: $message
1420: ENDVCSCREEN
1421: }
1422:
1.63 raeburn 1423: ################################################################
1424: # Subroutines for page display on course access (Course Coordinators)
1425: ################################################################
1426: sub coursedisplaychanger {
1427: my $r = shift;
1428: my $user = $env{'user.name'};
1429: my $domain = $env{'user.domain'};
1.66 albertel 1430: my %userenv = &Apache::lonnet::get('environment',['course_init_display']);
1.71 raeburn 1431: my $currvalue = 'whatsnew';
1.73 albertel 1432: my $firstselect = '';
1433: my $whatsnewselect = 'checked="checked"';
1.71 raeburn 1434: if (exists($userenv{'course_init_display'})) {
1435: if ($userenv{'course_init_display'} eq 'firstres') {
1436: $currvalue = 'firstres';
1.73 albertel 1437: $firstselect = 'checked="checked"';
1438: $whatsnewselect = '';
1.71 raeburn 1439: }
1.63 raeburn 1440: }
1.71 raeburn 1441: my %pagenames = (
1442: firstres => 'First resource',
1443: whatsnew => "What's new page",
1444: );
1.70 raeburn 1445: my $whatsnew_off=&mt('Display the [_1] in the course.','<b>first resource</b>');
1446: 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 1447:
1.71 raeburn 1448: $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 1449: $r->print(<<ENDLSCREEN);
1.88 albertel 1450: <form name="prefs" action="/adm/preferences" method="post">
1.63 raeburn 1451: <input type="hidden" name="action" value="verify_and_change_coursepage" />
1.72 albertel 1452: <br />
1.65 albertel 1453: <label><input type="radio" name="newdisp" value="firstres" $firstselect /> $whatsnew_off</label><br />
1.70 raeburn 1454: <label><input type="radio" name="newdisp" value="whatsnew" $whatsnewselect /> $whatsnew_on</label><input type="hidden" name="refpage" value="$env{'form.refpage'}" />
1.63 raeburn 1455: ENDLSCREEN
1.70 raeburn 1456: $r->print('<br /><br /><input type="submit" value="'.&mt('Change').'" />
1.63 raeburn 1457: </form>');
1458: }
1459:
1460: sub verify_and_change_coursepage {
1461: my $r = shift;
1462: my $message='';
1463: my %lt = &Apache::lonlocal::texthash(
1.70 raeburn 1464: 'defs' => 'Default now set',
1.71 raeburn 1465: 'when' => 'when you select a course role from the roles screen',
1.63 raeburn 1466: 'ywbt' => 'you will be taken to the start of the course.',
1467: 'apwb' => 'a page will be displayed that lists items in the course that may require action from you.',
1468: 'gtts' => 'Go to the start of the course',
1.70 raeburn 1469: 'dasp' => "Display the What's New page listing course action items",
1.63 raeburn 1470: );
1471: my $newdisp = $env{'form.newdisp'};
1.70 raeburn 1472: $message = '<b>'.$lt{'defs'}.'</b>: '.$lt{'when'}.', ';
1.63 raeburn 1473: if ($newdisp eq 'firstres') {
1.87 albertel 1474: $message .= $lt{'ywbt'}.'<br />';
1.63 raeburn 1475: &Apache::lonnet::put('environment',{'course_init_display' => $newdisp});
1476: &Apache::lonnet::appenv('environment.course_init_display' => $newdisp);
1477: } else {
1.87 albertel 1478: $message .= $lt{'apwb'}.'<br />';
1.63 raeburn 1479: &Apache::lonnet::del('environment',['course_init_display']);
1480: &Apache::lonnet::delenv('environment\.course_init_display');
1481: }
1.70 raeburn 1482: my $refpage = $env{'form.refpage'};
1.63 raeburn 1483: if (($env{'request.course.fn'}) && ($env{'request.course.id'})) {
1484: if ($newdisp eq 'firstres') {
1485: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1486: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1487: my ($furl,$ferr)=
1488: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
1489: $message .= '<br /><font size="+1"><a href="'.$furl.'">'.$lt{'gtts'}.' <i>'.&mt('now').'</i></a></font>';
1490: } else {
1.70 raeburn 1491: $message .= '<br /><font size="+1"><a href="/adm/whatsnew?refpage='.
1492: $refpage.'">'.$lt{'dasp'}.'</a></font>';
1.63 raeburn 1493: }
1494: }
1495: $r->print(<<ENDVCSCREEN);
1496: $message
1497: <br /><br />
1498: ENDVCSCREEN
1499: }
1500:
1501:
1.4 matthew 1502: ######################################################
1503: # other handler subroutines #
1504: ######################################################
1505:
1.3 matthew 1506: ################################################################
1507: # Main handler #
1508: ################################################################
1.1 www 1509: sub handler {
1510: my $r = shift;
1.59 albertel 1511: my $user = $env{'user.name'};
1512: my $domain = $env{'user.domain'};
1.31 www 1513: &Apache::loncommon::content_type($r,'text/html');
1.4 matthew 1514: # Some pages contain DES keys and should not be cached.
1515: &Apache::loncommon::no_cache($r);
1.1 www 1516: $r->send_http_header;
1517: return OK if $r->header_only;
1.9 matthew 1518: #
1.35 matthew 1519: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.70 raeburn 1520: ['action','wysiwyg','returnurl','refpage']);
1.35 matthew 1521: #
1522: &Apache::lonhtmlcommon::clear_breadcrumbs();
1523: &Apache::lonhtmlcommon::add_breadcrumb
1524: ({href => '/adm/preferences',
1525: text => 'Set User Preferences'});
1526:
1527: my @Options;
1528: # Determine current authentication method
1529: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1530: if ($currentauth =~ /^(unix|internal):/) {
1531: push (@Options,({ action => 'changepass',
1.40 www 1532: linktext => 'Change Password',
1.35 matthew 1533: href => '/adm/preferences',
1534: help => 'Change_Password',
1535: subroutine => \&passwordchanger,
1536: breadcrumb =>
1537: { href => '/adm/preferences?action=changepass',
1538: text => 'Change Password'},
1539: },
1540: { action => 'verify_and_change_pass',
1541: subroutine => \&verify_and_change_password,
1542: breadcrumb =>
1543: { href =>'/adm/preferences?action=changepass',
1544: text => 'Change Password'},
1.75 albertel 1545: printmenu => 'not_on_error',
1.35 matthew 1546: }));
1547: }
1548: push (@Options,({ action => 'changescreenname',
1549: linktext => 'Change Screen Name',
1550: href => '/adm/preferences',
1551: help => 'Prefs_Screen_Name_Nickname',
1552: subroutine => \&screennamechanger,
1553: breadcrumb =>
1554: { href => '/adm/preferences?action=changescreenname',
1555: text => 'Change Screen Name'},
1556: },
1557: { action => 'verify_and_change_screenname',
1558: subroutine => \&verify_and_change_screenname,
1559: breadcrumb =>
1560: { href => '/adm/preferences?action=changescreenname',
1561: text => 'Change Screen Name'},
1562: printmenu => 'yes',
1563: }));
1564:
1565: push (@Options,({ action => 'changemsgforward',
1.97 raeburn 1566: linktext => 'Change Message Forwarding and Notification Email Addresses',
1.35 matthew 1567: href => '/adm/preferences',
1568: help => 'Prefs_Forwarding',
1569: breadcrumb =>
1570: { href => '/adm/preferences?action=changemsgforward',
1571: text => 'Change Message Forwarding'},
1572: subroutine => \&msgforwardchanger,
1573: },
1574: { action => 'verify_and_change_msgforward',
1575: breadcrumb =>
1576: { href => '/adm/preferences?action=changemsgforward',
1577: text => 'Change Message Forwarding'},
1.102 raeburn 1578: printmenu => 'no',
1.35 matthew 1579: subroutine => \&verify_and_change_msgforward }));
1580: my $aboutmeaction=
1.59 albertel 1581: '/adm/'.$env{'user.domain'}.'/'.$env{'user.name'}.'/aboutme';
1.35 matthew 1582: push (@Options,{ action => 'none',
1583: linktext =>
1.41 www 1584: q{Edit the 'About Me' Personal Information Screen},
1.45 www 1585: help => 'Prefs_About_Me',
1.35 matthew 1586: href => $aboutmeaction});
1587: push (@Options,({ action => 'changecolors',
1588: linktext => 'Change Color Scheme',
1589: href => '/adm/preferences',
1590: help => 'Change_Colors',
1591: breadcrumb =>
1592: { href => '/adm/preferences?action=changecolors',
1593: text => 'Change Colors'},
1594: subroutine => \&colorschanger,
1595: },
1596: { action => 'verify_and_change_colors',
1597: breadcrumb =>
1598: { href => '/adm/preferences?action=changecolors',
1599: text => 'Change Colors'},
1600: printmenu => 'yes',
1601: subroutine => \&verify_and_change_colors,
1602: }));
1603: push (@Options,({ action => 'changelanguages',
1.39 www 1604: linktext => 'Change Language Preferences',
1.35 matthew 1605: href => '/adm/preferences',
1.45 www 1606: help => 'Prefs_Language',
1.35 matthew 1607: breadcrumb=>
1608: { href => '/adm/preferences?action=changelanguages',
1609: text => 'Change Language'},
1610: subroutine => \&languagechanger,
1611: },
1612: { action => 'verify_and_change_languages',
1613: breadcrumb=>
1614: {href => '/adm/preferences?action=changelanguages',
1615: text => 'Change Language'},
1616: printmenu => 'yes',
1617: subroutine=>\&verify_and_change_languages, }
1618: ));
1.44 www 1619: push (@Options,({ action => 'changewysiwyg',
1620: linktext => 'Change WYSIWYG Editor Preferences',
1621: href => '/adm/preferences',
1622: breadcrumb =>
1623: { href => '/adm/preferences?action=changewysiwyg',
1624: text => 'Change WYSIWYG Preferences'},
1625: subroutine => \&wysiwygchanger,
1626: },
1627: { action => 'set_wysiwyg',
1628: breadcrumb =>
1629: { href => '/adm/preferences?action=changewysiwyg',
1630: text => 'Change WYSIWYG Preferences'},
1631: printmenu => 'yes',
1632: subroutine => \&verify_and_change_wysiwyg, }
1633: ));
1.42 raeburn 1634: push (@Options,({ action => 'changediscussions',
1635: linktext => 'Change Discussion Display Preferences',
1636: href => '/adm/preferences',
1.46 raeburn 1637: help => 'Change_Discussion_Display',
1.42 raeburn 1638: breadcrumb =>
1639: { href => '/adm/preferences?action=changediscussions',
1.43 raeburn 1640: text => 'Change Discussion Preferences'},
1.42 raeburn 1641: subroutine => \&discussionchanger,
1642: },
1643: { action => 'verify_and_change_discussion',
1644: breadcrumb =>
1645: { href => '/adm/preferences?action=changediscussions',
1.43 raeburn 1646: text => 'Change Discussion Preferences'},
1.42 raeburn 1647: printmenu => 'yes',
1648: subroutine => \&verify_and_change_discussion, }
1649: ));
1.96 albertel 1650:
1651: my $role = ($env{'user.adv'} ? 'Roles' : 'Course');
1.50 albertel 1652: push (@Options,({ action => 'changerolespref',
1.96 albertel 1653: linktext => 'Change '.$role.' Page Preferences',
1.50 albertel 1654: href => '/adm/preferences',
1655: subroutine => \&rolesprefchanger,
1656: breadcrumb =>
1657: { href => '/adm/preferences?action=changerolespref',
1.96 albertel 1658: text => 'Change '.$role.' Page Pref'},
1.50 albertel 1659: },
1660: { action => 'verify_and_change_rolespref',
1661: subroutine => \&verify_and_change_rolespref,
1662: breadcrumb =>
1663: { href => '/adm/preferences?action=changerolespref',
1.96 albertel 1664: text => 'Change '.$role.' Page Preferences'},
1.50 albertel 1665: printmenu => 'yes',
1666: }));
1667:
1.54 albertel 1668: push (@Options,({ action => 'changetexenginepref',
1669: linktext => 'Change How Math Equations Are Displayed',
1670: href => '/adm/preferences',
1671: subroutine => \&texenginechanger,
1672: breadcrumb =>
1673: { href => '/adm/preferences?action=changetexenginepref',
1674: text => 'Change Math Pref'},
1675: },
1676: { action => 'verify_and_change_texengine',
1677: subroutine => \&verify_and_change_texengine,
1678: breadcrumb =>
1679: { href => '/adm/preferences?action=changetexenginepref',
1680: text => 'Change Math Preferences'},
1681: printmenu => 'yes',
1682: }));
1.85 albertel 1683:
1684: if ($env{'environment.remote'} eq 'off') {
1685: push (@Options,({ action => 'launch',
1686: linktext => 'Launch Remote Control',
1687: href => '/adm/remote?url=/adm/preferences',
1688: }));
1689: } else {
1690: push (@Options,({ action => 'collapse',
1691: linktext => 'Collapse Remote Control',
1692: href => '/adm/remote?url=/adm/preferences',
1693: }));
1694: }
1695:
1.98 www 1696: push (@Options,({ action => 'changeicons',
1.100 www 1697: linktext => 'Change How Menus are Displayed',
1.98 www 1698: href => '/adm/preferences',
1699: subroutine => \&iconchanger,
1700: breadcrumb =>
1701: { href => '/adm/preferences?action=changeicons',
1702: text => 'Change Main Menu'},
1703: },
1704: { action => 'verify_and_change_icons',
1705: subroutine => \&verify_and_change_icons,
1706: breadcrumb =>
1707: { href => '/adm/preferences?action=changeicons',
1708: text => 'Change Main Menu'},
1709: printmenu => 'yes',
1710: }));
1711:
1.74 albertel 1712: if (&Apache::lonnet::allowed('whn',$env{'request.course.id'})
1713: || &Apache::lonnet::allowed('whn',$env{'request.course.id'}.'/'
1714: .$env{'request.course.sec'})) {
1.63 raeburn 1715: push (@Options,({ action => 'changecourseinit',
1716: linktext => 'Change Course Initialization Preference',
1717: href => '/adm/preferences',
1718: subroutine => \&coursedisplaychanger,
1719: breadcrumb =>
1720: { href => '/adm/preferences?action=changecourseinit',
1721: text => 'Change Course Init. Pref.'},
1722: },
1723: { action => 'verify_and_change_coursepage',
1724: breadcrumb =>
1725: { href => '/adm/preferences?action=changecourseinit', text => 'Change Course Initialization Preference'},
1726: printmenu => 'yes',
1727: subroutine => \&verify_and_change_coursepage,
1728: }));
1729: }
1.50 albertel 1730:
1.62 raeburn 1731: if ($env{'user.name'} =~ /^(albertel|fox|foxr|koretemey|korte|hallmat3|turtle|raeburn)$/) {
1.35 matthew 1732: push (@Options,({ action => 'debugtoggle',
1733: printmenu => 'yes',
1734: subroutine => \&toggle_debug,
1735: }));
1736: }
1.76 albertel 1737:
1738: $r->print(&Apache::loncommon::start_page('Change Preferences'));
1739:
1.35 matthew 1740: my $call = undef;
1.48 albertel 1741: my $help = undef;
1.35 matthew 1742: my $printmenu = 'yes';
1743: foreach my $option (@Options) {
1.59 albertel 1744: if ($option->{'action'} eq $env{'form.action'}) {
1.35 matthew 1745: $call = $option->{'subroutine'};
1746: $printmenu = $option->{'printmenu'};
1747: if (exists($option->{'breadcrumb'})) {
1748: &Apache::lonhtmlcommon::add_breadcrumb
1749: ($option->{'breadcrumb'});
1750: }
1.48 albertel 1751: $help=$option->{'help'};
1.35 matthew 1752: }
1753: }
1.81 albertel 1754: $r->print(&Apache::lonhtmlcommon::breadcrumbs('Change Preferences',$help));
1.75 albertel 1755: my $error;
1.35 matthew 1756: if (defined($call)) {
1.75 albertel 1757: $error = $call->($r);
1.35 matthew 1758: }
1.75 albertel 1759: if ( ( ($printmenu eq 'yes')
1760: || ($printmenu eq 'not_on_error' && !$error) )
1761: && (!$env{'form.returnurl'})) {
1.35 matthew 1762: my $optionlist = '<table cellpadding="5">';
1.59 albertel 1763: if ($env{'user.name'} =~
1.62 raeburn 1764: /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle|raeburn)$/
1.35 matthew 1765: ) {
1766: push (@Options,({ action => 'debugtoggle',
1767: linktext => 'Toggle Debug Messages',
1768: text => 'Current Debug status is -'.
1.59 albertel 1769: $env{'user.debug'}.'-.',
1.35 matthew 1770: href => '/adm/preferences',
1771: printmenu => 'yes',
1772: subroutine => \&toggle_debug,
1773: }));
1774: }
1775: foreach my $option(@Options) {
1776: my $optiontext = '';
1777: if (exists($option->{'href'})) {
1.85 albertel 1778: $option->{'href_args'}{'action'}=$option->{'action'};
1779: $optiontext .=
1780: '<a href="'.&add_get_param($option->{'href'},
1781: $option->{'href_args'}).'">'.
1.47 albertel 1782: &mt($option->{'linktext'}).'</a>';
1.35 matthew 1783: }
1784: if (exists($option->{'text'})) {
1.47 albertel 1785: $optiontext .= ' '.&mt($option->{'text'});
1.35 matthew 1786: }
1787: if ($optiontext ne '') {
1788: $optiontext = '<font size="+1">'.$optiontext.'</font>';
1789: my $helplink = ' ';
1790: if (exists($option->{'help'})) {
1791: $helplink = &Apache::loncommon::help_open_topic
1792: ($option->{'help'});
1793: }
1794: $optionlist .= '<tr>'.
1795: '<td>'.$helplink.'</td>'.
1796: '<td>'.$optiontext.'</td>'.
1797: '</tr>';
1798: }
1.13 www 1799: }
1.35 matthew 1800: $optionlist .= '</table>';
1801: $r->print($optionlist);
1.59 albertel 1802: } elsif ($env{'form.returnurl'}) {
1803: $r->print('<br /><a href="'.$env{'form.returnurl'}.'"><font size="+1">'.
1.44 www 1804: &mt('Return').'</font></a>');
1.3 matthew 1805: }
1.76 albertel 1806: $r->print(&Apache::loncommon::end_page());
1.1 www 1807: return OK;
1.35 matthew 1808: }
1809:
1810: sub toggle_debug {
1.59 albertel 1811: if ($env{'user.debug'}) {
1.35 matthew 1812: &Apache::lonnet::delenv('user\.debug');
1813: } else {
1814: &Apache::lonnet::appenv('user.debug' => 1);
1815: }
1.13 www 1816: }
1.1 www 1817:
1818: 1;
1819: __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