--- loncom/interface/lonpreferences.pm 2001/01/03 16:20:59 1.1
+++ loncom/interface/lonpreferences.pm 2006/04/10 18:59:30 1.80
@@ -1,41 +1,1314 @@
# The LearningOnline Network
# Preferences
#
-# (Internal Server Error Handler
+# $Id: lonpreferences.pm,v 1.80 2006/04/10 18:59:30 albertel Exp $
#
-# (Login Screen
-# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
-# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
+# Copyright Michigan State University Board of Trustees
#
-# 3/1/1 Gerd Kortemeyer)
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
-# 3/1 Gerd Kortemeyer
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
+# This package uses the "londes.js" javascript code.
+#
+# TODOs that have to be completed:
+# interface with lonnet to change the password
+
package Apache::lonpreferences;
use strict;
use Apache::Constants qw(:common);
+use Apache::File;
+use Crypt::DES;
+use DynaLoader; # for Crypt::DES version
+use Apache::loncommon();
+use Apache::lonhtmlcommon();
+use Apache::lonlocal;
+use Apache::lonnet;
+
+#
+# Write lonnet::passwd to do the call below.
+# Use:
+# my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
+#
+##################################################
+# password associated functions #
+##################################################
+sub des_keys {
+ # Make a new key for DES encryption.
+ # Each key has two parts which are returned separately.
+ # Please note: Each key must be passed through the &hex function
+ # before it is output to the web browser. The hex versions cannot
+ # be used to decrypt.
+ my @hexstr=('0','1','2','3','4','5','6','7',
+ '8','9','a','b','c','d','e','f');
+ my $lkey='';
+ for (0..7) {
+ $lkey.=$hexstr[rand(15)];
+ }
+ my $ukey='';
+ for (0..7) {
+ $ukey.=$hexstr[rand(15)];
+ }
+ return ($lkey,$ukey);
+}
+
+sub des_decrypt {
+ my ($key,$cyphertext) = @_;
+ my $keybin=pack("H16",$key);
+ my $cypher;
+ if ($Crypt::DES::VERSION>=2.03) {
+ $cypher=new Crypt::DES $keybin;
+ } else {
+ $cypher=new DES $keybin;
+ }
+ my $plaintext=
+ $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
+ $plaintext.=
+ $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
+ $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
+ return $plaintext;
+}
+
+################################################################
+# Handler subroutines #
+################################################################
+
+################################################################
+# Language Change Subroutines #
+################################################################
+
+sub wysiwygchanger {
+ my $r = shift;
+ my %userenv = &Apache::lonnet::get
+ ('environment',['wysiwygeditor']);
+ my $onselect='checked="checked"';
+ my $offselect='';
+ if ($userenv{'wysiwygeditor'} eq 'on') {
+ $onselect='';
+ $offselect='checked="checked"';
+ }
+ my $switchoff=&mt('Disable WYSIWYG editor');
+ my $switchon=&mt('Enable WYSIWYG editor');
+ $r->print(<<ENDLSCREEN);
+<form name="prefs" action="/adm/preferences" method="POST">
+<input type="hidden" name="action" value="set_wysiwyg" />
+<br />
+<label><input type="radio" name="wysiwyg" value="off" $onselect /> $switchoff</label><br />
+<label><input type="radio" name="wysiwyg" value="on" $offselect /> $switchon</label>
+ENDLSCREEN
+ $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
+}
+
+
+sub verify_and_change_wysiwyg {
+ my $r = shift;
+ my $newsetting=$env{'form.wysiwyg'};
+ &Apache::lonnet::put('environment',{'wysiwygeditor' => $newsetting});
+ &Apache::lonnet::appenv('environment.wysiwygeditor' => $newsetting);
+ $r->print('<p>'.&mt('Setting WYSIWYG editor to:').' '.&mt($newsetting).'</p>');
+}
+
+################################################################
+# Language Change Subroutines #
+################################################################
+sub languagechanger {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my %userenv = &Apache::lonnet::get
+ ('environment',['languages']);
+ my $language=$userenv{'languages'};
+
+ my $pref=&mt('Preferred language');
+ my %langchoices=('' => 'No language preference');
+ foreach (&Apache::loncommon::languageids()) {
+ if (&Apache::loncommon::supportedlanguagecode($_)) {
+ $langchoices{&Apache::loncommon::supportedlanguagecode($_)}
+ = &Apache::loncommon::plainlanguagedescription($_);
+ }
+ }
+ my $selectionbox=&Apache::loncommon::select_form($language,'language',
+ %langchoices);
+ $r->print(<<ENDLSCREEN);
+<form name="prefs" action="/adm/preferences" method="POST">
+<input type="hidden" name="action" value="verify_and_change_languages" />
+<br />$pref: $selectionbox
+ENDLSCREEN
+ $r->print('<br /><input type="submit" value="'.&mt('Change').'" />');
+}
+
+
+sub verify_and_change_languages {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+# Screenname
+ my $newlanguage = $env{'form.language'};
+ $newlanguage=~s/[^\-\w]//g;
+ my $message='';
+ if ($newlanguage) {
+ &Apache::lonnet::put('environment',{'languages' => $newlanguage});
+ &Apache::lonnet::appenv('environment.languages' => $newlanguage);
+ $message='Set new preferred languages to '.$newlanguage;
+ } else {
+ &Apache::lonnet::del('environment',['languages']);
+ &Apache::lonnet::delenv('environment\.languages');
+ $message='Reset preferred language';
+ }
+ $r->print(<<ENDVCSCREEN);
+$message
+ENDVCSCREEN
+}
+
+################################################################
+# Tex Engine Change Subroutines #
+################################################################
+sub texenginechanger {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my %userenv = &Apache::lonnet::get('environment',['texengine']);
+ my $texengine=$userenv{'texengine'};
+
+ my $pref=&mt('Preferred method to display Math');
+ my %mathchoices=('' => 'Default',
+ 'tth' => 'TeX to HTML',
+ #'ttm' => 'TeX to MathML',
+ 'jsMath' => 'jsMath',
+ 'mimetex' => 'Convert to Images'
+ );
+ my $selectionbox=&Apache::loncommon::select_form($texengine,'texengine',
+ %mathchoices);
+ my $jsMath_start=&Apache::lontexconvert::jsMath_header();
+ my $change=&mt('Change');
+ $r->print(<<ENDLSCREEN);
+<br />
+
+<form name="prefs" action="/adm/preferences" method="POST">
+<input type="hidden" name="action" value="verify_and_change_texengine" />
+<p>$pref: $selectionbox</p>
+<p><input type="submit" value="$change" /></p>
+</form>
+Examples:
+<p> TeX to HTML <br />
+<iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=tth" width="400" hieght="200"></iframe>
+</p>
+<p>jsMath <br />
+$jsMath_start
+<script type="text/javascript">
+if (jsMath.nofonts == 1) {
+ document.writeln
+ ('<center><div style="padding: 10; border-style: solid; border-width:3;'
+ +' border-color: #DD0000; background-color: #FFF8F8; width: 75%; text-align: left">'
+ +'<small><font color="#AA0000"><b>Warning:</b> '
+ +'It looks like you don\\\'t have the TeX math fonts installed. '
+ +'The jsMath example on this page may not look right without them. '
+ +'The <a href="http://www.math.union.edu/locate/jsMath/" target="_blank"> '
+ +'jsMath Home Page</a> has information on how to download the '
+ +'needed fonts. In the meantime, jsMath will do the best it can '
+ +'with the fonts you have, but it may not be pretty and some equations '
+ +'may not be rendered correctly. '
+ +'</font></small></div></center>');
+}
+</script>
+<iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=jsMath" width="400" hieght="200"></iframe>
+
+</p>
+<p> Convert to Images <br />
+<br />
+<iframe src="/res/adm/pages/math_example.tex?inhibitmenu=yes&texengine=mimetex" width="400" hieght="200"></iframe>
+</p>
+ENDLSCREEN
+ if ($env{'environment.texengine'} ne 'jsMath') {
+ $r->print('<script type="text/javascript">jsMath.Process()</script>');
+ }
+}
+
+
+sub verify_and_change_texengine {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+# Screenname
+ my $newtexengine = $env{'form.texengine'};
+ $newtexengine=~s/[^\-\w]//g;
+ if ($newtexengine eq 'ttm') {
+ &Apache::lonnet::appenv('browser.mathml' => 1);
+ } else {
+ if ($env{'environment.texengine'} eq 'ttm') {
+ &Apache::lonnet::appenv('browser.mathml' => 0);
+ }
+ }
+ my $message='';
+ if ($newtexengine) {
+ &Apache::lonnet::put('environment',{'texengine' => $newtexengine});
+ &Apache::lonnet::appenv('environment.texengine' => $newtexengine);
+ $message='Set new preferred math display to '.$newtexengine;
+ } else {
+ &Apache::lonnet::del('environment',['texengine']);
+ &Apache::lonnet::delenv('environment\.texengine');
+ $message='Reset preferred math display.';
+ }
+
+
+ $r->print(<<ENDVCSCREEN);
+$message
+ENDVCSCREEN
+}
+
+################################################################
+# Roles Page Preference Change Subroutines #
+################################################################
+sub rolesprefchanger {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my %userenv = &Apache::lonnet::get
+ ('environment',['recentroles','recentrolesn']);
+ my $hotlist_flag=$userenv{'recentroles'};
+ my $hotlist_n=$userenv{'recentrolesn'};
+ my $checked;
+ if ($hotlist_flag) {
+ $checked = 'checked="checked"';
+ }
+
+ if (!$hotlist_n) { $hotlist_n=3; }
+ my $options;
+ for (my $i=1; $i<10; $i++) {
+ my $select;
+ if ($hotlist_n == $i) { $select = 'selected="selected"'; }
+ $options .= "<option $select>$i</option>\n";
+ }
+
+ $r->print(<<ENDSCREEN);
+<p>Some LON-CAPA users have a long list of roles. The Recent Roles Hotlist
+feature keeps track of the last N roles which have been
+visited and places a table of these at the top of the roles page.
+People with very few roles should leave this feature disabled.
+</p>
+
+<form name="prefs" action="/adm/preferences" method="POST">
+<input type="hidden" name="action" value="verify_and_change_rolespref" />
+<br />Enable Recent Roles Hotlist:
+<input type="checkbox" $checked name="recentroles" value="true" />
+<br />Number of roles in Hotlist:
+<select name="recentrolesn" size="1">
+$options
+</select>
+<br />
+<input type="submit" value="Change" />
+</form>
+ENDSCREEN
+}
+
+sub verify_and_change_rolespref {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+# Recent Roles Hotlist Flag
+ my $hotlist_flag = $env{'form.recentroles'};
+ my $hotlist_n = $env{'form.recentrolesn'};
+ my $message='';
+ if ($hotlist_flag) {
+ &Apache::lonnet::put('environment',{'recentroles' => $hotlist_flag});
+ &Apache::lonnet::appenv('environment.recentroles' => $hotlist_flag);
+ $message='Recent Roles Hotlist is Enabled';
+ } else {
+ &Apache::lonnet::del('environment',['recentroles']);
+ &Apache::lonnet::delenv('environment\.recentroles');
+ $message='Recent Roles Hotlist is Disabled';
+ }
+ if ($hotlist_n) {
+ &Apache::lonnet::put('environment',{'recentrolesn' => $hotlist_n});
+ &Apache::lonnet::appenv('environment.recentrolesn' => $hotlist_n);
+ if ($hotlist_flag) {
+ $message.="<br />Display $hotlist_n Most Recent Roles\n";
+ }
+ }
+
+ $r->print(<<ENDRPSCREEN);
+$message
+ENDRPSCREEN
+}
+
+
+
+################################################################
+# Anonymous Discussion Name Change Subroutines #
+################################################################
+sub screennamechanger {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my %userenv = &Apache::lonnet::get
+ ('environment',['screenname','nickname']);
+ my $screenname=$userenv{'screenname'};
+ my $nickname=$userenv{'nickname'};
+ $r->print(<<ENDSCREEN);
+<form name="prefs" action="/adm/preferences" method="POST">
+<input type="hidden" name="action" value="verify_and_change_screenname" />
+<br />New screenname (shown if you post anonymously):
+<input type="text" size="20" value="$screenname" name="screenname" />
+<br />New nickname (shown if you post non-anonymously):
+<input type="text" size="20" value="$nickname" name="nickname" />
+<input type="submit" value="Change" />
+</form>
+ENDSCREEN
+}
+
+sub verify_and_change_screenname {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+# Screenname
+ my $newscreen = $env{'form.screenname'};
+ $newscreen=~s/[^ \w]//g;
+ my $message='';
+ if ($newscreen) {
+ &Apache::lonnet::put('environment',{'screenname' => $newscreen});
+ &Apache::lonnet::appenv('environment.screenname' => $newscreen);
+ $message='Set new screenname to '.$newscreen;
+ } else {
+ &Apache::lonnet::del('environment',['screenname']);
+ &Apache::lonnet::delenv('environment\.screenname');
+ $message='Reset screenname';
+ }
+# Nickname
+ $message.='<br />';
+ $newscreen = $env{'form.nickname'};
+ $newscreen=~s/[^ \w]//g;
+ if ($newscreen) {
+ &Apache::lonnet::put('environment',{'nickname' => $newscreen});
+ &Apache::lonnet::appenv('environment.nickname' => $newscreen);
+ $message.='Set new nickname to '.$newscreen;
+ } else {
+ &Apache::lonnet::del('environment',['nickname']);
+ &Apache::lonnet::delenv('environment\.nickname');
+ $message.='Reset nickname';
+ }
+ &Apache::lonnet::devalidate_cache_new('namescache',$user.':'.$domain);
+ $r->print(<<ENDVCSCREEN);
+$message
+ENDVCSCREEN
+}
+
+################################################################
+# Message Forward #
+################################################################
+
+sub msgforwardchanger {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my %userenv = &Apache::lonnet::get('environment',['msgforward','notification','critnotification']);
+ my $msgforward=$userenv{'msgforward'};
+ my $notification=$userenv{'notification'};
+ my $critnotification=$userenv{'critnotification'};
+ my $forwardingHelp = Apache::loncommon::help_open_topic("Prefs_Forwarding",
+ "What are forwarding ".
+ "and notification ".
+ "addresses");
+ my $criticalMessageHelp = Apache::loncommon::help_open_topic("Course_Critical_Message",
+ "What are critical messages");
+ $r->print(<<ENDMSG);
+$forwardingHelp <br />
+<form name="prefs" action="/adm/preferences" method="POST">
+<input type="hidden" name="action" value="verify_and_change_msgforward" />
+New Forwarding Address(es) (<tt>user:domain,user:domain,...</tt>):
+<input type="text" size="40" value="$msgforward" name="msgforward" /><hr />
+New Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
+<input type="text" size="40" value="$notification" name="notification" /><hr />
+New Critical Message Notification Email Address(es) (<tt>joe\@doe.com,jane\@doe.edu,...</tt>):
+<input type="text" size="40" value="$critnotification" name="critnotification" />$criticalMessageHelp<hr />
+<input type="submit" value="Change" />
+</form>
+ENDMSG
+}
+
+sub verify_and_change_msgforward {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my $newscreen = '';
+ my $message='';
+ foreach (split(/\,/,$env{'form.msgforward'})) {
+ my ($msuser,$msdomain)=split(/[\@\:]/,$_);
+ $msuser=~s/\W//g;
+ $msdomain=~s/\W//g;
+ if (($msuser) && ($msdomain)) {
+ if (&Apache::lonnet::homeserver($msuser,$msdomain) ne 'no_host') {
+ $newscreen.=$msuser.':'.$msdomain.',';
+ } else {
+ $message.='No such user: '.$msuser.':'.$msdomain.'<br>';
+ }
+ }
+ }
+ $newscreen=~s/\,$//;
+ if ($newscreen) {
+ &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
+ &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
+ $message.='Set new message forwarding to '.$newscreen.'<br />';
+ } else {
+ &Apache::lonnet::del('environment',['msgforward']);
+ &Apache::lonnet::delenv('environment\.msgforward');
+ $message.='Reset message forwarding<br />';
+ }
+ my $notification=$env{'form.notification'};
+ $notification=~s/\s//gs;
+ if ($notification) {
+ &Apache::lonnet::put('environment',{'notification' => $notification});
+ &Apache::lonnet::appenv('environment.notification' => $notification);
+ $message.='Set message notification address to '.$notification.'<br />';
+ } else {
+ &Apache::lonnet::del('environment',['notification']);
+ &Apache::lonnet::delenv('environment\.notification');
+ $message.='Reset message notification<br />';
+ }
+ my $critnotification=$env{'form.critnotification'};
+ $critnotification=~s/\s//gs;
+ if ($critnotification) {
+ &Apache::lonnet::put('environment',{'critnotification' => $critnotification});
+ &Apache::lonnet::appenv('environment.critnotification' => $critnotification);
+ $message.='Set critical message notification address to '.$critnotification;
+ } else {
+ &Apache::lonnet::del('environment',['critnotification']);
+ &Apache::lonnet::delenv('environment\.critnotification');
+ $message.='Reset critical message notification<br />';
+ }
+ $r->print(<<ENDVCMSG);
+$message
+ENDVCMSG
+}
+
+################################################################
+# Colors #
+################################################################
+
+sub colorschanger {
+ my $r = shift;
+# figure out colors
+ my $function=&Apache::loncommon::get_users_function();
+ my $domain=&Apache::loncommon::determinedomain();
+ my %colortypes=('pgbg' => 'Page Background',
+ 'tabbg' => 'Header Background',
+ 'sidebg'=> 'Header Border',
+ 'font' => 'Font',
+ 'link' => 'Un-Visited Link',
+ 'vlink' => 'Visited Link',
+ 'alink' => 'Active Link');
+ my $chtable='';
+ foreach my $item (sort(keys(%colortypes))) {
+ my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
+ $chtable.='<tr><td>'.$colortypes{$item}.'</td><td bgcolor="'.$curcol.
+ '"> </td><td><input name="'.$item.
+ '" size="10" value="'.$curcol.
+'" /></td><td><a href="javascript:pjump('."'color_custom','".$colortypes{$item}.
+"','".$curcol."','"
+ .$item."','parmform.pres','psub'".');">Select</a></td></tr>';
+ }
+ my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
+ $r->print(<<ENDCOL);
+<script>
+
+ function pclose() {
+ parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
+ "height=350,width=350,scrollbars=no,menubar=no");
+ parmwin.close();
+ }
+
+ $pjump_def
+
+ function psub() {
+ pclose();
+ if (document.parmform.pres_marker.value!='') {
+ if (document.parmform.pres_type.value!='') {
+ eval('document.prefs.'+
+ document.parmform.pres_marker.value+
+ '.value=document.parmform.pres_value.value;');
+ }
+ } else {
+ document.parmform.pres_value.value='';
+ document.parmform.pres_marker.value='';
+ }
+ }
+
+
+</script>
+<form name="parmform">
+<input type="hidden" name="pres_marker" />
+<input type="hidden" name="pres_type" />
+<input type="hidden" name="pres_value" />
+</form>
+<form name="prefs" action="/adm/preferences" method="POST">
+<input type="hidden" name="action" value="verify_and_change_colors" />
+<table border="2">
+$chtable
+</table>
+<input type="submit" value="Change Custom Colors" />
+<input type="submit" name="resetall" value="Reset All Colors to Default" />
+</form>
+ENDCOL
+}
+
+sub verify_and_change_colors {
+ my $r = shift;
+# figure out colors
+ my $function=&Apache::loncommon::get_users_function();
+ my $domain=&Apache::loncommon::determinedomain();
+ my %colortypes=('pgbg' => 'Page Background',
+ 'tabbg' => 'Header Background',
+ 'sidebg'=> 'Header Border',
+ 'font' => 'Font',
+ 'link' => 'Un-Visited Link',
+ 'vlink' => 'Visited Link',
+ 'alink' => 'Active Link');
+
+ my $message='';
+ foreach my $item (keys %colortypes) {
+ my $color=$env{'form.'.$item};
+ my $entry='color.'.$function.'.'.$item;
+ if (($color=~/^\#[0-9A-Fa-f]{6}$/) && (!$env{'form.resetall'})) {
+ &Apache::lonnet::put('environment',{$entry => $color});
+ &Apache::lonnet::appenv('environment.'.$entry => $color);
+ $message.='Set '.$colortypes{$item}.' to '.$color.'<br />';
+ } else {
+ &Apache::lonnet::del('environment',[$entry]);
+ &Apache::lonnet::delenv('environment\.'.$entry);
+ $message.='Reset '.$colortypes{$item}.'<br />';
+ }
+ }
+ $r->print(<<ENDVCCOL);
+$message
+<form name="client" action="/adm/preferences" method="POST">
+<input type="hidden" name="action" value="changecolors" />
+</form>
+ENDVCCOL
+}
+
+######################################################
+# password handler subroutines #
+######################################################
+sub passwordchanger {
+ # This function is a bit of a mess....
+ # Passwords are encrypted using londes.js (DES encryption)
+ my $r = shift;
+ my $errormessage = shift;
+ $errormessage = ($errormessage || '');
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my $homeserver = $env{'user.home'};
+ my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
+ # Check for authentication types that allow changing of the password.
+ return if ($currentauth !~ /^(unix|internal):/);
+ #
+ # Generate keys
+ my ($lkey_cpass ,$ukey_cpass ) = &des_keys();
+ my ($lkey_npass1,$ukey_npass1) = &des_keys();
+ my ($lkey_npass2,$ukey_npass2) = &des_keys();
+ # Store the keys in the log files
+ my $lonhost = $r->dir_config('lonHostID');
+ my $logtoken=Apache::lonnet::reply('tmpput:'
+ .$ukey_cpass . $lkey_cpass .'&'
+ .$ukey_npass1 . $lkey_npass1.'&'
+ .$ukey_npass2 . $lkey_npass2,
+ $lonhost);
+ # Hexify the keys for output as javascript variables
+ $ukey_cpass = hex($ukey_cpass);
+ $lkey_cpass = hex($lkey_cpass);
+ $ukey_npass1= hex($ukey_npass1);
+ $lkey_npass1= hex($lkey_npass1);
+ $ukey_npass2= hex($ukey_npass2);
+ $lkey_npass2= hex($lkey_npass2);
+ # Output javascript to deal with passwords
+ # Output DES javascript
+ {
+ my $include = $r->dir_config('lonIncludes');
+ my $jsh=Apache::File->new($include."/londes.js");
+ $r->print(<$jsh>);
+ }
+ $r->print(<<ENDFORM);
+<script language="JavaScript">
+
+ function send() {
+ uextkey=this.document.client.elements.ukey_cpass.value;
+ lextkey=this.document.client.elements.lkey_cpass.value;
+ initkeys();
+
+ this.document.pserver.elements.currentpass.value
+ =crypted(this.document.client.elements.currentpass.value);
+
+ uextkey=this.document.client.elements.ukey_npass1.value;
+ lextkey=this.document.client.elements.lkey_npass1.value;
+ initkeys();
+ this.document.pserver.elements.newpass_1.value
+ =crypted(this.document.client.elements.newpass_1.value);
+
+ uextkey=this.document.client.elements.ukey_npass2.value;
+ lextkey=this.document.client.elements.lkey_npass2.value;
+ initkeys();
+ this.document.pserver.elements.newpass_2.value
+ =crypted(this.document.client.elements.newpass_2.value);
+
+ this.document.pserver.submit();
+ }
+
+</script>
+$errormessage
+
+<p>
+<!-- We separate the forms into 'server' and 'client' in order to
+ ensure that unencrypted passwords will not be sent out by a
+ crappy browser -->
+
+<form name="pserver" action="/adm/preferences" method="POST">
+<input type="hidden" name="logtoken" value="$logtoken" />
+<input type="hidden" name="action" value="verify_and_change_pass" />
+<input type="hidden" name="currentpass" value="" />
+<input type="hidden" name="newpass_1" value="" />
+<input type="hidden" name="newpass_2" value="" />
+</form>
+
+<form name="client" >
+<table>
+<tr><td align="right"> Current password: </td>
+ <td><input type="password" name="currentpass" size="10"/> </td></tr>
+<tr><td align="right"> New password: </td>
+ <td><input type="password" name="newpass_1" size="10" /> </td></tr>
+<tr><td align="right"> Confirm password: </td>
+ <td><input type="password" name="newpass_2" size="10" /> </td></tr>
+<tr><td colspan="2" align="center">
+ <input type="button" value="Change Password" onClick="send();">
+</table>
+<input type="hidden" name="ukey_cpass" value="$ukey_cpass" />
+<input type="hidden" name="lkey_cpass" value="$lkey_cpass" />
+<input type="hidden" name="ukey_npass1" value="$ukey_npass1" />
+<input type="hidden" name="lkey_npass1" value="$lkey_npass1" />
+<input type="hidden" name="ukey_npass2" value="$ukey_npass2" />
+<input type="hidden" name="lkey_npass2" value="$lkey_npass2" />
+</form>
+</p>
+ENDFORM
+ #
+ return;
+}
+
+sub verify_and_change_password {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my $homeserver = $env{'user.home'};
+ my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
+ # Check for authentication types that allow changing of the password.
+ return if ($currentauth !~ /^(unix|internal):/);
+ #
+ my $currentpass = $env{'form.currentpass'};
+ my $newpass1 = $env{'form.newpass_1'};
+ my $newpass2 = $env{'form.newpass_2'};
+ my $logtoken = $env{'form.logtoken'};
+ # Check for empty data
+ unless (defined($currentpass) &&
+ defined($newpass1) &&
+ defined($newpass2) ){
+ &passwordchanger($r,"<p>\n<font color='#ff0000'>ERROR</font>".
+ "Password data was blank.\n</p>");
+ return;
+ }
+ # Get the keys
+ my $lonhost = $r->dir_config('lonHostID');
+ my $tmpinfo = Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
+ if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
+ # I do not a have a better idea about how to handle this
+ $r->print(<<ENDERROR);
+<p>
+<font color="#ff0000">ERROR:</font> Unable to retrieve stored token for
+password decryption. Please log out and try again.
+</p>
+ENDERROR
+ # Probably should log an error here
+ return 1;
+ }
+ my ($ckey,$n1key,$n2key)=split(/&/,$tmpinfo);
+ #
+ $currentpass = &des_decrypt($ckey ,$currentpass);
+ $newpass1 = &des_decrypt($n1key,$newpass1);
+ $newpass2 = &des_decrypt($n2key,$newpass2);
+ #
+ if ($newpass1 ne $newpass2) {
+ &passwordchanger($r,
+ '<font color="#ff0000">ERROR:</font>'.
+ 'The new passwords you entered do not match. '.
+ 'Please try again.');
+ return 1;
+ }
+ if (length($newpass1) < 7) {
+ &passwordchanger($r,
+ '<font color="#ff0000">ERROR:</font>'.
+ 'Passwords must be a minimum of 7 characters long. '.
+ 'Please try again.');
+ return 1;
+ }
+ #
+ # Check for bad characters
+ my $badpassword = 0;
+ foreach (split(//,$newpass1)) {
+ $badpassword = 1 if ((ord($_)<32)||(ord($_)>126));
+ }
+ if ($badpassword) {
+ # I can't figure out how to enter bad characters on my browser.
+ &passwordchanger($r,<<ENDERROR);
+<font color="#ff0000">ERROR:</font>
+The password you entered contained illegal characters.<br />
+Valid characters are: space and <br />
+<pre>
+!"\#$%&\'()*+,-./0123456789:;<=>?\@
+ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_\`abcdefghijklmnopqrstuvwxyz{|}~
+</pre>
+ENDERROR
+ }
+ #
+ # Change the password (finally)
+ my $result = &Apache::lonnet::changepass
+ ($user,$domain,$currentpass,$newpass1,$homeserver);
+ # Inform the user the password has (not?) been changed
+ if ($result =~ /^ok$/) {
+ $r->print(<<"ENDTEXT");
+<h2>The password for $user was successfully changed</h2>
+ENDTEXT
+ } else {
+ # error error: run in circles, scream and shout
+ $r->print(<<ENDERROR);
+<h2><font color="#ff0000">The password for $user was not changed</font></h2>
+Please make sure your old password was entered correctly.
+ENDERROR
+ return 1;
+ }
+ return;
+}
+
+################################################################
+# discussion display subroutines
+################################################################
+sub discussionchanger {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my %userenv = &Apache::lonnet::get
+ ('environment',['discdisplay','discmarkread']);
+ my $discdisp = 'allposts';
+ my $discmark = 'onmark';
+
+ if (defined($userenv{'discdisplay'})) {
+ unless ($userenv{'discdisplay'} eq '') {
+ $discdisp = $userenv{'discdisplay'};
+ }
+ }
+ if (defined($userenv{'discmarkread'})) {
+ unless ($userenv{'discdisplay'} eq '') {
+ $discmark = $userenv{'discmarkread'};
+ }
+ }
+
+ my $newdisp = 'unread';
+ my $newmark = 'ondisp';
+
+ my $function = &Apache::loncommon::get_users_function();
+ my $color = &Apache::loncommon::designparm($function.'.tabbg',
+ $env{'user.domain'});
+ my %lt = &Apache::lonlocal::texthash(
+ 'pref' => 'Display Preference',
+ 'curr' => 'Current setting ',
+ 'actn' => 'Action',
+ 'sdpf' => 'Set display preferences for discussion posts for both bulletin boards and individual resources in all your courses.',
+ 'prca' => 'Preferences can be set that determine',
+ 'whpo' => 'Which posts are displayed when you display a bulletin board or resource, and',
+ 'unwh' => 'Under what circumstances posts are identfied as "New"',
+ 'allposts' => 'All posts',
+ 'unread' => 'New posts only',
+ 'ondisp' => 'Once displayed',
+ 'onmark' => 'Once marked as read',
+ 'disa' => 'Posts displayed?',
+ 'npmr' => 'New posts cease to be identified as "New"?',
+ 'thde' => 'The preferences you set here can be overridden within each individual discussion.',
+ 'chgt' => 'Change to '
+ );
+ my $dispchange = $lt{'unread'};
+ my $markchange = $lt{'ondisp'};
+ my $currdisp = $lt{'allposts'};
+ my $currmark = $lt{'onmark'};
+
+ if ($discdisp eq 'unread') {
+ $dispchange = $lt{'allposts'};
+ $currdisp = $lt{'unread'};
+ $newdisp = 'allposts';
+ }
+
+ if ($discmark eq 'ondisp') {
+ $markchange = $lt{'onmark'};
+ $currmark = $lt{'ondisp'};
+ $newmark = 'onmark';
+ }
+
+ $r->print(<<"END");
+<form name="prefs" action="/adm/preferences" method="POST">
+<input type="hidden" name="action" value="verify_and_change_discussion" />
+<br />
+$lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
+<br />
+<br />
+<table border="0" cellpadding="0" cellspacing="0">
+ <tr>
+ <td width="100%" bgcolor="#000000">
+ <table width="100%" border="0" cellpadding="1" cellspacing="0">
+ <tr>
+ <td width="100%" bgcolor="#000000">
+ <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
+ <tr bgcolor="$color">
+ <td><b>$lt{'pref'}</b></td>
+ <td><b>$lt{'curr'}</b></td>
+ <td><b>$lt{'actn'}?</b></td>
+ </tr>
+ <tr bgcolor="#dddddd">
+ <td>$lt{'disa'}</td>
+ <td>$lt{$discdisp}</td>
+ <td><input type="checkbox" name="discdisp" /><input type="hidden" name="newdisp" value="$newdisp" /> $lt{'chgt'} "$dispchange"</td>
+ </tr><tr bgcolor="#eeeeee">
+ <td>$lt{'npmr'}</td>
+ <td>$lt{$discmark}</td>
+ <td><input type="checkbox" name="discmark" /><input type="hidden" name="newmark" value="$newmark" /> $lt{'chgt'} "$markchange"</td>
+ </tr>
+ </table>
+ </td>
+ </tr>
+ </table>
+ </td>
+</tr>
+</table>
+<br />
+<br />
+<input type="submit" name="sub" value="Store Changes" />
+<br />
+<br />
+Note: $lt{'thde'}
+</form>
+END
+}
+
+sub verify_and_change_discussion {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my $message='';
+ if (defined($env{'form.discdisp'}) ) {
+ my $newdisp = $env{'form.newdisp'};
+ if ($newdisp eq 'unread') {
+ $message .='In discussions: only new posts will be displayed.<br/>';
+ &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
+ &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
+ } else {
+ $message .= 'In discussions: all posts will be displayed.<br/>';
+ &Apache::lonnet::del('environment',['discdisplay']);
+ &Apache::lonnet::delenv('environment\.discdisplay');
+ }
+ }
+ if (defined($env{'form.discmark'}) ) {
+ my $newmark = $env{'form.newmark'};
+ if ($newmark eq 'ondisp') {
+ $message.='In discussions: new posts will be cease to be identified as "new" after display.<br/>';
+ &Apache::lonnet::put('environment',{'discmarkread' => $newmark});
+ &Apache::lonnet::appenv('environment.discmarkread' => $newmark);
+ } else {
+ $message.='In discussions: posts will be identified as "new" until marked as read by the reader.<br/>';
+ &Apache::lonnet::del('environment',['discmarkread']);
+ &Apache::lonnet::delenv('environment\.discmarkread');
+ }
+ }
+ $r->print(<<ENDVCSCREEN);
+$message
+ENDVCSCREEN
+}
+
+################################################################
+# Subroutines for page display on course access (Course Coordinators)
+################################################################
+sub coursedisplaychanger {
+ my $r = shift;
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ my %userenv = &Apache::lonnet::get('environment',['course_init_display']);
+ my $currvalue = 'whatsnew';
+ my $firstselect = '';
+ my $whatsnewselect = 'checked="checked"';
+ if (exists($userenv{'course_init_display'})) {
+ if ($userenv{'course_init_display'} eq 'firstres') {
+ $currvalue = 'firstres';
+ $firstselect = 'checked="checked"';
+ $whatsnewselect = '';
+ }
+ }
+ my %pagenames = (
+ firstres => 'First resource',
+ whatsnew => "What's new page",
+ );
+ my $whatsnew_off=&mt('Display the [_1] in the course.','<b>first resource</b>');
+ my $whatsnew_on=&mt('Display the "[_1]" page - a summary of items in the course which require attention.',"<b>What's New</b>");
+
+ $r->print('<br /><b>'.&mt('Set the default page to be displayed when you select a course role').'</b> '.&mt('(Currently: [_1])',$pagenames{$currvalue}).'<br />'.&mt('The global user preference you set for your courses can be overridden in an individual course by setting a course specific setting via the "[_1]" page in the course',"<i>What's New</i>").'<br /><br />');
+ $r->print(<<ENDLSCREEN);
+<form name="prefs" action="/adm/preferences" method="POST">
+<input type="hidden" name="action" value="verify_and_change_coursepage" />
+<br />
+<label><input type="radio" name="newdisp" value="firstres" $firstselect /> $whatsnew_off</label><br />
+<label><input type="radio" name="newdisp" value="whatsnew" $whatsnewselect /> $whatsnew_on</label><input type="hidden" name="refpage" value="$env{'form.refpage'}" />
+ENDLSCREEN
+ $r->print('<br /><br /><input type="submit" value="'.&mt('Change').'" />
+</form>');
+}
+
+sub verify_and_change_coursepage {
+ my $r = shift;
+ my $message='';
+ my %lt = &Apache::lonlocal::texthash(
+ 'defs' => 'Default now set',
+ 'when' => 'when you select a course role from the roles screen',
+ 'ywbt' => 'you will be taken to the start of the course.',
+ 'apwb' => 'a page will be displayed that lists items in the course that may require action from you.',
+ 'gtts' => 'Go to the start of the course',
+ 'dasp' => "Display the What's New page listing course action items",
+ );
+ my $newdisp = $env{'form.newdisp'};
+ $message = '<b>'.$lt{'defs'}.'</b>: '.$lt{'when'}.', ';
+ if ($newdisp eq 'firstres') {
+ $message .= $lt{'ywbt'}.'<br/>';
+ &Apache::lonnet::put('environment',{'course_init_display' => $newdisp});
+ &Apache::lonnet::appenv('environment.course_init_display' => $newdisp);
+ } else {
+ $message .= $lt{'apwb'}.'<br/>';
+ &Apache::lonnet::del('environment',['course_init_display']);
+ &Apache::lonnet::delenv('environment\.course_init_display');
+ }
+ my $refpage = $env{'form.refpage'};
+ if (($env{'request.course.fn'}) && ($env{'request.course.id'})) {
+ if ($newdisp eq 'firstres') {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my ($furl,$ferr)=
+ &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
+ $message .= '<br /><font size="+1"><a href="'.$furl.'">'.$lt{'gtts'}.' <i>'.&mt('now').'</i></a></font>';
+ } else {
+ $message .= '<br /><font size="+1"><a href="/adm/whatsnew?refpage='.
+ $refpage.'">'.$lt{'dasp'}.'</a></font>';
+ }
+ }
+ $r->print(<<ENDVCSCREEN);
+$message
+<br /><br />
+ENDVCSCREEN
+}
+
+
+######################################################
+# other handler subroutines #
+######################################################
+
+################################################################
+# Main handler #
+################################################################
sub handler {
my $r = shift;
- $r->content_type('text/html');
+ my $user = $env{'user.name'};
+ my $domain = $env{'user.domain'};
+ &Apache::loncommon::content_type($r,'text/html');
+ # Some pages contain DES keys and should not be cached.
+ &Apache::loncommon::no_cache($r);
$r->send_http_header;
return OK if $r->header_only;
+ #
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['action','wysiwyg','returnurl','refpage']);
+ #
+ &Apache::lonhtmlcommon::clear_breadcrumbs();
+ &Apache::lonhtmlcommon::add_breadcrumb
+ ({href => '/adm/preferences',
+ text => 'Set User Preferences'});
-# --------------------------------------------------- Print login screen header
- $r->print(<<ENDDOCUMENT);
-<html>
-<head>
-<title>The LearningOnline Network with CAPA</title>
-</head>
-<body bgcolor="#FFFFFF">
-<h1>Preferences</h1>
-<img src="/adm/lonKaputt/lonconstruct.gif">
-</body>
-</html>
-ENDDOCUMENT
+ my @Options;
+ # Determine current authentication method
+ my $currentauth=&Apache::lonnet::queryauthenticate($user,$domain);
+ if ($currentauth =~ /^(unix|internal):/) {
+ push (@Options,({ action => 'changepass',
+ linktext => 'Change Password',
+ href => '/adm/preferences',
+ help => 'Change_Password',
+ subroutine => \&passwordchanger,
+ breadcrumb =>
+ { href => '/adm/preferences?action=changepass',
+ text => 'Change Password'},
+ },
+ { action => 'verify_and_change_pass',
+ subroutine => \&verify_and_change_password,
+ breadcrumb =>
+ { href =>'/adm/preferences?action=changepass',
+ text => 'Change Password'},
+ printmenu => 'not_on_error',
+ }));
+ }
+ push (@Options,({ action => 'changescreenname',
+ linktext => 'Change Screen Name',
+ href => '/adm/preferences',
+ help => 'Prefs_Screen_Name_Nickname',
+ subroutine => \&screennamechanger,
+ breadcrumb =>
+ { href => '/adm/preferences?action=changescreenname',
+ text => 'Change Screen Name'},
+ },
+ { action => 'verify_and_change_screenname',
+ subroutine => \&verify_and_change_screenname,
+ breadcrumb =>
+ { href => '/adm/preferences?action=changescreenname',
+ text => 'Change Screen Name'},
+ printmenu => 'yes',
+ }));
+
+ push (@Options,({ action => 'changemsgforward',
+ linktext => 'Change Message Forwarding and Notification Addresses',
+ href => '/adm/preferences',
+ help => 'Prefs_Forwarding',
+ breadcrumb =>
+ { href => '/adm/preferences?action=changemsgforward',
+ text => 'Change Message Forwarding'},
+ subroutine => \&msgforwardchanger,
+ },
+ { action => 'verify_and_change_msgforward',
+ breadcrumb =>
+ { href => '/adm/preferences?action=changemsgforward',
+ text => 'Change Message Forwarding'},
+ printmenu => 'yes',
+ subroutine => \&verify_and_change_msgforward }));
+ my $aboutmeaction=
+ '/adm/'.$env{'user.domain'}.'/'.$env{'user.name'}.'/aboutme';
+ push (@Options,{ action => 'none',
+ linktext =>
+ q{Edit the 'About Me' Personal Information Screen},
+ help => 'Prefs_About_Me',
+ href => $aboutmeaction});
+ push (@Options,({ action => 'changecolors',
+ linktext => 'Change Color Scheme',
+ href => '/adm/preferences',
+ help => 'Change_Colors',
+ breadcrumb =>
+ { href => '/adm/preferences?action=changecolors',
+ text => 'Change Colors'},
+ subroutine => \&colorschanger,
+ },
+ { action => 'verify_and_change_colors',
+ breadcrumb =>
+ { href => '/adm/preferences?action=changecolors',
+ text => 'Change Colors'},
+ printmenu => 'yes',
+ subroutine => \&verify_and_change_colors,
+ }));
+ push (@Options,({ action => 'changelanguages',
+ linktext => 'Change Language Preferences',
+ href => '/adm/preferences',
+ help => 'Prefs_Language',
+ breadcrumb=>
+ { href => '/adm/preferences?action=changelanguages',
+ text => 'Change Language'},
+ subroutine => \&languagechanger,
+ },
+ { action => 'verify_and_change_languages',
+ breadcrumb=>
+ {href => '/adm/preferences?action=changelanguages',
+ text => 'Change Language'},
+ printmenu => 'yes',
+ subroutine=>\&verify_and_change_languages, }
+ ));
+ push (@Options,({ action => 'changewysiwyg',
+ linktext => 'Change WYSIWYG Editor Preferences',
+ href => '/adm/preferences',
+ breadcrumb =>
+ { href => '/adm/preferences?action=changewysiwyg',
+ text => 'Change WYSIWYG Preferences'},
+ subroutine => \&wysiwygchanger,
+ },
+ { action => 'set_wysiwyg',
+ breadcrumb =>
+ { href => '/adm/preferences?action=changewysiwyg',
+ text => 'Change WYSIWYG Preferences'},
+ printmenu => 'yes',
+ subroutine => \&verify_and_change_wysiwyg, }
+ ));
+ push (@Options,({ action => 'changediscussions',
+ linktext => 'Change Discussion Display Preferences',
+ href => '/adm/preferences',
+ help => 'Change_Discussion_Display',
+ breadcrumb =>
+ { href => '/adm/preferences?action=changediscussions',
+ text => 'Change Discussion Preferences'},
+ subroutine => \&discussionchanger,
+ },
+ { action => 'verify_and_change_discussion',
+ breadcrumb =>
+ { href => '/adm/preferences?action=changediscussions',
+ text => 'Change Discussion Preferences'},
+ printmenu => 'yes',
+ subroutine => \&verify_and_change_discussion, }
+ ));
+
+ push (@Options,({ action => 'changerolespref',
+ linktext => 'Change Roles Page Preferences',
+ href => '/adm/preferences',
+ subroutine => \&rolesprefchanger,
+ breadcrumb =>
+ { href => '/adm/preferences?action=changerolespref',
+ text => 'Change Roles Pref'},
+ },
+ { action => 'verify_and_change_rolespref',
+ subroutine => \&verify_and_change_rolespref,
+ breadcrumb =>
+ { href => '/adm/preferences?action=changerolespref',
+ text => 'Change Roles Preferences'},
+ printmenu => 'yes',
+ }));
+
+ push (@Options,({ action => 'changetexenginepref',
+ linktext => 'Change How Math Equations Are Displayed',
+ href => '/adm/preferences',
+ subroutine => \&texenginechanger,
+ breadcrumb =>
+ { href => '/adm/preferences?action=changetexenginepref',
+ text => 'Change Math Pref'},
+ },
+ { action => 'verify_and_change_texengine',
+ subroutine => \&verify_and_change_texengine,
+ breadcrumb =>
+ { href => '/adm/preferences?action=changetexenginepref',
+ text => 'Change Math Preferences'},
+ printmenu => 'yes',
+ }));
+ if (&Apache::lonnet::allowed('whn',$env{'request.course.id'})
+ || &Apache::lonnet::allowed('whn',$env{'request.course.id'}.'/'
+ .$env{'request.course.sec'})) {
+ push (@Options,({ action => 'changecourseinit',
+ linktext => 'Change Course Initialization Preference',
+ href => '/adm/preferences',
+ subroutine => \&coursedisplaychanger,
+ breadcrumb =>
+ { href => '/adm/preferences?action=changecourseinit',
+ text => 'Change Course Init. Pref.'},
+ },
+ { action => 'verify_and_change_coursepage',
+ breadcrumb =>
+ { href => '/adm/preferences?action=changecourseinit', text => 'Change Course Initialization Preference'},
+ printmenu => 'yes',
+ subroutine => \&verify_and_change_coursepage,
+ }));
+ }
+
+ if ($env{'user.name'} =~ /^(albertel|fox|foxr|koretemey|korte|hallmat3|turtle|raeburn)$/) {
+ push (@Options,({ action => 'debugtoggle',
+ printmenu => 'yes',
+ subroutine => \&toggle_debug,
+ }));
+ }
+
+ $r->print(&Apache::loncommon::start_page('Change Preferences'));
+
+ my $call = undef;
+ my $help = undef;
+ my $printmenu = 'yes';
+ foreach my $option (@Options) {
+ if ($option->{'action'} eq $env{'form.action'}) {
+ $call = $option->{'subroutine'};
+ $printmenu = $option->{'printmenu'};
+ if (exists($option->{'breadcrumb'})) {
+ &Apache::lonhtmlcommon::add_breadcrumb
+ ($option->{'breadcrumb'});
+ }
+ $help=$option->{'help'};
+ }
+ }
+ $r->print(&Apache::lonhtmlcommon::breadcrumbs
+ (undef,'Change Preferences',$help));
+ my $error;
+ if (defined($call)) {
+ $error = $call->($r);
+ }
+ if ( ( ($printmenu eq 'yes')
+ || ($printmenu eq 'not_on_error' && !$error) )
+ && (!$env{'form.returnurl'})) {
+ my $optionlist = '<table cellpadding="5">';
+ if ($env{'user.name'} =~
+ /^(albertel|kortemey|fox|foxr|korte|hallmat3|turtle|raeburn)$/
+ ) {
+ push (@Options,({ action => 'debugtoggle',
+ linktext => 'Toggle Debug Messages',
+ text => 'Current Debug status is -'.
+ $env{'user.debug'}.'-.',
+ href => '/adm/preferences',
+ printmenu => 'yes',
+ subroutine => \&toggle_debug,
+ }));
+ }
+ foreach my $option(@Options) {
+ my $optiontext = '';
+ if (exists($option->{'href'})) {
+ $optiontext .=
+ '<a href="'.$option->{'href'}.
+ '?action='.$option->{'action'}.'">'.
+ &mt($option->{'linktext'}).'</a>';
+ }
+ if (exists($option->{'text'})) {
+ $optiontext .= ' '.&mt($option->{'text'});
+ }
+ if ($optiontext ne '') {
+ $optiontext = '<font size="+1">'.$optiontext.'</font>';
+ my $helplink = ' ';
+ if (exists($option->{'help'})) {
+ $helplink = &Apache::loncommon::help_open_topic
+ ($option->{'help'});
+ }
+ $optionlist .= '<tr>'.
+ '<td>'.$helplink.'</td>'.
+ '<td>'.$optiontext.'</td>'.
+ '</tr>';
+ }
+ }
+ $optionlist .= '</table>';
+ $r->print($optionlist);
+ } elsif ($env{'form.returnurl'}) {
+ $r->print('<br /><a href="'.$env{'form.returnurl'}.'"><font size="+1">'.
+ &mt('Return').'</font></a>');
+ }
+ $r->print(&Apache::loncommon::end_page());
return OK;
-}
+}
+
+sub toggle_debug {
+ if ($env{'user.debug'}) {
+ &Apache::lonnet::delenv('user\.debug');
+ } else {
+ &Apache::lonnet::appenv('user.debug' => 1);
+ }
+}
1;
__END__