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