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

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