Annotation of loncom/auth/lonroles.pm, revision 1.157

1.1       harris41    1: # The LearningOnline Network with CAPA
                      2: # User Roles Screen
1.31      www         3: #
1.157   ! albertel    4: # $Id: lonroles.pm,v 1.156 2006/06/07 20:07:09 albertel Exp $
1.31      www         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.32      harris41   28: ###
1.22      harris41   29: 
1.1       harris41   30: package Apache::lonroles;
                     31: 
                     32: use strict;
1.118     albertel   33: use Apache::lonnet;
1.7       www        34: use Apache::lonuserstate();
1.1       harris41   35: use Apache::Constants qw(:common);
1.2       www        36: use Apache::File();
1.26      www        37: use Apache::lonmenu;
1.29      albertel   38: use Apache::loncommon;
1.104     raeburn    39: use Apache::lonhtmlcommon;
1.57      www        40: use Apache::lonannounce;
1.72      www        41: use Apache::lonlocal;
1.151     www        42: use Apache::lonpageflip();
1.120     albertel   43: use GDBM_File;
1.149     www        44: use LONCAPA;
                     45:  
1.1       harris41   46: 
1.62      matthew    47: sub redirect_user {
1.95      albertel   48:     my ($r,$title,$url,$msg,$launch_nav) = @_;
1.62      matthew    49:     $msg = $title if (! defined($msg));
1.73      www        50:     &Apache::loncommon::content_type($r,'text/html');
1.62      matthew    51:     &Apache::loncommon::no_cache($r);
                     52:     $r->send_http_header;
                     53:     my $swinfo=&Apache::lonmenu::rawconfig();
1.96      albertel   54:     my $navwindow;
1.95      albertel   55:     if ($launch_nav eq 'on') {
1.128     albertel   56: 	$navwindow.=&Apache::lonnavmaps::launch_win('now',undef,undef,
1.140     raeburn    57: 						  ($url =~ m-^/adm/whatsnew-));
1.96      albertel   58:     } else {
                     59: 	$navwindow.=&Apache::lonnavmaps::close();
1.95      albertel   60:     }
1.147     albertel   61:     my $start_page = &Apache::loncommon::start_page('Switching Role',undef,
                     62: 						    {'redirect' => [1,$url],});
                     63:     my $end_page   = &Apache::loncommon::end_page();
                     64: 
1.92      www        65: # Note to style police: 
                     66: # This must only replace the spaces, nothing else, or it bombs elsewhere.
                     67:     $url=~s/ /\%20/g;
1.93      albertel   68:     $r->print(<<ENDREDIR);
1.147     albertel   69: $start_page
1.96      albertel   70: <script type="text/javascript">
1.62      matthew    71: $swinfo
                     72: </script>
1.96      albertel   73: $navwindow
1.62      matthew    74: <h1>$msg</h1>
1.147     albertel   75: $end_page
1.62      matthew    76: ENDREDIR
                     77:     return;
                     78: }
                     79: 
1.150     www        80: sub error_page {
                     81:     my ($r,$error,$dest)=@_;
                     82:     &Apache::loncommon::content_type($r,'text/html');
                     83:     &Apache::loncommon::no_cache($r);
                     84:     $r->send_http_header;
                     85:     return OK if $r->header_only;
                     86:     $r->print(&Apache::loncommon::start_page('Problems during Course Initialization').
                     87: 	      '<script type="text/javascript">'.
                     88: 	      &Apache::lonmenu::rawconfig().'</script>'.
                     89: 	      '<p>'.&mt('The following problems occurred:').
                     90: 	      $error.
1.156     albertel   91: 	      '</p><br /><a href="'.$dest.'">'.&mt('Continue').'</a>'.
1.150     www        92: 	      &Apache::loncommon::end_page());
                     93: }
                     94: 
