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