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