1.1       harris41   95: sub handler {
1.10      www        96: 
1.1       harris41   97:     my $r = shift;
                     98: 
1.6       www        99:     my $now=time;
1.118     albertel  100:     my $then=$env{'user.login.time'};
1.6       www       101:     my $envkey;
1.107     raeburn   102:     my %dcroles = ();
                    103:     my $numdc = &check_fordc(\%dcroles,$then);
1.148     albertel  104:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.10      www       105: 
1.6       www       106: # ================================================================== Roles Init
1.118     albertel  107:     if ($env{'form.selectrole'}) {
1.134     www       108:         if ($env{'form.newrole'}) {
                    109:             $env{'form.'.$env{'form.newrole'}}=1;
                    110: 	}
1.118     albertel  111: 	if ($env{'request.course.id'}) {
                    112: 	    my %temp=('logout_'.$env{'request.course.id'} => time);
1.33      www       113: 	    &Apache::lonnet::put('email_status',\%temp);
1.118     albertel  114: 	    &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'});
1.100     albertel  115: 	}
1.55      albertel  116: 	&Apache::lonnet::appenv("request.course.id"   => '',
                    117: 				"request.course.fn"   => '',
                    118: 				"request.course.uri"  => '',
                    119: 				"request.course.sec"  => '',
                    120: 				"request.role"        => 'cm',
1.118     albertel  121:                                 "request.role.adv"    => $env{'user.adv'},
                    122: 				"request.role.domain" => $env{'user.domain'});
1.106     raeburn   123: 
1.110     raeburn   124: # Check if user is a DC trying to enter a course and needs privs to be created
1.107     raeburn   125:         if ($numdc > 0) {
1.118     albertel  126:             foreach my $envkey (keys %env) {
1.146     raeburn   127:                 if (my ($domain,$coursenum) =
                    128:                                     ($envkey =~ m-^form\.cc\./(\w+)/(\w+)$-)) {
                    129:                     if ($dcroles{$domain}) {
                    130:                         &check_privs($domain,$coursenum,$then,$now);
1.107     raeburn   131:                     }
                    132:                     last;
                    133:                 }
                    134:             }
                    135:         }
                    136: 
1.118     albertel  137:         foreach $envkey (keys %env) {
1.40      matthew   138:             next if ($envkey!~/^user\.role\./);
1.102     raeburn   139:             my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
                    140:             &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
1.118     albertel  141:             if ($env{'form.'.$trolecode}) {
1.55      albertel  142: 		if ($tstatus eq 'is') {
                    143: 		    $where=~s/^\///;
                    144: 		    my ($cdom,$cnum,$csec)=split(/\//,$where);
1.137     raeburn   145: # check for course groups
                    146:                     my %coursegroups = &Apache::lonnet::get_active_groups(
                    147:                           $env{'user.domain'},$env{'user.name'},$cdom, $cnum);
                    148:                     my $cgrps = join(':',keys(%coursegroups));
                    149: 
1.111     albertel  150: # store role if recent_role list being kept
1.118     albertel  151:                     if ($env{'environment.recentroles'}) {
1.111     albertel  152: 			&Apache::lonhtmlcommon::store_recent('roles',
                    153: 							     $trolecode,' ');
                    154:                     }
                    155: 
                    156: 
1.53      www       157: # check for keyed access
1.55      albertel  158: 		    if (($role eq 'st') && 
1.118     albertel  159:                        ($env{'course.'.$cdom.'_'.$cnum.'.keyaccess'} eq 'yes')) {
1.89      www       160: # who is key authority?
                    161: 			my $authdom=$cdom;
                    162: 			my $authnum=$cnum;
1.118     albertel  163: 			if ($env{'course.'.$cdom.'_'.$cnum.'.keyauth'}) {
1.89      www       164: 			    ($authnum,$authdom)=
1.118     albertel  165: 				split(/\W/,$env{'course.'.$cdom.'_'.$cnum.'.keyauth'});
1.89      www       166: 			}
                    167: # check with key authority
                    168: 			unless (&Apache::lonnet::validate_access_key(
1.118     albertel  169: 				     $env{'environment.key.'.$cdom.'_'.$cnum},
1.89      www       170: 					     $authdom,$authnum)) {
1.53      www       171: # there is no valid key
1.118     albertel  172: 			     if ($env{'form.newkey'}) {
1.53      www       173: # student attempts to register a new key
1.89      www       174: 				 &Apache::loncommon::content_type($r,'text/html');
                    175: 				 &Apache::loncommon::no_cache($r);
                    176: 				 $r->send_http_header;
                    177: 				 my $swinfo=&Apache::lonmenu::rawconfig();
1.147     albertel  178: 				 my $start_page=&Apache::loncommon::start_page
1.89      www       179: 				    ('Verifying Access Key to Unlock this Course');
1.147     albertel  180: 				 my $end_page=&Apache::loncommon::end_page();
1.90      www       181: 				 my $buttontext=&mt('Enter Course');
                    182: 				 my $message=&mt('Successfully registered key');
                    183: 				 my $assignresult=
                    184: 				     &Apache::lonnet::assign_access_key(
1.118     albertel  185: 						     $env{'form.newkey'},
1.90      www       186: 						     $authdom,$authnum,
1.91      www       187: 						     $cdom,$cnum,
1.118     albertel  188:                                                      $env{'user.domain'},
                    189: 						     $env{'user.name'},
1.90      www       190: 	      'Assigned from '.$ENV{'REMOTE_ADDR'}.' at '.localtime().' for '.
                    191:                                                      $trolecode);
                    192: 				 unless ($assignresult eq 'ok') {
                    193: 				     $assignresult=~s/^error\:\s*//;
                    194: 				     $message=&mt($assignresult).
                    195: 				     '<br /><a href="/adm/logout">'.
1.89      www       196: 				     &mt('Logout').'</a>';
1.90      www       197: 				     $buttontext=&mt('Re-Enter Key');
                    198: 				 }
1.89      www       199: 				 $r->print(<<ENDENTEREDKEY);
1.147     albertel  200: $start_page
1.89      www       201: <script>
                    202: $swinfo
                    203: </script>
                    204: <form method="post">
                    205: <input type="hidden" name="selectrole" value="1" />
                    206: <input type="hidden" name="$trolecode" value="1" />
1.90      www       207: <font size="+2">$message</font><br />
1.89      www       208: <input type="submit" value="$buttontext" />
                    209: </form>
1.147     albertel  210: $end_page
1.89      www       211: ENDENTEREDKEY
                    212:                                  return OK;
1.55      albertel  213: 			     } else {
1.53      www       214: # print form to enter a new key
1.73      www       215: 				 &Apache::loncommon::content_type($r,'text/html');
1.55      albertel  216: 				 &Apache::loncommon::no_cache($r);
                    217: 				 $r->send_http_header;
                    218: 				 my $swinfo=&Apache::lonmenu::rawconfig();
1.147     albertel  219: 				 my $start_page=&Apache::loncommon::start_page
1.55      albertel  220: 				    ('Enter Access Key to Unlock this Course');
1.147     albertel  221: 				 my $end_page=&Apache::loncommon::end_page();
1.55      albertel  222: 				 $r->print(<<ENDENTERKEY);
1.147     albertel  223: $start_page
1.53      www       224: <script>
                    225: $swinfo
                    226: </script>
                    227: <form method="post">
1.89      www       228: <input type="hidden" name="selectrole" value="1" />
                    229: <input type="hidden" name="$trolecode" value="1" />
1.118     albertel  230: <input type="text" size="20" name="newkey" value="$env{'form.newkey'}" />
1.53      www       231: <input type="submit" value="Enter key" />
                    232: </form>
1.147     albertel  233: $end_page
1.53      www       234: ENDENTERKEY
1.55      albertel  235: 				 return OK;
                    236: 			     }
                    237: 			 }
                    238: 		     }
1.118     albertel  239: 		    &Apache::lonnet::log($env{'user.domain'},
                    240: 					 $env{'user.name'},
                    241: 					 $env{'user.home'},
1.87      www       242: 					 "Role ".$trolecode);
1.101     albertel  243: 		    
1.56      www       244: 		    &Apache::lonnet::appenv(
1.101     albertel  245: 					   'request.role'        => $trolecode,
1.56      www       246: 					   'request.role.domain' => $cdom,
1.137     raeburn   247: 					   'request.course.sec'  => $csec,
                    248:                                            'request.course.groups' => $cgrps);
1.101     albertel  249:                     my $tadv=0;
1.62      matthew   250: 
1.125     www       251: 		    if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {
1.152     raeburn   252:                         my $msg;
1.55      albertel  253: 			my ($furl,$ferr)=
                    254: 			    &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
1.118     albertel  255: 			if (($env{'form.orgurl'}) && 
                    256: 			    ($env{'form.orgurl'}!~/^\/adm\/flip/)) {
                    257: 			    my $dest=$env{'form.orgurl'};
1.117     albertel  258: 			    if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
                    259: 			    &Apache::lonnet::appenv('request.role.adv'=>$tadv);
1.150     www       260:                             if (($ferr) && ($tadv)) {
                    261: 				&error_page($r,$ferr,$dest);
                    262: 			    } else {
                    263: 				$r->internal_redirect($dest);
                    264: 			    }
1.55      albertel  265: 			    return OK;
                    266: 			} else {
1.152     raeburn   267:                             my $type = 'Course/Group';
1.155     albertel  268: 			    if (!$env{'request.course.id'}) {
1.157   ! albertel  269: 				$type = &Apache::loncommon::course_type();
1.55      albertel  270: 				&Apache::lonnet::appenv(
                    271: 				      "request.course.id"  => $cdom.'_'.$cnum);
1.61      www       272: 				$furl='/adm/roles?tryagain=1';
1.55      albertel  273: 				$msg=
1.157   ! albertel  274: 				    '<h1><span class="LC_error">'.
        !           275: 				    &mt('Could not initialize '.lc($type).' at this time.').
        !           276: 				    '</span></h1><h3>'.&mt('Please try again.').'</h3>'.$ferr;
1.55      albertel  277: 			    }
1.117     albertel  278: 			    if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
                    279: 			    &Apache::lonnet::appenv('request.role.adv'=>$tadv);
1.152     raeburn   280: 
1.150     www       281: 			    if (($ferr) && ($tadv)) {
                    282: 				&error_page($r,$ferr,$furl);
                    283: 			    } else {
                    284: 				# Check to see if the user is a CC entering a course 
                    285: 				# for the first time
                    286: 				my (undef, undef, $role, $courseid) = split(/\./, $envkey);
                    287: 				if (substr($courseid, 0, 1) eq '/') {
                    288: 				    $courseid = substr($courseid, 1);
                    289: 				}
                    290: 				$courseid =~ s/\//_/;
                    291: 				if ($role eq 'cc' && $env{'course.' . $courseid . 
                    292: 							      '.course.helper.not.run'}) {
                    293: 				    $furl = "/adm/helper/course.initialization.helper";
                    294: 				    # Send the user to the course they selected
                    295: 				} elsif ($env{'request.course.id'}) {
                    296: 				    if (&Apache::lonnet::allowed('whn',
                    297: 								 $env{'request.course.id'})
                    298: 					|| &Apache::lonnet::allowed('whn',
                    299: 								    $env{'request.course.id'}.'/'
                    300: 								    .$env{'request.course.sec'})
                    301: 					) {
                    302: 					my $startpage = &courseloadpage($courseid);
                    303: 					unless ($startpage eq 'firstres') {         
1.157   ! albertel  304: 					    $msg = &mt('Entering '.lc($type).' ....');
1.150     www       305: 					    &redirect_user($r,&mt('New in course'),
                    306: 							   '/adm/whatsnew?refpage=start',$msg,
                    307: 							   $env{'environment.remotenavmap'});
                    308: 					    return OK;
                    309: 					}
                    310: 				    }
                    311: 				}
1.151     www       312: # Are we allowed to look at the first resource?
                    313: 				if (!&Apache::lonnet::allowed('bre',$furl)) {
                    314: # Guess not ...
                    315: 				    $furl=&Apache::lonpageflip::first_accessible_resource();
                    316: 				}
1.157   ! albertel  317:                                 $msg = &mt('Entering '.lc($type).' ...');
        !           318: 				&redirect_user($r,&mt('Entering '.$type),
1.150     www       319: 					       $furl,$msg,
                    320: 					       $env{'environment.remotenavmap'});
1.58      bowersj2  321: 			    }
1.124     albertel  322: 			    return OK;
1.55      albertel  323: 			}
                    324: 		    }
1.62      matthew   325:                     #
                    326:                     # Send the user to the construction space they selected
1.125     www       327:                     if ($role =~ /^(au|ca|aa)$/) {
1.62      matthew   328:                         my $redirect_url = '/priv/';
                    329:                         if ($role eq 'au') {
1.118     albertel  330:                             $redirect_url.=$env{'user.name'};
1.62      matthew   331:                         } else {
                    332:                             $where =~ /\/(.*)$/;
                    333:                             $redirect_url .= $1;
                    334:                         }
                    335:                         $redirect_url .= '/';
1.78      sakharuk  336:                         &redirect_user($r,&mt('Entering Construction Space'),
1.62      matthew   337:                                        $redirect_url);
                    338:                         return OK;
                    339:                     }
1.104     raeburn   340:                     if ($role eq 'dc') {
1.108     raeburn   341:                         my $redirect_url = '/adm/menu/';
                    342:                         &redirect_user($r,&mt('Loading Domain Coordinator Menu'),
1.104     raeburn   343:                                        $redirect_url);
1.108     raeburn   344:                         return OK;
1.104     raeburn   345:                     }
1.55      albertel  346: 		}
                    347:             }
1.6       www       348:         }
1.40      matthew   349:     }
1.44      www       350: 
1.10      www       351: 
1.6       www       352: # =============================================================== No Roles Init
1.10      www       353: 
1.73      www       354:     &Apache::loncommon::content_type($r,'text/html');
1.30      albertel  355:     &Apache::loncommon::no_cache($r);
1.10      www       356:     $r->send_http_header;
                    357:     return OK if $r->header_only;
                    358: 
1.52      www       359:     my $swinfo=&Apache::lonmenu::rawconfig();
1.147     albertel  360:     my $start_page=&Apache::loncommon::start_page('User Roles');
1.134     www       361:     my $standby=&mt('Role selected. Please stand by.');
1.135     albertel  362:     $standby=~s/\n/\\n/g;
1.94      albertel  363:     my $helptag='<table><tr><td>'.&Apache::loncommon::help_open_menu('','General Intro','General_Intro','User Roles',1,undef,undef,undef,undef,,&mt("Click here for help")).'</td></td></tr></table>';
1.10      www       364:     $r->print(<<ENDHEADER);
1.147     albertel  365: $start_page
1.45      www       366: $helptag<br />
1.26      www       367: <script>
                    368: $swinfo
                    369: window.focus();
1.134     www       370: 
                    371: active=true;
                    372: 
                    373: function enterrole (thisform,rolecode,buttonname) {
                    374:     if (active) {
                    375: 	active=false;
                    376:         document.title='$standby';
                    377:         window.status='$standby';
                    378: 	thisform.newrole.value=rolecode;
                    379: 	thisform.submit();
                    380:     } else {
                    381:        alert('$standby');
                    382:     }   
                    383: }
1.26      www       384: </script>
1.10      www       385: ENDHEADER
1.6       www       386: 
1.2       www       387: # ------------------------------------------ Get Error Message from Environment
                    388: 
1.118     albertel  389:     my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$env{'user.error.msg'});
                    390:     if ($env{'user.error.msg'}) {
1.55      albertel  391: 	$r->log_reason(
1.118     albertel  392:    "$msg for $env{'user.name'} domain $env{'user.domain'} access $priv",$fn);
1.12      www       393:     }
1.1       harris41  394: 
1.61      www       395: # ------------------------------------------------- Can this user re-init, etc?
1.6       www       396: 
1.118     albertel  397:     my $advanced=$env{'user.adv'};
1.61      www       398:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['tryagain']);
1.118     albertel  399:     my $tryagain=$env{'form.tryagain'};
1.6       www       400: 
1.2       www       401: # -------------------------------------------------------- Generate Page Output
1.6       www       402: # --------------------------------------------------------------- Error Header?
1.2       www       403:     if ($error) {
                    404: 	$r->print("<h1>LON-CAPA Access Control</h1>");
1.126     www       405:         $r->print("<!-- LONCAPAACCESSCONTROLERRORSCREEN --><hr /><pre>Access  : ".
1.4       www       406:                   Apache::lonnet::plaintext($priv)."\n");
1.115     albertel  407:         $r->print("Resource: ".&Apache::lonenc::check_encrypt($fn)."\n");
1.120     albertel  408:         $r->print("Action  : $msg\n</pre><hr />");
                    409: 	my $url=$fn;
                    410: 	my $last;
                    411: 	if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                    412: 		&GDBM_READER(),0640)) {
                    413: 	    $last=$hash{'last_known'};
                    414: 	    untie(%hash);
                    415: 	}
