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