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