1.149     www       416: 	if ($last) { $fn.='?symb='.&escape($last); }
1.120     albertel  417: 
                    418: 	&Apache::londocs::changewarning($r,undef,'You have modified your course recently, [_1] may fix this access problem.',
                    419: 					&Apache::lonenc::check_encrypt($fn));
1.2       www       420:     } else {
1.118     albertel  421:         if ($env{'user.error.msg'}) {
1.25      www       422: 	    $r->print(
1.157   ! albertel  423:  '<h3><span class="LC_error">'.
        !           424:  &mt('You need to choose another user role or enter a specific course for this function').'</span></h3>');
1.25      www       425: 	}
1.2       www       426:     }
1.6       www       427: # -------------------------------------------------------- Choice or no choice?
1.2       www       428:     if ($nochoose) {
1.150     www       429: 	$r->print("<h2>".&mt('Sorry ...')."</h2>\n".
                    430: 		  &mt('This action is currently not authorized.').
                    431: 		  &Apache::loncommon::end_page());
                    432: 	return OK;
1.6       www       433:     } else {
                    434:         if ($advanced) {
1.72      www       435: 	    $r->print(&mt("Your home server is ").
1.55      albertel  436: 		      $Apache::lonnet::hostname{&Apache::lonnet::homeserver
1.118     albertel  437:                       ($env{'user.name'},$env{'user.domain'})}.
1.55      albertel  438: 		      "<br />\n");
1.72      www       439: 	    $r->print(&mt(
1.126     www       440:       "Author and Co-Author roles are not available on servers other than their respective home servers."));
1.17      www       441:         }
1.18      www       442:         if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
                    443:     	    $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
1.6       www       444:         }
1.84      www       445:         $r->print('<form method="post" name="rolechoice" action="'.(($fn)?$fn:$r->uri).'">');
1.116     albertel  446:         $r->print('<input type="hidden" name="orgurl" value="'.$fn.'" />');
                    447:         $r->print('<input type="hidden" name="selectrole" value="1" />');
