Annotation of loncom/interface/lonpreferences.pm, revision 1.94
1.1 www 1: # The LearningOnline Network
2: # Preferences
3: #
1.94 ! raeburn 4: # $Id: lonpreferences.pm,v 1.93 2006/06/26 18:56:50 albertel 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.3 matthew 45:
46: #
47: # Write lonnet::passwd to do the call below.
48: # Use:
49: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
50: #
51: ##################################################
52: # password associated functions #
53: ##################################################
54: sub des_keys {
1.4 matthew 55: # Make a new key for DES encryption.
1.36 www 56: # Each key has two parts which are returned separately.
1.4 matthew 57: # Please note: Each key must be passed through the &hex function
58: # before it is output to the web browser. The hex versions cannot
59: # be used to decrypt.
1.3 matthew 60: my @hexstr=('0','1','2','3','4','5','6','7',
61: '8','9','a','b','c','d','e','f');
62: my $lkey='';
63: for (0..7) {
64: $lkey.=$hexstr[rand(15)];
65: }
66: my $ukey='';
67: for (0..7) {
68: $ukey.=$hexstr[rand(15)];
69: }
70: return ($lkey,$ukey);
71: }
72:
73: sub des_decrypt {
74: my ($key,$cyphertext) = @_;
75: my $keybin=pack("H16",$key);
76: my $cypher;
77: if ($Crypt::DES::VERSION>=2.03) {
78: $cypher=new Crypt::DES $keybin;
79: } else {
80: $cypher=new DES $keybin;
81: }
82: my $plaintext=
83: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
84: $plaintext.=
85: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
1.4 matthew 86: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
1.3 matthew 87: return $plaintext;
88: }
89:
1.4 matthew 90: ################################################################
91: # Handler subroutines #
92: ################################################################
1.9 matthew 93:
94: ################################################################
1.28 www 95: # Language Change Subroutines #
96: ################################################################
1.44 www 97:
98: sub wysiwygchanger {
99: my $r = shift;
100: my %userenv = &Apache::lonnet::get
101: ('environment',['wysiwygeditor']);
1.78 albertel 102: my $onselect='checked="checked"';
1.44 www 103: my $offselect='';
1.77 albertel 104: if ($userenv{'wysiwygeditor'} eq 'on') {
1.44 www 105: $onselect='';
1.78 albertel 106: $offselect='checked="checked"';
1.44 www 107: }
108: my $switchoff=&mt('Disable WYSIWYG editor');
109: my $switchon=&mt('Enable WYSIWYG editor');
110: $r->print(<<ENDLSCREEN);
1.88 albertel 111: <form name="prefs" action="/adm/preferences" method="post">
1.44 www 112: <input type="hidden" name="action" value="set_wysiwyg" />
113: <br />
1.65 albertel 114: <label><input type="radio" name="wysiwyg" value="off" $onselect /> $switchoff</label><br />
115: <label><input type="radio" name="wysiwyg" value="on" $offselect /> $switchon</label>
1.44 www 116: ENDLSCREEN
117: $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
118: }
119:
120:
121: sub verify_and_change_wysiwyg {
122: my $r = shift;
1.59 albertel 123: my $newsetting=$env{'form.wysiwyg'};
1.44 www 124: &Apache::lonnet::put('environment',{'wysiwygeditor' => $newsetting});
125: &Apache::lonnet::appenv('environment.wysiwygeditor' => $newsetting);
126: $r->print('<p>'.&mt('Setting WYSIWYG editor to:').' '.&mt($newsetting).'</p>');
127: }
128:
129: ################################################################
130: # Language Change Subroutines #
131: ################################################################
1.28 www 132: sub languagechanger {
133: my $r = shift;
1.59 albertel 134: my $user = $env{'user.name'};
135: my $domain = $env{'user.domain'};
1.28 www 136: my %userenv = &Apache::lonnet::get
1.32 www 137: ('environment',['languages']);
1.29 www 138: my $language=$userenv{'languages'};
1.32 www 139:
1.33 www 140: my $pref=&mt('Preferred language');
141: my %langchoices=('' => 'No language preference');
142: foreach (&Apache::loncommon::languageids()) {
143: if (&Apache::loncommon::supportedlanguagecode($_)) {
144: $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
145: = &Apache::loncommon::plainlanguagedescription($_);
146: }
147: }
148: my $selectionbox=&Apache::loncommon::select_form($language,'language',
149: %langchoices);
1.28 www 150: $r->print(<<ENDLSCREEN);
1.88 albertel 151: <form name="prefs" action="/adm/preferences" method="post">
1.28 www 152: <input type="hidden" name="action" value="verify_and_change_languages" />
1.33 www 153: <br />$pref: $selectionbox
1.28 www 154: ENDLSCREEN
1.35 matthew 155: $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
1.28 www 156: }
157:
158:
159: sub verify_and_change_languages {
160: my $r = shift;
1.59 albertel 161: my $user = $env{'user.name'};
162: my $domain = $env{'user.domain'};
1.28 www 163: # Screenname
1.59 albertel 164: my $newlanguage = $env{'form.language'};
1.28 www 165: $newlanguage=~s/[^\-\w]//g;
166: my $message='';
167: if ($newlanguage) {
1.29 www 168: &Apache::lonnet::put('environment',{'languages' => $newlanguage});
169: &Apache::lonnet::appenv('environment.languages' => $newlanguage);
170: $message='Set new preferred languages to '.$newlanguage;
1.28 www 171: } else {
1.29 www 172: &Apache::lonnet::del('environment',['languages']);
173: &Apache::lonnet::delenv('environment\.languages');
1.28 www 174: $message='Reset preferred language';
175: }
176: $r->print(<<ENDVCSCREEN);
177: $message
178: ENDVCSCREEN
179: }
180:
1.50 albertel 181: ################################################################
1.54 albertel 182: # Tex Engine Change Subroutines #
183: ################################################################
184: sub texenginechanger {
185: my $r = shift;
1.59 albertel 186: my $user = $env{'user.name'};
187: my $domain = $env{'user.domain'};
1.54 albertel 188: my %userenv = &Apache::lonnet::get('environment',['texengine']);
189: my $texengine=$userenv{'texengine'};
190:
191: my $pref=&mt('Preferred method to display Math');
1.69 albertel 192: my %mathchoices=('' => 'Default',
1.54 albertel 193: 'tth' => 'TeX to HTML',
1.64 albertel 194: #'ttm' => 'TeX to MathML',
1.54 albertel 195: 'jsMath' => 'jsMath',
1.57 albertel 196: '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.54 albertel 201: my $change=&mt('Change');
202: $r->print(<<ENDLSCREEN);
1.67 albertel 203: <br />
204:
1.88 albertel 205: <form name="prefs" action="/adm/preferences" method="post">
1.54 albertel 206: <input type="hidden" name="action" value="verify_and_change_texengine" />
207: <p>$pref: $selectionbox</p>
208: <p><input type="submit" value="$change" /></p>
209: </form>
210: Examples:
1.67 albertel 211: <p> TeX to HTML <br />
1.79 albertel 212: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=tth" width="400" hieght="200"></iframe>
1.67 albertel 213: </p>
1.54 albertel 214: <p>jsMath <br />
1.67 albertel 215: $jsMath_start
1.57 albertel 216: <script type="text/javascript">
1.54 albertel 217: if (jsMath.nofonts == 1) {
218: document.writeln
219: ('<center><div style="padding: 10; border-style: solid; border-width:3;'
220: +' border-color: #DD0000; background-color: #FFF8F8; width: 75%; text-align: left">'
221: +'<small><font color="#AA0000"><b>Warning:</b> '
222: +'It looks like you don\\\'t have the TeX math fonts installed. '
223: +'The jsMath example on this page may not look right without them. '
224: +'The <a href="http://www.math.union.edu/locate/jsMath/" target="_blank"> '
225: +'jsMath Home Page</a> has information on how to download the '
226: +'needed fonts. In the meantime, jsMath will do the best it can '
227: +'with the fonts you have, but it may not be pretty and some equations '
228: +'may not be rendered correctly. '
229: +'</font></small></div></center>');
230: }
231: </script>
1.79 albertel 232: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=jsMath" width="400" hieght="200"></iframe>
1.54 albertel 233:
1.67 albertel 234: </p>
235: <p> Convert to Images <br />
236: <br />
1.79 albertel 237: <iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=mimetex" width="400" hieght="200"></iframe>
1.67 albertel 238: </p>
1.54 albertel 239: ENDLSCREEN
1.59 albertel 240: if ($env{'environment.texengine'} ne 'jsMath') {
1.55 albertel 241: $r->print('<script type="text/javascript">jsMath.Process()</script>');
242: }
1.54 albertel 243: }
244:
245:
246: sub verify_and_change_texengine {
247: my $r = shift;
1.59 albertel 248: my $user = $env{'user.name'};
249: my $domain = $env{'user.domain'};
1.54 albertel 250: # Screenname
1.59 albertel 251: my $newtexengine = $env{'form.texengine'};
1.54 albertel 252: $newtexengine=~s/[^\-\w]//g;
1.56 albertel 253: if ($newtexengine eq 'ttm') {
254: &Apache::lonnet::appenv('browser.mathml' => 1);
255: } else {
1.59 albertel 256: if ($env{'environment.texengine'} eq 'ttm') {
1.56 albertel 257: &Apache::lonnet::appenv('browser.mathml' => 0);
258: }
259: }
1.54 albertel 260: my $message='';
261: if ($newtexengine) {
262: &Apache::lonnet::put('environment',{'texengine' => $newtexengine});
263: &Apache::lonnet::appenv('environment.texengine' => $newtexengine);
264: $message='Set new preferred math display to '.$newtexengine;
265: } else {
266: &Apache::lonnet::del('environment',['texengine']);
267: &Apache::lonnet::delenv('environment\.texengine');
268: $message='Reset preferred math display.';
269: }
1.56 albertel 270:
271:
1.54 albertel 272: $r->print(<<ENDVCSCREEN);
273: $message
274: ENDVCSCREEN
275: }
276:
277: ################################################################
1.50 albertel 278: # Roles Page Preference Change Subroutines #
279: ################################################################
280: sub rolesprefchanger {
281: my $r = shift;
1.59 albertel 282: my $user = $env{'user.name'};
283: my $domain = $env{'user.domain'};
1.50 albertel 284: my %userenv = &Apache::lonnet::get
285: ('environment',['recentroles','recentrolesn']);
286: my $hotlist_flag=$userenv{'recentroles'};
287: my $hotlist_n=$userenv{'recentrolesn'};
288: my $checked;
289: if ($hotlist_flag) {
290: $checked = 'checked="checked"';
291: }
292:
293: if (!$hotlist_n) { $hotlist_n=3; }
294: my $options;
295: for (my $i=1; $i<10; $i++) {
296: my $select;
297: if ($hotlist_n == $i) { $select = 'selected="selected"'; }
298: $options .= "<option $select>$i</option>\n";
299: }
300:
1.89 albertel 301: # Get list of recent roles and display with checkbox in front
302: my $roles_check_list = '';
303: my $role_key='';
304: if ($env{'environment.recentroles'}) {
305: my %recent_roles =
306: &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.91 albertel 307: my %frozen_roles =
308: &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.89 albertel 309:
1.93 albertel 310: my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
1.92 albertel 311: my @sorted_roles = sort {$role_text{$a} cmp $role_text{$b}} keys(%role_text);
312:
1.89 albertel 313: $roles_check_list .=
314: &Apache::loncommon::start_data_table().
315: &Apache::loncommon::start_data_table_header_row().
316: "<th>".&mt('Freeze Role')."</th>".
317: "<th>".&mt('Role')."</td>".
318: &Apache::loncommon::end_data_table_header_row().
319: "\n";
320: my $count;
1.92 albertel 321: foreach $role_key (@sorted_roles) {
1.89 albertel 322: my $checked = "";
323: my $value = $recent_roles{$role_key};
1.91 albertel 324: if ($frozen_roles{$role_key}) {
1.89 albertel 325: $checked = "checked=\"checked\"";
326: }
327: $count++;
328: $roles_check_list .=
329: &Apache::loncommon::start_data_table_row().
330: '<td class="LC_table_cell_checkbox">'.
331: "<input type=\"checkbox\" $checked name=\"freezeroles\"".
332: " id=\"freezeroles$count\" value=\"$role_key\" /></td>".
333: "<td><label for=\"freezeroles$count\">".
1.92 albertel 334: "$role_text{$role_key}</label></td>".
1.89 albertel 335: &Apache::loncommon::end_data_table_row(). "\n";
336: }
337: $roles_check_list .= "</table>\n";
338: }
339:
340: $r->print('
341: <p>'.&mt('Some LON-CAPA users have a long list of roles. The Recent Roles Hotlist feature keeps track of the last N roles which have been visited and places a table of these at the top of the roles page. People with very few roles should leave this feature disabled.').'
1.50 albertel 342: </p>
1.89 albertel 343: <form name="prefs" action="/adm/preferences" method="POST">
1.50 albertel 344: <input type="hidden" name="action" value="verify_and_change_rolespref" />
1.89 albertel 345: <br /><label>'.&mt('Enable Recent Roles Hotlist:').'
346: <input type="checkbox" '.$checked.' name="recentroles" value="true" /></label>
347: <br />'.&mt('Number of roles in Hotlist:').'
1.50 albertel 348: <select name="recentrolesn" size="1">
1.89 albertel 349: '.$options.'
1.50 albertel 350: </select>
1.89 albertel 351: <p>'.&mt('This list below can be used to <q>freeze</q> roles on your screen. Those marked as frozen will not be removed from the list, even if they have not been used recently.').'
352: </p>
353: '.$roles_check_list.'
1.50 albertel 354: <br />
1.89 albertel 355: <input type="submit" value="'.&mt('Change').'" />
356: </form>');
1.50 albertel 357: }
358:
1.92 albertel 359: sub rolespref_get_role_text {
360: # Get a line of text for each role
361: my ($roles) = @_;
362: my %roletext = ();
363:
364: foreach my $item (@$roles) {
365: # get course information
366: my ($role,$rest) = split(/\./, $item);
1.93 albertel 367: my $trole = "";
368: $trole = &Apache::lonnet::plaintext($role);
1.92 albertel 369: my ($tdomain,$other,$tsection)= split(/\//,Apache::lonnet::declutter($rest));
370: my $tother = '-';
1.93 albertel 371: if ($role =~ /^(cc|st|in|ta|ep|cr)/ ) {
1.92 albertel 372: my %newhash=&Apache::lonnet::coursedescription($tdomain."_".$other);
373: $tother = " - ".$newhash{'description'};
374: } elsif ($role =~ /dc/) {
375: $tother = "";
376: } else {
377: $tother = " - $other";
378: }
379:
380: my $section="";
381: if ($tsection) {
382: $section = " - Section/Group: $tsection";
383: }
384: $roletext{$item} = $tdomain." - ".$trole.$tother.$section;
385: }
386: return %roletext;
387: }
388:
1.50 albertel 389: sub verify_and_change_rolespref {
390: my $r = shift;
1.59 albertel 391: my $user = $env{'user.name'};
392: my $domain = $env{'user.domain'};
1.50 albertel 393: # Recent Roles Hotlist Flag
1.59 albertel 394: my $hotlist_flag = $env{'form.recentroles'};
395: my $hotlist_n = $env{'form.recentrolesn'};
1.89 albertel 396: my $message='<hr />';
1.50 albertel 397: if ($hotlist_flag) {
398: &Apache::lonnet::put('environment',{'recentroles' => $hotlist_flag});
399: &Apache::lonnet::appenv('environment.recentroles' => $hotlist_flag);
1.89 albertel 400: $message=&mt('Recent Roles Hotlist is Enabled');
1.50 albertel 401: } else {
402: &Apache::lonnet::del('environment',['recentroles']);
403: &Apache::lonnet::delenv('environment\.recentroles');
1.89 albertel 404: $message=&mt('Recent Roles Hotlist is Disabled');
1.50 albertel 405: }
406: if ($hotlist_n) {
407: &Apache::lonnet::put('environment',{'recentrolesn' => $hotlist_n});
408: &Apache::lonnet::appenv('environment.recentrolesn' => $hotlist_n);
409: if ($hotlist_flag) {
1.90 albertel 410: $message.="<br />".
411: &mt('Display [_1] Most Recent Roles',$hotlist_n)."\n";
1.89 albertel 412: }
413: }
414:
415: # Get list of froze roles and list of recent roles
416: my @freeze_list = &Apache::loncommon::get_env_multiple('form.freezeroles');
417: my %freeze = ();
1.92 albertel 418: my %roletext = ();
419:
1.89 albertel 420: foreach my $key (@freeze_list) {
1.91 albertel 421: $freeze{$key}='1';
1.89 albertel 422: }
1.92 albertel 423:
1.89 albertel 424: my %recent_roles =
425: &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.91 albertel 426: my %frozen_roles =
427: &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.92 albertel 428: my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
1.89 albertel 429:
430: # Unset any roles that were previously frozen but aren't in list
431: foreach my $role_key (sort(keys(%recent_roles))) {
1.91 albertel 432: if (($frozen_roles{$role_key}) && (!exists($freeze{$role_key}))) {
1.92 albertel 433: $message .= "<br />".&mt('Unfreezing Role: [_1]',$role_text{$role_key})."\n";
1.91 albertel 434: &Apache::lonhtmlcommon::store_recent('roles',$role_key,' ',0);
1.89 albertel 435: }
436: }
437:
438: # Freeze selected roles
439: foreach my $role_key (@freeze_list) {
1.91 albertel 440: if (!$frozen_roles{$role_key}) {
1.92 albertel 441: $message .= "<br />".&mt('Freezing Role: [_1]',$role_text{$role_key})."\n";
1.89 albertel 442: &Apache::lonhtmlcommon::store_recent('roles',
1.91 albertel 443: $role_key,' ',1);
1.50 albertel 444: }
445: }
1.89 albertel 446: $message .= "<hr /><br />\n";
1.50 albertel 447:
448: $r->print(<<ENDRPSCREEN);
449: $message
450: ENDRPSCREEN
451: }
452:
453:
1.28 www 454:
455: ################################################################
1.9 matthew 456: # Anonymous Discussion Name Change Subroutines #
457: ################################################################
1.5 www 458: sub screennamechanger {
459: my $r = shift;
1.59 albertel 460: my $user = $env{'user.name'};
461: my $domain = $env{'user.domain'};
1.14 www 462: my %userenv = &Apache::lonnet::get
463: ('environment',['screenname','nickname']);
1.6 www 464: my $screenname=$userenv{'screenname'};
1.14 www 465: my $nickname=$userenv{'nickname'};
1.5 www 466: $r->print(<<ENDSCREEN);
1.88 albertel 467: <form name="prefs" action="/adm/preferences" method="post">
1.6 www 468: <input type="hidden" name="action" value="verify_and_change_screenname" />
1.14 www 469: <br />New screenname (shown if you post anonymously):
1.6 www 470: <input type="text" size="20" value="$screenname" name="screenname" />
1.14 www 471: <br />New nickname (shown if you post non-anonymously):
472: <input type="text" size="20" value="$nickname" name="nickname" />
1.6 www 473: <input type="submit" value="Change" />
474: </form>
1.5 www 475: ENDSCREEN
476: }
1.6 www 477:
478: sub verify_and_change_screenname {
479: my $r = shift;
1.59 albertel 480: my $user = $env{'user.name'};
481: my $domain = $env{'user.domain'};
1.14 www 482: # Screenname
1.59 albertel 483: my $newscreen = $env{'form.screenname'};
1.14 www 484: $newscreen=~s/[^ \w]//g;
1.6 www 485: my $message='';
486: if ($newscreen) {
1.7 www 487: &Apache::lonnet::put('environment',{'screenname' => $newscreen});
488: &Apache::lonnet::appenv('environment.screenname' => $newscreen);
1.6 www 489: $message='Set new screenname to '.$newscreen;
490: } else {
491: &Apache::lonnet::del('environment',['screenname']);
1.7 www 492: &Apache::lonnet::delenv('environment\.screenname');
1.6 www 493: $message='Reset screenname';
494: }
1.14 www 495: # Nickname
496: $message.='<br />';
1.59 albertel 497: $newscreen = $env{'form.nickname'};
1.14 www 498: $newscreen=~s/[^ \w]//g;
499: if ($newscreen) {
500: &Apache::lonnet::put('environment',{'nickname' => $newscreen});
501: &Apache::lonnet::appenv('environment.nickname' => $newscreen);
502: $message.='Set new nickname to '.$newscreen;
503: } else {
504: &Apache::lonnet::del('environment',['nickname']);
505: &Apache::lonnet::delenv('environment\.nickname');
506: $message.='Reset nickname';
507: }
1.68 www 508: &Apache::lonnet::devalidate_cache_new('namescache',$user.':'.$domain);
1.6 www 509: $r->print(<<ENDVCSCREEN);
510: $message
511: ENDVCSCREEN
1.20 www 512: }
513:
514: ################################################################
515: # Message Forward #
516: ################################################################
517:
518: sub msgforwardchanger {
519: my $r = shift;
1.59 albertel 520: my $user = $env{'user.name'};
521: my $domain = $env{'user.domain'};
1.26 www 522: my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
1.20 www 523: my $msgforward=$userenv{'msgforward'};
524: my $notification=$userenv{'notification'};
525: my $critnotification=$userenv{'critnotification'};
1.25 bowersj2 526: my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
527: "What are forwarding ".
528: "and notification ".
529: "addresses");
1.27 bowersj2 530: my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
531: "What are critical messages");
532:
1.20 www 533: $r->print(<<ENDMSG);
1.25 bowersj2 534: $forwardingHelp <br />
1.88 albertel 535: <form name="prefs" action="/adm/preferences" method="post">
1.20 www 536: <input type="hidden" name="action" value="verify_and_change_msgforward" />
537: New Forwarding Address(es) (<tt>user:domain,user:domain,...</tt>):
538: <input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
539: New Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
540: <input type="text" size="40" value="$notification" name="notification" /><hr />
541: New Critical Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
1.27 bowersj2 542: <input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
1.20 www 543: <input type="submit" value="Change" />
544: </form>
545: ENDMSG
546: }
547:
548: sub verify_and_change_msgforward {
549: my $r = shift;
1.59 albertel 550: my $user = $env{'user.name'};
551: my $domain = $env{'user.domain'};
1.20 www 552: my $newscreen = '';
553: my $message='';
1.59 albertel 554: foreach (split(/\,/,$env{'form.msgforward'})) {
1.20 www 555: my ($msuser,$msdomain)=split(/[\@\:]/,$_);
556: $msuser=~s/\W//g;
557: $msdomain=~s/\W//g;
558: if (($msuser) && ($msdomain)) {
559: if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
560: $newscreen.=$msuser.':'.$msdomain.',';
561: } else {
562: $message.='No such user: '.$msuser.':'.$msdomain.'<br>';
563: }
564: }
565: }
566: $newscreen=~s/\,$//;
567: if ($newscreen) {
568: &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
569: &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
570: $message.='Set new message forwarding to '.$newscreen.'<br />';
571: } else {
572: &Apache::lonnet::del('environment',['msgforward']);
573: &Apache::lonnet::delenv('environment\.msgforward');
574: $message.='Reset message forwarding<br />';
575: }
1.59 albertel 576: my $notification=$env{'form.notification'};
1.20 www 577: $notification=~s/\s//gs;
578: if ($notification) {
579: &Apache::lonnet::put('environment',{'notification' => $notification});
580: &Apache::lonnet::appenv('environment.notification' => $notification);
581: $message.='Set message notification address to '.$notification.'<br />';
582: } else {
583: &Apache::lonnet::del('environment',['notification']);
584: &Apache::lonnet::delenv('environment\.notification');
585: $message.='Reset message notification<br />';
586: }
1.59 albertel 587: my $critnotification=$env{'form.critnotification'};
1.20 www 588: $critnotification=~s/\s//gs;
589: if ($critnotification) {
590: &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
591: &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
592: $message.='Set critical message notification address to '.$critnotification;
593: } else {
594: &Apache::lonnet::del('environment',['critnotification']);
595: &Apache::lonnet::delenv('environment\.critnotification');
596: $message.='Reset critical message notification<br />';
597: }
598: $r->print(<<ENDVCMSG);
599: $message
600: ENDVCMSG
1.6 www 601: }
602:
1.12 www 603: ################################################################
1.19 www 604: # Colors #
1.12 www 605: ################################################################
606:
1.19 www 607: sub colorschanger {
1.12 www 608: my $r = shift;
1.19 www 609: # figure out colors
1.80 albertel 610: my $function=&Apache::loncommon::get_users_function();
1.19 www 611: my $domain=&Apache::loncommon::determinedomain();
612: my %colortypes=('pgbg' => 'Page Background',
613: 'tabbg' => 'Header Background',
614: 'sidebg'=> 'Header Border',
615: 'font' => 'Font',
616: 'link' => 'Un-Visited Link',
617: 'vlink' => 'Visited Link',
618: 'alink' => 'Active Link');
1.82 albertel 619: my $start_data_table = &Apache::loncommon::start_data_table();
1.19 www 620: my $chtable='';
1.22 matthew 621: foreach my $item (sort(keys(%colortypes))) {
1.19 www 622: my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
1.82 albertel 623: $chtable.=&Apache::loncommon::start_data_table_row().
1.83 albertel 624: '<td>'.$colortypes{$item}.'</td><td style="background: '.$curcol.
1.19 www 625: '"> </td><td><input name="'.$item.
1.21 www 626: '" size="10" value="'.$curcol.
627: '" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
1.19 www 628: "','".$curcol."','"
1.82 albertel 629: .$item."','parmform.pres','psub'".');">Select</a></td>'.
1.83 albertel 630: &Apache::loncommon::end_data_table_row()."\n";
1.19 www 631: }
1.82 albertel 632: my $end_data_table = &Apache::loncommon::end_data_table();
1.23 matthew 633: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.19 www 634: $r->print(<<ENDCOL);
1.82 albertel 635: <script type="text/javascript">
1.19 www 636:
637: function pclose() {
638: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
639: "height=350,width=350,scrollbars=no,menubar=no");
640: parmwin.close();
641: }
642:
1.23 matthew 643: $pjump_def
1.19 www 644:
645: function psub() {
646: pclose();
647: if (document.parmform.pres_marker.value!='') {
1.21 www 648: if (document.parmform.pres_type.value!='') {
1.77 albertel 649: eval('document.prefs.'+
1.21 www 650: document.parmform.pres_marker.value+
1.19 www 651: '.value=document.parmform.pres_value.value;');
1.21 www 652: }
1.19 www 653: } else {
654: document.parmform.pres_value.value='';
655: document.parmform.pres_marker.value='';
656: }
657: }
658:
659:
660: </script>
1.21 www 661: <form name="parmform">
662: <input type="hidden" name="pres_marker" />
663: <input type="hidden" name="pres_type" />
664: <input type="hidden" name="pres_value" />
665: </form>
1.88 albertel 666: <form name="prefs" action="/adm/preferences" method="post">
1.19 www 667: <input type="hidden" name="action" value="verify_and_change_colors" />
1.82 albertel 668: $start_data_table
1.19 www 669: $chtable
1.82 albertel 670: $end_data_table
1.19 www 671: </table>
1.21 www 672: <input type="submit" value="Change Custom Colors" />
673: <input type="submit" name="resetall" value="Reset All Colors to Default" />
1.12 www 674: </form>
1.19 www 675: ENDCOL
1.12 www 676: }
677:
1.19 www 678: sub verify_and_change_colors {
1.12 www 679: my $r = shift;
1.19 www 680: # figure out colors
1.80 albertel 681: my $function=&Apache::loncommon::get_users_function();
1.19 www 682: my $domain=&Apache::loncommon::determinedomain();
683: my %colortypes=('pgbg' => 'Page Background',
684: 'tabbg' => 'Header Background',
685: 'sidebg'=> 'Header Border',
686: 'font' => 'Font',
687: 'link' => 'Un-Visited Link',
688: 'vlink' => 'Visited Link',
689: 'alink' => 'Active Link');
690:
1.12 www 691: my $message='';
1.21 www 692: foreach my $item (keys %colortypes) {
1.59 albertel 693: my $color=$env{'form.'.$item};
1.21 www 694: my $entry='color.'.$function.'.'.$item;
1.59 albertel 695: if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$env{'form.resetall'})) {
1.21 www 696: &Apache::lonnet::put('environment',{$entry => $color});
697: &Apache::lonnet::appenv('environment.'.$entry => $color);
698: $message.='Set '.$colortypes{$item}.' to '.$color.'<br />';
699: } else {
700: &Apache::lonnet::del('environment',[$entry]);
701: &Apache::lonnet::delenv('environment\.'.$entry);
702: $message.='Reset '.$colortypes{$item}.'<br />';
703: }
704: }
1.84 albertel 705: my $now = time;
706: &Apache::lonnet::put('environment',{'color.timestamp' => $now});
707: &Apache::lonnet::appenv('environment.color.timestamp' => $now);
708:
1.19 www 709: $r->print(<<ENDVCCOL);
1.12 www 710: $message
1.88 albertel 711: <form name="client" action="/adm/preferences" method="post">
1.21 www 712: <input type="hidden" name="action" value="changecolors" />
713: </form>
1.19 www 714: ENDVCCOL
1.12 www 715: }
716:
1.4 matthew 717: ######################################################
718: # password handler subroutines #
719: ######################################################
1.3 matthew 720: sub passwordchanger {
1.94 ! raeburn 721: my ($r,$errormessage,$caller,$mailtoken) = @_;
1.4 matthew 722: # This function is a bit of a mess....
1.3 matthew 723: # Passwords are encrypted using londes.js (DES encryption)
1.4 matthew 724: $errormessage = ($errormessage || '');
1.94 ! raeburn 725: my ($user,$domain,$currentpass,$defdom);
! 726: if ((!defined($caller)) || ($caller eq 'preferences')) {
! 727: $user = $env{'user.name'};
! 728: $domain = $env{'user.domain'};
! 729: if (!defined($caller)) {
! 730: $caller = 'preferences';
! 731: }
! 732: } elsif ($caller eq 'reset_by_email') {
! 733: $defdom = $r->dir_config('lonDefDomain');
! 734: my %data = &Apache::lonnet::tmpget($mailtoken);
! 735: if (keys(%data) == 0) {
! 736: $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.'));
! 737: return;
! 738: }
! 739: if (defined($data{time})) {
! 740: if (time - $data{'time'} < 7200) {
! 741: $user = $data{'username'};
! 742: $domain = $data{'domain'};
! 743: $currentpass = $data{'temppasswd'};
! 744: } else {
! 745: $r->print(&mt('Sorry, the token generated when you requested a password reset has expired.').'<br />');
! 746: return;
! 747: }
! 748: } else {
! 749: $r->print(&mt('Sorry, the URL generated when you requested reset of your password contained incomplete information.').'<br />');
! 750: return;
! 751: }
! 752: } else {
! 753: $r->print(&mt('Page requested in unexpected context').'<br />');
! 754: return;
! 755: }
1.3 matthew 756: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
757: # Check for authentication types that allow changing of the password.
758: return if ($currentauth !~ /^(unix|internal):/);
759: #
760: # Generate keys
761: my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
762: my ($lkey_npass1,$ukey_npass1) = &des_keys();
763: my ($lkey_npass2,$ukey_npass2) = &des_keys();
1.4 matthew 764: # Store the keys in the log files
1.3 matthew 765: my $lonhost = $r->dir_config('lonHostID');
766: my $logtoken=Apache::lonnet::reply('tmpput:'
767: .$ukey_cpass . $lkey_cpass .'&'
768: .$ukey_npass1 . $lkey_npass1.'&'
769: .$ukey_npass2 . $lkey_npass2,
770: $lonhost);
1.4 matthew 771: # Hexify the keys for output as javascript variables
1.94 ! raeburn 772: my %hexkey;
! 773: $hexkey{'ukey_cpass'} = hex($ukey_cpass);
! 774: $hexkey{'lkey_cpass'} = hex($lkey_cpass);
! 775: $hexkey{'ukey_npass1'} = hex($ukey_npass1);
! 776: $hexkey{'lkey_npass1'} = hex($lkey_npass1);
! 777: $hexkey{'ukey_npass2'} = hex($ukey_npass2);
! 778: $hexkey{'lkey_npass2'} = hex($lkey_npass2);
1.3 matthew 779: # Output javascript to deal with passwords
1.4 matthew 780: # Output DES javascript
1.3 matthew 781: {
782: my $include = $r->dir_config('lonIncludes');
783: my $jsh=Apache::File->new($include."/londes.js");
784: $r->print(<$jsh>);
785: }
1.94 ! raeburn 786: $r->print(&jscript_send($caller));
1.3 matthew 787: $r->print(<<ENDFORM);
1.94 ! raeburn 788: $errormessage
! 789:
! 790: <p>
! 791: <!-- We separate the forms into 'server' and 'client' in order to
! 792: ensure that unencrypted passwords will not be sent out by a
! 793: crappy browser -->
! 794: ENDFORM
! 795: $r->print(&server_form($logtoken,$caller,$mailtoken));
! 796: $r->print(&client_form($caller,\%hexkey,$currentpass,$defdom));
! 797:
! 798: #
! 799: return;
! 800: }
! 801:
! 802: sub jscript_send {
! 803: my ($caller) = @_;
! 804: my $output = qq|
1.3 matthew 805: <script language="JavaScript">
806:
807: function send() {
808: uextkey=this.document.client.elements.ukey_cpass.value;
809: lextkey=this.document.client.elements.lkey_cpass.value;
810: initkeys();
811:
1.52 raeburn 812: this.document.pserver.elements.currentpass.value
1.3 matthew 813: =crypted(this.document.client.elements.currentpass.value);
814:
815: uextkey=this.document.client.elements.ukey_npass1.value;
816: lextkey=this.document.client.elements.lkey_npass1.value;
817: initkeys();
1.52 raeburn 818: this.document.pserver.elements.newpass_1.value
1.3 matthew 819: =crypted(this.document.client.elements.newpass_1.value);
820:
821: uextkey=this.document.client.elements.ukey_npass2.value;
822: lextkey=this.document.client.elements.lkey_npass2.value;
823: initkeys();
1.52 raeburn 824: this.document.pserver.elements.newpass_2.value
1.3 matthew 825: =crypted(this.document.client.elements.newpass_2.value);
1.94 ! raeburn 826: |;
! 827: if ($caller eq 'reset_by_email') {
! 828: $output .= qq|
! 829: this.document.pserver.elements.uname.value =
! 830: this.document.client.elements.uname.value;
! 831: this.document.pserver.elements.udom.value =
! 832: this.document.client.elements.udom.options[this.document.client.elements.udom.selectedIndex].value;
! 833: |;
! 834: }
! 835: $ output .= qq|
1.52 raeburn 836: this.document.pserver.submit();
1.3 matthew 837: }
838: </script>
1.94 ! raeburn 839: |;
! 840: }
1.3 matthew 841:
1.94 ! raeburn 842: sub client_form {
! 843: my ($caller,$hexkey,$currentpass,$defdom) = @_;
! 844: my $output = qq|
1.3 matthew 845: <form name="client" >
846: <table>
1.94 ! raeburn 847: |;
! 848: if ($caller eq 'reset_by_email') {
! 849: $output .= qq|
! 850: <tr><td align="right"> E-mail address: </td>
! 851: <td><input type="text" name="email" size="15" /> </td></tr>
! 852: <tr><td align="right"> Username: </td>
! 853: <td>
! 854: <input type="text" name="uname" size="10" />
! 855: <input type="hidden" name="currentpass" value="$currentpass" />
! 856: </td></tr>
! 857: <tr><td align="right"> Domain: </td>
! 858: <td>
! 859: |;
! 860: $output .= &Apache::loncommon::select_dom_form($defdom,'udom').'
! 861: </td>
! 862: </tr>
! 863: ';
! 864: } else {
! 865: $output .= qq|
1.4 matthew 866: <tr><td align="right"> Current password: </td>
867: <td><input type="password" name="currentpass" size="10"/> </td></tr>
1.94 ! raeburn 868: |;
! 869: }
! 870: $output .= <<"ENDFORM";
1.4 matthew 871: <tr><td align="right"> New password: </td>
872: <td><input type="password" name="newpass_1" size="10" /> </td></tr>
873: <tr><td align="right"> Confirm password: </td>
874: <td><input type="password" name="newpass_2" size="10" /> </td></tr>
1.3 matthew 875: <tr><td colspan="2" align="center">
876: <input type="button" value="Change Password" onClick="send();">
877: </table>
1.94 ! raeburn 878: <input type="hidden" name="ukey_cpass" value="$hexkey->{'ukey_cpass'}" />
! 879: <input type="hidden" name="lkey_cpass" value="$hexkey->{'lkey_cpass'}" />
! 880: <input type="hidden" name="ukey_npass1" value="$hexkey->{'ukey_npass1'}" />
! 881: <input type="hidden" name="lkey_npass1" value="$hexkey->{'lkey_npass1'}" />
! 882: <input type="hidden" name="ukey_npass2" value="$hexkey->{'ukey_npass2'}" />
! 883: <input type="hidden" name="lkey_npass2" value="$hexkey->{'lkey_npass2'}" />
1.3 matthew 884: </form>
885: </p>
886: ENDFORM
1.94 ! raeburn 887: return $output;
! 888: }
! 889:
! 890: sub server_form {
! 891: my ($logtoken,$caller,$mailtoken) = @_;
! 892: my $action = '/adm/preferences';
! 893: if ($caller eq 'reset_by_email') {
! 894: $action = '/adm/resetpw';
! 895: }
! 896: my $output = qq|
! 897: <form name="pserver" action="$action" method="post">
! 898: <input type="hidden" name="logtoken" value="$logtoken" />
! 899: <input type="hidden" name="currentpass" value="" />
! 900: <input type="hidden" name="newpass_1" value="" />
! 901: <input type="hidden" name="newpass_2" value="" />
! 902: |;
! 903: if ($caller eq 'reset_by_email') {
! 904: $output .= qq|
! 905: <input type="hidden" name="token" value="$mailtoken" />
! 906: <input type="hidden" name="uname" value="" />
! 907: <input type="hidden" name="udom" value="" />
! 908:
! 909: |;
! 910: }
! 911: $output .= qq|
! 912: <input type="hidden" name="action" value="verify_and_change_pass" />
! 913: </form>
! 914: |;
! 915: return $output;
1.3 matthew 916: }
917:
918: sub verify_and_change_password {
1.94 ! raeburn 919: my ($r,$caller,$mailtoken) = @_;
! 920: my ($user,$domain,$homeserver);
! 921: if ($caller eq 'reset_by_email') {
! 922: $user = $env{'form.uname'};
! 923: $domain = $env{'form.udom'};
! 924: if ($user ne '' && $domain ne '') {
! 925: $homeserver = &Apache::lonnet::homeserver($user,$domain);
! 926: if ($homeserver eq 'no_host') {
! 927: &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
! 928: "Invalid username and/or domain .\n</p>",
! 929: $caller,$mailtoken);
! 930: return 1;
! 931: }
! 932: } else {
! 933: &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
! 934: "Username and Domain were blank.\n</p>",
! 935: $caller,$mailtoken);
! 936: return 1;
! 937: }
! 938: } else {
! 939: $user = $env{'user.name'};
! 940: $domain = $env{'user.domain'};
! 941: $homeserver = $env{'user.home'};
! 942: }
1.3 matthew 943: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1.4 matthew 944: # Check for authentication types that allow changing of the password.
1.94 ! raeburn 945: if ($currentauth !~ /^(unix|internal):/) {
! 946: if ($caller eq 'reset_by_email') {
! 947: &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
! 948: "Authentication type for this user can not be changed by this mechanism..\n</p>",
! 949: $caller,$mailtoken);
! 950: return 1;
! 951: } else {
! 952: return;
! 953: }
! 954: }
1.3 matthew 955: #
1.59 albertel 956: my $currentpass = $env{'form.currentpass'};
957: my $newpass1 = $env{'form.newpass_1'};
958: my $newpass2 = $env{'form.newpass_2'};
959: my $logtoken = $env{'form.logtoken'};
1.3 matthew 960: # Check for empty data
1.4 matthew 961: unless (defined($currentpass) &&
962: defined($newpass1) &&
963: defined($newpass2) ){
964: &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
1.94 ! raeburn 965: "One or more password fields were blank.\n</p>",$caller,$mailtoken);
1.3 matthew 966: return;
967: }
1.16 albertel 968: # Get the keys
969: my $lonhost = $r->dir_config('lonHostID');
1.3 matthew 970: my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
971: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
1.4 matthew 972: # I do not a have a better idea about how to handle this
1.94 ! raeburn 973: my $tryagain_text = &mt('Please log out and try again.');
! 974: if ($caller eq 'reset_by_email') {
! 975: $tryagain_text = &mt('Please try again later.');
! 976: }
1.3 matthew 977: $r->print(<<ENDERROR);
978: <p>
979: <font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
1.94 ! raeburn 980: password decryption. $tryagain_text
1.3 matthew 981: </p>
982: ENDERROR
1.4 matthew 983: # Probably should log an error here
1.75 albertel 984: return 1;
1.3 matthew 985: }
986: my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
1.4 matthew 987: #
1.17 matthew 988: $currentpass = &des_decrypt($ckey ,$currentpass);
989: $newpass1 = &des_decrypt($n1key,$newpass1);
990: $newpass2 = &des_decrypt($n2key,$newpass2);
1.94 ! raeburn 991: #
! 992: if ($caller eq 'reset_by_email') {
! 993: my %data = &Apache::lonnet::tmpget($mailtoken);
! 994: if ($currentpass ne $data{'temppasswd'}) {
! 995: &passwordchanger($r,
! 996: '<font color="#ff0000">ERROR:</font>'.
! 997: 'Could not verify current authentication. '.
! 998: 'Please try again.',$caller,$mailtoken);
! 999: return 1;
! 1000: }
! 1001: }
1.3 matthew 1002: if ($newpass1 ne $newpass2) {
1.4 matthew 1003: &passwordchanger($r,
1004: '<font color="#ff0000">ERROR:</font>'.
1005: 'The new passwords you entered do not match. '.
1.94 ! raeburn 1006: 'Please try again.',$caller,$mailtoken);
1.75 albertel 1007: return 1;
1.4 matthew 1008: }
1009: if (length($newpass1) < 7) {
1010: &passwordchanger($r,
1011: '<font color="#ff0000">ERROR:</font>'.
1012: 'Passwords must be a minimum of 7 characters long. '.
1.94 ! raeburn 1013: 'Please try again.',$caller,$mailtoken);
1.75 albertel 1014: return 1;
1.3 matthew 1015: }
1.4 matthew 1016: #
1017: # Check for bad characters
1018: my $badpassword = 0;
1019: foreach (split(//,$newpass1)) {
1020: $badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
1021: }
1022: if ($badpassword) {
1023: # I can't figure out how to enter bad characters on my browser.
1.94 ! raeburn 1024: my $errormessage = <<"ENDERROR";
1.4 matthew 1025: <font color="#ff0000">ERROR:</font>
1026: The password you entered contained illegal characters.<br />
1027: Valid characters are: space and <br />
1028: <pre>
1029: !"\#$%&\'()*+,-./0123456789:;<=>?\@
1030: ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
1031: </pre>
1032: ENDERROR
1.94 ! raeburn 1033: &passwordchanger($r,$errormessage,$caller,$mailtoken);
! 1034: return 1;
1.4 matthew 1035: }
1036: #
1037: # Change the password (finally)
1038: my $result = &Apache::lonnet::changepass
1.94 ! raeburn 1039: ($user,$domain,$currentpass,$newpass1,$homeserver,$caller);
1.4 matthew 1040: # Inform the user the password has (not?) been changed
1041: if ($result =~ /^ok$/) {
1042: $r->print(<<"ENDTEXT");
1.94 ! raeburn 1043: <h3>The password for $user was successfully changed</h3>
1.4 matthew 1044: ENDTEXT
1045: } else {
1046: # error error: run in circles, scream and shout
1047: $r->print(<<ENDERROR);
1.94 ! raeburn 1048: <h3><font color="#ff0000">The password for $user was not changed</font></h3>
1.8 matthew 1049: Please make sure your old password was entered correctly.
1.4 matthew 1050: ENDERROR
1.75 albertel 1051: return 1;
1.4 matthew 1052: }
1053: return;
1.3 matthew 1054: }
1055:
1.42 raeburn 1056: ################################################################
1057: # discussion display subroutines
1058: ################################################################
1059: sub discussionchanger {
1060: my $r = shift;
1.59 albertel 1061: my $user = $env{'user.name'};
1062: my $domain = $env{'user.domain'};
1.42 raeburn 1063: my %userenv = &Apache::lonnet::get
1.43 raeburn 1064: ('environment',['discdisplay','discmarkread']);
1065: my $discdisp = 'allposts';
1066: my $discmark = 'onmark';
1067:
1068: if (defined($userenv{'discdisplay'})) {
1069: unless ($userenv{'discdisplay'} eq '') {
1070: $discdisp = $userenv{'discdisplay'};
1071: }
1072: }
1073: if (defined($userenv{'discmarkread'})) {
1074: unless ($userenv{'discdisplay'} eq '') {
1075: $discmark = $userenv{'discmarkread'};
1076: }
1077: }
1078:
1079: my $newdisp = 'unread';
1080: my $newmark = 'ondisp';
1081:
1082: my $function = &Apache::loncommon::get_users_function();
1083: my $color = &Apache::loncommon::designparm($function.'.tabbg',
1.59 albertel 1084: $env{'user.domain'});
1.43 raeburn 1085: my %lt = &Apache::lonlocal::texthash(
1086: 'pref' => 'Display Preference',
1087: 'curr' => 'Current setting ',
1088: 'actn' => 'Action',
1089: 'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
1090: 'prca' => 'Preferences can be set that determine',
1091: 'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
1092: 'unwh' => 'Under what circumstances posts are identfied as "New"',
1093: 'allposts' => 'All posts',
1094: 'unread' => 'New posts only',
1095: 'ondisp' => 'Once displayed',
1096: 'onmark' => 'Once marked as read',
1097: 'disa' => 'Posts displayed?',
1098: 'npmr' => 'New posts cease to be identified as "New"?',
1099: 'thde' => 'The preferences you set here can be overridden within each individual discussion.',
1100: 'chgt' => 'Change to '
1101: );
1102: my $dispchange = $lt{'unread'};
1103: my $markchange = $lt{'ondisp'};
1104: my $currdisp = $lt{'allposts'};
1105: my $currmark = $lt{'onmark'};
1106:
1107: if ($discdisp eq 'unread') {
1108: $dispchange = $lt{'allposts'};
1109: $currdisp = $lt{'unread'};
1110: $newdisp = 'allposts';
1111: }
1112:
1113: if ($discmark eq 'ondisp') {
1114: $markchange = $lt{'onmark'};
1115: $currmark = $lt{'ondisp'};
1116: $newmark = 'onmark';
1.42 raeburn 1117: }
1.43 raeburn 1118:
1119: $r->print(<<"END");
1.88 albertel 1120: <form name="prefs" action="/adm/preferences" method="post">
1.42 raeburn 1121: <input type="hidden" name="action" value="verify_and_change_discussion" />
1122: <br />
1.87 albertel 1123: $lt{'sdpf'}<br /> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
1.43 raeburn 1124: <br />
1125: <br />
1.82 albertel 1126: END
1127: $r->print(&Apache::loncommon::start_data_table());
1128: $r->print(<<"END");
1129: <tr>
1130: <th>$lt{'pref'}</th>
1131: <th>$lt{'curr'}</th>
1132: <th>$lt{'actn'}?</th>
1.43 raeburn 1133: </tr>
1.82 albertel 1134: END
1135: $r->print(&Apache::loncommon::start_data_table_row());
1136: $r->print(<<"END");
1.43 raeburn 1137: <td>$lt{'disa'}</td>
1138: <td>$lt{$discdisp}</td>
1.82 albertel 1139: <td><label><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" /> $lt{'chgt'} "$dispchange"</label></td>
1140: END
1141: $r->print(&Apache::loncommon::end_data_table_row().
1142: &Apache::loncommon::start_data_table_row());
1143: $r->print(<<"END");
1.43 raeburn 1144: <td>$lt{'npmr'}</td>
1145: <td>$lt{$discmark}</td>
1.82 albertel 1146: <td><label><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" /> $lt{'chgt'} "$markchange"</label></td>
1.43 raeburn 1147: </tr>
1.82 albertel 1148: END
1149: $r->print(&Apache::loncommon::end_data_table_row().
1150: &Apache::loncommon::end_data_table());
1151: $r->print(<<"END");
1.43 raeburn 1152: <br />
1153: <br />
1154: <input type="submit" name="sub" value="Store Changes" />
1155: <br />
1156: <br />
1157: Note: $lt{'thde'}
1158: </form>
1159: END
1.42 raeburn 1160: }
1161:
1162: sub verify_and_change_discussion {
1163: my $r = shift;
1.59 albertel 1164: my $user = $env{'user.name'};
1165: my $domain = $env{'user.domain'};
1.42 raeburn 1166: my $message='';
1.59 albertel 1167: if (defined($env{'form.discdisp'}) ) {
1168: my $newdisp = $env{'form.newdisp'};
1.43 raeburn 1169: if ($newdisp eq 'unread') {
1.87 albertel 1170: $message .='In discussions: only new posts will be displayed.<br />';
1.43 raeburn 1171: &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
1172: &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
1173: } else {
1.87 albertel 1174: $message .= 'In discussions: all posts will be displayed.<br />';
1.43 raeburn 1175: &Apache::lonnet::del('environment',['discdisplay']);
1176: &Apache::lonnet::delenv('environment\.discdisplay');
1177: }
1178: }
1.59 albertel 1179: if (defined($env{'form.discmark'}) ) {
1180: my $newmark = $env{'form.newmark'};
1.43 raeburn 1181: if ($newmark eq 'ondisp') {
1.87 albertel 1182: $message.='In discussions: new posts will be cease to be identified as "new" after display.<br />';
1.43 raeburn 1183: &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
1184: &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
1185: } else {
1.87 albertel 1186: $message.='In discussions: posts will be identified as "new" until marked as read by the reader.<br />';
1.43 raeburn 1187: &Apache::lonnet::del('environment',['discmarkread']);
1188: &Apache::lonnet::delenv('environment\.discmarkread');
1189: }
1.42 raeburn 1190: }
1191: $r->print(<<ENDVCSCREEN);
1192: $message
1193: ENDVCSCREEN
1194: }
1195:
1.63 raeburn 1196: ################################################################
1197: # Subroutines for page display on course access (Course Coordinators)
1198: ################################################################
1199: sub coursedisplaychanger {
1200: my $r = shift;
1201: my $user = $env{'user.name'};
1202: my $domain = $env{'user.domain'};
1.66 albertel 1203: my %userenv = &Apache::lonnet::get('environment',['course_init_display']);
1.71 raeburn 1204: my $currvalue = 'whatsnew';
1.73 albertel 1205: my $firstselect = '';
1206: my $whatsnewselect = 'checked="checked"';
1.71 raeburn 1207: if (exists($userenv{'course_init_display'})) {
1208: if ($userenv{'course_init_display'} eq 'firstres') {
1209: $currvalue = 'firstres';
1.73 albertel 1210: $firstselect = 'checked="checked"';
1211: $whatsnewselect = '';
1.71 raeburn 1212: }
1.63 raeburn 1213: }
1.71 raeburn 1214: my %pagenames = (
1215: firstres => 'First resource',
1216: whatsnew => "What's new page",
1217: );
1.70 raeburn 1218: my $whatsnew_off=&mt('Display the [_1] in the course.','<b>first resource</b>');
1219: 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 1220:
1.71 raeburn 1221: $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 1222: $r->print(<<ENDLSCREEN);
1.88 albertel 1223: <form name="prefs" action="/adm/preferences" method="post">
1.63 raeburn 1224: <input type="hidden" name="action" value="verify_and_change_coursepage" />
1.72 albertel 1225: <br />
1.65 albertel 1226: <label><input type="radio" name="newdisp" value="firstres" $firstselect /> $whatsnew_off</label><br />
1.70 raeburn 1227: <label><input type="radio" name="newdisp" value="whatsnew" $whatsnewselect /> $whatsnew_on</label><input type="hidden" name="refpage" value="$env{'form.refpage'}" />
1.63 raeburn 1228: ENDLSCREEN
1.70 raeburn 1229: $r->print('<br /><br /><input type="submit" value="'.&mt('Change').'" />
1.63 raeburn 1230: </form>');
1231: }
1232:
1233: sub verify_and_change_coursepage {
1234: my $r = shift;
1235: my $message='';
1236: my %lt = &Apache::lonlocal::texthash(
1.70 raeburn 1237: 'defs' => 'Default now set',
1.71 raeburn 1238: 'when' => 'when you select a course role from the roles screen',
1.63 raeburn 1239: 'ywbt' => 'you will be taken to the start of the course.',
1240: 'apwb' => 'a page will be displayed that lists items in the course that may require action from you.',
1241: 'gtts' => 'Go to the start of the course',
1.70 raeburn 1242: 'dasp' => "Display the What's New page listing course action items",
1.63 raeburn 1243: );
1244: my $newdisp = $env{'form.newdisp'};
1.70 raeburn 1245: $message = '<b>'.$lt{'defs'}.'</b>: '.$lt{'when'}.', ';
1.63 raeburn 1246: if ($newdisp eq 'firstres') {
1.87 albertel 1247: $message .= $lt{'ywbt'}.'<br />';
1.63 raeburn 1248: &Apache::lonnet::put('environment',{'course_init_display' => $newdisp});
1249: &Apache::lonnet::appenv('environment.course_init_display' => $newdisp);
1250: } else {
1.87 albertel 1251: $message .= $lt{'apwb'}.'<br />';
1.63 raeburn 1252: &Apache::lonnet::del('environment',['course_init_display']);
1253: &Apache::lonnet::delenv('environment\.course_init_display');
1254: }
1.70 raeburn 1255: my $refpage = $env{'form.refpage'};
1.63 raeburn 1256: if (($env{'request.course.fn'}) && ($env{'request.course.id'})) {
1257: if ($newdisp eq 'firstres') {
1258: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1259: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1260: my ($furl,$ferr)=
1261: &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
1262: $message .= '<br /><font size="+1"><a href="'.$furl.'">'.$lt{'gtts'}.' <i>'.&mt('now').'</i></a></font>';
1263: } else {
1.70 raeburn 1264: $message .= '<br /><font size="+1"><a href="/adm/whatsnew?refpage='.
1265: $refpage.'">'.$lt{'dasp'}.'</a></font>';
1.63 raeburn 1266: }
1267: }
1268: $r->print(<<ENDVCSCREEN);
1269: $message
1270: <br /><br />
1271: ENDVCSCREEN
1272: }
1273:
1274:
1.4 matthew 1275: ######################################################
1276: # other handler subroutines #
1277: ######################################################
1278:
1.3 matthew 1279: ################################################################
1280: # Main handler #
1281: ################################################################
1.1 www 1282: sub handler {
1283: my $r = shift;
1.59 albertel 1284: my $user = $env{'user.name'};
1285: my $domain = $env{'user.domain'};
1.31 www 1286: &Apache::loncommon::content_type($r,'text/html');
1.4 matthew 1287: # Some pages contain DES keys and should not be cached.
1288: &Apache::loncommon::no_cache($r);
1.1 www 1289: $r->send_http_header;
1290: return OK if $r->header_only;
1.9 matthew 1291: #
1.35 matthew 1292: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.70 raeburn 1293: ['action','wysiwyg','returnurl','refpage']);
1.35 matthew 1294: #
1295: &Apache::lonhtmlcommon::clear_breadcrumbs();
1296: &Apache::lonhtmlcommon::add_breadcrumb
1297: ({href => '/adm/preferences',
1298: text => 'Set User Preferences'});
1299:
1300: my @Options;
1301: # Determine current authentication method
1302: my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
1303: if ($currentauth =~ /^(unix|internal):/) {
1304: push (@Options,({ action => 'changepass',
1.40 www 1305: linktext => 'Change Password',
1.35 matthew 1306: href => '/adm/preferences',
1307: help => 'Change_Password',
1308: subroutine => \&passwordchanger,
1309: breadcrumb =>
1310: { href => '/adm/preferences?action=changepass',
1311: text => 'Change Password'},
1312: },
1313: { action => 'verify_and_change_pass',
1314: subroutine => \&verify_and_change_password,
1315: breadcrumb =>
1316: { href =>'/adm/preferences?action=changepass',
1317: text => 'Change Password'},
1.75 albertel 1318: printmenu => 'not_on_error',
1.35 matthew 1319: }));
1320: }
1321: push (@Options,({ action => 'changescreenname',
1322: linktext => 'Change Screen Name',
1323: href => '/adm/preferences',
1324: help => 'Prefs_Screen_Name_Nickname',
1325: subroutine => \&screennamechanger,
1326: breadcrumb =>
1327: { href => '/adm/preferences?action=changescreenname',
1328: text => 'Change Screen Name'},
1329: },
1330: { action => 'verify_and_change_screenname',
1331: subroutine => \&verify_and_change_screenname,
1332: breadcrumb =>
1333: { href => '/adm/preferences?action=changescreenname',
1334: text => 'Change Screen Name'},
1335: printmenu => 'yes',
1336: }));
1337:
1338: push (@Options,({ action => 'changemsgforward',
1.49 albertel 1339: linktext => 'Change Message Forwarding and Notification Addresses',
1.35 matthew 1340: href => '/adm/preferences',
1341: help => 'Prefs_Forwarding',
1342: breadcrumb =>
1343: { href => '/adm/preferences?action=changemsgforward',
1344: text => 'Change Message Forwarding'},
1345: subroutine => \&msgforwardchanger,
1346: },
1347: { action => 'verify_and_change_msgforward',
1348: breadcrumb =>
1349: { href => '/adm/preferences?action=changemsgforward',
1350: text => 'Change Message Forwarding'},
1351: printmenu => 'yes',
1352: subroutine => \&verify_and_change_msgforward }));
1353: my $aboutmeaction=
1.59 albertel 1354: '/adm/'.$env{'user.domain'}.'/'.$env{'user.name'}.'/aboutme';
1.35 matthew 1355: push (@Options,{ action => 'none',
1356: linktext =>
1.41 www 1357: q{Edit the 'About Me' Personal Information Screen},
1.45 www 1358: help => 'Prefs_About_Me',
1.35 matthew 1359: href => $aboutmeaction});
1360: push (@Options,({ action => 'changecolors',
1361: linktext => 'Change Color Scheme',
1362: href => '/adm/preferences',
1363: help => 'Change_Colors',
1364: breadcrumb =>
1365: { href => '/adm/preferences?action=changecolors',
1366: text => 'Change Colors'},
1367: subroutine => \&colorschanger,
1368: },
1369: { action => 'verify_and_change_colors',
1370: breadcrumb =>
1371: { href => '/adm/preferences?action=changecolors',
1372: text => 'Change Colors'},
1373: printmenu => 'yes',
1374: subroutine => \&verify_and_change_colors,
1375: }));
1376: push (@Options,({ action => 'changelanguages',
1.39 www 1377: linktext => 'Change Language Preferences',
1.35 matthew 1378: href => '/adm/preferences',
1.45 www 1379: help => 'Prefs_Language',
1.35 matthew 1380: breadcrumb=>
1381: { href => '/adm/preferences?action=changelanguages',
1382: text => 'Change Language'},
1383: subroutine => \&languagechanger,
1384: },
1385: { action => 'verify_and_change_languages',
1386: breadcrumb=>
1387: {href => '/adm/preferences?action=changelanguages',
1388: text => 'Change Language'},
1389: printmenu => 'yes',
1390: subroutine=>\&verify_and_change_languages, }
1391: ));
1.44 www 1392: push (@Options,({ action => 'changewysiwyg',
1393: linktext => 'Change WYSIWYG Editor Preferences',
1394: href => '/adm/preferences',
1395: breadcrumb =>
1396: { href => '/adm/preferences?action=changewysiwyg',
1397: text => 'Change WYSIWYG Preferences'},
1398: subroutine => \&wysiwygchanger,
1399: },
1400: { action => 'set_wysiwyg',
1401: breadcrumb =>
1402: { href => '/adm/preferences?action=changewysiwyg',
1403: text => 'Change WYSIWYG Preferences'},
1404: printmenu => 'yes',
1405: subroutine => \&verify_and_change_wysiwyg, }
1406: ));
1.42 raeburn 1407: push (@Options,({ action => 'changediscussions',
1408: linktext => 'Change Discussion Display Preferences',
1409: href => '/adm/preferences',
1.46 raeburn 1410: help => 'Change_Discussion_Display',
1.42 raeburn 1411: breadcrumb =>
1412: { href => '/adm/preferences?action=changediscussions',
1.43 raeburn 1413: text => 'Change Discussion Preferences'},
1.42 raeburn 1414: subroutine => \&discussionchanger,
1415: },
1416: { action => 'verify_and_change_discussion',
1417: breadcrumb =>
1418: { href => '/adm/preferences?action=changediscussions',
1.43 raeburn 1419: text => 'Change Discussion Preferences'},
1.42 raeburn 1420: printmenu => 'yes',
1421: subroutine => \&verify_and_change_discussion, }
1422: ));
1423:
1.50 albertel 1424: push (@Options,({ action => 'changerolespref',
1425: linktext => 'Change Roles Page Preferences',
1426: href => '/adm/preferences',
1427: subroutine => \&rolesprefchanger,
1428: breadcrumb =>
1429: { href => '/adm/preferences?action=changerolespref',
1430: text => 'Change Roles Pref'},
1431: },
1432: { action => 'verify_and_change_rolespref',
1433: subroutine => \&verify_and_change_rolespref,
1434: breadcrumb =>
1435: { href => '/adm/preferences?action=changerolespref',
1436: text => 'Change Roles Preferences'},
1437: printmenu => 'yes',
1438: }));
1439:
1.54 albertel 1440: push (@Options,({ action => 'changetexenginepref',
1441: linktext => 'Change How Math Equations Are Displayed',
1442: href => '/adm/preferences',
1443: subroutine => \&texenginechanger,
1444: breadcrumb =>
1445: { href => '/adm/preferences?action=changetexenginepref',
1446: text => 'Change Math Pref'},
1447: },
1448: { action => 'verify_and_change_texengine',
1449: subroutine => \&verify_and_change_texengine,
1450: breadcrumb =>
1451: { href => '/adm/preferences?action=changetexenginepref',
1452: text => 'Change Math Preferences'},
1453: printmenu => 'yes',
1454: }));
1.85 albertel 1455:
1456: if ($env{'environment.remote'} eq 'off') {
1457: push (@Options,({ action => 'launch',
1458: linktext => 'Launch Remote Control',
1459: href => '/adm/remote?url=/adm/preferences',
1460: }));
1461: } else {
1462: push (@Options,({ action => 'collapse',
1463: linktext => 'Collapse Remote Control',
1464: href => '/adm/remote?url=/adm/preferences',
1465: }));
1466: }
1467:
1.74 albertel 1468: if (&Apache::lonnet::allowed('whn',$env{'request.course.id'})
1469: || &Apache::lonnet::allowed('whn',$env{'request.course.id'}.'/'
1470: .$env{'request.course.sec'})) {
1.63 raeburn 1471: push (@Options,({ action => 'changecourseinit',
1472: linktext => 'Change Course Initialization Preference',
1473: href => '/adm/preferences',
1474: subroutine => \&coursedisplaychanger,
1475: breadcrumb =>
1476: { href => '/adm/preferences?action=changecourseinit',
1477: text => 'Change Course Init. Pref.'},
1478: },
1479: { action => 'verify_and_change_coursepage',
1480: breadcrumb =>
1481: { href => '/adm/preferences?action=changecourseinit', text => 'Change Course Initialization Preference'},
1482: printmenu => 'yes',
1483: subroutine => \&verify_and_change_coursepage,
1484: }));
1485: }
1.50 albertel 1486:
1.62 raeburn 1487: if ($env{'user.name'} =~ /^(albertel|fox|foxr|koretemey|korte|hallmat3|turtle|raeburn)$/) {
1.35 matthew 1488: push (@Options,({ action => 'debugtoggle',
1489: printmenu => 'yes',
1490: subroutine => \&toggle_debug,
1491: }));
1492: }
1.76 albertel 1493:
1494: $r->print(&Apache::loncommon::start_page('Change Preferences'));
1495:
1.35 matthew 1496: my $call = undef;
1.48 albertel 1497: my $help = undef;
1.35 matthew 1498: my $printmenu = 'yes';
1499: foreach my $option (@Options) {
1.59 albertel 1500: if ($option->{'action'} eq $env{'form.action'}) {
1.35 matthew 1501: $call = $option->{'subroutine'};
1502: $printmenu = $option->{'printmenu'};
1503: if (exists($option->{'breadcrumb'})) {
1504: &Apache::lonhtmlcommon::add_breadcrumb
1505: ($option->{'breadcrumb'});
1506: }
1.48 albertel 1507: $help=$option->{'help'};
1.35 matthew 1508: }
1509: }
1.81 albertel 1510: $r->print(&Apache::lonhtmlcommon::breadcrumbs('Change Preferences',$help));
1.75 albertel 1511: my $error;
1.35 matthew 1512: if (defined($call)) {
1.75 albertel 1513: $error = $call->($r);
1.35 matthew 1514: }
1.75 albertel 1515: if ( ( ($printmenu eq 'yes')
1516: || ($printmenu eq 'not_on_error' && !$error) )
1517: && (!$env{'form.returnurl'})) {
1.35 matthew 1518: my $optionlist = '<table cellpadding="5">';
1.59 albertel 1519: if ($env{'user.name'} =~
1.62 raeburn 1520: /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle|raeburn)$/
1.35 matthew 1521: ) {
1522: push (@Options,({ action => 'debugtoggle',
1523: linktext => 'Toggle Debug Messages',
1524: text => 'Current Debug status is -'.
1.59 albertel 1525: $env{'user.debug'}.'-.',
1.35 matthew 1526: href => '/adm/preferences',
1527: printmenu => 'yes',
1528: subroutine => \&toggle_debug,
1529: }));
1530: }
1531: foreach my $option(@Options) {
1532: my $optiontext = '';
1533: if (exists($option->{'href'})) {
1.85 albertel 1534: $option->{'href_args'}{'action'}=$option->{'action'};
1535: $optiontext .=
1536: '<a href="'.&add_get_param($option->{'href'},
1537: $option->{'href_args'}).'">'.
1.47 albertel 1538: &mt($option->{'linktext'}).'</a>';
1.35 matthew 1539: }
1540: if (exists($option->{'text'})) {
1.47 albertel 1541: $optiontext .= ' '.&mt($option->{'text'});
1.35 matthew 1542: }
1543: if ($optiontext ne '') {
1544: $optiontext = '<font size="+1">'.$optiontext.'</font>';
1545: my $helplink = ' ';
1546: if (exists($option->{'help'})) {
1547: $helplink = &Apache::loncommon::help_open_topic
1548: ($option->{'help'});
1549: }
1550: $optionlist .= '<tr>'.
1551: '<td>'.$helplink.'</td>'.
1552: '<td>'.$optiontext.'</td>'.
1553: '</tr>';
1554: }
1.13 www 1555: }
1.35 matthew 1556: $optionlist .= '</table>';
1557: $r->print($optionlist);
1.59 albertel 1558: } elsif ($env{'form.returnurl'}) {
1559: $r->print('<br /><a href="'.$env{'form.returnurl'}.'"><font size="+1">'.
1.44 www 1560: &mt('Return').'</font></a>');
1.3 matthew 1561: }
1.76 albertel 1562: $r->print(&Apache::loncommon::end_page());
1.1 www 1563: return OK;
1.35 matthew 1564: }
1565:
1566: sub toggle_debug {
1.59 albertel 1567: if ($env{'user.debug'}) {
1.35 matthew 1568: &Apache::lonnet::delenv('user\.debug');
1569: } else {
1570: &Apache::lonnet::appenv('user.debug' => 1);
1571: }
1.13 www 1572: }
1.1 www 1573:
1574: 1;
1575: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>