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