1.134     www       448:         $r->print('<input type="hidden" name="newrole" value="" />');
1.6       www       449:     }
1.118     albertel  450:     if ($env{'user.adv'}) {
1.63      www       451: 	$r->print(
1.116     albertel  452: 	      '<br /><label>'.&mt('Show all roles').': <input type="checkbox" name="showall"');
1.118     albertel  453: 	if ($env{'form.showall'}) { $r->print(' checked="checked" '); }
1.116     albertel  454: 	$r->print(' /></label><input type="submit" value="'.&mt('Display').'" />');
1.63      www       455:     }
1.4       www       456: 
1.75      albertel  457:     my (%roletext,%sortrole,%roleclass);
1.84      www       458:     my $countactive=0;
                    459:     my $inrole=0;
                    460:     my $possiblerole='';
1.118     albertel  461:     foreach $envkey (sort keys %env) {
1.35      matthew   462:         my $button = 1;
1.49      www       463:         my $switchserver='';
1.75      albertel  464: 	my $roletext;
                    465: 	my $sortkey;
1.2       www       466:         if ($envkey=~/^user\.role\./) {
1.102     raeburn   467:             my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend,$tfont);
                    468:             &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
1.136     raeburn   469:             next if (!defined($role) || $role eq '' || $role =~ /^gr/);
1.102     raeburn   470:             $tremark='';
                    471:             $tpstart='&nbsp;';
                    472:             $tpend='&nbsp;';
                    473:             $tfont='#000000';
1.4       www       474:             if ($tstart) {
1.74      www       475:                 $tpstart=&Apache::lonlocal::locallocaltime($tstart);
1.4       www       476:             }
                    477:             if ($tend) {
1.74      www       478:                 $tpend=&Apache::lonlocal::locallocaltime($tend);
1.4       www       479:             }
1.118     albertel  480:             if ($env{'request.role'} eq $trolecode) {
1.6       www       481: 		$tstatus='selected';
                    482:             }
1.4       www       483:             my $tbg;
1.35      matthew   484:             if (($tstatus eq 'is') || ($tstatus eq 'selected') ||
1.118     albertel  485:                 ($env{'form.showall'})) {
1.35      matthew   486:                 if ($tstatus eq 'is') {
                    487:                     $tbg='#77FF77';
1.47      www       488:                     $tfont='#003300';
1.84      www       489: 		    $possiblerole=$trolecode;
                    490: 		    $countactive++;
1.35      matthew   491:                 } elsif ($tstatus eq 'future') {
                    492:                     $tbg='#FFFF77';
1.49      www       493:                     $button=0;
1.35      matthew   494:                 } elsif ($tstatus eq 'will') {
                    495:                     $tbg='#FFAA77';
1.72      www       496:                     $tremark.=&mt('Active at next login. ');
1.35      matthew   497:                 } elsif ($tstatus eq 'expired') {
                    498:                     $tbg='#FF7777';
1.47      www       499:                     $tfont='#330000';
1.49      www       500:                     $button=0;
1.35      matthew   501:                 } elsif ($tstatus eq 'will_not') {
                    502:                     $tbg='#AAFF77';
1.72      www       503:                     $tremark.=&mt('Expired after logout. ');
1.35      matthew   504:                 } elsif ($tstatus eq 'selected') {
                    505:                     $tbg='#11CC55';
1.47      www       506:                     $tfont='#002200';
1.84      www       507: 		    $inrole=1;
1.86      albertel  508: 		    $countactive++;
1.72      www       509:                     $tremark.=&mt('Currently selected. ');
1.35      matthew   510:                 }
                    511:                 my $trole;
                    512:                 if ($role =~ /^cr\//) {
                    513:                     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
1.132     albertel  514: 		    if ($tremark) { $tremark.='<br />'; }
                    515:                     $tremark.=&mt('Defined by ').$rauthor.
1.72      www       516: 			&mt(' at ').$rdomain.'.';
1.35      matthew   517:                     $trole=$rrole;
1.8       www       518:                 } else {
1.35      matthew   519:                     $trole=Apache::lonnet::plaintext($role);
                    520:                 }
                    521:                 my $ttype;
                    522:                 my $twhere;
                    523:                 my ($tdom,$trest,$tsection)=
                    524:                     split(/\//,Apache::lonnet::declutter($where));
                    525:                 # First, Co-Authorship roles
1.125     www       526:                 if (($role eq 'ca') || ($role eq 'aa')) {
1.39      stredwic  527:                     my $home = &Apache::lonnet::homeserver($trest,$tdom);
1.83      albertel  528: 		    my $allowed=0;
                    529: 		    my @ids=&Apache::lonnet::current_machine_ids();
                    530: 		    foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
                    531:                     if (!$allowed) {
1.49      www       532: 			$button=0;
1.130     albertel  533:                         $switchserver='otherserver='.$home.'&role='.$trolecode;
1.49      www       534:                     }
1.35      matthew   535:                     #next if ($home eq 'no_host');
                    536:                     $home = $Apache::lonnet::hostname{$home};
1.78      sakharuk  537:                     $ttype='Construction Space';
1.72      www       538:                     $twhere=&mt('User').': '.$trest.'<br />'.&mt('Domain').
                    539: 			': '.$tdom.'<br />'.
                    540:                         ' '.&mt('Server').':&nbsp;'.$home;
1.118     albertel  541:                     $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
1.82      www       542: 		    $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$trest.'/');
1.75      albertel  543: 		    $sortkey=$role."$trest:$tdom";
1.35      matthew   544:                 } elsif ($role eq 'au') {
                    545:                     # Authors
                    546:                     my $home = &Apache::lonnet::homeserver
1.118     albertel  547:                         ($env{'user.name'},$env{'user.domain'});
1.83      albertel  548: 		    my $allowed=0;
                    549: 		    my @ids=&Apache::lonnet::current_machine_ids();
                    550: 		    foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
                    551:                     if (!$allowed) {
1.49      www       552: 			$button=0;
1.143     albertel  553:                         $switchserver='otherserver='.$home.'&role='.$trolecode;
1.49      www       554:                     }
1.35      matthew   555:                     #next if ($home eq 'no_host');
                    556:                     $home = $Apache::lonnet::hostname{$home};
1.78      sakharuk  557:                     $ttype='Construction Space';
1.72      www       558:                     $twhere=&mt('Domain').': '.$tdom.'<br />'.&mt('Server').
                    559: 			':&nbsp;'.$home;
1.118     albertel  560:                     $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
                    561: 		    $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/');
1.75      albertel  562: 		    $sortkey=$role;
1.35      matthew   563:                 } elsif ($trest) {
                    564:                     my $tcourseid=$tdom.'_'.$trest;
1.153     raeburn   565:                     $ttype = &Apache::loncommon::course_type($tcourseid);
                    566:                     $trole = &Apache::lonnet::plaintext($role,$ttype);
1.118     albertel  567:                     if ($env{'course.'.$tcourseid.'.description'}) {
                    568:                         $twhere=$env{'course.'.$tcourseid.'.description'};
1.80      albertel  569: 			$sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
1.72      www       570:                         unless ($twhere eq &mt('Currently not available')) {
1.55      albertel  571: 			    $twhere.=' <font size="-2">'.
1.72      www       572:         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom,$tfont).
1.49      www       573:                                     '</font>';
1.55      albertel  574: 			}
1.8       www       575:                     } else {
1.105     raeburn   576:                         my %newhash=&Apache::lonnet::coursedescription($tcourseid);
1.35      matthew   577:                         if (%newhash) {
1.80      albertel  578: 			    $sortkey=$role."\0".$tdom."\0".$newhash{'description'}.
1.77      albertel  579: 				"\0".$envkey;
1.49      www       580:                             $twhere=$newhash{'description'}.
                    581:                               ' <font size="-2">'.
1.72      www       582:         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom,$tfont).
1.49      www       583:                               '</font>';
1.152     raeburn   584:                             $ttype = $newhash{'type'};
1.153     raeburn   585:                             $trole = &Apache::lonnet::plaintext($role,$ttype);
1.35      matthew   586:                         } else {
1.72      www       587:                             $twhere=&mt('Currently not available');
1.118     albertel  588:                             $env{'course.'.$tcourseid.'.description'}=$twhere;
1.80      albertel  589: 			    $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
1.152     raeburn   590:                             $ttype = 'Unavailable';
1.35      matthew   591:                         }
1.8       www       592:                     }
1.121     albertel  593:                     if ($tsection) {
                    594:                         $twhere.='<br />'.&mt('Section/Group').': '.$tsection;
                    595: 		    }
1.72      www       596: 		    if ($role ne 'st') { $twhere.="<br />".&mt('Domain').":".$tdom; }
1.35      matthew   597:                 } elsif ($tdom) {
1.78      sakharuk  598:                     $ttype='Domain';
1.35      matthew   599:                     $twhere=$tdom;
1.75      albertel  600: 		    $sortkey=$role.$twhere;
1.35      matthew   601:                 } else {
1.78      sakharuk  602:                     $ttype='System';
1.72      www       603:                     $twhere=&mt('system wide');
1.75      albertel  604: 		    $sortkey=$role.$twhere;
1.13      www       605:                 }
1.152     raeburn   606:                 $roletext.=&build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$tfont,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver);
1.75      albertel  607: 		$roletext{$envkey}=$roletext;
                    608: 		if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
                    609: 		$sortrole{$sortkey}=$envkey;
                    610: 		$roleclass{$envkey}=$ttype;
