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