Annotation of loncom/interface/lonpreferences.pm, revision 1.106

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>