1.55      albertel  611: 	    }
1.4       www       612:         }
1.75      albertel  613:     }
1.84      www       614: # No active roles
                    615:     if ($countactive==0) {
                    616: 	if ($inrole) {
                    617: 	    $r->print('<h2>'.&mt('Currently no additional roles or courses').'</h2>');
                    618: 	} else {
                    619: 	    $r->print('<h2>'.&mt('Currently no active roles or courses').'</h2>');
                    620: 	}
1.147     albertel  621: 	$r->print('</form>'.&Apache::loncommon::end_page());
1.84      www       622: 	return OK;
                    623: # Is there only one choice?
1.118     albertel  624:     } elsif (($countactive==1) && ($env{'request.role'} eq 'cm')) {
1.84      www       625: 	$r->print('<h3>'.&mt('Please stand by.').'</h3>'.
                    626: 	    '<input type="hidden" name="'.$possiblerole.'" value="1" />');
                    627: 	$r->print("</form>\n");
                    628: 	$r->rflush();
                    629: 	$r->print('<script>document.forms.rolechoice.submit();</script>');
1.147     albertel  630: 	$r->print(&Apache::loncommon::end_page());
1.84      www       631: 	return OK;
                    632:     }
                    633: # More than one possible role
                    634: # ----------------------------------------------------------------------- Table
                    635:     unless (($advanced) || ($nochoose)) {
1.152     raeburn   636: 	$r->print("<h2>".&mt('Select a Course/Group to Enter')."</h2>\n");
1.84      www       637:     }
                    638:     $r->print('<br /><table><tr>');
                    639:     unless ($nochoose) { $r->print('<th>&nbsp;</th>'); }
1.121     albertel  640:     $r->print('<th>'.&mt('User Role').'</th><th>'.&mt('Extent').
1.132     albertel  641:          '</th><th>'.&mt('Start').'</th><th>'.&mt('End').'</th></tr>'."\n");
1.76      albertel  642:     my $doheaders=-1;
1.152     raeburn   643:     foreach my $type ('Domain','Construction Space','Course','Group','Unavailable','System') {
1.76      albertel  644: 	my $haverole=0;
1.75      albertel  645: 	foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {
                    646: 	    if ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/) { 
1.76      albertel  647: 		$haverole=1;
1.75      albertel  648: 	    }
1.76      albertel  649: 	}
                    650: 	if ($haverole) { $doheaders++; }
                    651:     }
1.111     albertel  652: 
1.118     albertel  653:     if ($env{'environment.recentroles'}) {
1.111     albertel  654:         my %recent_roles =
1.118     albertel  655:                &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.111     albertel  656: 	my $output='';
                    657: 	foreach (sort(keys(%recent_roles))) {
                    658: 	    if (defined($roletext{'user.role.'.$_})) {
                    659: 		$output.=$roletext{'user.role.'.$_};
1.133     albertel  660:                 if ($_ =~ m-dc\./(\w+)/- && $dcroles{$1}) {
1.138     raeburn   661: 		    $output .= &allcourses_row($1,'recent');
1.133     albertel  662:                 }
1.113     raeburn   663: 	    } elsif ($numdc > 0) {
                    664:                 unless ($_ =~/^error\:/) {
                    665:                     $output.=&display_cc_role('user.role.'.$_);
                    666:                 }
                    667:             } 
1.111     albertel  668: 	}
                    669: 	if ($output) {
1.132     albertel  670: 	    $r->print("<tr><td align='center' colspan='5'><font face='arial'>".
1.126     www       671: 		      &mt('Recent Roles')."</font></td>");
1.111     albertel  672: 	    $r->print($output);
                    673: 	    $r->print("</tr>");
1.114     raeburn   674:             $doheaders ++;
1.111     albertel  675: 	}
                    676:     }
                    677: 
1.104     raeburn   678:     if ($numdc > 0) {
1.112     raeburn   679:         $r->print(&coursepick_jscript());
                    680:         $r->print(&Apache::loncommon::coursebrowser_javascript());
1.108     raeburn   681:     }
1.152     raeburn   682:     foreach my $type ('Construction Space','Domain','Course','Group','Unavailable','System') {
1.108     raeburn   683: 	my $output;
                    684: 	foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {
                    685: 	    if ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/) { 
                    686: 		$output.=$roletext{$sortrole{$which}};
                    687:                 if ($sortrole{$which} =~ m-dc\./(\w+)/-) {
                    688:                     if ($dcroles{$1}) {
1.138     raeburn   689:                         $output .= &allcourses_row($1,'');
1.104     raeburn   690:                     }
                    691:                 }
1.76      albertel  692: 	    }
1.108     raeburn   693: 	}
                    694: 	if ($output) {
                    695: 	    if ($doheaders > 0) {
1.126     www       696: 		$r->print("<tr>".
1.132     albertel  697: 			  "<td align='center' colspan='5'><font face='arial'>".&mt($type)."</font></td></tr>");
1.76      albertel  698: 	    }
1.108     raeburn   699: 	    $r->print($output);	
                    700: 	}
1.4       www       701:     }
1.14      www       702:     my $tremark='';
1.47      www       703:     my $tfont='#003300';
1.118     albertel  704:     if ($env{'request.role'} eq 'cm') {
1.19      www       705: 	$r->print('<tr bgcolor="#11CC55">');
1.72      www       706:         $tremark=&mt('Currently selected. ');
1.47      www       707:         $tfont='#002200';
1.14      www       708:     } else {
                    709:         $r->print('<tr bgcolor="#77FF77">');
                    710:     }
                    711:     unless ($nochoose) {
1.118     albertel  712: 	if ($env{'request.role'} ne 'cm') {
1.134     www       713: 	    $r->print('<td><input type="submit" value="'.
1.72      www       714: 		      &mt('Select').'" name="cm"></td>');
1.55      albertel  715: 	} else {
                    716: 	    $r->print('<td>&nbsp;</td>');
                    717: 	}
1.14      www       718:     }
1.132     albertel  719:     $r->print('<td colspan="3"><font color="'.$tfont.'">'.&mt('No role specified').
1.47      www       720:       '</font></td><td><font color="'.$tfont.'">'.$tremark.
                    721:       '&nbsp;</font></td></tr>'."\n");
