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