'.&mt('Some LON-CAPA users have a long list of roles. The Recent Roles Hotlist feature keeps track of the last N roles which have been visited and places a table of these at the top of the roles page. People with very few roles should leave this feature disabled.').'
+
+');
+}
+
+sub rolespref_get_role_text {
+# Get a line of text for each role
+ my ($roles) = @_;
+ my %roletext = ();
+
+ foreach my $item (@$roles) {
+# get course information
+ my ($role,$rest) = split(/\./, $item);
+ my $trole = "";
+ $trole = &Apache::lonnet::plaintext($role);
+ my ($tdomain,$other,$tsection)= split(/\//,Apache::lonnet::declutter($rest));
+ my $tother = '-';
+ if ($role =~ /^(cc|st|in|ta|ep|cr)/ ) {
+ my %newhash=&Apache::lonnet::coursedescription($tdomain."_".$other);
+ $tother = " - ".$newhash{'description'};
+ } elsif ($role =~ /dc/) {
+ $tother = "";
+ } else {
+ $tother = " - $other";
+ }
+
+ my $section="";
+ if ($tsection) {
+ $section = " - Section/Group: $tsection";
+ }
+ $roletext{$item} = $tdomain." - ".$trole.$tother.$section;
+ }
+ return %roletext;
+}
+
+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=&mt('Recent Roles Hotlist is Enabled');
+ } else {
+ &Apache::lonnet::del('environment',['recentroles']);
+ &Apache::lonnet::delenv('environment\.recentroles');
+ $message=&mt('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.=" ".
+ &mt('Display [_1] Most Recent Roles',$hotlist_n)."\n";
+ }
+ }
+
+# Get list of froze roles and list of recent roles
+ my @freeze_list = &Apache::loncommon::get_env_multiple('form.freezeroles');
+ my %freeze = ();
+ my %roletext = ();
+
+ foreach my $key (@freeze_list) {
+ $freeze{$key}='1';
+ }
+
+ my %recent_roles =
+ &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
+ my %frozen_roles =
+ &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
+ my %role_text = &rolespref_get_role_text([keys(%recent_roles)]);
+
+# Unset any roles that were previously frozen but aren't in list
+ foreach my $role_key (sort(keys(%recent_roles))) {
+ if (($frozen_roles{$role_key}) && (!exists($freeze{$role_key}))) {
+ $message .= " ".&mt('Unfreezing Role: [_1]',$role_text{$role_key})."\n";
+ &Apache::lonhtmlcommon::store_recent('roles',$role_key,' ',0);
+ }
+ }
+
+# Freeze selected roles
+ foreach my $role_key (@freeze_list) {
+ if (!$frozen_roles{$role_key}) {
+ $message .= " ".&mt('Freezing Role: [_1]',$role_text{$role_key})."\n";
+ &Apache::lonhtmlcommon::store_recent('roles',
+ $role_key,' ',1);
+ }
+ }
+ $message .= " \n";
+
+ $r->print(<print(<
+
+ New screenname (shown if you post anonymously):
+
+ New nickname (shown if you post non-anonymously):
+
+
+
+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.=' ';
+ $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(<print(<
+
+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.' ';
+ }
+ }
+ }
+ $newscreen=~s/\,$//;
+ if ($newscreen) {
+ &Apache::lonnet::put('environment',{'msgforward' => $newscreen});
+ &Apache::lonnet::appenv('environment.msgforward' => $newscreen);
+ $message.='Set new message forwarding to '.$newscreen.' ';
+ } else {
+ &Apache::lonnet::del('environment',['msgforward']);
+ &Apache::lonnet::delenv('environment\.msgforward');
+ $message.='Reset message forwarding ';
+ }
+ 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.' ';
+ } else {
+ &Apache::lonnet::del('environment',['notification']);
+ &Apache::lonnet::delenv('environment\.notification');
+ $message.='Reset message notification ';
+ }
+ 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 ';
+ }
+ $r->print(< 'Page Background',
+ 'tabbg' => 'Header Background',
+ 'sidebg'=> 'Header Border',
+ 'font' => 'Font',
+ 'link' => 'Un-Visited Link',
+ 'vlink' => 'Visited Link',
+ 'alink' => 'Active Link');
+ my $start_data_table = &Apache::loncommon::start_data_table();
+ my $chtable='';
+ foreach my $item (sort(keys(%colortypes))) {
+ my $curcol=&Apache::loncommon::designparm($function.'.'.$item,$domain);
+ $chtable.=&Apache::loncommon::start_data_table_row().
+ '
'.
+ &Apache::loncommon::end_data_table_row()."\n";
+ }
+ my $end_data_table = &Apache::loncommon::end_data_table();
+ my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
+ $r->print(<
+
+ 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='';
+ }
+ }
+
+
+
+
+
+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.' ';
+ } else {
+ &Apache::lonnet::del('environment',[$entry]);
+ &Apache::lonnet::delenv('environment\.'.$entry);
+ $message.='Reset '.$colortypes{$item}.' ';
+ }
+ }
+ my $now = time;
+ &Apache::lonnet::put('environment',{'color.timestamp' => $now});
+ &Apache::lonnet::appenv('environment.color.timestamp' => $now);
+
+ $r->print(<
+
+
+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(<
+
+ 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();
+ }
+
+
+$errormessage
+
+
+
+
+
+
+
+
+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,"
\nERROR".
+ "Password data was blank.\n
");
+ 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(<
+ERROR: Unable to retrieve stored token for
+password decryption. Please log out and try again.
+
+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,
+ 'ERROR:'.
+ 'The new passwords you entered do not match. '.
+ 'Please try again.');
+ return 1;
+ }
+ if (length($newpass1) < 7) {
+ &passwordchanger($r,
+ 'ERROR:'.
+ '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,<ERROR:
+The password you entered contained illegal characters.
+Valid characters are: space and
+
+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");
+
The password for $user was successfully changed
+ENDTEXT
+ } else {
+ # error error: run in circles, scream and shout
+ $r->print(<The password for $user was not changed
+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");
+
+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. ';
+ &Apache::lonnet::put('environment',{'discdisplay' => $newdisp});
+ &Apache::lonnet::appenv('environment.discdisplay' => $newdisp);
+ } else {
+ $message .= 'In discussions: all posts will be displayed. ';
+ &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. ';
+ &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. ';
+ &Apache::lonnet::del('environment',['discmarkread']);
+ &Apache::lonnet::delenv('environment\.discmarkread');
+ }
+ }
+ $r->print(< 'First resource',
+ whatsnew => "What's new page",
+ );
+ my $whatsnew_off=&mt('Display the [_1] in the course.','first resource');
+ my $whatsnew_on=&mt('Display the "[_1]" page - a summary of items in the course which require attention.',"What's New");
+
+ $r->print(' '.&mt('Set the default page to be displayed when you select a course role').' '.&mt('(Currently: [_1])',$pagenames{$currvalue}).' '.&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',"What's New").'