1.4       www       722: 
                    723:     $r->print('</table>');
                    724:     unless ($nochoose) {
                    725: 	$r->print("</form>\n");
                    726:     }
1.22      harris41  727: # ------------------------------------------------------------ Privileges Info
1.118     albertel  728:     if (($advanced) && (($env{'user.error.msg'}) || ($error))) {
1.127     albertel  729: 	$r->print('<hr /><h2>Current Privileges</h2>');
1.4       www       730: 
1.118     albertel  731: 	foreach $envkey (sort keys %env) {
                    732: 	    if ($envkey=~/^user\.priv\.$env{'request.role'}\./) {
1.55      albertel  733: 		my $where=$envkey;
1.118     albertel  734: 		$where=~s/^user\.priv\.$env{'request.role'}\.//;
1.55      albertel  735: 		my $ttype;
                    736: 		my $twhere;
                    737: 		my ($tdom,$trest,$tsec)=
                    738: 		    split(/\//,Apache::lonnet::declutter($where));
                    739: 		if ($trest) {
1.118     albertel  740: 		    if ($env{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
1.55      albertel  741: 			$ttype='Construction Space';
                    742: 			$twhere='User: '.$trest.', Domain: '.$tdom;
                    743: 		    } else {
1.157   ! albertel  744: 			$ttype= 
        !           745: 			    &Apache::loncommon::course_type($tdom.'_'.$trest);
1.118     albertel  746: 			$twhere=$env{'course.'.$tdom.'_'.$trest.'.description'};
1.55      albertel  747: 			if ($tsec) {
1.152     raeburn   748: 			    $twhere.=' (Section: '.$tsec.')';
1.55      albertel  749: 			}
                    750: 		    }
                    751: 		} elsif ($tdom) {
                    752: 		    $ttype='Domain';
                    753: 		    $twhere=$tdom;
                    754: 		} else {
                    755: 		    $ttype='System';
                    756: 		    $twhere='/';
                    757: 		}
                    758: 		$r->print("\n<h3>".$ttype.': '.$twhere.'</h3><ul>');
1.118     albertel  759: 		foreach (sort split(/:/,$env{$envkey})) {
1.55      albertel  760: 		    if ($_) {
                    761: 			my ($prv,$restr)=split(/\&/,$_);
                    762: 			my $trestr='';
                    763: 			if ($restr ne 'F') {
                    764: 			    my $i;
                    765: 			    $trestr.=' (';
                    766: 			    for ($i=0;$i<length($restr);$i++) {
                    767: 				$trestr.=
                    768: 			       Apache::lonnet::plaintext(substr($restr,$i,1));
                    769: 				if ($i<length($restr)-1) { $trestr.=', '; }
                    770: 			    }
                    771: 			    $trestr.=')';
                    772: 			}
                    773: 			$r->print('<li>'.
                    774: 				  Apache::lonnet::plaintext($prv).$trestr.
                    775: 				  '</li>');
                    776: 		    }
                    777: 		}
                    778: 		$r->print('</ul>');
                    779: 	    }
                    780: 	}
1.4       www       781:     }
1.66      www       782:     $r->print(&Apache::lonnet::getannounce());
1.65      www       783:     if ($advanced) {
                    784: 	$r->print('<p><small><i>This is LON-CAPA '.
1.85      www       785: 		  $r->dir_config('lonVersion').'</i><br />'.
                    786: 		  '<a href="/adm/logout">'.&mt('Logout').'</a></small></p>');
1.65      www       787:     }
1.147     albertel  788:     $r->print(&Apache::loncommon::end_page());
1.1       harris41  789:     return OK;
1.102     raeburn   790: }
                    791: 
                    792: sub role_status {
                    793:     my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
                    794:     my @pwhere = ();
1.118     albertel  795:     if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
1.102     raeburn   796:         (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
                    797:         unless (!defined($$role) || $$role eq '') {
                    798:             $$where=join('.',@pwhere);
                    799:             $$trolecode=$$role.'.'.$$where;
1.118     albertel  800:             ($$tstart,$$tend)=split(/\./,$env{$rolekey});
1.102     raeburn   801:             $$tstatus='is';
1.105     raeburn   802:             if ($$tstart && $$tstart>$then) {
                    803: 		$$tstatus='future';
                    804: 		if ($$tstart<$now) { $$tstatus='will'; }
1.102     raeburn   805:             }
                    806:             if ($$tend) {
                    807:                 if ($$tend<$then) {
                    808:                     $$tstatus='expired';
1.103     raeburn   809:                 } elsif ($$tend<$now) {
1.104     raeburn   810:                     $$tstatus='will_not';
1.102     raeburn   811:                 }
                    812:             }
                    813:         }
                    814:     }
                    815: }
1.1       harris41  816: 
1.110     raeburn   817: sub build_roletext {
1.152     raeburn   818:     my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$tfont,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver) = @_;
1.127     albertel  819:     my $roletext='<tr bgcolor="'.$tbg.'">';
1.132     albertel  820:     my $is_dc=($trolecode =~ m/^dc\./);
                    821:     my $rowspan=($is_dc) ? ''
                    822:                          : ' rowspan="2" ';
                    823: 
1.110     raeburn   824:     unless ($nochoose) {
1.134     www       825:         my $buttonname=$trolecode;
                    826:         $buttonname=~s/\W//g;
1.110     raeburn   827:         if (!$button) {
                    828:             if ($switchserver) {
1.132     albertel  829:                 $roletext.='<td'.$rowspan.'><a href="/adm/switchserver?'.
1.110     raeburn   830:                 $switchserver.'">'.&mt('Switch Server').'</a></td>';
                    831:             } else {
                    832:                 $roletext.=('<td>&nbsp;</td>');
                    833:             }
                    834:         } elsif ($tstatus eq 'is') {
1.134     www       835:             $roletext.='<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'.
                    836:                         &mt('Select').'" onClick="javascript:enterrole(this.form,\''.
                    837:                         $trolecode."','".$buttonname.'\');"></td>';
1.110     raeburn   838:         } elsif ($tryagain) {
                    839:             $roletext.=
1.134     www       840:                 '<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'.
                    841:                 &mt('Try Selecting Again').'" onClick="javascript:enterrole(this.form,\''.
                    842:                         $trolecode."','".$buttonname.'\');"></td>';
1.110     raeburn   843:         } elsif ($advanced) {
                    844:             $roletext.=
1.134     www       845:                 '<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'.
                    846:                 &mt('Re-Initialize').'" onClick="javascript:enterrole(this.form,\''.
                    847:                         $trolecode."','".$buttonname.'\');"></td>';
1.110     raeburn   848:         } else {
1.132     albertel  849:             $roletext.='<td'.$rowspan.'>&nbsp;</td>';
1.110     raeburn   850:         }
                    851:     }
                    852:     $tremark.=&Apache::lonannounce::showday(time,1,
                    853:                  &Apache::lonannounce::readcalendar($tdom.'_'.$trest));
                    854: 
                    855:     $roletext.='<td><font color="'.$tfont.'">'.$trole.
1.121     albertel  856: 	       '</font></td><td><font color="'.$tfont.'">'.$twhere.
1.110     raeburn   857:                '</font></td><td><font color="'.$tfont.'">'.$tpstart.
                    858:                '</font></td><td><font color="'.$tfont.'">'.$tpend.
1.132     albertel  859:                '</font></td></tr>';
                    860:     if (!$is_dc) {
                    861: 	$roletext.='<tr bgcolor="'.$tbg.'"><td colspan="4"><font color="'.$tfont.'">'.$tremark.
                    862: 	    '&nbsp;</font></td></tr><tr><td colspan="5" height="3"></td></tr>'."\n";
                    863:     }
1.110     raeburn   864:     return $roletext;
                    865: }
                    866: 
                    867: sub check_privs {
1.146     raeburn   868:     my ($cdom,$cnum,$then,$now) = @_;
                    869:     my $cckey = 'user.role.cc./'.$cdom.'/'.$cnum; 
1.118     albertel  870:     if ($env{$cckey}) {
1.110     raeburn   871:         my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend,$tfont);
                    872:         &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
                    873:         unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
1.146     raeburn   874:             &set_privileges($cdom,$cnum);
1.110     raeburn   875:         }
                    876:     } else {
1.146     raeburn   877:         &set_privileges($cdom,$cnum);
1.110     raeburn   878:     }
                    879: }
                    880: 
