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