1.104     raeburn   881: sub check_fordc {
                    882:     my ($dcroles,$then) = @_;
                    883:     my $numdc = 0;
1.118     albertel  884:     if ($env{'user.adv'}) {
                    885:         foreach my $envkey (sort keys %env) {
1.104     raeburn   886:             if ($envkey=~/^user\.role\.dc\.\/(\w+)\/$/) {
                    887:                 my $dcdom = $1;
                    888:                 my $livedc = 1;
1.118     albertel  889:                 my ($tstart,$tend)=split(/\./,$env{$envkey});
1.105     raeburn   890:                 if ($tstart && $tstart>$then) { $livedc = 0; }
                    891:                 if ($tend   && $tend  <$then) { $livedc = 0; }
1.104     raeburn   892:                 if ($livedc) {
                    893:                     $$dcroles{$dcdom} = $envkey;
1.105     raeburn   894:                     $numdc++;
1.104     raeburn   895:                 }
                    896:             }
                    897:         }
                    898:     }
                    899:     return $numdc;
                    900: }
                    901: 
1.108     raeburn   902: sub courselink {
1.152     raeburn   903:     my ($dcdom,$rowtype,$selecttype) = @_;
1.109     raeburn   904:     my $courseform=&Apache::loncommon::selectcourse_link
1.152     raeburn   905:                    ('rolechoice','dccourse'.$rowtype.'_'.$dcdom,
                    906:                     'dcdomain'.$rowtype.'_'.$dcdom,'coursedesc'.$rowtype.'_'.
                    907:                     $dcdom,$dcdom,undef,$selecttype);
1.138     raeburn   908:     my $hiddenitems = '<input type="hidden" name="dcdomain'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'.
                    909:                       '<input type="hidden" name="origdom'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'.
                    910:                       '<input type="hidden" name="dccourse'.$rowtype.'_'.$dcdom.'" value="" />'.
                    911:                       '<input type="hidden" name="coursedesc'.$rowtype.'_'.$dcdom.'" value="" />';
1.112     raeburn   912:     return $courseform.$hiddenitems;
1.109     raeburn   913: }
                    914: 
                    915: sub coursepick_jscript {
1.104     raeburn   916:     my $verify_script = <<"END";
                    917: <script>
1.108     raeburn   918: function verifyCoursePick(caller) {
                    919:     var numbutton = getIndex(caller)
1.112     raeburn   920:     var pickedCourse = document.rolechoice.elements[numbutton+4].value
                    921:     var pickedDomain = document.rolechoice.elements[numbutton+2].value
                    922:     if (document.rolechoice.elements[numbutton+2].value == document.rolechoice.elements[numbutton+3].value) {
1.104     raeburn   923:         if (pickedCourse != '') {
1.108     raeburn   924:             if (numbutton != -1) {
                    925:                 var courseTarget = "cc./"+pickedDomain+"/"+pickedCourse
                    926:                 document.rolechoice.elements[numbutton+1].name = courseTarget
                    927:                 document.rolechoice.submit()
                    928:             }
1.104     raeburn   929:         }
                    930:         else {
1.114     raeburn   931:             alert("Please use the 'Select Course' link to open a separate pick course window where you may select the course you wish to enter.");
1.104     raeburn   932:         }
                    933:     }
                    934:     else {
                    935:         alert("You can only use this screen to select courses in the current domain")
                    936:     }
                    937: }
1.109     raeburn   938: function getIndex(caller) {
1.108     raeburn   939:     for (var i=0;i<document.rolechoice.elements.length;i++) {
1.109     raeburn   940:         if (document.rolechoice.elements[i] == caller) {
1.108     raeburn   941:             return i;
                    942:         }
                    943:     }
                    944:     return -1;
                    945: }
1.104     raeburn   946: </script>
                    947: END
1.109     raeburn   948:     return $verify_script;
1.104     raeburn   949: }
                    950: 
1.109     raeburn   951: sub processpick {
                    952:     my $process_pick = <<"END";
                    953: <script>
                    954: function process_pick(dom) {
1.138     raeburn   955:     var pickedCourse=opener.document.rolechoice.$env{'form.cnumelement'}.value;
                    956:     var pickedDomain=opener.document.rolechoice.$env{'form.cdomelement'}.value;
                    957:     var okDomain = 0;
                    958: 
                    959:     if (pickedDomain == dom) {
1.109     raeburn   960:         if (pickedCourse != '') {
1.138     raeburn   961:             var courseTarget = "cc./"+pickedDomain+"/"+pickedCourse
                    962:             opener.document.title='Role selected. Please stand by.';
                    963:             opener.status='Role selected. Please stand by.';
                    964: 	    opener.document.rolechoice.newrole.value=courseTarget
                    965:             opener.document.rolechoice.submit()
1.109     raeburn   966:         }
1.138     raeburn   967:     } else {
                    968:         alert("You may only use this screen to select courses in the current domain: "+dom+"\\nPlease return to the roles page window and click the 'Select Course' link for domain: "+pickedDomain+",\\n if you are a Domain Coordinator in that domain, and wish to become a Course Coordinator in a course in the domain");
1.109     raeburn   969:     }
                    970: }
                    971:  
                    972: </script>
                    973: END
                    974:     return $process_pick;
                    975: }
1.108     raeburn   976: 
1.113     raeburn   977: sub display_cc_role {
                    978:     my $rolekey = shift;
                    979:     my $roletext;
1.118     albertel  980:     my $advanced = $env{'user.adv'};
                    981:     my $tryagain = $env{'form.tryagain'};
1.113     raeburn   982:     unless ($rolekey =~/^error\:/) {
                    983:         if ($rolekey =~ m-^user\.role.cc\./(\w+)/(\w+)$-) {
                    984:             my $tcourseid = $1.'_'.$2;
                    985:             my $trolecode = 'cc./'.$1.'/'.$2;
                    986:             my $twhere;
1.152     raeburn   987:             my $ttype;
1.113     raeburn   988:             my $tbg='#77FF77';
                    989:             my $tfont='#003300';
                    990:             my %newhash=&Apache::lonnet::coursedescription($tcourseid);
                    991:             if (%newhash) {
                    992:                 $twhere=$newhash{'description'}.
                    993:                         ' <font size="-2">'.
                    994:                         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$2,$1,$tfont).
                    995:                         '</font>';
1.153     raeburn   996:                 $ttype = $newhash{'type'};
1.113     raeburn   997:             } else {
                    998:                 $twhere=&mt('Currently not available');
1.118     albertel  999:                 $env{'course.'.$tcourseid.'.description'}=$twhere;
1.110     raeburn  1000:             }
1.153     raeburn  1001:             my $trole = &Apache::lonnet::plaintext('cc',$ttype);
1.113     raeburn  1002:             $twhere.="<br />".&mt('Domain').":".$1;
1.152     raeburn  1003:             $roletext = &build_roletext($trolecode,$1,$2,'is',$tryagain,$advanced,'',$tbg,$tfont,$trole,$twhere,'','','',1,'');
1.104     raeburn  1004:         }
                   1005:     }
1.152     raeburn  1006:     return ($roletext);
1.104     raeburn  1007: }
                   1008: 
1.108     raeburn  1009: sub allcourses_row {
1.138     raeburn  1010:     my ($dcdom,$rowtype) = @_;
1.132     albertel 1011:     my $output = '<tr bgcolor="#77FF77">'.
1.152     raeburn  1012:                  ' <td colspan="5">';
                   1013:     foreach my $type ('Course','Group') {
                   1014:         my $selectlink = &courselink($dcdom,$rowtype,$type);
1.153     raeburn  1015:         my $ccrole = &Apache::lonnet::plaintext('cc',$type);
1.152     raeburn  1016:         $output.= '<font color="#002200">'.$ccrole.'</font>'.
                   1017:               ' <b>'.$selectlink.'</b>'.
                   1018:               ' from '.&mt('Domain').' '.$dcdom.'<br />';
                   1019:     }
                   1020:     $output .= '</tr><tr><td colspan="5" height="3"></td></tr>'."\n";
1.108     raeburn  1021:     return $output;
                   1022: }
                   1023: 
1.104     raeburn  1024: sub recent_filename {
                   1025:     my $area=shift;
1.149     www      1026:     return 'nohist_recent_'.&escape($area);
1.104     raeburn  1027: }
                   1028: 
1.106     raeburn  1029: sub set_privileges {
                   1030:     my ($dcdom,$pickedcourse) = @_;
                   1031:     my $area = '/'.$dcdom.'/'.$pickedcourse;
                   1032:     my $role = 'cc';
                   1033:     my $spec = $role.'.'.$area;
1.154     albertel 1034:     my %userroles = &Apache::lonnet::set_arearole($role,$area,'','',$dcdom,$env{'user.name'});
1.106     raeburn  1035:     my %ccrole = ();
                   1036:     &Apache::lonnet::standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
1.154     albertel 1037:     my ($author,$adv)= &Apache::lonnet::set_userprivs(\%userroles,\%ccrole);
                   1038:     &Apache::lonnet::appenv(%userroles);
1.118     albertel 1039:     &Apache::lonnet::log($env{'user.domain'},
                   1040:                          $env{'user.name'},
                   1041:                          $env{'user.home'},
1.106     raeburn  1042:                         "Role ".$role);
                   1043:     &Apache::lonnet::appenv(
1.146     raeburn  1044:                           'request.role'        => $spec,
1.106     raeburn  1045:                           'request.role.domain' => $dcdom,
                   1046:                           'request.course.sec'  => '');
                   1047:     my $tadv=0;
                   1048:     if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
                   1049:     &Apache::lonnet::appenv('request.role.adv'    => $tadv);
                   1050: }
                   1051: 
1.139     raeburn  1052: sub courseloadpage {
                   1053:     my ($courseid) = @_;
                   1054:     my $startpage;
1.144     albertel 1055:     my %entry_settings = &Apache::lonnet::get('nohist_whatsnew',
                   1056: 					      [$courseid.':courseinit']);
1.139     raeburn  1057:     my ($tmp) = %entry_settings;
1.144     albertel 1058:     unless ($tmp =~ /^error: 2 /) {
1.139     raeburn  1059:         $startpage = $entry_settings{$courseid.':courseinit'};
                   1060:     }
                   1061:     if ($startpage eq '') {
                   1062:         if (exists($env{'environment.course_init_display'})) {
                   1063:             $startpage = $env{'environment.course_init_display'};
                   1064:         }
                   1065:     }
                   1066:     return $startpage;
                   1067: }
                   1068: 
1.1       harris41 1069: 1;
                   1070: __END__
1.32      harris41 1071: 
                   1072: =head1 NAME
                   1073: 
                   1074: Apache::lonroles - User Roles Screen
                   1075: 
                   1076: =head1 SYNOPSIS
                   1077: 
                   1078: Invoked by /etc/httpd/conf/srm.conf:
                   1079: 
                   1080:  <Location /adm/roles>
                   1081:  PerlAccessHandler       Apache::lonacc
                   1082:  SetHandler perl-script
                   1083:  PerlHandler Apache::lonroles
                   1084:  ErrorDocument     403 /adm/login
                   1085:  ErrorDocument	  500 /adm/errorhandler
                   1086:  </Location>
1.64      bowersj2 1087: 
                   1088: =head1 OVERVIEW
                   1089: 
                   1090: =head2 Choosing Roles
                   1091: 
                   1092: C<lonroles> is a handler that allows a user to switch roles in
                   1093: mid-session. LON-CAPA attempts to work with "No Role Specified", the
                   1094: default role that a user has before selecting a role, as widely as
                   1095: possible, but certain handlers for example need specification which
                   1096: course they should act on, etc. Both in this scenario, and when the
                   1097: handler determines via C<lonnet>'s C<&allowed> function that a certain
                   1098: action is not allowed, C<lonroles> is used as error handler. This
                   1099: allows the user to select another role which may have permission to do
                   1100: what they were trying to do. C<lonroles> can also be accessed via the
                   1101: B<CRS> button in the Remote Control. 
                   1102: 
                   1103: =begin latex
                   1104: 
                   1105: \begin{figure}
                   1106: \begin{center}
                   1107: \includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen}
                   1108:   \caption{\label{Sample_Roles_Screen}Sample Roles Screen} 
                   1109: \end{center}
                   1110: \end{figure}
                   1111: 
                   1112: =end latex
                   1113: 
                   1114: =head2 Role Initialization
                   1115: 
                   1116: The privileges for a user are established at login time and stored in the session environment. As a consequence, a new role does not become active till the next login. Handlers are able to query for privileges using C<lonnet>'s C<&allowed> function. When a user first logs in, their role is the "common" role, which means that they have the sum of all of their privileges. During a session it might become necessary to choose a particular role, which as a consequence also limits the user to only the privileges in that particular role.
1.32      harris41 1117: 
                   1118: =head1 INTRODUCTION
                   1119: 
                   1120: This module enables a user to select what role he wishes to
                   1121: operate under (instructor, student, teaching assistant, course
                   1122: coordinator, etc).  These roles are pre-established by the actions
                   1123: of upper-level users.
                   1124: 
                   1125: This is part of the LearningOnline Network with CAPA project
                   1126: described at http://www.lon-capa.org.
                   1127: 
                   1128: =head1 HANDLER SUBROUTINE
                   1129: 
                   1130: This routine is called by Apache and mod_perl.
                   1131: 
                   1132: =over 4
                   1133: 
                   1134: =item *
                   1135: 
                   1136: Roles Initialization (yes/no)
                   1137: 
                   1138: =item *
                   1139: 
                   1140: Get Error Message from Environment
                   1141: 
                   1142: =item *
                   1143: 
                   1144: Who is this?
                   1145: 
                   1146: =item *
                   1147: 
                   1148: Generate Page Output
                   1149: 
                   1150: =item *
                   1151: 
                   1152: Choice or no choice
                   1153: 
                   1154: =item *
                   1155: 
                   1156: Table
                   1157: 
                   1158: =item *
                   1159: 
                   1160: Privileges
                   1161: 
                   1162: =back
                   1163: 
                   1164: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.