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

1.1       harris41    1: # The LearningOnline Network with CAPA
                      2: # User Roles Screen
1.31      www         3: #
1.320   ! raeburn     4: # $Id: lonroles.pm,v 1.319 2016/10/27 21:06:00 raeburn 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.210     jms        30: =pod
                     31: 
                     32: =head1 NAME
                     33: 
                     34: Apache::lonroles - User Roles Screen
                     35: 
                     36: =head1 SYNOPSIS
                     37: 
                     38: Invoked by /etc/httpd/conf/srm.conf:
                     39: 
                     40:  <Location /adm/roles>
                     41:  PerlAccessHandler       Apache::lonacc
                     42:  SetHandler perl-script
                     43:  PerlHandler Apache::lonroles
                     44:  ErrorDocument     403 /adm/login
                     45:  ErrorDocument	  500 /adm/errorhandler
                     46:  </Location>
                     47: 
                     48: =head1 OVERVIEW
                     49: 
                     50: =head2 Choosing Roles
                     51: 
                     52: C<lonroles> is a handler that allows a user to switch roles in
                     53: mid-session. LON-CAPA attempts to work with "No Role Specified", the
                     54: default role that a user has before selecting a role, as widely as
                     55: possible, but certain handlers for example need specification which
                     56: course they should act on, etc. Both in this scenario, and when the
                     57: handler determines via C<lonnet>'s C<&allowed> function that a certain
                     58: action is not allowed, C<lonroles> is used as error handler. This
                     59: allows the user to select another role which may have permission to do
1.246     droeschl   60: what they were trying to do.
1.210     jms        61: 
                     62: =begin latex
                     63: 
                     64: \begin{figure}
                     65: \begin{center}
                     66: \includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen}
                     67:   \caption{\label{Sample_Roles_Screen}Sample Roles Screen} 
                     68: \end{center}
                     69: \end{figure}
                     70: 
                     71: =end latex
                     72: 
                     73: =head2 Role Initialization
                     74: 
                     75: 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.
                     76: 
                     77: =head1 INTRODUCTION
                     78: 
                     79: This module enables a user to select what role he wishes to
                     80: operate under (instructor, student, teaching assistant, course
                     81: coordinator, etc).  These roles are pre-established by the actions
                     82: of upper-level users.
                     83: 
                     84: This is part of the LearningOnline Network with CAPA project
                     85: described at http://www.lon-capa.org.
                     86: 
                     87: =head1 HANDLER SUBROUTINE
                     88: 
                     89: This routine is called by Apache and mod_perl.
                     90: 
                     91: =over 4
                     92: 
                     93: =item *
                     94: 
                     95: Roles Initialization (yes/no)
                     96: 
                     97: =item *
                     98: 
                     99: Get Error Message from Environment
                    100: 
                    101: =item *
                    102: 
                    103: Who is this?
                    104: 
                    105: =item *
                    106: 
                    107: Generate Page Output
                    108: 
                    109: =item *
                    110: 
                    111: Choice or no choice
                    112: 
                    113: =item *
                    114: 
                    115: Table
                    116: 
                    117: =item *
                    118: 
                    119: Privileges
                    120: 
                    121: =back
                    122: 
                    123: =cut
                    124: 
                    125: 
1.1       harris41  126: package Apache::lonroles;
                    127: 
                    128: use strict;
1.118     albertel  129: use Apache::lonnet;
1.7       www       130: use Apache::lonuserstate();
1.304     musolffc  131: use Apache::Constants qw(:common REDIRECT);
1.2       www       132: use Apache::File();
1.26      www       133: use Apache::lonmenu;
1.29      albertel  134: use Apache::loncommon;
1.104     raeburn   135: use Apache::lonhtmlcommon;
1.57      www       136: use Apache::lonannounce;
1.72      www       137: use Apache::lonlocal;
1.151     www       138: use Apache::lonpageflip();
1.167     albertel  139: use Apache::lonnavdisplay();
1.241     raeburn   140: use Apache::loncoursequeueadmin;
1.279     raeburn   141: use Apache::longroup;
1.283     raeburn   142: use Apache::lonrss;
1.313     raeburn   143: use Apache::lonplacementtest;
1.120     albertel  144: use GDBM_File;
1.170     albertel  145: use LONCAPA qw(:DEFAULT :match);
1.201     raeburn   146: use HTML::Entities;
1.276     raeburn   147: 
1.1       harris41  148: 
1.62      matthew   149: sub redirect_user {
1.245     droeschl  150:     my ($r,$title,$url,$msg) = @_;
1.62      matthew   151:     $msg = $title if (! defined($msg));
1.73      www       152:     &Apache::loncommon::content_type($r,'text/html');
1.62      matthew   153:     &Apache::loncommon::no_cache($r);
                    154:     $r->send_http_header;
1.228     bisitz    155: 
                    156:     # Breadcrumbs
                    157:     my $brcrum = [{'href' => $url,
                    158:                    'text' => 'Switching Role'},];
1.147     albertel  159:     my $start_page = &Apache::loncommon::start_page('Switching Role',undef,
1.228     bisitz    160:                                                     {'redirect' => [1,$url],
                    161:                                                      'bread_crumbs' => $brcrum,});
1.147     albertel  162:     my $end_page   = &Apache::loncommon::end_page();
                    163: 
1.92      www       164: # Note to style police: 
                    165: # This must only replace the spaces, nothing else, or it bombs elsewhere.
                    166:     $url=~s/ /\%20/g;
1.93      albertel  167:     $r->print(<<ENDREDIR);
1.147     albertel  168: $start_page
1.222     bisitz    169: <p>$msg</p>
1.147     albertel  170: $end_page
1.62      matthew   171: ENDREDIR
                    172:     return;
                    173: }
                    174: 
1.150     www       175: sub error_page {
                    176:     my ($r,$error,$dest)=@_;
                    177:     &Apache::loncommon::content_type($r,'text/html');
                    178:     &Apache::loncommon::no_cache($r);
                    179:     $r->send_http_header;
                    180:     return OK if $r->header_only;
1.228     bisitz    181:     # Breadcrumbs
                    182:     my $brcrum = [{'href' => $dest,
                    183:                    'text' => 'Problems during Course Initialization'},];
                    184:     $r->print(&Apache::loncommon::start_page('Problems during Course Initialization',
                    185:                                              undef,
                    186:                                              {'bread_crumbs' => $brcrum,})
                    187:     );
                    188:     $r->print(
1.225     bisitz    189:         '<script type="text/javascript">'.
                    190:         '// <![CDATA['.
                    191:         &Apache::lonmenu::rawconfig().
                    192:         '// ]]>'.
                    193:         '</script>'.
                    194: 	      '<p class="LC_error">'.&mt('The following problems occurred:').
1.228     bisitz    195:           '<br />'.
1.150     www       196: 	      $error.
1.228     bisitz    197: 	      '</p><br /><a href="'.$dest.'">'.&mt('Continue').'</a>'
                    198:     );
                    199:     $r->print(&Apache::loncommon::end_page());
1.150     www       200: }
                    201: 
1.1       harris41  202: sub handler {
1.10      www       203: 
1.1       harris41  204:     my $r = shift;
                    205: 
1.308     raeburn   206:     # Check for critical messages and redirect if present.
1.304     musolffc  207:     my ($redirect,$url) = &Apache::loncommon::critical_redirect(300);
                    208:     if ($redirect) {
                    209:         &Apache::loncommon::content_type($r,'text/html');
                    210:         $r->header_out(Location => $url);
                    211:         return REDIRECT;
                    212:     }
                    213: 
1.6       www       214:     my $now=time;
1.118     albertel  215:     my $then=$env{'user.login.time'};
1.226     raeburn   216:     my $refresh=$env{'user.refresh.time'};
1.260     raeburn   217:     my $update=$env{'user.update.time'};
1.226     raeburn   218:     if (!$refresh) {
                    219:         $refresh = $then;
                    220:     }
1.260     raeburn   221:     if (!$update) {
                    222:         $update = $then;
                    223:     }
                    224: 
1.274     raeburn   225:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
                    226: 
                    227: # -------------------------------------------------- Check if setting hot list 
                    228:     my $hotlist;
                    229:     if ($env{'form.action'} eq 'verify_and_change_rolespref') {
                    230:         $hotlist = &Apache::lonpreferences::verify_and_change_rolespref($r);
                    231:     }
                    232: 
1.260     raeburn   233: # -------------------------------------------------------- Check for new roles
                    234:     my $updateresult;
1.274     raeburn   235:     if ($env{'form.state'} eq 'doupdate') {
1.260     raeburn   236:         my $show_course=&Apache::loncommon::show_course();
                    237:         my $checkingtxt;
                    238:         if ($show_course) {
                    239:             $checkingtxt = &mt('Checking for new courses ...');
                    240:         } else {
                    241:             $checkingtxt = &mt('Checking for new roles ...');
                    242:         }
1.274     raeburn   243:         $updateresult = $checkingtxt;
1.260     raeburn   244:         $updateresult .= &update_session_roles();
                    245:         &Apache::lonnet::appenv({'user.update.time'  => $now});
                    246:         $update = $now;
1.272     raeburn   247:         &Apache::loncoursequeueadmin::reqauthor_check();
1.270     raeburn   248:     }
                    249: 
                    250: # -------------------------------------------------- Check for author requests
                    251:     my $reqauthor;
1.274     raeburn   252:     if ($env{'form.state'} eq 'requestauthor') {
1.272     raeburn   253:        $reqauthor = &Apache::loncoursequeueadmin::process_reqauthor(\$update);
1.260     raeburn   254:     }
                    255: 
1.6       www       256:     my $envkey;
1.107     raeburn   257:     my %dcroles = ();
1.317     raeburn   258:     my %dhroles = ();
                    259:     my ($numdc,$numdh,$numadhoc) = &check_for_adhoc(\%dcroles,\%dhroles,$update,$then);
1.304     musolffc  260:     my $loncaparev = $r->dir_config('lonVersion');
1.10      www       261: 
1.6       www       262: # ================================================================== Roles Init
1.118     albertel  263:     if ($env{'form.selectrole'}) {
1.188     www       264: 
                    265:         my $locknum=&Apache::lonnet::get_locks();
                    266:         if ($locknum) { return 409; }
                    267: 
1.315     raeburn   268:         my $custom_adhoc;
1.134     www       269:         if ($env{'form.newrole'}) {
                    270:             $env{'form.'.$env{'form.newrole'}}=1;
1.315     raeburn   271: # Check if this is a Domain Helpdesk role trying to enter a course
                    272:             if ($env{'form.newrole'} =~ m{^cr/($match_domain)/\1\-domainconfig/\w+\./\1/$match_courseid$}) {
1.317     raeburn   273:                 if ($dhroles{$1}) {
1.315     raeburn   274:                     $custom_adhoc = 1;
                    275:                 }
                    276:             }
1.134     www       277: 	}
1.118     albertel  278: 	if ($env{'request.course.id'}) {
1.185     raeburn   279:             # Check if user is CC trying to select a course role
                    280:             if ($env{'form.switchrole'}) {
1.252     raeburn   281:                 my $switch_is_active;
                    282:                 if (defined($env{'user.role.'.$env{'form.switchrole'}})) {
                    283:                     my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}});
                    284:                     if (!$end || $end > $now) {
1.260     raeburn   285:                         if (!$start || $start < $update) {
1.252     raeburn   286:                             $switch_is_active = 1;
                    287:                         }
                    288:                     }
                    289:                 }
                    290:                 unless ($switch_is_active) {
1.260     raeburn   291:                     &adhoc_course_role($refresh,$update,$then);
1.185     raeburn   292:                 }
                    293:             }
1.118     albertel  294: 	    my %temp=('logout_'.$env{'request.course.id'} => time);
1.33      www       295: 	    &Apache::lonnet::put('email_status',\%temp);
1.118     albertel  296: 	    &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'});
1.100     albertel  297: 	}
1.310     raeburn   298: 	&Apache::lonnet::appenv({"request.course.id"           => '',
                    299: 			 	 "request.course.fn"           => '',
                    300: 				 "request.course.uri"          => '',
                    301: 				 "request.course.sec"          => '',
                    302:                                  "request.course.tied"         => '',
                    303:                                  "request.course.timechecked"  => '',
                    304: 				 "request.role"                => 'cm',
                    305:                                  "request.role.adv"            => $env{'user.adv'},
                    306: 				 "request.role.domain"         => $env{'user.domain'}});
1.315     raeburn   307: # Check if Domain Helpdesk role trying to enter a course needs privs to be created
                    308:         if ($env{'form.newrole'} =~ m{^cr/($match_domain)/\1\-domainconfig/(\w+)\./\1/($match_courseid)$}) {
                    309:             my $cdom = $1;
                    310:             my $rolename = $2;
                    311:             my $cnum = $3;
                    312:             if ($custom_adhoc) {
                    313:                 my %adhocroles = &Apache::lonnet::userenvironment($env{'user.domain'},$env{'user.name'},
                    314:                                                                   'adhocroles.'.$cdom);
                    315:                 if (keys(%adhocroles)) {
                    316:                     my @adhoc = split(',',$adhocroles{'adhocroles.'.$cdom});
                    317:                     if (grep(/^\Q$rolename\E$/,@adhoc)) {
                    318:                         if (&Apache::lonnet::check_adhoc_privs($cdom,$cnum,$update,$refresh,$now,
                    319:                                                                "cr/$cdom/$cdom".'-domainconfig/'.$rolename)) {
1.316     raeburn   320:                             &Apache::lonnet::appenv({"environment.internal.$cdom.$cnum.cr/$cdom/$cdom".'-domainconfig/'."$rolename.adhoc" => time});
1.315     raeburn   321:                         }
                    322:                     }
                    323:                 }
                    324:             }
1.319     raeburn   325:         } elsif (($numdc > 0) || ($numdh > 0)) {
1.182     www       326: # Check if user is a DC trying to enter a course or author space and needs privs to be created
1.319     raeburn   327: # Check if user is a DH trying to enter a course and needs privs to be created
1.296     raeburn   328:             foreach my $envkey (keys(%env)) {
1.240     raeburn   329: # Is this an ad-hoc Coordinator role?
1.319     raeburn   330:                 if ($numdc) {
                    331:                     if (my ($ccrole,$domain,$coursenum) =
                    332: 		        ($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {
                    333:                         if ($dcroles{$domain}) {
                    334:                             if (&Apache::lonnet::check_adhoc_privs($domain,$coursenum,
                    335:                                                                    $update,$refresh,$now,$ccrole)) {
                    336:                                 &Apache::lonnet::appenv({"environment.internal.$domain.$coursenum.$ccrole.adhoc" => time});
                    337:                             }
1.275     raeburn   338:                         }
1.319     raeburn   339:                         last;
1.182     www       340:                     }
1.193     raeburn   341: # Is this an ad-hoc CA-role?
1.319     raeburn   342:                     if (my ($domain,$user) =
                    343: 		        ($envkey =~ m-^form\.ca\./($match_domain)/($match_username)$-)) {
                    344:                         if (($domain eq $env{'user.domain'}) && ($user eq $env{'user.name'})) {
                    345:                             delete($env{$envkey});
                    346:                             $env{'form.au./'.$domain.'/'} = 1;
1.206     raeburn   347:                             my ($server_status,$home) = &check_author_homeserver($user,$domain);
                    348:                             if ($server_status eq 'switchserver') {
1.319     raeburn   349:                                 my $trolecode = 'au./'.$domain.'/';
1.248     raeburn   350:                                 my $switchserver = '/adm/switchserver?otherserver='.$home.'&amp;role='.$trolecode;
1.206     raeburn   351:                                 $r->internal_redirect($switchserver);
1.285     raeburn   352:                                 return OK;
1.206     raeburn   353:                             }
                    354:                             last;
                    355:                         }
1.319     raeburn   356:                         if (my ($castart,$caend) = ($env{'user.role.ca./'.$domain.'/'.$user} =~ /^(\d*)\.(\d*)$/)) {
                    357:                             if (((($castart) && ($castart < $now)) || !$castart) && 
                    358:                                 ((!$caend) || (($caend) && ($caend > $now)))) {
                    359:                                 my ($server_status,$home) = &check_author_homeserver($user,$domain);
                    360:                                 if ($server_status eq 'switchserver') {
                    361:                                     my $trolecode = 'ca./'.$domain.'/'.$user;
                    362:                                     my $switchserver = '/adm/switchserver?otherserver='.$home.'&amp;role='.$trolecode;
                    363:                                     $r->internal_redirect($switchserver);
                    364:                                     return OK;
                    365:                                 }
                    366:                                 last;
                    367:                             }
                    368:                         }
                    369:                         # Check if author blocked ca-access
                    370:                         my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],$domain,$user);
                    371:                         if ($blocked{'domcoord.author'} eq 'blocked') {
                    372:                             delete($env{$envkey});
                    373:                             $env{'user.error.msg'}=':::1:User '.$user.' in domain '.$domain.' blocked domain coordinator access';
                    374:                             last;
                    375:                         }
                    376:                         if ($dcroles{$domain}) {
                    377:                             my ($server_status,$home) = &check_author_homeserver($user,$domain);
                    378:                             if (($server_status eq 'ok') || ($server_status eq 'switchserver')) {
                    379:                                 &Apache::lonnet::check_adhoc_privs($domain,$user,$update,
                    380:                                                                    $refresh,$now,'ca');
                    381:                                 if ($server_status eq 'switchserver') {
                    382:                                     my $trolecode = 'ca./'.$domain.'/'.$user; 
                    383:                                     my $switchserver = '/adm/switchserver?'
                    384:                                                       .'otherserver='.$home.'&amp;role='.$trolecode;
                    385:                                     $r->internal_redirect($switchserver);
                    386:                                     return OK;
                    387:                                 }
                    388:                             } else {
                    389:                                 delete($env{$envkey});
1.193     raeburn   390:                             }
                    391:                         } else {
                    392:                             delete($env{$envkey});
                    393:                         }
1.319     raeburn   394:                         last;
1.182     www       395:                     }
                    396:                 }
1.319     raeburn   397:                 if ($numdh) {
                    398: # Is this an ad hoc custom role in a course/community?
1.320   ! raeburn   399:                     if (my ($domain,$rolename,$coursenum) = ($envkey =~ m{^form\.cr/($match_domain)/\1\-domainconfig/(\w+)\./\1/($match_courseid)$})) {
        !           400:                         if ($dhroles{$domain}) { 
        !           401:                             my @adhoc; 
        !           402:                             if ($env{'environment.adhocroles.'.$domain}) {
        !           403:                                 @adhoc = split(',',$env{'environment.adhocroles.'.$domain});
        !           404:                             } else {
        !           405:                                 my %adhocroles = &Apache::lonnet::userenvironment($env{'user.domain'},$env{'user.name'},
        !           406:                                                                                   'adhocroles.'.$domain);
        !           407:                                 if (keys(%adhocroles)) {
        !           408:                                     @adhoc = split(',',$adhocroles{'adhocroles.'.$domain});
        !           409:                                 }
        !           410:                             }
        !           411:                             if ((@adhoc > 0) && ($rolename ne '')) {
        !           412:                                 if (grep(/^\Q$rolename\E$/,@adhoc)) {
        !           413:                                     if (&Apache::lonnet::check_adhoc_privs($domain,$coursenum,$update,$refresh,$now,
        !           414:                                                                            "cr/$domain/$domain".'-domainconfig/'.$rolename)) {
        !           415:                                         &Apache::lonnet::appenv({"environment.internal.$domain.$coursenum.cr/$domain/$domain".
        !           416:                                                                  '-domainconfig/'."$rolename.adhoc" => time});
        !           417:                                     }
        !           418:                                 } else {
        !           419:                                     delete($env{$envkey});
        !           420:                                 }
        !           421:                             } else {
        !           422:                                 delete($env{$envkey});
        !           423:                             }
        !           424:                         } else {
        !           425:                             delete($env{$envkey});
        !           426:                         }
        !           427:                         last;
        !           428:                     }
        !           429:                 }
        !           430:             }
1.107     raeburn   431:         }
1.296     raeburn   432:         foreach $envkey (keys(%env)) {
1.40      matthew   433:             next if ($envkey!~/^user\.role\./);
1.102     raeburn   434:             my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
1.260     raeburn   435:             &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
1.218     raeburn   436:                                          \$trolecode,\$tstatus,\$tstart,\$tend);
1.118     albertel  437:             if ($env{'form.'.$trolecode}) {
1.55      albertel  438: 		if ($tstatus eq 'is') {
                    439: 		    $where=~s/^\///;
                    440: 		    my ($cdom,$cnum,$csec)=split(/\//,$where);
1.255     raeburn   441:                     if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {
                    442:                         my $home = $env{'course.'.$cdom.'_'.$cnum.'.home'};
                    443:                         my @ids = &Apache::lonnet::current_machine_ids();
                    444:                         unless ($loncaparev eq '' && $home && grep(/^\Q$home\E$/,@ids)) {
                    445:                             my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
1.256     raeburn   446:                             if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
1.255     raeburn   447:                                 my ($switchserver,$switchwarning) =
1.310     raeburn   448:                                     &Apache::loncommon::check_release_required($loncaparev,$cdom.'_'.$cnum,$trolecode,
                    449:                                                                                $curr_reqd_hash{'internal.releaserequired'});
1.256     raeburn   450:                                 if ($switchwarning ne '' || $switchserver ne '') {
                    451:                                     &Apache::loncommon::content_type($r,'text/html');
                    452:                                     &Apache::loncommon::no_cache($r);
                    453:                                     $r->send_http_header;
1.310     raeburn   454:                                     $r->print(&Apache::loncommon::check_release_result($switchwarning,$switchserver));
1.256     raeburn   455:                                     return OK;
1.255     raeburn   456:                                 }
                    457:                             }
                    458:                         }
                    459:                     }
1.137     raeburn   460: # check for course groups
                    461:                     my %coursegroups = &Apache::lonnet::get_active_groups(
                    462:                           $env{'user.domain'},$env{'user.name'},$cdom, $cnum);
                    463:                     my $cgrps = join(':',keys(%coursegroups));
                    464: 
1.111     albertel  465: # store role if recent_role list being kept
1.118     albertel  466:                     if ($env{'environment.recentroles'}) {
1.158     albertel  467:                         my %frozen_roles =
                    468:                            &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.111     albertel  469: 			&Apache::lonhtmlcommon::store_recent('roles',
1.158     albertel  470: 							     $trolecode,' ',$frozen_roles{$trolecode});
1.111     albertel  471:                     }
                    472: 
                    473: 
1.53      www       474: # check for keyed access
1.55      albertel  475: 		    if (($role eq 'st') && 
1.118     albertel  476:                        ($env{'course.'.$cdom.'_'.$cnum.'.keyaccess'} eq 'yes')) {
1.89      www       477: # who is key authority?
                    478: 			my $authdom=$cdom;
                    479: 			my $authnum=$cnum;
1.118     albertel  480: 			if ($env{'course.'.$cdom.'_'.$cnum.'.keyauth'}) {
1.89      www       481: 			    ($authnum,$authdom)=
1.172     albertel  482: 				split(/:/,$env{'course.'.$cdom.'_'.$cnum.'.keyauth'});
1.89      www       483: 			}
                    484: # check with key authority
                    485: 			unless (&Apache::lonnet::validate_access_key(
1.118     albertel  486: 				     $env{'environment.key.'.$cdom.'_'.$cnum},
1.89      www       487: 					     $authdom,$authnum)) {
1.53      www       488: # there is no valid key
1.118     albertel  489: 			     if ($env{'form.newkey'}) {
1.53      www       490: # student attempts to register a new key
1.89      www       491: 				 &Apache::loncommon::content_type($r,'text/html');
                    492: 				 &Apache::loncommon::no_cache($r);
                    493: 				 $r->send_http_header;
                    494: 				 my $swinfo=&Apache::lonmenu::rawconfig();
1.147     albertel  495: 				 my $start_page=&Apache::loncommon::start_page
1.89      www       496: 				    ('Verifying Access Key to Unlock this Course');
1.147     albertel  497: 				 my $end_page=&Apache::loncommon::end_page();
1.90      www       498: 				 my $buttontext=&mt('Enter Course');
                    499: 				 my $message=&mt('Successfully registered key');
                    500: 				 my $assignresult=
                    501: 				     &Apache::lonnet::assign_access_key(
1.118     albertel  502: 						     $env{'form.newkey'},
1.90      www       503: 						     $authdom,$authnum,
1.91      www       504: 						     $cdom,$cnum,
1.118     albertel  505:                                                      $env{'user.domain'},
                    506: 						     $env{'user.name'},
1.204     bisitz    507:                                                      &mt('Assigned from [_1] at [_2] for [_3]'
                    508:                                                         ,$ENV{'REMOTE_ADDR'}
                    509:                                                         ,&Apache::lonlocal::locallocaltime()
                    510:                                                         ,$trolecode)
                    511:                                                      );
1.90      www       512: 				 unless ($assignresult eq 'ok') {
                    513: 				     $assignresult=~s/^error\:\s*//;
                    514: 				     $message=&mt($assignresult).
                    515: 				     '<br /><a href="/adm/logout">'.
1.89      www       516: 				     &mt('Logout').'</a>';
1.90      www       517: 				     $buttontext=&mt('Re-Enter Key');
                    518: 				 }
1.89      www       519: 				 $r->print(<<ENDENTEREDKEY);
1.147     albertel  520: $start_page
1.179     raeburn   521: <script type="text/javascript">
1.225     bisitz    522: // <![CDATA[
1.89      www       523: $swinfo
1.225     bisitz    524: // ]]>
1.89      www       525: </script>
1.225     bisitz    526: <form action="" method="post">
1.89      www       527: <input type="hidden" name="selectrole" value="1" />
                    528: <input type="hidden" name="$trolecode" value="1" />
1.211     tempelho  529: <span class="LC_fontsize_large">$message</span><br />
1.89      www       530: <input type="submit" value="$buttontext" />
                    531: </form>
1.147     albertel  532: $end_page
1.89      www       533: ENDENTEREDKEY
                    534:                                  return OK;
1.55      albertel  535: 			     } else {
1.53      www       536: # print form to enter a new key
1.73      www       537: 				 &Apache::loncommon::content_type($r,'text/html');
1.55      albertel  538: 				 &Apache::loncommon::no_cache($r);
                    539: 				 $r->send_http_header;
                    540: 				 my $swinfo=&Apache::lonmenu::rawconfig();
1.147     albertel  541: 				 my $start_page=&Apache::loncommon::start_page
1.55      albertel  542: 				    ('Enter Access Key to Unlock this Course');
1.147     albertel  543: 				 my $end_page=&Apache::loncommon::end_page();
1.55      albertel  544: 				 $r->print(<<ENDENTERKEY);
1.147     albertel  545: $start_page
1.179     raeburn   546: <script type="text/javascript">
1.225     bisitz    547: // <![CDATA[
1.53      www       548: $swinfo
1.225     bisitz    549: // ]]>
1.53      www       550: </script>
1.225     bisitz    551: <form action="" method="post">
1.89      www       552: <input type="hidden" name="selectrole" value="1" />
                    553: <input type="hidden" name="$trolecode" value="1" />
1.118     albertel  554: <input type="text" size="20" name="newkey" value="$env{'form.newkey'}" />
1.53      www       555: <input type="submit" value="Enter key" />
                    556: </form>
1.147     albertel  557: $end_page
1.53      www       558: ENDENTERKEY
1.55      albertel  559: 				 return OK;
                    560: 			     }
                    561: 			 }
                    562: 		     }
1.118     albertel  563: 		    &Apache::lonnet::log($env{'user.domain'},
                    564: 					 $env{'user.name'},
                    565: 					 $env{'user.home'},
1.87      www       566: 					 "Role ".$trolecode);
1.101     albertel  567: 		    
1.56      www       568: 		    &Apache::lonnet::appenv(
1.186     raeburn   569: 					   {'request.role'        => $trolecode,
                    570: 					    'request.role.domain' => $cdom,
                    571: 					    'request.course.sec'  => $csec,
                    572:                                             'request.course.groups' => $cgrps});
1.101     albertel  573:                     my $tadv=0;
1.62      matthew   574: 
1.125     www       575: 		    if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {
1.152     raeburn   576:                         my $msg;
1.55      albertel  577: 			my ($furl,$ferr)=
                    578: 			    &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
1.284     raeburn   579:                         unless ($ferr) {
                    580:                             unless (($env{'form.switchrole'}) || 
                    581:                                     ($env{"environment.internal.$cdom.$cnum.$role.adhoc"})) {
                    582:                                 &Apache::lonnet::put('nohist_crslastlogin',
                    583:                                     {$env{'user.name'}.':'.$env{'user.domain'}.
                    584:                                      ':'.$csec.':'.$role => $now},$cdom,$cnum);
                    585:                             }
                    586:                             my ($feeds,$syllabus_time);
1.283     raeburn   587:                             &Apache::lonrss::advertisefeeds($cnum,$cdom,undef,\$feeds);
1.284     raeburn   588:                             &Apache::lonnet::appenv({'request.course.feeds' => $feeds});
1.289     raeburn   589:                             &Apache::lonnet::get_numsuppfiles($cnum,$cdom,1);
1.284     raeburn   590:                             unless ($env{'course.'.$cdom.'_'.$cnum.'.updatedsyllabus'}) {
                    591:                                 unless (($env{'course.'.$cdom.'_'.$cnum.'.externalsyllabus'}) ||
                    592:                                         ($env{'course.'.$cdom.'_'.$cnum.'.uploadedsyllabus'})) {
                    593:                                     my %syllabus=&Apache::lonnet::dump('syllabus',$cdom,$cnum);
                    594:                                     $syllabus_time = $syllabus{'uploaded.lastmodified'};
                    595:                                     if ($syllabus_time) {
                    596:                                         &Apache::lonnet::appenv({'request.course.syllabustime' => $syllabus_time});
                    597:                                     }
                    598:                                 }
                    599:                             }
1.275     raeburn   600:                         }
1.118     albertel  601: 			if (($env{'form.orgurl'}) && 
1.292     raeburn   602: 			    ($env{'form.orgurl'}!~/^\/adm\/flip/) &&
                    603: 			    ($env{'form.orgurl'} ne '/adm/roles')) {
1.118     albertel  604: 			    my $dest=$env{'form.orgurl'};
1.219     raeburn   605:                             if ($env{'form.symb'}) {
                    606:                                 if ($dest =~ /\?/) {
                    607:                                     $dest .= '&';
                    608:                                 } else {
1.292     raeburn   609:                                     $dest .= '?';
1.219     raeburn   610:                                 }
                    611:                                 $dest .= 'symb='.$env{'form.symb'};
                    612:                             }
1.117     albertel  613: 			    if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
1.186     raeburn   614: 			    &Apache::lonnet::appenv({'request.role.adv'=>$tadv});
1.150     www       615:                             if (($ferr) && ($tadv)) {
                    616: 				&error_page($r,$ferr,$dest);
                    617: 			    } else {
1.255     raeburn   618:                                 if ($dest =~ m{^/adm/coursedocs\?folderpath}) {
                    619:                                     if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { 
                    620:                                         my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
1.268     raeburn   621:                                         &Apache::loncommon::update_content_constraints($cdom,$cnum,$chome,
                    622:                                                                                        $cdom.'_'.$cnum);
1.255     raeburn   623:                                     }
                    624:                                 }
1.150     www       625: 				$r->internal_redirect($dest);
                    626: 			    }
1.55      albertel  627: 			    return OK;
                    628: 			} else {
1.155     albertel  629: 			    if (!$env{'request.course.id'}) {
1.55      albertel  630: 				&Apache::lonnet::appenv(
1.186     raeburn   631: 				      {"request.course.id"  => $cdom.'_'.$cnum});
1.61      www       632: 				$furl='/adm/roles?tryagain=1';
1.221     bisitz    633:                 $msg='<p><span class="LC_error">'
                    634:                     .&mt('Could not initialize [_1] at this time.',
                    635:                          $env{'course.'.$cdom.'_'.$cnum.'.description'})
                    636:                     .'</span></p>'
                    637:                     .'<p>'.&mt('Please try again.').'</p>'
                    638:                     .'<p>'.$ferr.'</p>';
1.55      albertel  639: 			    }
1.117     albertel  640: 			    if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
1.186     raeburn   641: 			    &Apache::lonnet::appenv({'request.role.adv'=>$tadv});
1.152     raeburn   642: 
1.150     www       643: 			    if (($ferr) && ($tadv)) {
                    644: 				&error_page($r,$ferr,$furl);
                    645: 			    } else {
                    646: 				# Check to see if the user is a CC entering a course 
                    647: 				# for the first time
1.240     raeburn   648: 				if ((($role eq 'cc') || ($role eq 'co')) 
1.297     raeburn   649:                                     && ($env{'course.'.$cdom.'_'.$cnum.'.course.helper.not.run'})) { 
1.150     www       650: 				    $furl = "/adm/helper/course.initialization.helper";
                    651: 				    # Send the user to the course they selected
                    652: 				} elsif ($env{'request.course.id'}) {
1.313     raeburn   653:                                     if ((&Apache::loncommon::course_type() eq 'Placement') && 
                    654:                                         (!$env{'request.role.adv'})) {
                    655:                                         my ($score,$incomplete) = 
                    656:                                             &Apache::lonplacementtest::check_completion(undef,undef,1);
                    657:                                         if (($incomplete) && ($incomplete < 100)) {
                    658:                                             &redirect_user($r, &mt('Entering [_1]',
                    659:                                                           $env{'course.'.$cdom.'_'.$cnum.'.description'}),
                    660:                                                           '/adm/placement', $msg);
                    661:                                             return OK;
                    662:                                         }
                    663:                                     }
1.276     raeburn   664:                                     my ($dest,$destsymb,$checkenc);
                    665:                                     $dest = $env{'form.destinationurl'};
                    666:                                     $destsymb = $env{'form.destsymb'};
                    667:                                     if ($dest ne '') {
                    668:                                         if ($env{'form.switchrole'}) {
                    669:                                             if ($destsymb ne '') {
                    670:                                                 if ($destsymb !~ m{^/enc/}) {
                    671:                                                     unless ($env{'request.role.adv'}) {
                    672:                                                         $checkenc = 1;
                    673:                                                     }
                    674:                                                 }
                    675:                                             }
                    676:                                             if ($dest =~ m{^/enc/}) {
                    677:                                                 if ($env{'request.role.adv'}) {
                    678:                                                     $dest = &Apache::lonenc::unencrypted($dest);
                    679:                                                     if ($destsymb eq '') {
1.277     raeburn   680:                                                         ($destsymb) = ($dest =~ /(?:\?|\&)symb=([^\&]*)/);
1.276     raeburn   681:                                                         $destsymb = &unescape($destsymb);
                    682:                                                     }
                    683:                                                 }
                    684:                                             } else {
                    685:                                                 if ($destsymb eq '') {
1.280     raeburn   686:                                                     ($destsymb) = ($dest =~ /(?:\?|\&)symb=([^\&]+)/);
1.276     raeburn   687:                                                     $destsymb = &unescape($destsymb);
                    688:                                                 }
                    689:                                                 unless ($env{'request.role.adv'}) {
                    690:                                                     $checkenc = 1;
                    691:                                                 }
                    692:                                             }
                    693:                                             if (($checkenc) && ($destsymb ne '')) {
                    694:                                                 my ($encstate,$unencsymb,$res);
1.281     raeburn   695:                                                 $unencsymb = &Apache::lonnet::symbclean($destsymb);
1.276     raeburn   696:                                                 (undef,undef,$res) = &Apache::lonnet::decode_symb($unencsymb);
                    697:                                                 &Apache::lonnet::symbverify($unencsymb,$res,\$encstate);
                    698:                                                 if ($encstate) {
                    699:                                                     if (($dest ne '') && ($dest !~ m{^/enc/})) {
                    700:                                                         $dest=&Apache::lonenc::encrypted($dest);
                    701:                                                     }
                    702:                                                 }
                    703:                                             }
                    704:                                         }
1.277     raeburn   705:                                         unless (($dest =~ m{^/enc/}) || ($dest =~ /(\?|\&)symb=.+___\d+___.+/)) {
1.276     raeburn   706:                                             if (($destsymb ne '') && ($destsymb !~ m{^/enc/})) {
                    707:                                                 my $esc_symb = &escape($destsymb);
                    708:                                                 $dest .= '?symb='.$esc_symb;
                    709:                                             }
1.203     raeburn   710:                                         }
1.245     droeschl  711:                                         &redirect_user($r, &mt('Entering [_1]',
1.297     raeburn   712:                                                        $env{'course.'.$cdom.'_'.$cnum.'.description'}),
1.245     droeschl  713:                                                        $dest, $msg);
1.185     raeburn   714:                                         return OK;
                    715:                                     }
1.150     www       716: 				    if (&Apache::lonnet::allowed('whn',
                    717: 								 $env{'request.course.id'})
                    718: 					|| &Apache::lonnet::allowed('whn',
                    719: 								    $env{'request.course.id'}.'/'
                    720: 								    .$env{'request.course.sec'})
                    721: 					) {
1.297     raeburn   722: 					my $startpage = &courseloadpage($env{'request.course.id'});
1.150     www       723: 					unless ($startpage eq 'firstres') {         
1.204     bisitz    724: 					    $msg = &mt('Entering [_1] ...',
1.297     raeburn   725: 						       $env{'course.'.$env{'request.course.id'}.'.description'});
1.245     droeschl  726: 					    &redirect_user($r, &mt('New in course'),
                    727:                                        '/adm/whatsnew?refpage=start', $msg);
1.150     www       728: 					    return OK;
                    729: 					}
                    730: 				    }
                    731: 				}
1.300     raeburn   732:                                 # Are we allowed to look at the first resource?
1.311     raeburn   733:                                 my $access;
1.299     musolffc  734:                                 if ($furl =~ m{^(/adm/wrapper|)/ext/}) {
1.300     raeburn   735:                                     # If it's an external resource,
1.299     musolffc  736:                                     # strip off the symb argument and possible query
                    737:                                     my ($exturl,$symb) = ($furl =~ m{^(.+)(?:\?|\&)symb=(.+)$});
                    738:                                     # Unencode $symb
                    739:                                     $symb = &unescape($symb);
                    740:                                     # Then check for permission
1.311     raeburn   741:                                     $access = &Apache::lonnet::allowed('bre',$exturl,$symb);
1.300     raeburn   742:                                 # For other resources just check for permission
1.311     raeburn   743:                                 } else {
                    744:                                     $access = &Apache::lonnet::allowed('bre',$furl);
                    745:                                 }
                    746:                                 if (!$access) {
1.299     musolffc  747:                                     $furl = &Apache::lonpageflip::first_accessible_resource();
1.311     raeburn   748:                                 } elsif ($access eq 'B') {
                    749:                                     $furl = '/adm/navmaps?showOnlyHomework=1';
1.299     musolffc  750:                                 }
1.162     albertel  751:                                 $msg = &mt('Entering [_1] ...',
1.297     raeburn   752: 					   $env{'course.'.$cdom.'_'.$cnum.'.description'});
1.245     droeschl  753: 				&redirect_user($r, &mt('Entering [_1]',
1.297     raeburn   754:                                $env{'course.'.$cdom.'_'.$cnum.'.description'}),
1.245     droeschl  755:                                $furl, $msg);
1.58      bowersj2  756: 			    }
1.124     albertel  757: 			    return OK;
1.55      albertel  758: 			}
                    759: 		    }
1.62      matthew   760:                     #
                    761:                     # Send the user to the construction space they selected
1.125     www       762:                     if ($role =~ /^(au|ca|aa)$/) {
1.62      matthew   763:                         my $redirect_url = '/priv/';
                    764:                         if ($role eq 'au') {
1.262     www       765:                             $redirect_url.=$env{'user.domain'}.'/'.$env{'user.name'};
1.62      matthew   766:                         } else {
1.263     www       767:                             $redirect_url .= $where;
1.62      matthew   768:                         }
                    769:                         $redirect_url .= '/';
1.288     raeburn   770:                         &redirect_user($r,&mt('Entering Authoring Space'),
1.62      matthew   771:                                        $redirect_url);
                    772:                         return OK;
                    773:                     }
1.104     raeburn   774:                     if ($role eq 'dc') {
1.108     raeburn   775:                         my $redirect_url = '/adm/menu/';
                    776:                         &redirect_user($r,&mt('Loading Domain Coordinator Menu'),
1.104     raeburn   777:                                        $redirect_url);
1.108     raeburn   778:                         return OK;
1.104     raeburn   779:                     }
1.315     raeburn   780:                     if ($role eq 'dh') {
                    781:                         my $redirect_url = '/adm/menu/';
                    782:                         &redirect_user($r,&mt('Loading Domain Helpdesk Menu'),
                    783:                                        $redirect_url);
                    784:                         return OK;
                    785:                     }
1.220     raeburn   786:                     if ($role eq 'sc') {
                    787:                         my $redirect_url = '/adm/grades?command=scantronupload';
                    788:                         &redirect_user($r,&mt('Loading Data Upload Page'),
                    789:                                        $redirect_url);
                    790:                         return OK;
                    791:                     }
1.55      albertel  792: 		}
                    793:             }
1.6       www       794:         }
1.40      matthew   795:     }
1.44      www       796: 
1.10      www       797: 
1.6       www       798: # =============================================================== No Roles Init
1.10      www       799: 
1.73      www       800:     &Apache::loncommon::content_type($r,'text/html');
1.30      albertel  801:     &Apache::loncommon::no_cache($r);
1.10      www       802:     $r->send_http_header;
                    803:     return OK if $r->header_only;
                    804: 
1.224     raeburn   805:     my $crumbtext = 'User Roles';
                    806:     my $pagetitle = 'My Roles';
                    807:     my $recent = &mt('Recent Roles');
1.287     raeburn   808:     my $standby = &mt('Role selected. Please stand by.');
1.224     raeburn   809:     my $show_course=&Apache::loncommon::show_course();
                    810:     if ($show_course) {
                    811:         $crumbtext = 'Courses';
                    812:         $pagetitle = 'My Courses';
                    813:         $recent = &mt('Recent Courses');
1.287     raeburn   814:         $standby = &mt('Course selected. Please stand by.'); 
1.224     raeburn   815:     }
                    816:     my $brcrum =[{href=>"/adm/roles",text=>$crumbtext}];
1.274     raeburn   817: 
                    818:     my %roles_in_env;
                    819:     my $showcount = &roles_from_env(\%roles_in_env,$update); 
                    820: 
1.52      www       821:     my $swinfo=&Apache::lonmenu::rawconfig();
1.302     raeburn   822:     my %domdefs=&Apache::lonnet::get_domain_defaults($env{'user.domain'}); 
                    823:     my $cattype = 'std';
                    824:     if ($domdefs{'catauth'}) {
                    825:         $cattype = $domdefs{'catauth'};
                    826:     }
1.313     raeburn   827:     my $placementonly;
                    828:     if ($showcount == 1) {
                    829:         if ($env{'request.course.id'}) {
                    830:             if ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement') {
                    831:                 $placementonly = 1;
                    832:             }
                    833:         } else {
                    834:             foreach my $rolecode (keys(%roles_in_env)) {
                    835:                 my ($cid) = ($rolecode =~ m{^\Quser.role.st./\E($match_domain/$match_courseid)(?:/|$)});
                    836:                 if ($cid) {
                    837:                     my %coursedescription =
                    838:                         &Apache::lonnet::coursedescription($cid,{'one_time' => '1'});
                    839:                     if ($coursedescription{'type'} eq 'Placement') {
                    840:                         $placementonly = 1;
                    841:                     }
                    842:                     last;
                    843:                 }
                    844:             }
                    845:         }
                    846:     }
                    847:     my ($start_page,$funcs);
                    848:     if ($placementonly) {
                    849:         $start_page=&Apache::loncommon::start_page($pagetitle,undef,
                    850:                                                   {bread_crumbs=>$brcrum,crstype=>'Placement'});
                    851:     } else {
                    852:         $funcs = &get_roles_functions($showcount,$cattype);
1.314     raeburn   853:         my $crumbsright;
                    854:         if ($env{'browser.mobile'}) {
                    855:             $crumbsright = $funcs;
                    856:             undef($funcs);
                    857:         }
                    858:         $start_page=&Apache::loncommon::start_page($pagetitle,undef,{bread_crumbs=>$brcrum,
                    859:                                                                      bread_crumbs_component=>$crumbsright});
1.313     raeburn   860:     }
1.312     damieng   861:     &js_escape(\$standby);
1.274     raeburn   862:     my $noscript='<br /><span class="LC_error">'.&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.').'<br />'.&mt('As this is not the case, most functionality in the system will be unavailable.').'</span><br />';
1.163     www       863: 
1.10      www       864:     $r->print(<<ENDHEADER);
1.147     albertel  865: $start_page
1.274     raeburn   866: $funcs
1.179     raeburn   867: <noscript>
                    868: $noscript
                    869: </noscript>
                    870: <script type="text/javascript">
1.225     bisitz    871: // <![CDATA[
1.26      www       872: $swinfo
                    873: window.focus();
1.134     www       874: 
                    875: active=true;
                    876: 
                    877: function enterrole (thisform,rolecode,buttonname) {
                    878:     if (active) {
                    879: 	active=false;
                    880:         document.title='$standby';
                    881:         window.status='$standby';
                    882: 	thisform.newrole.value=rolecode;
                    883: 	thisform.submit();
                    884:     } else {
                    885:        alert('$standby');
1.260     raeburn   886:     }
                    887: }
                    888: 
1.274     raeburn   889: function rolesView (caller) {
                    890:     if ((caller == 'showall') || (caller == 'noshowall')) {
                    891:         document.rolechoice.display.value = caller;
                    892:     } else {
                    893:         if ((caller == 'doupdate') || (caller == 'requestauthor') ||
                    894:             (caller == 'queued')) { 
                    895:             document.rolechoice.state.value = caller;
                    896:         }
                    897:     }
                    898:     document.rolechoice.selectrole.value='';
                    899:     document.rolechoice.submit();
1.270     raeburn   900: }
                    901: 
1.225     bisitz    902: // ]]>
1.26      www       903: </script>
1.10      www       904: ENDHEADER
1.6       www       905: 
1.2       www       906: # ------------------------------------------ Get Error Message from Environment
                    907: 
1.118     albertel  908:     my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$env{'user.error.msg'});
                    909:     if ($env{'user.error.msg'}) {
1.55      albertel  910: 	$r->log_reason(
1.118     albertel  911:    "$msg for $env{'user.name'} domain $env{'user.domain'} access $priv",$fn);
1.12      www       912:     }
1.1       harris41  913: 
1.61      www       914: # ------------------------------------------------- Can this user re-init, etc?
1.6       www       915: 
1.118     albertel  916:     my $advanced=$env{'user.adv'};
1.61      www       917:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['tryagain']);
1.118     albertel  918:     my $tryagain=$env{'form.tryagain'};
1.209     raeburn   919:     my $reinit=$env{'user.reinit'};
                    920:     delete $env{'user.reinit'};
1.6       www       921: 
1.2       www       922: # -------------------------------------------------------- Generate Page Output
1.6       www       923: # --------------------------------------------------------------- Error Header?
1.2       www       924:     if ($error) {
1.187     bisitz    925:         $r->print("<h1>".&mt('LON-CAPA Access Control')."</h1>");
1.174     albertel  926: 	$r->print("<!-- LONCAPAACCESSCONTROLERRORSCREEN --><hr /><pre>");
                    927: 	if ($priv ne '') {
1.187     bisitz    928:             $r->print(&mt('Access  : ').&Apache::lonnet::plaintext($priv)."\n");
1.174     albertel  929: 	}
                    930: 	if ($fn ne '') {
1.187     bisitz    931:             $r->print(&mt('Resource: ').&Apache::lonenc::check_encrypt($fn)."\n");
1.174     albertel  932: 	}
                    933: 	if ($msg ne '') {
1.187     bisitz    934:             $r->print(&mt('Action  : ').$msg."\n");
1.174     albertel  935: 	}
                    936: 	$r->print("</pre><hr />");
1.120     albertel  937: 	my $url=$fn;
                    938: 	my $last;
                    939: 	if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                    940: 		&GDBM_READER(),0640)) {
                    941: 	    $last=$hash{'last_known'};
                    942: 	    untie(%hash);
                    943: 	}
1.149     www       944: 	if ($last) { $fn.='?symb='.&escape($last); }
1.120     albertel  945: 
                    946: 	&Apache::londocs::changewarning($r,undef,'You have modified your course recently, [_1] may fix this access problem.',
                    947: 					&Apache::lonenc::check_encrypt($fn));
1.2       www       948:     } else {
1.118     albertel  949:         if ($env{'user.error.msg'}) {
1.209     raeburn   950:             if ($reinit) {
                    951:                 $r->print(
                    952:  '<h3><span class="LC_error">'.
1.234     raeburn   953:  &mt('As your session file for the course or community has expired, you will need to re-select it.').'</span></h3>');
1.209     raeburn   954:             } else {
                    955: 	        $r->print(
1.157     albertel  956:  '<h3><span class="LC_error">'.
1.235     bisitz    957:  &mt('You need to choose another user role or enter a specific course or community for this function.').
                    958:  '</span></h3>');
1.209     raeburn   959: 	    }
                    960:         }
1.2       www       961:     }
                    962:     if ($nochoose) {
1.177     www       963: 	$r->print("<h2>".&mt('Sorry ...')."</h2>\n<span class='LC_error'>".
                    964: 		  &mt('This action is currently not authorized.').'</span>'.
1.150     www       965: 		  &Apache::loncommon::end_page());
                    966: 	return OK;
1.6       www       967:     } else {
1.274     raeburn   968:         if ($updateresult || $reqauthor || $hotlist) {
                    969:             my $showresult = '<div>';
                    970:             if ($updateresult) {
                    971:                 $showresult .= &Apache::lonhtmlcommon::confirm_success($updateresult);
                    972:             }
                    973:             if ($reqauthor) {
                    974:                 $showresult .= &Apache::lonhtmlcommon::confirm_success($reqauthor);
                    975:             }
                    976:             if ($hotlist) {
                    977:                 $showresult .= $hotlist;
                    978:             } 
                    979:             $showresult .= '</div>';
                    980:             $r->print($showresult);
                    981:         } elsif ($env{'form.state'} eq 'queued') {
                    982:             $r->print(&get_queued());
1.270     raeburn   983:         }
1.18      www       984:         if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
                    985:     	    $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
1.6       www       986:         }
1.274     raeburn   987:         my $display = ($env{'form.display'} =~ /^(showall)$/);
1.84      www       988:         $r->print('<form method="post" name="rolechoice" action="'.(($fn)?$fn:$r->uri).'">');
1.116     albertel  989:         $r->print('<input type="hidden" name="orgurl" value="'.$fn.'" />');
                    990:         $r->print('<input type="hidden" name="selectrole" value="1" />');
1.134     www       991:         $r->print('<input type="hidden" name="newrole" value="" />');
1.274     raeburn   992:         $r->print('<input type="hidden" name="display" value="'.$display.'" />');
                    993:         $r->print('<input type="hidden" name="state" value="" />');
1.6       www       994:     }
1.259     raeburn   995:     $r->rflush();
1.226     raeburn   996: 
                    997:     my (%roletext,%sortrole,%roleclass,%futureroles,%timezones);
                    998:     my ($countactive,$countfuture,$inrole,$possiblerole) = 
1.274     raeburn   999:         &gather_roles($update,$refresh,$now,$reinit,$nochoose,\%roles_in_env,\%roletext,
                   1000:                       \%sortrole,\%roleclass,\%futureroles,\%timezones,$loncaparev);
1.226     raeburn  1001:     $refresh = $now;
                   1002:     &Apache::lonnet::appenv({'user.refresh.time'  => $refresh});
1.313     raeburn  1003:     if ($countactive == 1) {
                   1004:         if ($env{'request.course.id'}) {
                   1005:             if ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement') {
                   1006:                 $placementonly = 1;
                   1007:             }
                   1008:         } elsif ($possiblerole) {
                   1009:             if ($possiblerole =~ m{^st\./($match_domain)/($match_courseid)(?:/|$)}) {
                   1010:                 if ($env{'course.'.$1.'_'.$2.'.type'} eq 'Placement') {
                   1011:                     $placementonly = 1;
                   1012:                 }
                   1013:             }
                   1014:         }
                   1015:     }
                   1016:     if ((($cattype eq 'std') || ($cattype eq 'domonly')) && (!$env{'user.adv'}) &&
                   1017:           (!$placementonly)) {
1.196     raeburn  1018:         if ($countactive > 0) {
                   1019:             my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
1.201     raeburn  1020:             my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); 
1.233     bisitz   1021:             $r->print(
                   1022:                 '<p>'
1.295     bisitz   1023:                .&mt('[_1]Visit the [_2]Course/Community Catalog[_3][_4]'
                   1024:                    .' to view all [_5] LON-CAPA courses and communities.'
1.233     bisitz   1025:                    ,'<b>'
                   1026:                    ,'<a href="/adm/coursecatalog?showdom='.$esc_dom.'">'
1.295     bisitz   1027:                    ,'</a>'
                   1028:                    ,'</b>'
                   1029:                    ,'"'.$domdesc.'"')
1.233     bisitz   1030:                .'<br />'
1.235     bisitz   1031:                .&mt('If a course or community is [_1]not[_2] in your list of current courses and communities below,'
1.233     bisitz   1032:                    .' you may be able to enroll if self-enrollment is permitted.'
                   1033:                    ,'<b>','</b>')
                   1034:                .'</p>'
                   1035:             );
1.196     raeburn  1036:         }
                   1037:     }
                   1038: 
1.84      www      1039: # No active roles
                   1040:     if ($countactive==0) {
1.306     raeburn  1041:         &requestcourse_advice($r,$cattype,$inrole); 
1.191     raeburn  1042: 	$r->print('</form>');
                   1043:         if ($countfuture) {
                   1044:             $r->print(&mt('The following [quant,_1,role,roles] will become active in the future:',$countfuture));
                   1045:             my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,
                   1046:                                                $nochoose);
                   1047:             &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,
                   1048:                             \%roletext);
                   1049:             my $tremark='';
1.212     bisitz   1050:             my $tbg;
1.191     raeburn  1051:             if ($env{'request.role'} eq 'cm') {
1.212     bisitz   1052:                 $tbg="LC_roles_selected";
1.204     bisitz   1053:                 $tremark=&mt('Currently selected.').' ';
1.191     raeburn  1054:             } else {
1.212     bisitz   1055:                 $tbg="LC_roles_is";
1.191     raeburn  1056:             }
1.212     bisitz   1057:             $r->print(&Apache::loncommon::start_data_table_row()
                   1058:                      .'<td class="'.$tbg.'">&nbsp;</td>'
                   1059:                      .'<td colspan="3">'
                   1060:                      .&mt('No role specified')
                   1061:                      .'</td>'
                   1062:                      .'<td>'.$tremark.'&nbsp;</td>'
                   1063:                      .&Apache::loncommon::end_data_table_row()
                   1064:             );
1.191     raeburn  1065: 
1.212     bisitz   1066:             $r->print(&Apache::loncommon::end_data_table());
1.191     raeburn  1067:         }
                   1068:         $r->print(&Apache::loncommon::end_page());
1.84      www      1069: 	return OK;
1.313     raeburn  1070:     } elsif (($placementonly) && ($env{'request.role'} eq 'cm')) {
                   1071: 	$r->print('<h3>'.&mt('Please stand by.').'</h3>
                   1072: 	          <input type="hidden" name="'.$possiblerole.'" value="1" />
                   1073:                   <noscript><br />
                   1074:                   <input type="submit" name="submit" value="'.&mt('Continue').'" />
                   1075:                   </noscript></form>');
                   1076: 	$r->rflush();
                   1077: 	$r->print('<script type="text/javascript">document.forms.rolechoice.submit();</script>');
                   1078: 	$r->print(&Apache::loncommon::end_page());
                   1079: 	return OK;
1.84      www      1080:     }
                   1081: # ----------------------------------------------------------------------- Table
1.247     raeburn  1082: 
1.317     raeburn  1083:     if (($numdc > 0) || (($numdh > 0) && ($numadhoc > 0))) {
1.247     raeburn  1084:         $r->print(&coursepick_jscript());
                   1085:         $r->print(&Apache::loncommon::coursebrowser_javascript().
                   1086:                   &Apache::loncommon::authorbrowser_javascript());
                   1087:     }
                   1088: 
1.224     raeburn  1089:     unless ((!&Apache::loncommon::show_course()) || ($nochoose) || ($countactive==1)) {
1.173     albertel 1090: 	$r->print("<h2>".&mt('Select a Course to Enter')."</h2>\n");
1.84      www      1091:     }
1.229     raeburn  1092:     if ($env{'form.destinationurl'}) {
                   1093:         $r->print('<input type="hidden" name="destinationurl" value="'.
                   1094:                   $env{'form.destinationurl'}.'" />');
                   1095:         if ($env{'form.destsymb'} ne '') {
                   1096:             $r->print('<input type="hidden" name="destsymb" value="'.
                   1097:                       $env{'form.destsymb'}.'" />');
                   1098:         }
                   1099:     }
1.247     raeburn  1100: 
1.191     raeburn  1101:     my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,$nochoose);
1.118     albertel 1102:     if ($env{'environment.recentroles'}) {
1.111     albertel 1103:         my %recent_roles =
1.118     albertel 1104:                &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.111     albertel 1105: 	my $output='';
1.247     raeburn  1106: 	foreach my $role (sort(keys(%recent_roles))) {
                   1107: 	    if (ref($roletext{'user.role.'.$role}) eq 'ARRAY') {
1.223     raeburn  1108: 		$output.= &Apache::loncommon::start_data_table_row().
1.247     raeburn  1109:                           $roletext{'user.role.'.$role}->[0].
1.223     raeburn  1110:                           &Apache::loncommon::end_data_table_row();
1.249     raeburn  1111:                 if ($roletext{'user.role.'.$role}->[1] ne '') {
                   1112:                     $output .= &Apache::loncommon::continue_data_table_row().
                   1113:                                $roletext{'user.role.'.$role}->[1].
                   1114:                                &Apache::loncommon::end_data_table_row();
                   1115:                 }
1.318     raeburn  1116:                 if ($role =~ m{^dc\./($match_domain)/$} 
1.170     albertel 1117: 		    && $dcroles{$1}) {
1.192     raeburn  1118: 		    $output .= &adhoc_roles_row($1,'recent');
1.318     raeburn  1119:                 } elsif ($role =~ m{^dh\./($match_domain)/$}
1.317     raeburn  1120:                          && ($env{'environment.adhocroles.'.$1} ne '')) {
                   1121:                     $output .= &adhoc_customroles_row($1,'recent');
1.133     albertel 1122:                 }
1.113     raeburn  1123: 	    } elsif ($numdc > 0) {
1.247     raeburn  1124:                 unless ($role =~/^error\:/) {
1.249     raeburn  1125:                     my ($roletext,$role_text_end) = &display_cc_role('user.role.'.$role);
1.259     raeburn  1126:                     if ($roletext) {
                   1127:                         $output.= &Apache::loncommon::start_data_table_row().
                   1128:                                   $roletext.
                   1129:                                   &Apache::loncommon::end_data_table_row();
                   1130:                         if ($role_text_end) {
                   1131:                             $output .= &Apache::loncommon::continue_data_table_row().
                   1132:                                        $role_text_end.
                   1133:                                        &Apache::loncommon::end_data_table_row();
                   1134:                         }
                   1135:                     }
1.113     raeburn  1136:                 }
1.247     raeburn  1137:             }
1.111     albertel 1138: 	}
                   1139: 	if ($output) {
1.212     bisitz   1140: 	    $r->print(&Apache::loncommon::start_data_table_empty_row()
                   1141:                      .'<td align="center" colspan="5">'
1.224     raeburn  1142:                      .$recent
1.212     bisitz   1143:                      .'</td>'
                   1144:                      .&Apache::loncommon::end_data_table_empty_row()
                   1145:             );
1.111     albertel 1146: 	    $r->print($output);
1.114     raeburn  1147:             $doheaders ++;
1.111     albertel 1148: 	}
                   1149:     }
1.191     raeburn  1150:     &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,\%roletext);
1.202     raeburn  1151:     if ($countactive > 1) {
                   1152:         my $tremark='';
1.212     bisitz   1153:         my $tbg;
1.202     raeburn  1154:         if ($env{'request.role'} eq 'cm') {
1.212     bisitz   1155:             $tbg="LC_roles_selected";
1.204     bisitz   1156:             $tremark=&mt('Currently selected.').' ';
1.202     raeburn  1157:         } else {
1.212     bisitz   1158:                 $tbg="LC_roles_is";
1.202     raeburn  1159:         }
1.212     bisitz   1160:         $r->print(&Apache::loncommon::start_data_table_row());
1.202     raeburn  1161:         unless ($nochoose) {
                   1162: 	    if ($env{'request.role'} ne 'cm') {
1.212     bisitz   1163: 	        $r->print('<td class="'.$tbg.'"><input type="submit" value="'.
1.202     raeburn  1164: 		          &mt('Select').'" name="cm" /></td>');
                   1165: 	    } else {
1.212     bisitz   1166: 	        $r->print('<td class="'.$tbg.'">&nbsp;</td>');
1.202     raeburn  1167: 	    }
                   1168:         }
1.212     bisitz   1169:         $r->print('<td colspan="3">'
                   1170:                  .&mt('No role specified')
                   1171:                  .'</td>'
                   1172:                  .'<td>'.$tremark.'&nbsp;</td>'
                   1173:                  .&Apache::loncommon::end_data_table_row()
                   1174:         );
1.202     raeburn  1175:     } 
1.212     bisitz   1176:     $r->print(&Apache::loncommon::end_data_table());
1.4       www      1177:     unless ($nochoose) {
                   1178: 	$r->print("</form>\n");
                   1179:     }
1.22      harris41 1180: # ------------------------------------------------------------ Privileges Info
1.118     albertel 1181:     if (($advanced) && (($env{'user.error.msg'}) || ($error))) {
1.212     bisitz   1182: 	$r->print('<hr /><h2>'.&mt('Current Privileges').'</h2>');
1.175     albertel 1183: 	$r->print(&privileges_info());
1.4       www      1184:     }
1.267     bisitz   1185:     my $announcements = &Apache::lonnet::getannounce();
                   1186:     $r->print(
                   1187:         '<br />'.
                   1188:         '<h2>'.&mt('Announcements').'</h2>'.
                   1189:         $announcements
                   1190:     ) unless (!$announcements);
1.65      www      1191:     if ($advanced) {
1.201     raeburn  1192:         my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
1.231     bisitz   1193:         $r->print('<p><small><i>'
                   1194:                  .&mt('This LON-CAPA server is version [_1]',$r->dir_config('lonVersion'))
1.308     raeburn  1195:                  .'</i></small></p>');
1.65      www      1196:     }
1.147     albertel 1197:     $r->print(&Apache::loncommon::end_page());
1.1       harris41 1198:     return OK;
1.102     raeburn  1199: }
                   1200: 
1.274     raeburn  1201: sub roles_from_env {
                   1202:     my ($roleshash,$update) = @_;
                   1203:     my $count = 0;
                   1204:     if (ref($roleshash) eq 'HASH') {
                   1205:         foreach my $envkey (keys(%env)) {
                   1206:             if ($envkey =~ m{^user\.role\.(\w+)[./]}) {
                   1207:                 next if ($1 eq 'gr');
                   1208:                 $roleshash->{$envkey} = $env{$envkey};
                   1209:                 my ($start,$end) = split(/\./,$env{$envkey});
                   1210:                 unless ($end && $end<$update) {
                   1211:                     $count ++;
                   1212:                 }
                   1213:             }
                   1214:         }
                   1215:     }
                   1216:     return $count;
                   1217: }
                   1218: 
1.226     raeburn  1219: sub gather_roles {
1.274     raeburn  1220:     my ($update,$refresh,$now,$reinit,$nochoose,$roles_in_env,$roletext,$sortrole,$roleclass,$futureroles,
                   1221:         $timezones,$loncaparev) = @_;
1.226     raeburn  1222:     my ($countactive,$countfuture,$inrole,$possiblerole) = (0,0,0,'');
                   1223:     my $advanced = $env{'user.adv'};
                   1224:     my $tryagain = $env{'form.tryagain'};
1.254     raeburn  1225:     my @ids = &Apache::lonnet::current_machine_ids();
1.274     raeburn  1226:     if (ref($roles_in_env) eq 'HASH') {
                   1227:         foreach my $envkey (sort(keys(%{$roles_in_env}))) {
                   1228:             my $button = 1;
                   1229:             my $switchserver='';
                   1230:             my $switchwarning;
                   1231:             my ($role_text,$role_text_end,$sortkey,$role,$where,$trolecode,$tstart,
                   1232:                 $tend,$tremark,$tstatus,$tpstart,$tpend);
1.260     raeburn  1233:             &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
1.226     raeburn  1234:                                          \$trolecode,\$tstatus,\$tstart,\$tend);
                   1235:             next if (!defined($role) || $role eq '' || $role =~ /^gr/);
                   1236:             $tremark='';
                   1237:             $tpstart='&nbsp;';
                   1238:             $tpend='&nbsp;';
                   1239:             if ($env{'request.role'} eq $trolecode) {
                   1240:                 $tstatus='selected';
                   1241:             }
                   1242:             my $tbg;
                   1243:             if (($tstatus eq 'is')
                   1244:                 || ($tstatus eq 'selected')
                   1245:                 || ($tstatus eq 'future')
1.274     raeburn  1246:                 || ($env{'form.display'} eq 'showall')) {
1.259     raeburn  1247:                 my $timezone = &role_timezone($where,$timezones);
                   1248:                 if ($tstart) {
                   1249:                     $tpstart=&Apache::lonlocal::locallocaltime($tstart,$timezone);
                   1250:                 }
                   1251:                 if ($tend) {
                   1252:                     $tpend=&Apache::lonlocal::locallocaltime($tend,$timezone);
                   1253:                 }
1.226     raeburn  1254:                 if ($tstatus eq 'is') {
                   1255:                     $tbg='LC_roles_is';
                   1256:                     $possiblerole=$trolecode;
                   1257:                     $countactive++;
                   1258:                 } elsif ($tstatus eq 'future') {
                   1259:                     $tbg='LC_roles_future';
                   1260:                     $button=0;
                   1261:                     $futureroles->{$trolecode} = $tstart.':'.$tend;
                   1262:                     $countfuture ++;
                   1263:                 } elsif ($tstatus eq 'expired') {
                   1264:                     $tbg='LC_roles_expired';
                   1265:                     $button=0;
                   1266:                 } elsif ($tstatus eq 'will_not') {
                   1267:                     $tbg='LC_roles_will_not';
                   1268:                     $tremark.=&mt('Expired after logout.').' ';
                   1269:                 } elsif ($tstatus eq 'selected') {
                   1270:                     $tbg='LC_roles_selected';
                   1271:                     $inrole=1;
                   1272:                     $countactive++;
                   1273:                     $tremark.=&mt('Currently selected.').' ';
                   1274:                 }
                   1275:                 my $trole;
                   1276:                 if ($role =~ /^cr\//) {
                   1277:                     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
                   1278:                     if ($tremark) { $tremark.='<br />'; }
1.298     bisitz   1279:                     $tremark.=&mt('Custom role defined by [_1].',$rauthor.':'.$rdomain);
1.226     raeburn  1280:                 }
                   1281:                 $trole=Apache::lonnet::plaintext($role);
                   1282:                 my $ttype;
                   1283:                 my $twhere;
1.313     raeburn  1284:                 my $skipcal;
1.226     raeburn  1285:                 my ($tdom,$trest,$tsection)=
                   1286:                     split(/\//,Apache::lonnet::declutter($where));
                   1287:                 # First, Co-Authorship roles
                   1288:                 if (($role eq 'ca') || ($role eq 'aa')) {
                   1289:                     my $home = &Apache::lonnet::homeserver($trest,$tdom);
                   1290:                     my $allowed=0;
                   1291:                     foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
                   1292:                     if (!$allowed) {
                   1293:                         $button=0;
1.248     raeburn  1294:                         $switchserver='otherserver='.$home.'&amp;role='.$trolecode;
1.226     raeburn  1295:                     }
                   1296:                     #next if ($home eq 'no_host');
                   1297:                     $home = &Apache::lonnet::hostname($home);
1.288     raeburn  1298:                     $ttype='Authoring Space';
1.226     raeburn  1299:                     $twhere=&mt('User').': '.$trest.'<br />'.&mt('Domain').
                   1300:                         ': '.$tdom.'<br />'.
                   1301:                         ' '.&mt('Server').':&nbsp;'.$home;
                   1302:                     $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
                   1303:                     $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$trest.'/');
                   1304:                     $sortkey=$role."$trest:$tdom";
                   1305:                 } elsif ($role eq 'au') {
                   1306:                     # Authors
                   1307:                     my $home = &Apache::lonnet::homeserver
                   1308:                         ($env{'user.name'},$env{'user.domain'});
                   1309:                     my $allowed=0;
                   1310:                     foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
                   1311:                     if (!$allowed) {
                   1312:                         $button=0;
1.248     raeburn  1313:                         $switchserver='otherserver='.$home.'&amp;role='.$trolecode;
1.226     raeburn  1314:                     }
                   1315:                     #next if ($home eq 'no_host');
                   1316:                     $home = &Apache::lonnet::hostname($home);
1.288     raeburn  1317:                     $ttype='Authoring Space';
1.226     raeburn  1318:                     $twhere=&mt('Domain').': '.$tdom.'<br />'.&mt('Server').
                   1319:                         ':&nbsp;'.$home;
                   1320:                     $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
                   1321:                     $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/');
                   1322:                     $sortkey=$role;
                   1323:                 } elsif ($trest) {
                   1324:                     my $tcourseid=$tdom.'_'.$trest;
                   1325:                     $ttype = &Apache::loncommon::course_type($tcourseid);
1.242     raeburn  1326:                     $trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);
1.226     raeburn  1327:                     if ($env{'course.'.$tcourseid.'.description'}) {
1.254     raeburn  1328:                         my $home=$env{'course.'.$tcourseid.'.home'};
1.226     raeburn  1329:                         $twhere=$env{'course.'.$tcourseid.'.description'};
                   1330:                         $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
1.248     raeburn  1331:                         $twhere = &HTML::Entities::encode($twhere,'"<>&');
1.226     raeburn  1332:                         unless ($twhere eq &mt('Currently not available')) {
                   1333:                             $twhere.=' <span class="LC_fontsize_small">'.
                   1334:         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
                   1335:                                     '</span>';
1.254     raeburn  1336:                             unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') {
1.255     raeburn  1337:                                 my $required = $env{'course.'.$tcourseid.'.internal.releaserequired'};
1.259     raeburn  1338:                                 if ($required ne '') {
                   1339:                                     ($switchserver,$switchwarning) = 
1.310     raeburn  1340:                                         &Apache::loncommon::check_release_required($loncaparev,$tcourseid,$trolecode,$required);
1.259     raeburn  1341:                                     if ($switchserver || $switchwarning) {
                   1342:                                         $button = 0;
                   1343:                                     }
1.254     raeburn  1344:                                 }
                   1345:                             }
1.226     raeburn  1346:                         }
                   1347:                     } else {
                   1348:                         my %newhash=&Apache::lonnet::coursedescription($tcourseid);
                   1349:                         if (%newhash) {
                   1350:                             $sortkey=$role."\0".$tdom."\0".$newhash{'description'}.
                   1351:                                 "\0".$envkey;
1.248     raeburn  1352:                             $twhere=&HTML::Entities::encode($newhash{'description'},'"<>&').
                   1353:                                     ' <span class="LC_fontsize_small">'.
                   1354:                                      &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
                   1355:                                     '</span>';
1.226     raeburn  1356:                             $ttype = $newhash{'type'};
1.243     raeburn  1357:                             $trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);
1.254     raeburn  1358:                             my $home = $newhash{'home'};
                   1359:                             unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') {
1.255     raeburn  1360:                                 my $required = $newhash{'internal.releaserequired'};
1.259     raeburn  1361:                                 if ($required ne '') {
                   1362:                                     ($switchserver,$switchwarning) =
1.310     raeburn  1363:                                         &Apache::loncommon::check_release_required($loncaparev,$tcourseid,$trolecode,$required);
1.259     raeburn  1364:                                     if ($switchserver || $switchwarning) {
                   1365:                                         $button = 0;
                   1366:                                     }
1.254     raeburn  1367:                                 }
                   1368:                             }
1.226     raeburn  1369:                         } else {
                   1370:                             $twhere=&mt('Currently not available');
                   1371:                             $env{'course.'.$tcourseid.'.description'}=$twhere;
                   1372:                             $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
                   1373:                             $ttype = 'Unavailable';
1.313     raeburn  1374:                             $skipcal = 1;
1.226     raeburn  1375:                         }
                   1376:                     }
1.313     raeburn  1377:                     if ($ttype eq 'Placement') {
                   1378:                         $ttype = 'Placement Test';
                   1379:                     }
1.226     raeburn  1380:                     if ($tsection) {
                   1381:                         $twhere.='<br />'.&mt('Section').': '.$tsection;
                   1382:                     }
                   1383:                     if ($role ne 'st') { $twhere.="<br />".&mt('Domain').":".$tdom; }
                   1384:                 } elsif ($tdom) {
                   1385:                     $ttype='Domain';
                   1386:                     $twhere=$tdom;
                   1387:                     $sortkey=$role.$twhere;
                   1388:                 } else {
                   1389:                     $ttype='System';
                   1390:                     $twhere=&mt('system wide');
                   1391:                     $sortkey=$role.$twhere;
                   1392:                 }
                   1393:                 ($role_text,$role_text_end) =
                   1394:                     &build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,
                   1395:                                     $advanced,$tremark,$tbg,$trole,$twhere,$tpstart,
1.313     raeburn  1396:                                     $tpend,$nochoose,$button,$switchserver,$reinit,
                   1397:                                     $switchwarning,$skipcal);
1.226     raeburn  1398:                 $roletext->{$envkey}=[$role_text,$role_text_end];
                   1399:                 if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
                   1400:                 $sortrole->{$sortkey}=$envkey;
                   1401:                 $roleclass->{$envkey}=$ttype;
                   1402:             }
                   1403:         }
                   1404:     }
                   1405:     return ($countactive,$countfuture,$inrole,$possiblerole);
                   1406: }
                   1407: 
1.215     raeburn  1408: sub role_timezone {
                   1409:     my ($where,$timezones) = @_;
                   1410:     my $timezone;
                   1411:     if (ref($timezones) eq 'HASH') { 
                   1412:         if ($where =~ m{^/($match_domain)/($match_courseid)}) {
                   1413:             my $cdom = $1;
                   1414:             my $cnum = $2;
                   1415:             if ($cdom && $cnum) {
                   1416:                 if (!exists($timezones->{$cdom.'_'.$cnum})) {
1.259     raeburn  1417:                     my $tz;
                   1418:                     if ($env{'course.'.$cdom.'_'.$cnum.'.description'}) {
                   1419:                         $tz = $env{'course.'.$cdom.'_'.$cnum.'.timezone'};
                   1420:                     } else {
                   1421:                         my %timehash =
                   1422:                             &Apache::lonnet::get('environment',['timezone'],$cdom,$cnum);
                   1423:                         $tz = $timehash{'timezone'};
                   1424:                     }
                   1425:                     if ($tz eq '') {
1.215     raeburn  1426:                         if (!exists($timezones->{$cdom})) {
                   1427:                             my %domdefaults = 
                   1428:                                 &Apache::lonnet::get_domain_defaults($cdom);
                   1429:                             if ($domdefaults{'timezone_def'} eq '') {
                   1430:                                 $timezones->{$cdom} = 'local';
                   1431:                             } else {
                   1432:                                 $timezones->{$cdom} = $domdefaults{'timezone_def'};
                   1433:                             }
                   1434:                         }
                   1435:                         $timezones->{$cdom.'_'.$cnum} = $timezones->{$cdom};
                   1436:                     } else {
                   1437:                         $timezones->{$cdom.'_'.$cnum} = 
1.259     raeburn  1438:                             &Apache::lonlocal::gettimezone($tz);
1.215     raeburn  1439:                     }
                   1440:                 }
                   1441:                 $timezone = $timezones->{$cdom.'_'.$cnum};
                   1442:             }
                   1443:         } else {
                   1444:             my ($tdom) = ($where =~ m{^/($match_domain)});
                   1445:             if ($tdom) {
                   1446:                 if (!exists($timezones->{$tdom})) {
                   1447:                     my %domdefaults = &Apache::lonnet::get_domain_defaults($tdom);
                   1448:                     if ($domdefaults{'timezone_def'} eq '') {
                   1449:                         $timezones->{$tdom} = 'local';
                   1450:                     } else {
                   1451:                         $timezones->{$tdom} = $domdefaults{'timezone_def'};
                   1452:                     }
                   1453:                 }
                   1454:                 $timezone = $timezones->{$tdom};
                   1455:             }
                   1456:         }
                   1457:         if ($timezone eq 'local') {
                   1458:             $timezone = undef;
                   1459:         }
                   1460:     }
                   1461:     return $timezone;
                   1462: }
                   1463: 
1.191     raeburn  1464: sub roletable_headers {
                   1465:     my ($r,$roleclass,$sortrole,$nochoose) = @_;
                   1466:     my $doheaders;
                   1467:     if ((ref($sortrole) eq 'HASH') && (ref($roleclass) eq 'HASH')) {
1.212     bisitz   1468:         $r->print('<br />'
1.314     raeburn  1469:                  .&Apache::loncommon::start_data_table('LC_textsize_mobile')
1.212     bisitz   1470:                  .&Apache::loncommon::start_data_table_header_row()
                   1471:         );
1.191     raeburn  1472:         if (!$nochoose) { $r->print('<th>&nbsp;</th>'); }
1.212     bisitz   1473:         $r->print('<th>'.&mt('User Role').'</th>'
                   1474:                  .'<th>'.&mt('Extent').'</th>'
                   1475:                  .'<th>'.&mt('Start').'</th>'
                   1476:                  .'<th>'.&mt('End').'</th>'
                   1477:                  .&Apache::loncommon::end_data_table_header_row()
                   1478:         );
1.191     raeburn  1479:         $doheaders=-1;
                   1480:         my @roletypes = &roletypes();
                   1481:         foreach my $type (@roletypes) {
                   1482:             my $haverole=0;
                   1483:             foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) {
                   1484:                 if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) {
                   1485:                     $haverole=1;
                   1486:                 }
                   1487:             }
                   1488:             if ($haverole) { $doheaders++; }
                   1489:         }
                   1490:     }
                   1491:     return $doheaders;
                   1492: }
                   1493: 
                   1494: sub roletypes {
1.313     raeburn  1495:     my @types = ('Domain','Authoring Space','Course','Placement Test','Community','Unavailable','System');
1.191     raeburn  1496:     return @types; 
                   1497: }
                   1498: 
                   1499: sub print_rolerows {
                   1500:     my ($r,$doheaders,$roleclass,$sortrole,$dcroles,$roletext) = @_;
                   1501:     if ((ref($roleclass) eq 'HASH') && (ref($sortrole) eq 'HASH')) {
                   1502:         my @types = &roletypes();
                   1503:         foreach my $type (@types) {
                   1504:             my $output;
                   1505:             foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) {
                   1506:                 if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) {
                   1507:                     if (ref($roletext) eq 'HASH') {
1.223     raeburn  1508:                         if (ref($roletext->{$sortrole->{$which}}) eq 'ARRAY') {
                   1509:                             $output.= &Apache::loncommon::start_data_table_row().
                   1510:                                       $roletext->{$sortrole->{$which}}->[0].
                   1511:                                       &Apache::loncommon::end_data_table_row();
1.251     raeburn  1512:                             if ($roletext->{$sortrole->{$which}}->[1] ne '') {
                   1513:                                 $output .= &Apache::loncommon::continue_data_table_row().
                   1514:                                            $roletext->{$sortrole->{$which}}->[1].
                   1515:                                            &Apache::loncommon::end_data_table_row();
                   1516:                             }
1.223     raeburn  1517:                         }
1.317     raeburn  1518:                         if ($sortrole->{$which} =~ m{^user\.role\.dc\./($match_domain)/}) {
1.191     raeburn  1519:                             if (ref($dcroles) eq 'HASH') {
                   1520:                                 if ($dcroles->{$1}) {
1.192     raeburn  1521:                                     $output .= &adhoc_roles_row($1,'');
1.191     raeburn  1522:                                 }
                   1523:                             }
1.317     raeburn  1524:                         } elsif (($sortrole->{$which} =~ m{^user\.role\.dh\./($match_domain)/}) &&
                   1525:                                  ($env{'environment.adhocroles.'.$1} ne '')) {
                   1526:                             $output .= &adhoc_customroles_row($1,'');
1.191     raeburn  1527:                         }
                   1528:                     }
                   1529:                 }
                   1530:             }
                   1531:             if ($output) {
                   1532:                 if ($doheaders > 0) {
1.212     bisitz   1533:                     $r->print(&Apache::loncommon::start_data_table_empty_row()
                   1534:                              .'<td align="center" colspan="5">'
                   1535:                              .&mt($type)
                   1536:                              .'</td>'
                   1537:                              .&Apache::loncommon::end_data_table_empty_row()
                   1538:                     );
1.191     raeburn  1539:                 }
                   1540:                 $r->print($output);
                   1541:             }
                   1542:         }
                   1543:     }
                   1544: }
                   1545: 
                   1546: sub findcourse_advice {
1.302     raeburn  1547:     my ($r,$cattype) = @_;
1.191     raeburn  1548:     my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
1.201     raeburn  1549:     my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
1.200     raeburn  1550:     if (&Apache::lonnet::auto_run(undef,$env{'user.domain'})) {
1.191     raeburn  1551:         $r->print(&mt('If you were expecting to see an active role listed for a particular course in the [_1] domain, it may be missing for one of the following reasons:',$domdesc).'
                   1552: <ul>
                   1553:  <li>'.&mt('The course has yet to be created.').'</li>
                   1554:  <li>'.&mt('Automatic enrollment of registered students has not been enabled for the course.').'</li>
                   1555:  <li>'.&mt('You are in a section of course for which automatic enrollment in the corresponding LON-CAPA course is not active.').'</li>
                   1556:  <li>'.&mt('The start date for automated enrollment has yet to be reached.').'</li>
                   1557:  <li>'.&mt('You registered for the course recently and there is a time lag between the time you register, and the time this information becomes available for the update of LON-CAPA course rosters.').'</li>
                   1558:  </ul>');
                   1559:     } else {
                   1560:         $r->print(&mt('If you were expecting to see an active role listed for a particular course, that course may not have been created yet.').'<br />');
                   1561:     }
1.302     raeburn  1562:     if (($cattype eq 'std') || ($cattype eq 'domonly')) {
                   1563:         $r->print('<h3>'.&mt('Self-Enrollment').'</h3>'.
                   1564:                   '<p>'.&mt('The [_1]Course/Community Catalog[_2] provides information about all [_3] classes for which LON-CAPA courses have been created, as well as any communities in the domain.','<a href="/adm/coursecatalog?showdom='.$esc_dom.'">','</a>',$domdesc).'<br />');
                   1565:         $r->print(&mt('You can search for courses and communities which permit self-enrollment, if you would like to enroll in one.').'</p>'.
                   1566:         &Apache::loncoursequeueadmin::queued_selfenrollment());
                   1567:     }
1.216     raeburn  1568:     return;
                   1569: }
                   1570: 
1.234     raeburn  1571: sub requestcourse_advice {
1.306     raeburn  1572:     my ($r,$cattype,$inrole) = @_;
1.234     raeburn  1573:     my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
                   1574:     my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
1.306     raeburn  1575:     my (%can_request,%request_doms,$output);
1.234     raeburn  1576:     &Apache::lonnet::check_can_request($env{'user.domain'},\%can_request,\%request_doms);
                   1577:     if (keys(%request_doms) > 0) {
                   1578:         my ($types,$typename) = &Apache::loncommon::course_types();
                   1579:         if ((ref($types) eq 'ARRAY') && (ref($typename) eq 'HASH')) { 
                   1580:             my (@reqdoms,@reqtypes);
                   1581:             foreach my $type (sort(keys(%request_doms))) {
                   1582:                 push(@reqtypes,$type); 
                   1583:                 if (ref($request_doms{$type}) eq 'ARRAY') {
                   1584:                     my $domstr = join(', ',map { &Apache::lonnet::domain($_) } sort(@{$request_doms{$type}}));
1.306     raeburn  1585:                     $output .=
1.238     bisitz   1586:                         '<li>'
                   1587:                        .&mt('[_1]'.$typename->{$type}.'[_2] in domain: [_3]',
                   1588:                             '<i>',
                   1589:                             '</i>',
                   1590:                             '<b>'.$domstr.'</b>')
1.306     raeburn  1591:                        .'</li>';
1.234     raeburn  1592:                     foreach my $dom (@{$request_doms{$type}}) {
                   1593:                         unless (grep(/^\Q$dom\E/,@reqdoms)) {
                   1594:                             push(@reqdoms,$dom);
                   1595:                         }
                   1596:                     }
                   1597:                 }
                   1598:             }
                   1599:             my @showtypes;
                   1600:             foreach my $type (@{$types}) {
                   1601:                 if (grep(/^\Q$type\E$/,@reqtypes)) {
                   1602:                     push(@showtypes,$type);
                   1603:                 }
                   1604:             }
                   1605:             my $requrl = '/adm/requestcourse';
                   1606:             if (@reqdoms == 1) {
                   1607:                 $requrl .= '?showdom='.$reqdoms[0];
                   1608:             }
                   1609:             if (@showtypes > 0) {
                   1610:                 $requrl.=(($requrl=~/\?/)?'&':'?').'crstype='.$showtypes[0];
                   1611:             }
                   1612:             if (@reqdoms == 1 || @showtypes > 0) {
                   1613:                 $requrl .= '&state=crstype&action=new';
1.306     raeburn  1614:             }
1.307     raeburn  1615:             if ($output) {
                   1616:                 $r->print('<h3>'.&mt('Request creation of a course or community').'</h3>'.
                   1617:                           '<p>'.
                   1618:                           &mt('You have rights to request the creation of courses and/or communities in the following domain(s):').
                   1619:                           '<ul>'.
                   1620:                           $output.
                   1621:                           '</ul>'.
                   1622:                           &mt('Use the [_1]request form[_2] to submit a request for creation of a new course or community.',
                   1623:                               '<a href="'.$requrl.'">','</a>').
                   1624:                           '</p>');
                   1625:             }
1.234     raeburn  1626:         }
1.302     raeburn  1627:     } elsif (!$env{'user.adv'}) {
1.306     raeburn  1628:        if ($inrole) {
                   1629:             $r->print('<h3>'.&mt('Currently no additional roles, courses or communities').'</h3>');
                   1630:         } else {
                   1631:             $r->print('<h3>'.&mt('Currently no active roles, courses or communities').'</h3>');
                   1632:         }
1.302     raeburn  1633:         &findcourse_advice($r,$cattype);
1.234     raeburn  1634:     }
                   1635:     return;
                   1636: }
                   1637: 
1.175     albertel 1638: sub privileges_info {
                   1639:     my ($which) = @_;
                   1640:     my $output;
                   1641: 
                   1642:     $which ||= $env{'request.role'};
                   1643: 
                   1644:     foreach my $envkey (sort(keys(%env))) {
                   1645: 	next if ($envkey!~/^user\.priv\.\Q$which\E\.(.*)/);
                   1646: 
                   1647: 	my $where=$1;
                   1648: 	my $ttype;
                   1649: 	my $twhere;
                   1650: 	my (undef,$tdom,$trest,$tsec)=split(m{/},$where);
                   1651: 	if ($trest) {
                   1652: 	    if ($env{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
1.288     raeburn  1653: 		$ttype='Authoring Space';
1.175     albertel 1654: 		$twhere='User: '.$trest.', Domain: '.$tdom;
                   1655: 	    } else {
                   1656: 		$ttype= &Apache::loncommon::course_type($tdom.'_'.$trest);
                   1657: 		$twhere=$env{'course.'.$tdom.'_'.$trest.'.description'};
                   1658: 		if ($tsec) {
                   1659: 		    my $sec_type = 'Section';
                   1660: 		    if (exists($env{"user.role.gr.$where"})) {
                   1661: 			$sec_type = 'Group';
                   1662: 		    }
                   1663: 		    $twhere.=' ('.$sec_type.': '.$tsec.')';
                   1664: 		}
                   1665: 	    }
                   1666: 	} elsif ($tdom) {
                   1667: 	    $ttype='Domain';
                   1668: 	    $twhere=$tdom;
                   1669: 	} else {
                   1670: 	    $ttype='System';
                   1671: 	    $twhere='/';
                   1672: 	}
1.204     bisitz   1673: 	$output .= "\n<h3>".&mt($ttype).': '.$twhere.'</h3>'."\n<ul>";
1.175     albertel 1674: 	foreach my $priv (sort(split(/:/,$env{$envkey}))) {
                   1675: 	    next if (!$priv);
                   1676: 
                   1677: 	    my ($prv,$restr)=split(/\&/,$priv);
                   1678: 	    my $trestr='';
                   1679: 	    if ($restr ne 'F') {
                   1680: 		$trestr.=' ('.
                   1681: 		    join(', ',
                   1682: 			 map { &Apache::lonnet::plaintext($_) } 
                   1683: 			     (split('',$restr))).') ';
                   1684: 	    }
                   1685: 	    $output .= "\n\t".
                   1686: 		'<li>'.&Apache::lonnet::plaintext($prv).$trestr.'</li>';
                   1687: 	}
                   1688: 	$output .= "\n".'</ul>';
                   1689:     }
                   1690:     return $output;
                   1691: }
                   1692: 
1.110     raeburn  1693: sub build_roletext {
1.313     raeburn  1694:     my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$trole,$twhere,
                   1695:         $tpstart,$tpend,$nochoose,$button,$switchserver,$reinit,$switchwarning,$skipcal) = @_;
1.223     raeburn  1696:     my ($roletext,$roletext_end);
1.132     albertel 1697:     my $is_dc=($trolecode =~ m/^dc\./);
                   1698:     my $rowspan=($is_dc) ? ''
                   1699:                          : ' rowspan="2" ';
                   1700: 
1.110     raeburn  1701:     unless ($nochoose) {
1.134     www      1702:         my $buttonname=$trolecode;
                   1703:         $buttonname=~s/\W//g;
1.110     raeburn  1704:         if (!$button) {
                   1705:             if ($switchserver) {
1.212     bisitz   1706:                 $roletext.='<td'.$rowspan.' class="'.$tbg.'">'
                   1707:                           .'<a href="/adm/switchserver?'.$switchserver.'">'
                   1708:                           .&mt('Switch Server')
                   1709:                           .'</a></td>';
1.110     raeburn  1710:             } else {
1.212     bisitz   1711:                 $roletext.=('<td'.$rowspan.' class="'.$tbg.'">&nbsp;</td>');
1.110     raeburn  1712:             }
1.255     raeburn  1713:             if ($switchwarning) {
                   1714:                 if ($tremark eq '') {
                   1715:                     $tremark = $switchwarning;
                   1716:                 } else {
                   1717:                     $tremark .= '<br />'.$switchwarning;
                   1718:                 }
                   1719:             }
1.110     raeburn  1720:         } elsif ($tstatus eq 'is') {
1.212     bisitz   1721:             $roletext.='<td'.$rowspan.' class="'.$tbg.'">'.
                   1722:                         '<input name="'.$buttonname.'" type="button" value="'.
1.225     bisitz   1723:                         &mt('Select').'" onclick="javascript:enterrole(this.form,\''.
1.192     raeburn  1724:                         $trolecode."','".$buttonname.'\');" /></td>';
1.110     raeburn  1725:         } elsif ($tryagain) {
                   1726:             $roletext.=
1.212     bisitz   1727:                 '<td'.$rowspan.' class="'.$tbg.'">'.
                   1728:                 '<input name="'.$buttonname.'" type="button" value="'.
1.225     bisitz   1729:                 &mt('Try Selecting Again').'" onclick="javascript:enterrole(this.form,\''.
1.192     raeburn  1730:                         $trolecode."','".$buttonname.'\');" /></td>';
1.110     raeburn  1731:         } elsif ($advanced) {
                   1732:             $roletext.=
1.212     bisitz   1733:                 '<td'.$rowspan.' class="'.$tbg.'">'.
                   1734:                 '<input name="'.$buttonname.'" type="button" value="'.
1.225     bisitz   1735:                 &mt('Re-Initialize').'" onclick="javascript:enterrole(this.form,\''.
1.192     raeburn  1736:                         $trolecode."','".$buttonname.'\');" /></td>';
1.209     raeburn  1737:         } elsif ($reinit) {
                   1738:             $roletext.= 
1.212     bisitz   1739:                 '<td'.$rowspan.' class="'.$tbg.'">'.
                   1740:                 '<input name="'.$buttonname.'" type="button" value="'.
1.225     bisitz   1741:                 &mt('Re-Select').'" onclick="javascript:enterrole(this.form,\''.
1.209     raeburn  1742:                         $trolecode."','".$buttonname.'\');" /></td>';
1.110     raeburn  1743:         } else {
1.209     raeburn  1744:             $roletext.=
1.212     bisitz   1745:                 '<td'.$rowspan.' class="'.$tbg.'">'.
                   1746:                 '<input name="'.$buttonname.'" type="button" value="'.
1.225     bisitz   1747:                 &mt('Re-Select').'" onclick="javascript:enterrole(this.form,\''.
1.209     raeburn  1748:                         $trolecode."','".$buttonname.'\');" /></td>';
1.110     raeburn  1749:         }
                   1750:     }
1.313     raeburn  1751:     if (($trolecode !~ m/^(dc|ca|au|aa)\./)  && (!$skipcal)) {
1.165     albertel 1752: 	$tremark.=&Apache::lonannounce::showday(time,1,
                   1753: 			 &Apache::lonannounce::readcalendar($tdom.'_'.$trest));
                   1754:     }
1.212     bisitz   1755:     $roletext.='<td>'.$trole.'</td>'
                   1756:               .'<td>'.$twhere.'</td>'
                   1757:               .'<td>'.$tpstart.'</td>'
1.223     raeburn  1758:               .'<td>'.$tpend.'</td>';
1.132     albertel 1759:     if (!$is_dc) {
1.223     raeburn  1760:         $roletext_end = '<td colspan="4">'.
                   1761:                         $tremark.'&nbsp;'.
                   1762:                         '</td>';
1.132     albertel 1763:     }
1.223     raeburn  1764:     return ($roletext,$roletext_end);
1.110     raeburn  1765: }
                   1766: 
1.193     raeburn  1767: sub check_author_homeserver {
1.183     www      1768:     my ($uname,$udom)=@_;
1.193     raeburn  1769:     if (($uname eq '') || ($udom eq '')) {
                   1770:         return ('fail','');
                   1771:     }
1.183     www      1772:     my $home = &Apache::lonnet::homeserver($uname,$udom);
1.193     raeburn  1773:     if (&Apache::lonnet::host_domain($home) ne $udom) {
                   1774:         return ('fail',$home);
                   1775:     }
1.183     www      1776:     my @ids=&Apache::lonnet::current_machine_ids();
1.193     raeburn  1777:     if (grep(/^\Q$home\E$/,@ids)) {
                   1778:         return ('ok',$home);
                   1779:     } else {
                   1780:         return ('switchserver',$home);
1.183     www      1781:     }
                   1782: }
                   1783: 
1.317     raeburn  1784: sub check_for_adhoc {
                   1785:     my ($dcroles,$dhroles,$update,$then) = @_;
1.104     raeburn  1786:     my $numdc = 0;
1.317     raeburn  1787:     my $numdh = 0;
                   1788:     my $numadhoc = 0;
                   1789:     my $num_custom_adhoc = 0; 
1.118     albertel 1790:     if ($env{'user.adv'}) {
1.309     raeburn  1791:         foreach my $envkey (sort(keys(%env))) {
1.317     raeburn  1792:             if ($envkey=~/^user\.role\.(dc|dh)\.\/($match_domain)\/$/) {
                   1793:                 my $role = $1;
                   1794:                 my $roledom = $2;
                   1795:                 my $liverole = 1;
1.118     albertel 1796:                 my ($tstart,$tend)=split(/\./,$env{$envkey});
1.260     raeburn  1797:                 my $limit = $update;
1.317     raeburn  1798:                 if ((($role eq 'dc') && ($env{'request.role'} eq 'dc./'.$roledom.'/')) ||
                   1799:                     (($role eq 'dh') && ($env{'request.role'} eq 'dh./'.$roledom.'/'))) {
1.260     raeburn  1800:                     $limit = $then;
                   1801:                 }
1.317     raeburn  1802:                 if ($tstart && $tstart>$limit) { $liverole = 0; }
                   1803:                 if ($tend   && $tend  <$limit) { $liverole = 0; }
                   1804:                 if ($liverole) {
                   1805:                     if ($role eq 'dc') {
                   1806:                         $dcroles->{$roledom} = $envkey;
                   1807:                         $numdc++;
                   1808:                     } else {
                   1809:                         $dhroles->{$roledom} = $envkey;
                   1810:                         if ($env{'environment.adhocroles.'.$roledom} ne '') {
                   1811:                             $numadhoc ++;
                   1812:                         }
                   1813:                         $numdh++;
                   1814:                     }
1.104     raeburn  1815:                 }
                   1816:             }
                   1817:         }
                   1818:     }
1.317     raeburn  1819:     return ($numdc,$numdh,$numadhoc);
1.104     raeburn  1820: }
                   1821: 
1.185     raeburn  1822: sub adhoc_course_role {
1.260     raeburn  1823:     my ($refresh,$update,$then) = @_;
1.239     raeburn  1824:     my ($cdom,$cnum,$crstype);
1.201     raeburn  1825:     $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1826:     $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.239     raeburn  1827:     $crstype = &Apache::loncommon::course_type();
1.260     raeburn  1828:     if (&check_forcc($cdom,$cnum,$refresh,$update,$then,$crstype)) {
1.185     raeburn  1829:         my $setprivs;
1.198     raeburn  1830:         if (!defined($env{'user.role.'.$env{'form.switchrole'}})) {
1.185     raeburn  1831:             $setprivs = 1;
                   1832:         } else {
1.198     raeburn  1833:             my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}});
1.232     raeburn  1834:             if (($start && ($start>$refresh || $start == -1)) ||
1.260     raeburn  1835:                 ($end && $end<$update)) {
1.185     raeburn  1836:                 $setprivs = 1;
                   1837:             }
1.232     raeburn  1838:         }
1.278     raeburn  1839:         unless ($setprivs) {
                   1840:             if (!exists($env{'user.priv.'.$env{'form.switchrole'}.'./'})) {
                   1841:                 $setprivs = 1;
                   1842:             }
                   1843:         }
1.185     raeburn  1844:         if ($setprivs) {
1.297     raeburn  1845:             if ($env{'form.switchrole'} =~ m-^(in|ta|ep|ad|st|cr)(.*?)\./\Q$cdom\E/\Q$cnum\E/?(\w*)$-) {
1.185     raeburn  1846:                 my $role = $1;
                   1847:                 my $custom_role = $2;
                   1848:                 my $usec = $3;
                   1849:                 if ($role eq 'cr') {
1.199     raeburn  1850:                     if ($custom_role =~ m-^/$match_domain/$match_username/\w+$-) {
1.185     raeburn  1851:                         $role .= $custom_role;
                   1852:                     } else {
                   1853:                         return;
                   1854:                     }
                   1855:                 }
1.208     raeburn  1856:                 my (%userroles,%newrole,%newgroups,%group_privs);
                   1857:                 my %cgroups =
                   1858:                     &Apache::lonnet::get_active_groups($env{'user.domain'},
                   1859:                                             $env{'user.name'},$cdom,$cnum);
                   1860:                 foreach my $group (keys(%cgroups)) {
                   1861:                     $group_privs{$group} =
                   1862:                         $env{'user.priv.cc./'.$cdom.'/'.$cnum.'./'.$cdom.'/'.$cnum.'/'.$group};
                   1863:                 }
                   1864:                 $newgroups{'/'.$cdom.'/'.$cnum} = \%group_privs;
1.185     raeburn  1865:                 my $area = '/'.$cdom.'/'.$cnum;
                   1866:                 my $spec = $role.'.'.$area;
                   1867:                 if ($usec ne '') {
                   1868:                     $spec .= '/'.$usec;
                   1869:                     $area .= '/'.$usec;
                   1870:                 }
1.278     raeburn  1871:                 if ($role =~ /^cr/) {
                   1872:                     &Apache::lonnet::custom_roleprivs(\%newrole,$role,$cdom,$cnum,$spec,$area);
                   1873:                 } else {
                   1874:                     &Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,$area);
                   1875:                 }
1.208     raeburn  1876:                 &Apache::lonnet::set_userprivs(\%userroles,\%newrole,\%newgroups);
1.232     raeburn  1877:                 my $adhocstart = $refresh-1;
1.185     raeburn  1878:                 $userroles{'user.role.'.$spec} = $adhocstart.'.';
1.186     raeburn  1879:                 &Apache::lonnet::appenv(\%userroles,[$role,'cm']);
1.185     raeburn  1880:             }
                   1881:         }
                   1882:     }
                   1883:     return;
                   1884: }
                   1885: 
                   1886: sub check_forcc {
1.260     raeburn  1887:     my ($cdom,$cnum,$refresh,$update,$then,$crstype) = @_;
1.239     raeburn  1888:     my ($is_cc,$ccrole);
                   1889:     if ($crstype eq 'Community') {
                   1890:         $ccrole = 'co';
                   1891:     } else {
                   1892:         $ccrole = 'cc';
                   1893:     }
1.266     droeschl 1894:     if (&Apache::lonnet::is_course($cdom,$cnum)) {
                   1895:         my $envkey = 'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum;
                   1896:         if (defined($env{$envkey})) {
                   1897:             $is_cc = 1;
                   1898:             my ($tstart,$tend)=split(/\./,$env{$envkey});
                   1899:             my $limit = $update;
                   1900:             if ($env{'request.role'} eq $ccrole.'./'.$cdom.'/'.$cnum) {
                   1901:                 $limit = $then;
1.185     raeburn  1902:             }
1.266     droeschl 1903:             if ($tstart && $tstart>$refresh) { $is_cc = 0; }
                   1904:             if ($tend   && $tend  <$limit) { $is_cc = 0; }
1.185     raeburn  1905:         }
                   1906:     }
                   1907:     return $is_cc;
                   1908: }
                   1909: 
1.108     raeburn  1910: sub courselink {
1.317     raeburn  1911:     my ($roledom,$rowtype,$role) = @_;
1.109     raeburn  1912:     my $courseform=&Apache::loncommon::selectcourse_link
1.317     raeburn  1913:                    ('rolechoice','course'.$rowtype.'_'.$roledom.'_'.$role,
                   1914:                     'domain'.$rowtype.'_'.$roledom.'_'.$role,
                   1915:                     'coursedesc'.$rowtype.'_'.$roledom.'_'.$role,
                   1916:                     $roledom.':'.$role,undef,'Course/Community');
                   1917:     my $hiddenitems = '<input type="hidden" name="domain'.$rowtype.'_'.$roledom.'_'.$role.'" value="'.$roledom.'" />'.
                   1918:                       '<input type="hidden" name="origdom'.$rowtype.'_'.$roledom.'_'.$role.'" value="'.$roledom.'" />'.
                   1919:                       '<input type="hidden" name="course'.$rowtype.'_'.$roledom.'_'.$role.'" value="" />'.
                   1920:                       '<input type="hidden" name="coursedesc'.$rowtype.'_'.$roledom.'_'.$role.'" value="" />';
1.112     raeburn  1921:     return $courseform.$hiddenitems;
1.109     raeburn  1922: }
                   1923: 
                   1924: sub coursepick_jscript {
1.312     damieng  1925:     my %js_lt = &Apache::lonlocal::texthash(
1.239     raeburn  1926:                   plsu => "Please use the 'Select Course/Community' link to open a separate pick course window where you may select the course or community you wish to enter.",
1.234     raeburn  1927:                   youc => 'You can only use this screen to select courses and communities in the current domain.',
1.184     raeburn  1928:              );
1.312     damieng  1929:     &js_escape(\%js_lt);
1.104     raeburn  1930:     my $verify_script = <<"END";
1.179     raeburn  1931: <script type="text/javascript">
1.225     bisitz   1932: // <![CDATA[
1.108     raeburn  1933: function verifyCoursePick(caller) {
                   1934:     var numbutton = getIndex(caller)
1.112     raeburn  1935:     var pickedCourse = document.rolechoice.elements[numbutton+4].value
                   1936:     var pickedDomain = document.rolechoice.elements[numbutton+2].value
                   1937:     if (document.rolechoice.elements[numbutton+2].value == document.rolechoice.elements[numbutton+3].value) {
1.104     raeburn  1938:         if (pickedCourse != '') {
1.108     raeburn  1939:             if (numbutton != -1) {
                   1940:                 var courseTarget = "cc./"+pickedDomain+"/"+pickedCourse
                   1941:                 document.rolechoice.elements[numbutton+1].name = courseTarget
                   1942:                 document.rolechoice.submit()
                   1943:             }
1.104     raeburn  1944:         }
                   1945:         else {
1.312     damieng  1946:             alert("$js_lt{'plsu'}");
1.104     raeburn  1947:         }
                   1948:     }
                   1949:     else {
1.312     damieng  1950:         alert("$js_lt{'youc'}")
1.104     raeburn  1951:     }
                   1952: }
1.109     raeburn  1953: function getIndex(caller) {
1.108     raeburn  1954:     for (var i=0;i<document.rolechoice.elements.length;i++) {
1.109     raeburn  1955:         if (document.rolechoice.elements[i] == caller) {
1.108     raeburn  1956:             return i;
                   1957:         }
                   1958:     }
                   1959:     return -1;
                   1960: }
1.225     bisitz   1961: // ]]>
1.104     raeburn  1962: </script>
                   1963: END
1.109     raeburn  1964:     return $verify_script;
1.104     raeburn  1965: }
                   1966: 
1.193     raeburn  1967: sub coauthorlink {
                   1968:     my ($dcdom,$rowtype) = @_;
                   1969:     my $coauthorform=&Apache::loncommon::selectauthor_link('rolechoice',$dcdom);
                   1970:     my $hiddenitems = '<input type="hidden" name="adhoccauname'.$rowtype.'_'.$dcdom.'" value="" />';
                   1971:     return $coauthorform.$hiddenitems;
                   1972: }
                   1973: 
1.113     raeburn  1974: sub display_cc_role {
                   1975:     my $rolekey = shift;
1.223     raeburn  1976:     my ($roletext,$roletext_end);
1.118     albertel 1977:     my $advanced = $env{'user.adv'};
                   1978:     my $tryagain = $env{'form.tryagain'};
1.113     raeburn  1979:     unless ($rolekey =~/^error\:/) {
1.240     raeburn  1980:         if ($rolekey =~ m{^user\.role\.(cc|co)\./($match_domain)/($match_courseid)$}) {
                   1981:             my $ccrole = $1;
1.249     raeburn  1982:             my $tdom = $2;
                   1983:             my $trest = $3;
                   1984:             my $tcourseid = $tdom.'_'.$trest;
                   1985:             my $trolecode = $ccrole.'./'.$tdom.'/'.$trest;
1.113     raeburn  1986:             my $twhere;
1.152     raeburn  1987:             my $ttype;
1.313     raeburn  1988:             my $skipcal;
1.212     bisitz   1989:             my $tbg='LC_roles_is';
1.113     raeburn  1990:             my %newhash=&Apache::lonnet::coursedescription($tcourseid);
                   1991:             if (%newhash) {
                   1992:                 $twhere=$newhash{'description'}.
1.261     bisitz   1993:                         ' <span class="LC_fontsize_small">'.
1.249     raeburn  1994:                         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
1.211     tempelho 1995:                         '</span>';
1.153     raeburn  1996:                 $ttype = $newhash{'type'};
1.113     raeburn  1997:             } else {
                   1998:                 $twhere=&mt('Currently not available');
1.118     albertel 1999:                 $env{'course.'.$tcourseid.'.description'}=$twhere;
1.313     raeburn  2000:                 $skipcal = 1;
1.110     raeburn  2001:             }
1.242     raeburn  2002:             my $trole = &Apache::lonnet::plaintext($ccrole,$ttype,$tcourseid);
1.258     raeburn  2003:             $twhere.="<br />".&mt('Domain').":".$tdom;
1.313     raeburn  2004:             ($roletext,$roletext_end) = &build_roletext($trolecode,$tdom,$trest,'is',$tryagain,$advanced,'',$tbg,$trole,$twhere,'','','',1,'','','',$skipcal);
1.104     raeburn  2005:         }
                   2006:     }
1.223     raeburn  2007:     return ($roletext,$roletext_end);
1.104     raeburn  2008: }
                   2009: 
1.192     raeburn  2010: sub adhoc_roles_row {
1.138     raeburn  2011:     my ($dcdom,$rowtype) = @_;
1.212     bisitz   2012:     my $output = &Apache::loncommon::continue_data_table_row()
1.314     raeburn  2013:                  .' <td colspan="5" class="LC_textsize_mobile">'
1.212     bisitz   2014:                  .&mt('[_1]Ad hoc[_2] roles in domain [_3] --'
                   2015:                      ,'<span class="LC_cusr_emph">','</span>',$dcdom)
1.227     bisitz   2016:                  .' ';
1.317     raeburn  2017:     my $role = 'cc';
                   2018:     my $selectcclink = &courselink($dcdom,$rowtype,$role);
1.239     raeburn  2019:     my $ccrole = &Apache::lonnet::plaintext('co',undef,undef,1);
1.182     www      2020:     my $carole = &Apache::lonnet::plaintext('ca');
1.193     raeburn  2021:     my $selectcalink = &coauthorlink($dcdom,$rowtype);
1.227     bisitz   2022:     $output.=$ccrole.': '.$selectcclink
1.249     raeburn  2023:             .' | '.$carole.': '.$selectcalink.'</td>'
1.212     bisitz   2024:             .&Apache::loncommon::end_data_table_row();
1.108     raeburn  2025:     return $output;
                   2026: }
                   2027: 
1.317     raeburn  2028: sub adhoc_customroles_row {
                   2029:     my ($dhdom,$rowtype) = @_;
                   2030:     my $output = &Apache::loncommon::continue_data_table_row()
                   2031:                  .' <td colspan="5" class="LC_textsize_mobile">'
                   2032:                  .&mt('[_1]Ad hoc[_2] course/community roles in domain [_3] --',
                   2033:                       '<span class="LC_cusr_emph">','</span>',$dhdom);
                   2034:     my @customroles = split(/,/,$env{'environment.adhocroles.'.$dhdom});
                   2035:     my $count = 0;
                   2036:     foreach my $role (@customroles) {
                   2037:         next if (($role eq '') || ($role =~ /\W/));
                   2038:         $output .= ' '.$role.': '.&courselink($dhdom,$rowtype,$role).' |';
                   2039:         $count ++;
                   2040:     }
                   2041:     if ($count) {
                   2042:         return $output;
                   2043:     }
                   2044:     return;
                   2045: }
                   2046: 
1.104     raeburn  2047: sub recent_filename {
                   2048:     my $area=shift;
1.149     www      2049:     return 'nohist_recent_'.&escape($area);
1.104     raeburn  2050: }
                   2051: 
1.139     raeburn  2052: sub courseloadpage {
                   2053:     my ($courseid) = @_;
                   2054:     my $startpage;
1.144     albertel 2055:     my %entry_settings = &Apache::lonnet::get('nohist_whatsnew',
                   2056: 					      [$courseid.':courseinit']);
1.139     raeburn  2057:     my ($tmp) = %entry_settings;
1.144     albertel 2058:     unless ($tmp =~ /^error: 2 /) {
1.139     raeburn  2059:         $startpage = $entry_settings{$courseid.':courseinit'};
                   2060:     }
                   2061:     if ($startpage eq '') {
                   2062:         if (exists($env{'environment.course_init_display'})) {
                   2063:             $startpage = $env{'environment.course_init_display'};
                   2064:         }
                   2065:     }
                   2066:     return $startpage;
                   2067: }
                   2068: 
1.260     raeburn  2069: sub update_session_roles {
                   2070:     my $then=$env{'user.login.time'};
                   2071:     my $refresh=$env{'user.refresh.time'};
                   2072:     if (!$refresh) {
                   2073:         $refresh = $then;
                   2074:     }
                   2075:     my $update = $env{'user.update.time'};
                   2076:     if (!$update) {
                   2077:         $update = $then;
                   2078:     }
                   2079:     my $now = time;
                   2080:     my %roleshash =
                   2081:         &Apache::lonnet::get_my_roles('','','userroles',
                   2082:                                       ['active','future','previous'],
                   2083:                                       undef,undef,1);
                   2084:     my ($msg,@newsec,$oldsec,$currrole_expired,@changed_roles,
1.264     raeburn  2085:         %changed_groups,%dbroles,%deletedroles,%allroles,%allgroups,
1.260     raeburn  2086:         %userroles,%checkedgroup,%crprivs,$hasgroups,%rolechange,
                   2087:         %groupchange,%newrole,%newgroup,%customprivchg,%groups_roles,
                   2088:         @rolecodes);
                   2089:     my @possroles = ('cr','st','ta','ad','ep','in','co','cc');
                   2090:     my %courseroles;
                   2091:     foreach my $item (keys(%roleshash)) {
                   2092:         my ($uname,$udom,$role,$remainder) = split(/:/,$item,4);
                   2093:         my ($tstart,$tend) = split(/:/,$roleshash{$item});
                   2094:         my ($section,$group,@group_privs);
                   2095:         if ($role =~ m{^gr/(\w*)$}) {
                   2096:             $role = 'gr';
                   2097:             my $priv = $1;
                   2098:             next if ($tstart eq '-1');
                   2099:             if (&curr_role_status($tstart,$tend,$refresh,$now) eq 'active') {
                   2100:                 if ($priv ne '') {
                   2101:                     push(@group_privs,$priv);
                   2102:                 }
                   2103:             }
                   2104:             if ($remainder =~ /:/) {
                   2105:                 (my $additional_privs,$group) =
                   2106:                     ($remainder =~ /^([\w:]+):([^:]+)$/);
                   2107:                 if ($additional_privs ne '') {
                   2108:                     if (&curr_role_status($tstart,$tend,$refresh,$now) eq 'active') {
                   2109:                         push(@group_privs,split(/:/,$additional_privs));
                   2110:                         @group_privs = sort(@group_privs);
                   2111:                     }
                   2112:                 }
                   2113:             } else {
                   2114:                 $group = $remainder;
                   2115:             }
                   2116:         } else {
                   2117:             $section = $remainder;
                   2118:         }
                   2119:         my $where = "/$udom/$uname";
                   2120:         if ($section ne '') {
                   2121:             $where .= "/$section";
                   2122:         } elsif ($group ne '') {
                   2123:             $where .= "/$group";
                   2124:         }
                   2125:         my $rolekey = "$role.$where";
                   2126:         my $envkey = "user.role.$rolekey";
                   2127:         $dbroles{$envkey} = 1;
                   2128:         if (($env{'request.role'} eq $rolekey) && ($role ne 'st')) {
                   2129:             if (&curr_role_status($tstart,$tend,$refresh,$now) ne 'active') {
                   2130:                 $currrole_expired = 1;
                   2131:             }
                   2132:         }
                   2133:         if ($env{$envkey} eq '') {
                   2134:             my $status_in_db =
1.271     raeburn  2135:                 &curr_role_status($tstart,$tend,$now,$now);
1.260     raeburn  2136:                 &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
                   2137:             if (($role eq 'st') && ($env{'request.role'} =~ m{^\Q$role\E\.\Q/$udom/$uname\E})) {
                   2138:                 if ($status_in_db eq 'active') {
                   2139:                     if ($section eq '') {
                   2140:                         push(@newsec,'none');
                   2141:                     } else {
                   2142:                         push(@newsec,$section);
                   2143:                     }
                   2144:                 }
                   2145:             } else {
                   2146:                 unless (grep(/^\Q$role\E$/,@changed_roles)) {
                   2147:                     push(@changed_roles,$role);
                   2148:                 }
                   2149:                 if ($status_in_db ne 'previous') {
                   2150:                     if ($role eq 'gr') {
                   2151:                         $newgroup{$rolekey} = $status_in_db;
                   2152:                         if ($status_in_db eq 'active') {
                   2153:                             unless (ref($courseroles{$udom}) eq 'HASH') {
                   2154:                                 %{$courseroles{$udom}} =
                   2155:                                     &Apache::lonnet::get_my_roles('','','userroles',
                   2156:                                                                   ['active'],\@possroles,
                   2157:                                                                   [$udom],1);
                   2158:                             }
                   2159:                             &Apache::lonnet::get_groups_roles($udom,$uname,
                   2160:                                                               $courseroles{$udom},
                   2161:                                                               \@rolecodes,\%groups_roles);
                   2162:                         }
                   2163:                     } else {
                   2164:                         $newrole{$rolekey} = $status_in_db;
                   2165:                     }
                   2166:                 }
                   2167:             }
                   2168:         } else {
                   2169:             my ($currstart,$currend) = split(/\./,$env{$envkey});
                   2170:             if ($role eq 'gr') {
                   2171:                 if (&curr_role_status($currstart,$currend,$refresh,$update) ne 'previous') {
                   2172:                     $hasgroups = 1;
                   2173:                 }
                   2174:             }
                   2175:             if (($currstart ne $tstart) || ($currend ne $tend)) {
                   2176:                 my $status_in_env =
                   2177:                     &curr_role_status($currstart,$currend,$refresh,$update);
                   2178:                 my $status_in_db =
1.271     raeburn  2179:                     &curr_role_status($tstart,$tend,$now,$now);
1.260     raeburn  2180:                 if ($status_in_env ne $status_in_db) {
                   2181:                     if ($status_in_env eq 'active') {
                   2182:                         if ($role eq 'st') {
                   2183:                             if ($env{'request.role'} eq $rolekey) {
                   2184:                                 my $switchsection;
                   2185:                                 unless (ref($courseroles{$udom}) eq 'HASH') {
                   2186:                                     %{$courseroles{$udom}} =
                   2187:                                         &Apache::lonnet::get_my_roles('','','userroles',
                   2188:                                                                       ['active'],
                   2189:                                                                       \@possroles,[$udom],1);
                   2190:                                 }
                   2191:                                 foreach my $crsrole (keys(%{$courseroles{$udom}})) {
                   2192:                                     if ($crsrole =~ /^\Q$uname\E:\Q$udom\E:st/) {
                   2193:                                         $switchsection = 1;
                   2194:                                         last;
                   2195:                                     }
                   2196:                                 }
                   2197:                                 if ($switchsection) {
                   2198:                                     if ($section eq '') {
                   2199:                                         $oldsec = 'none';
                   2200:                                     } else {
                   2201:                                         $oldsec = $section;
                   2202:                                     }
                   2203:                                     &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
                   2204:                                 } else {
                   2205:                                     $currrole_expired = 1;
                   2206:                                     next;
                   2207:                                 }
                   2208:                             }
                   2209:                         }
                   2210:                         unless ($rolekey eq $env{'request.role'}) {
                   2211:                             if ($role eq 'gr') {
                   2212:                                 &Apache::lonnet::delete_env_groupprivs($where,\%courseroles,\@possroles);
                   2213:                             } else {
                   2214:                                 &Apache::lonnet::delenv("user.priv.$rolekey",undef,[$role]);
                   2215:                                 &Apache::lonnet::delenv("user.priv.cm.$where",undef,['cm']);
                   2216:                             }
                   2217:                             &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
                   2218:                         }
                   2219:                     } elsif ($status_in_db eq 'active') {
                   2220:                         if (($role eq 'st') &&
                   2221:                             ($env{'request.role'} =~ m{^\Q$role\E\.\Q/$udom/$uname\E})) {
                   2222:                             if ($section eq '') {
                   2223:                                 push(@newsec,'none');
                   2224:                             } else {
                   2225:                                 push(@newsec,$section);
                   2226:                             }
                   2227:                         } elsif ($role eq 'gr') {
                   2228:                             unless (ref($courseroles{$udom}) eq 'HASH') {
                   2229:                                 %{$courseroles{$udom}} =
                   2230:                                     &Apache::lonnet::get_my_roles('','','userroles',
                   2231:                                                                   ['active'],
                   2232:                                                                   \@possroles,[$udom],1);
                   2233:                             }
                   2234:                             &Apache::lonnet::get_groups_roles($udom,$uname,
                   2235:                                                               $courseroles{$udom},
                   2236:                                                               \@rolecodes,\%groups_roles);
                   2237:                         }
                   2238:                         &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
                   2239:                     }
                   2240:                     unless (grep(/^\Q$role\E$/,@changed_roles)) {
                   2241:                         push(@changed_roles,$role);
                   2242:                     }
                   2243:                     if ($role eq 'gr') {
                   2244:                         $groupchange{"/$udom/$uname"}{$group} = $status_in_db;
                   2245:                     } else {
                   2246:                         $rolechange{$rolekey} = $status_in_db;
                   2247:                     }
                   2248:                 }
                   2249:             } else {
                   2250:                 if ($role eq 'gr') {
                   2251:                     unless ($checkedgroup{$where}) {
                   2252:                         my $status_in_db =
                   2253:                             &curr_role_status($tstart,$tend,$refresh,$now);
                   2254:                         if ($tstart eq '-1') {
                   2255:                             $status_in_db = 'deleted';
                   2256:                         }
                   2257:                         unless (ref($courseroles{$udom}) eq 'HASH') {
                   2258:                             %{$courseroles{$udom}} =
                   2259:                                 &Apache::lonnet::get_my_roles('','','userroles',
                   2260:                                                               ['active'],
                   2261:                                                               \@possroles,[$udom],1);
                   2262:                         }
                   2263:                         if (ref($courseroles{$udom}) eq 'HASH') {
                   2264:                             foreach my $item (keys(%{$courseroles{$udom}})) {
                   2265:                                 next unless ($item =~ /^\Q$uname\E/);
                   2266:                                 my ($cnum,$cdom,$crsrole,$crssec) = split(/:/,$item);
                   2267:                                 my $area = '/'.$cdom.'/'.$cnum;
                   2268:                                 if ($crssec ne '') {
                   2269:                                     $area .= '/'.$crssec;
                   2270:                                 }
                   2271:                                 my $crsrolekey = $crsrole.'.'.$area;
                   2272:                                 my $currprivs = $env{'user.priv.'.$crsrole.'.'.$area.'.'.$where};
                   2273:                                 $currprivs =~ s/^://;
                   2274:                                 $currprivs =~ s/\&F$//;
                   2275:                                 my @curr_grp_privs = split(/\&F:/,$currprivs);
                   2276:                                 @curr_grp_privs = sort(@curr_grp_privs);
                   2277:                                 my @diffs;
                   2278:                                 if (@group_privs > 0 || @curr_grp_privs > 0) {
                   2279:                                     @diffs = &Apache::loncommon::compare_arrays(\@group_privs,\@curr_grp_privs);
                   2280:                                 }
                   2281:                                 if (@diffs == 0) {
                   2282:                                     last;
                   2283:                                 } else {
                   2284:                                     unless(grep(/^\Qgr\E$/,@rolecodes)) {
                   2285:                                         push(@rolecodes,'gr');
                   2286:                                     }
                   2287:                                     &gather_roleprivs(\%allroles,\%allgroups,
                   2288:                                                       \%userroles,$where,$role,
                   2289:                                                       $tstart,$tend,$status_in_db);
                   2290:                                     if ($status_in_db eq 'active') {
                   2291:                                         &Apache::lonnet::get_groups_roles($udom,$uname,
                   2292:                                                                           $courseroles{$udom},
                   2293:                                                                           \@rolecodes,\%groups_roles);
                   2294:                                     }
                   2295:                                     $changed_groups{$udom.'_'.$uname}{$group} = $status_in_db;
                   2296:                                     last;
                   2297:                                 }
                   2298:                             }
                   2299:                         }
                   2300:                         $checkedgroup{$where} = 1;
                   2301:                     }
                   2302:                 } elsif ($role =~ /^cr/) {
                   2303:                     my $status_in_db =
                   2304:                         &curr_role_status($tstart,$tend,$refresh,$now);
                   2305:                     my ($rdummy,$rest) = split(/\//,$role,2);
                   2306:                     my %currpriv;
                   2307:                     unless (exists($crprivs{$rest})) {
                   2308:                         my ($rdomain,$rauthor,$rrole)=split(/\//,$rest);
                   2309:                         my $homsvr=&Apache::lonnet::homeserver($rauthor,$rdomain);
                   2310:                         if (&Apache::lonnet::hostname($homsvr) ne '') {
                   2311:                             my ($rdummy,$roledef)=
                   2312:                             &Apache::lonnet::get('roles',["rolesdef_$rrole"],
                   2313:                                                  $rdomain,$rauthor);
                   2314:                             if (($rdummy ne 'con_lost') && ($roledef ne '')) {
                   2315:                                 my $i = 0;
                   2316:                                 my @scopes = ('sys','dom','crs');
                   2317:                                 my @privs = split(/\_/,$roledef);
                   2318:                                 foreach my $priv (@privs) {
                   2319:                                     my ($blank,@prv) = split(/:/,$priv);
                   2320:                                     @prv = map { $_ .= (/\&\w+$/ ? '':'&F') } @prv;
1.264     raeburn  2321:                                     if (@prv) {
                   2322:                                         $priv = ':'.join(':',sort(@prv));
                   2323:                                     }
1.260     raeburn  2324:                                     $crprivs{$rest}{$scopes[$i]} = $priv;
                   2325:                                     $i++;
                   2326:                                 }
                   2327:                             }
                   2328:                         }
                   2329:                     }
1.279     raeburn  2330:                     my $status_in_env =
                   2331:                         &curr_role_status($currstart,$currend,$refresh,$update);
                   2332:                     if ($status_in_env eq 'active') {
                   2333:                         $currpriv{sys} = $env{"user.priv.$rolekey./"};
                   2334:                         $currpriv{dom} = $env{"user.priv.$rolekey./$udom/"};
                   2335:                         $currpriv{crs} = $env{"user.priv.$rolekey.$where"};
                   2336:                         if (keys(%crprivs)) {
                   2337:                             if (($crprivs{$rest}{sys} ne $currpriv{sys}) ||
                   2338:                                 ($crprivs{$rest}{dom} ne $currpriv{dom})
1.260     raeburn  2339:  ||
1.279     raeburn  2340:                                 ($crprivs{$rest}{crs} ne $currpriv{crs})) {
                   2341:                                 &gather_roleprivs(\%allroles,\%allgroups,
                   2342:                                                   \%userroles,$where,$role,
                   2343:                                                   $tstart,$tend,$status_in_db);
                   2344:                                 unless (grep(/^\Q$role\E$/,@changed_roles)) {
                   2345:                                     push(@changed_roles,$role);
                   2346:                                 }
1.260     raeburn  2347:                                 $customprivchg{$rolekey} = $status_in_env;
                   2348:                             }
                   2349:                         }
                   2350:                     }
                   2351:                 }
                   2352:             }
                   2353:         }
                   2354:     }
                   2355:     foreach my $envkey (keys(%env)) {
                   2356:         next unless ($envkey =~ /^user\.role\./);
                   2357:         next if ($dbroles{$envkey});
                   2358:         next if ($envkey eq 'user.role.'.$env{'request.role'});
                   2359:         my ($currstart,$currend) = split(/\./,$env{$envkey});
                   2360:         my $status_in_env =
                   2361:             &curr_role_status($currstart,$currend,$refresh,$update);
                   2362:         my ($rolekey) = ($envkey =~ /^user\.role\.(.+)$/);
1.297     raeburn  2363:         my ($role,$rest)=split(m{\./},$rolekey,2);
                   2364:         $rest = '/'.$rest;
1.260     raeburn  2365:         if (&Apache::lonnet::delenv($envkey,undef,[$role])) {
                   2366:             if ($status_in_env eq 'active') {
                   2367:                 if ($role eq 'gr') {
                   2368:                     &Apache::lonnet::delete_env_groupprivs($rest,\%courseroles,
                   2369:                                                            \@possroles);
                   2370:                 } else {
                   2371:                     &Apache::lonnet::delenv("user.priv.$rolekey",undef,[$role]);
                   2372:                     &Apache::lonnet::delenv("user.priv.cm.$rest",undef,['cm']);
                   2373:                 }
                   2374:                 unless (grep(/^\Q$role\E$/,@changed_roles)) {
                   2375:                     push(@changed_roles,$role);
                   2376:                 }
                   2377:                 $deletedroles{$rolekey} = 1;
                   2378:             }
                   2379:         }
                   2380:     }
                   2381:     if (($oldsec) && (@newsec > 0)) {
                   2382:         if (@newsec > 1) {
1.274     raeburn  2383:             $msg = '<p class="LC_warning">'.&mt('The section has changed for your current role. Log-out and log-in again to select a role for the new section.').'</p>';
1.260     raeburn  2384:         } else {
                   2385:             my $newrole = $env{'request.role'};
                   2386:             if ($newsec[0] eq 'none') {
                   2387:                 $newrole =~ s{(/[^/])$}{};
                   2388:             } elsif ($oldsec eq 'none') {
                   2389:                 $newrole .= '/'.$newsec[0];
                   2390:             } else {
                   2391:                 $newrole =~ s{([^/]+)$}{$newsec[0]};
                   2392:             }
                   2393:             my $coursedesc = $env{'course.'.$env{'request.course.id'}.'.description'};
                   2394:             my ($curr_role) = ($env{'request.role'} =~ m{^(\w+)\./$match_domain/$match_courseid});
                   2395:             my %temp=('logout_'.$env{'request.course.id'} => time);
                   2396:             &Apache::lonnet::put('email_status',\%temp);
                   2397:             &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'});
                   2398:             &Apache::lonnet::appenv({"request.course.id"   => '',
                   2399:                                      "request.course.fn"   => '',
                   2400:                                      "request.course.uri"  => '',
                   2401:                                      "request.course.sec"  => '',
                   2402:                                      "request.role"        => 'cm',
                   2403:                                      "request.role.adv"    => $env{'user.adv'},
                   2404:                                      "request.role.domain" => $env{'user.domain'}});
                   2405:             my $rolename = &Apache::loncommon::plainname($curr_role);
                   2406:             $msg = '<p><form name="reselectrole" action="/adm/roles" method="post" />'.
                   2407:                    '<input type="hidden" name="newrole" value="" />'.
                   2408:                    '<input type="hidden" name="selectrole" value="1" />'.
                   2409:                    '<span class="LC_info">'.
                   2410:                    &mt('Your section has changed for your current [_1] role in [_2].',$rolename,$coursedesc).'</span><br />';
                   2411:             my $button = '<input type="button" name="sectionchanged" value="'.
                   2412:                          &mt('Re-Select').'" onclick="javascript:enterrole(this.form,'."'$newrole','sectionchanged'".')" />';
                   2413:             if ($newsec[0] eq 'none') {
                   2414:                 $msg .= &mt('[_1] to continue with your new section-less role.',$button);
                   2415:             } else {
                   2416:                 $msg .= &mt('[_1] to continue with your new role in section ([_2]).',$button,$newsec[0]);
                   2417:             }
                   2418:             $msg .= '</form></p>';
                   2419:         }
                   2420:     } elsif ($currrole_expired) {
1.274     raeburn  2421:         $msg .= '<p class="LC_warning">';
1.260     raeburn  2422:         if (&Apache::loncommon::show_course()) {
                   2423:             $msg .= &mt('Your role in the current course has expired.');
                   2424:         } else {
                   2425:             $msg .= &mt('Your current role has expired.');
                   2426:         }
1.274     raeburn  2427:         $msg .= '<br />'.&mt('However you can continue to use this role until you logout, click the "Re-Select" button, or your session has been idle for more than 24 hours.').'</p>';
1.260     raeburn  2428:     }
1.279     raeburn  2429:     &Apache::lonnet::set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles);
                   2430:     my ($curr_is_adv,$curr_role_adv,$curr_author,$curr_role_author);
                   2431:     $curr_author = $env{'user.author'};
                   2432:     if (($env{'request.role'} =~/^au/) || ($env{'request.role'} =~/^ca/) ||
                   2433:         ($env{'request.role'} =~/^aa/)) {
                   2434:         $curr_role_author=1;
                   2435:     }
                   2436:     $curr_is_adv = $env{'user.adv'};
                   2437:     $curr_role_adv = $env{'request.role.adv'};
                   2438:     if (keys(%userroles) > 0) {
                   2439:         foreach my $role (@changed_roles) {
                   2440:             unless(grep(/^\Q$role\E$/,@rolecodes)) {
                   2441:                 push(@rolecodes,$role);
                   2442:             }
                   2443:         }
                   2444:         unless(grep(/^\Qcm\E$/,@rolecodes)) {
                   2445:             push(@rolecodes,'cm');
                   2446:         }
                   2447:         &Apache::lonnet::appenv(\%userroles,\@rolecodes);
                   2448:     }
                   2449:     my %newenv;
                   2450:     if (&Apache::lonnet::is_advanced_user($env{'user.domain'},$env{'user.name'})) {
                   2451:         unless ($curr_is_adv) {
                   2452:             $newenv{'user.adv'} = 1;
                   2453:         }
                   2454:     } elsif ($curr_is_adv && !$curr_role_adv) {
                   2455:         &Apache::lonnet::delenv('user.adv');
                   2456:     }
                   2457:     my %authorroleshash =
                   2458:         &Apache::lonnet::get_my_roles('','','userroles',['active'],['au','ca','aa']);
                   2459:     if (keys(%authorroleshash)) {
                   2460:         unless ($curr_author) {
                   2461:             $newenv{'user.author'} = 1;
                   2462:         }
                   2463:     } elsif ($curr_author && !$curr_role_author) {
                   2464:         &Apache::lonnet::delenv('user.author');
                   2465:     }
                   2466:     if ($env{'request.course.id'}) {
                   2467:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2468:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2469:         my (@activecrsgroups,$crsgroupschanged);
                   2470:         if ($env{'request.course.groups'}) {
                   2471:             @activecrsgroups = split(/:/,$env{'request.course.groups'});
                   2472:             foreach my $item (keys(%deletedroles)) {
                   2473:                 if ($item =~ m{^gr\./\Q$cdom\E/\Q$cnum\E/(\w+)$}) {
                   2474:                     if (grep(/^\Q$1\E$/,@activecrsgroups)) {
                   2475:                         $crsgroupschanged = 1;
                   2476:                         last;
                   2477:                     }
                   2478:                 }
                   2479:             }
                   2480:         }
                   2481:         unless ($crsgroupschanged) {
                   2482:             foreach my $item (keys(%newgroup)) {
                   2483:                 if ($item =~ m{^gr\./\Q$cdom\E/\Q$cnum\E/(\w+)$}) {
                   2484:                     if ($newgroup{$item} eq 'active') {
                   2485:                         $crsgroupschanged = 1;
                   2486:                         last;
                   2487:                     }
                   2488:                 }
                   2489:             }
                   2490:         }
                   2491:         if ((ref($changed_groups{$env{'request.course.id'}}) eq 'HASH') ||
                   2492:             (ref($groupchange{"/$cdom/$cnum"}) eq 'HASH') ||
                   2493:             ($crsgroupschanged)) {
                   2494:             my %grouproles =  &Apache::lonnet::get_my_roles('','','userroles',
                   2495:                                                             ['active'],['gr'],[$cdom],1);
                   2496:             my @activegroups;
                   2497:             foreach my $item (keys(%grouproles)) {
                   2498:                 next unless($item =~ /^\Q$cnum\E:\Q$cdom\E/);
                   2499:                 my $group;
                   2500:                 my ($crsn,$crsd,$role,$remainder) = split(/:/,$item,4);
                   2501:                 if ($remainder =~ /:/) {
                   2502:                     (my $other,$group) = ($remainder =~ /^([\w:]+):([^:]+)$/);
                   2503:                 } else {
                   2504:                     $group = $remainder;
                   2505:                 }
                   2506:                 if ($group ne '') {
                   2507:                     push(@activegroups,$group);
                   2508:                 }
                   2509:             }
                   2510:             $newenv{'request.course.groups'} = join(':',@activegroups);
                   2511:         }
                   2512:     }
                   2513:     if (keys(%newenv)) {
                   2514:         &Apache::lonnet::appenv(\%newenv);
                   2515:     }
1.260     raeburn  2516:     if (!@changed_roles || !(keys(%changed_groups))) {
1.264     raeburn  2517:         my ($rolesmsg,$groupsmsg);
1.260     raeburn  2518:         if (!@changed_roles) {
                   2519:             if (&Apache::loncommon::show_course()) {
1.264     raeburn  2520:                 $rolesmsg = &mt('No new courses or communities');
1.260     raeburn  2521:             } else {
1.264     raeburn  2522:                 $rolesmsg = &mt('No role changes');
1.260     raeburn  2523:             }
                   2524:         }
                   2525:         if ($hasgroups && !(keys(%changed_groups)) && !(grep(/gr/,@changed_roles))) {
1.264     raeburn  2526:             $groupsmsg = &mt('No changes in course/community groups');
1.260     raeburn  2527:         }
                   2528:         if (!@changed_roles && !(keys(%changed_groups))) {
1.264     raeburn  2529:             if (($msg ne '') || ($groupsmsg ne '')) {
                   2530:                 $msg .= '<ul>';
                   2531:                 if ($rolesmsg) {
                   2532:                     $msg .= '<li>'.$rolesmsg.'</li>';
                   2533:                 }
                   2534:                 if ($groupsmsg) {
                   2535:                     $msg .= '<li>'.$groupsmsg.'</li>';
                   2536:                 }
                   2537:                 $msg .= '</ul>';
                   2538:             } else {
1.270     raeburn  2539:                 $msg = '&nbsp;<span class="LC_cusr_emph">'.$rolesmsg.'</span><br />';
1.264     raeburn  2540:             }
1.260     raeburn  2541:             return $msg;
                   2542:         }
                   2543:     }
                   2544:     my $changemsg;
                   2545:     if (@changed_roles > 0) {
                   2546:         if (keys(%newgroup) > 0) {
                   2547:             my $groupmsg;
1.279     raeburn  2548:             my (%curr_groups,%groupdescs,$currcrs);
1.260     raeburn  2549:             foreach my $item (sort(keys(%newgroup))) {
                   2550:                 if (&is_active_course($item,$refresh,$update,\%roleshash)) {
1.279     raeburn  2551:                     if ($item =~ m{^gr\./($match_domain/$match_courseid)/(\w+)$}) {
                   2552:                         my ($cdom,$cnum) = split(/\//,$1);
                   2553:                         my $group = $2;
                   2554:                         if ($currcrs ne $cdom.'_'.$cnum) {
                   2555:                             if ($currcrs) {
                   2556:                                 $groupmsg .= '</ul><li>';
                   2557:                             }
                   2558:                             $groupmsg .= '<li><b>'.
                   2559:                                          $env{'course.'.$cdom.'_'.$cnum.'.description'}.'</b><ul>';
1.281     raeburn  2560:                             $currcrs = $cdom.'_'.$cnum;
1.279     raeburn  2561:                         }
                   2562:                         my $groupdesc;
                   2563:                         unless (ref($curr_groups{$cdom.'_'.$cnum}) eq 'HASH') {
                   2564:                             %{$curr_groups{$cdom.'_'.$cnum}} = 
                   2565:                                 &Apache::longroup::coursegroups($cdom,$cnum);
                   2566:                         }
                   2567:                         unless ((ref($groupdescs{$cdom.'_'.$cnum}) eq 'HASH') &&
                   2568:                             ($groupdescs{$cdom.'_'.$cnum}{$group})) {
                   2569: 
                   2570:                             my %groupinfo = 
                   2571:                                 &Apache::longroup::get_group_settings($curr_groups{$cdom.'_'.$cnum}{$group});
                   2572:                             $groupdescs{$cdom.'_'.$cnum}{$group} = 
                   2573:                                 &unescape($groupinfo{'description'});
                   2574:                         }
                   2575:                         $groupdesc = $groupdescs{$cdom.'_'.$cnum}{$group};
1.286     raeburn  2576:                         if ($groupdesc) {
                   2577:                             $groupmsg .= '<li>'.
                   2578:                                          &mt('[_1] with status: [_2].',
                   2579:                                          '<b>'.$groupdesc.'</b>',$newgroup{$item}).'</li>';
                   2580:                         }
1.279     raeburn  2581:                     }
                   2582:                 }
                   2583:                 if ($groupmsg) {
                   2584:                     $groupmsg .= '</ul></li>';
1.260     raeburn  2585:                 }
                   2586:             }
                   2587:             if ($groupmsg) {
                   2588:                 $changemsg .= '<li>'.
                   2589:                               &mt('Courses with new groups').'</li>'.
                   2590:                               '<ul>'.$groupmsg.'</ul></li>';
                   2591:             }
                   2592:         }
                   2593:         if (keys(%newrole) > 0) {
1.286     raeburn  2594:             my $newmsg;
1.260     raeburn  2595:             foreach my $item (sort(keys(%newrole))) {
1.279     raeburn  2596:                 my $desc = &role_desc($item,$update,$refresh,$now);
1.286     raeburn  2597:                 if ($desc) {
                   2598:                     $newmsg .= '<li>'.
                   2599:                                &mt('[_1] with status: [_2].',
1.293     bisitz   2600:                                $desc,&mt($newrole{$item})).'</li>';
1.286     raeburn  2601:                 }
                   2602:             }
                   2603:             if ($newmsg) {
                   2604:                 $changemsg .= '<li>'.&mt('New roles').
                   2605:                               '<ul>'.$newmsg.'</ul>'.
                   2606:                               '</li>';
1.260     raeburn  2607:             }
                   2608:         }
                   2609:         if (keys(%customprivchg) > 0) {
1.286     raeburn  2610:             my $privmsg;
1.260     raeburn  2611:             foreach my $item (sort(keys(%customprivchg))) {
1.279     raeburn  2612:                 my $desc = &role_desc($item,$update,$refresh,$now);
1.286     raeburn  2613:                 if ($desc) {
                   2614:                     $privmsg .= '<li>'.$desc.'</li>';
                   2615:                 }
1.260     raeburn  2616:             }
1.286     raeburn  2617:             if ($privmsg) {
                   2618:                 $changemsg .= '<li>'.
                   2619:                               &mt('Custom roles with privilege changes').
                   2620:                               '<ul>'.$privmsg.'</ul>'.
                   2621:                               '</li>';
                   2622:              }
1.260     raeburn  2623:         }
                   2624:         if (keys(%rolechange) > 0) {
1.286     raeburn  2625:             my $rolemsg;
1.260     raeburn  2626:             foreach my $item (sort(keys(%rolechange))) {
1.279     raeburn  2627:                 my $desc = &role_desc($item,$update,$refresh,$now);  
1.286     raeburn  2628:                 if ($desc) {
                   2629:                     $rolemsg .= '<li>'.
                   2630:                                 &mt('[_1] status now: [_2].',$desc,
                   2631:                                 $rolechange{$item}).'</li>';
                   2632:                 }
                   2633:             }
                   2634:             if ($rolemsg) {
1.260     raeburn  2635:                 $changemsg .= '<li>'.
1.286     raeburn  2636:                               &mt('Existing roles with status changes').'</li>'.
                   2637:                               '<ul>'.$rolemsg.'</ul>'.
                   2638:                               '</li>';
1.260     raeburn  2639:             }
                   2640:         }
                   2641:         if (keys(%deletedroles) > 0) {
1.286     raeburn  2642:             my $delmsg;
1.260     raeburn  2643:             foreach my $item (sort(keys(%deletedroles))) {
1.279     raeburn  2644:                 my $desc = &role_desc($item,$update,$refresh,$now);
1.286     raeburn  2645:                 if ($desc) {
                   2646:                     $delmsg .= '<li>'.$desc.'</li>';
                   2647:                 }
                   2648:             }
                   2649:             if ($delmsg) {
                   2650:                 $changemsg .= '<li>'.
                   2651:                               &mt('Existing roles now expired').'</li>'.
                   2652:                               '<ul>'.$delmsg.'</ul>'.
                   2653:                               '</li>';
1.260     raeburn  2654:             }
                   2655:         }
                   2656:     }
                   2657:     if ((keys(%changed_groups) > 0) || (keys(%groupchange) > 0)) {
                   2658:         my $groupchgmsg;
                   2659:         foreach my $key (sort(keys(%changed_groups))) {
                   2660:             my $crs = 'gr/'.$key;
                   2661:             $crs =~ s/_/\//;
                   2662:             if (&is_active_course($crs,$refresh,$update,\%roleshash)) {
                   2663:                 if (ref($changed_groups{$key}) eq 'HASH') {
                   2664:                     my @showgroups;
                   2665:                     foreach my $group (sort(keys(%{$changed_groups{$key}}))) {
                   2666:                         if ($changed_groups{$key}{$group} eq 'active') {
                   2667:                             push(@showgroups,$group);
                   2668:                         }
                   2669:                     }
                   2670:                     if (@showgroups > 0) {
                   2671:                         $groupchgmsg .= '<li>'.
                   2672:                                         &mt('Course: [_1], groups: [_2].',$key,
                   2673:                                         join(', ',@showgroups)).
                   2674:                                         '</li>';
                   2675:                     }
                   2676:                 }
                   2677:             }
                   2678:         }
                   2679:         if (keys(%groupchange) > 0) {
                   2680:             $groupchgmsg .= '<li>'.
                   2681:                           &mt('Existing course/community groups with status changes').'</li>'.
                   2682:                           '<ul>';
                   2683:             foreach my $crs (sort(keys(%groupchange))) {
1.279     raeburn  2684:                 my $cid = $crs;
                   2685:                 $cid=~s{^/}{};
                   2686:                 $cid=~s{/}{_};
                   2687:                 my $crsdesc = $env{'course.'.$cid.'.description'};
                   2688:                 my $cdom = $env{'course.'.$cid.'.domain'};
                   2689:                 my $cnum = $env{'course.'.$cid.'.num'};
                   2690:                 my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   2691:                 my %groupdesc; 
1.260     raeburn  2692:                 if (ref($groupchange{$crs}) eq 'HASH') {
1.279     raeburn  2693:                     $groupchgmsg .= '<li>'.&mt('Course/Community: [_1]','<b>'.$crsdesc.'</b><ul>');
1.260     raeburn  2694:                     foreach my $group (sort(keys(%{$groupchange{$crs}}))) {
1.279     raeburn  2695:                         unless ($groupdesc{$group}) {
                   2696:                             my %groupinfo = &Apache::longroup::get_group_settings($curr_groups{$group});
                   2697:                             $groupdesc{$group} =  &unescape($groupinfo{'description'});
                   2698:                         }
                   2699:                         $groupchgmsg .= '<li>'.&mt('Group: [_1] status now: [_2].','<b>'.$groupdesc{$group}.'</b>',$groupchange{$crs}{$group}).'</li>';
1.260     raeburn  2700:                     }
                   2701:                     $groupchgmsg .= '</ul></li>';
                   2702:                 }
                   2703:             }
                   2704:             $groupchgmsg .= '</ul></li>';
                   2705:         }
                   2706:         if ($groupchgmsg) {
                   2707:             $changemsg .= '<li>'.
                   2708:                           &mt('Courses with changes in groups').'</li>'.
                   2709:                           '<ul>'.$groupchgmsg.'</ul></li>';
                   2710:         }
                   2711:     }
                   2712:     if ($changemsg) {
                   2713:         $msg .= '<ul>'.$changemsg.'</ul>';
1.286     raeburn  2714:     } else {
                   2715:         if (&Apache::loncommon::show_course()) {
                   2716:             $msg = &mt('No new courses or communities');
                   2717:         } else {
                   2718:             $msg = &mt('No role changes');
                   2719:         }
1.260     raeburn  2720:     }
1.279     raeburn  2721:     return $msg;
                   2722: }
                   2723: 
                   2724: sub role_desc {
                   2725:     my ($item,$update,$refresh,$now) = @_;
                   2726:     my ($where,$trolecode,$role,$tstatus,$tend,$tstart,$twhere,
                   2727:         $trole,$tremark);
1.282     raeburn  2728:     &Apache::lonnet::role_status('user.role.'.$item,$update,$refresh,
                   2729:                                  $now,\$role,\$where,\$trolecode,
1.279     raeburn  2730:                                  \$tstatus,\$tstart,\$tend);
1.286     raeburn  2731:     return unless ($role);
1.279     raeburn  2732:     if ($role =~ /^cr\//) {
                   2733:         my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
1.298     bisitz   2734:         $tremark = &mt('Custom role defined by [_1].',$rauthor.':'.$rdomain);
1.279     raeburn  2735:     }
                   2736:     $trole=Apache::lonnet::plaintext($role);
                   2737:     my ($tdom,$trest,$tsection)=
                   2738:         split(/\//,Apache::lonnet::declutter($where));
                   2739:     if (($role eq 'ca') || ($role eq 'aa')) {
                   2740:         my $home = &Apache::lonnet::homeserver($trest,$tdom);
                   2741:         $home = &Apache::lonnet::hostname($home);
                   2742:         $twhere=&mt('User').':&nbsp;'.$trest.'&nbsp; '.&mt('Domain').
                   2743:                 ':&nbsp;'.$tdom.'&nbsp; '.&mt('Server').':&nbsp;'.$home;
                   2744:     } elsif ($role eq 'au') {
                   2745:         my $home = &Apache::lonnet::homeserver
                   2746:                        ($env{'user.name'},$env{'user.domain'});
                   2747:         $home = &Apache::lonnet::hostname($home);
                   2748:         $twhere=&mt('Domain').':&nbsp;'.$tdom.'&nbsp; '.&mt('Server').
                   2749:                         ':&nbsp;'.$home;
                   2750:     } elsif ($trest) {
                   2751:         my $tcourseid=$tdom.'_'.$trest;
                   2752:         my $crstype = &Apache::loncommon::course_type($tcourseid);
                   2753:         $trole = &Apache::lonnet::plaintext($role,$crstype,$tcourseid);
                   2754:         if ($env{'course.'.$tcourseid.'.description'}) {
                   2755:             $twhere=$env{'course.'.$tcourseid.'.description'};
                   2756:         } else {
                   2757:             my %newhash=&Apache::lonnet::coursedescription($tcourseid);
                   2758:             if (%newhash) {
                   2759:                 $twhere=$newhash{'description'};
                   2760:             } else {
                   2761:                 $twhere=&mt('Currently not available');
1.260     raeburn  2762:             }
                   2763:         }
1.279     raeburn  2764:         if ($tsection) {
                   2765:             $twhere.= '&nbsp; '.&mt('Section').':&nbsp;'.$tsection;
1.260     raeburn  2766:         }
1.279     raeburn  2767:         if ($role ne 'st') {
                   2768:             $twhere.= '&nbsp; '.&mt('Domain').':&nbsp;'.$tdom;
1.260     raeburn  2769:         }
1.279     raeburn  2770:     } elsif ($tdom) {
                   2771:         $twhere = &mt('Domain').':&nbsp;'.$tdom;
1.260     raeburn  2772:     }
1.286     raeburn  2773:     my $output;
                   2774:     if ($trole) {
                   2775:         $output = $trole;
                   2776:         if ($twhere) {
                   2777:             $output .= " -- $twhere";
                   2778:         }
                   2779:         if ($tremark) {
                   2780:             $output .= '<br />'.$tremark;
                   2781:         }
1.260     raeburn  2782:     }
1.279     raeburn  2783:     return $output;
1.260     raeburn  2784: }
                   2785: 
                   2786: sub curr_role_status {
                   2787:     my ($start,$end,$refresh,$update) = @_;
                   2788:     if (($start) && ($start<0)) { return 'deleted' };
                   2789:     my $status = 'active';
                   2790:     if (($end) && ($end<=$update)) {
                   2791:         $status = 'previous';
                   2792:     }
                   2793:     if (($start) && ($refresh<$start)) {
                   2794:         $status = 'future';
                   2795:     }
                   2796:     return $status;
                   2797: }
                   2798: 
                   2799: sub gather_roleprivs {
                   2800:     my ($allroles,$allgroups,$userroles,$area,$role,$tstart,$tend,$status) = @_;
                   2801:     return unless ((ref($allroles) eq 'HASH') && (ref($allgroups) eq 'HASH') && (ref($userroles) eq 'HASH'));
                   2802:     if (($area ne '') && ($role ne '')) {
                   2803:         &Apache::lonnet::userrolelog($role,$env{'user.name'},$env{'user.domain'},
                   2804:                                      $area,$tstart,$tend);
                   2805:         my $spec=$role.'.'.$area;
                   2806:         $userroles->{'user.role.'.$spec} = $tstart.'.'.$tend;
                   2807:         my ($tdummy,$tdomain,$trest)=split(/\//,$area);
                   2808:         if ($status eq 'active') { 
                   2809:             if ($role =~ /^cr\//) {
                   2810:                 &Apache::lonnet::custom_roleprivs($allroles,$role,$tdomain,$trest,$spec,$area);
                   2811:             } elsif ($role eq 'gr') {
                   2812:                 my %rolehash = &Apache::lonnet::get('roles',[$area.'_'.$role],
                   2813:                                                     $env{'user.domain'},
                   2814:                                                     $env{'user.name'});
                   2815:                 my ($trole) = split(/_/,$rolehash{$area.'_'.$role},2);
                   2816:                 (undef,my $group_privs) = split(/\//,$trole);
                   2817:                 $group_privs = &unescape($group_privs);
                   2818:                 &Apache::lonnet::group_roleprivs($allgroups,$area,$group_privs,$tend,$tstart);
                   2819:             } else {
                   2820:                 &Apache::lonnet::standard_roleprivs($allroles,$role,$tdomain,$spec,$trest,$area);
                   2821:             }
                   2822:         }
                   2823:     }
                   2824:     return;
                   2825: }
                   2826: 
                   2827: sub is_active_course {
                   2828:     my ($rolekey,$refresh,$update,$roleshashref) = @_;
                   2829:     return unless(ref($roleshashref) eq 'HASH');
                   2830:     my ($role,$cdom,$cnum) = split(/\//,$rolekey);
                   2831:     my $is_active;
                   2832:     foreach my $key (keys(%{$roleshashref})) {
                   2833:         if ($key =~ /^\Q$cnum\E:\Q$cdom\E:/) {
                   2834:             my ($tstart,$tend) = split(/:/,$roleshashref->{$key});
                   2835:             my $status = &curr_role_status($tstart,$tend,$refresh,$update);
                   2836:             if ($status eq 'active') {
                   2837:                 $is_active = 1;
                   2838:                 last;
                   2839:             }
                   2840:         }
                   2841:     }
                   2842:     return $is_active;
                   2843: }
                   2844: 
1.274     raeburn  2845: sub get_roles_functions {
1.302     raeburn  2846:     my ($rolescount,$cattype) = @_;
1.274     raeburn  2847:     my @links;
                   2848:     push(@links,["javascript:rolesView('doupdate');",'start-here-22x22',&mt('Check for changes')]);
                   2849:     if ($env{'environment.canrequest.author'}) {
                   2850:         unless (&Apache::loncoursequeueadmin::is_active_author()) {
                   2851:             push(@links,["javascript:rolesView('requestauthor');",'list-add-22x22',&mt('Request author role')]);
                   2852:         }
                   2853:     }
1.279     raeburn  2854:     if (($rolescount > 3) || ($env{'environment.recentroles'})) {
                   2855:         push(@links,['/adm/preferences?action=changerolespref&amp;returnurl=/adm/roles','role_hotlist-22x22',&mt('Hotlist')]);
                   2856:     }
1.274     raeburn  2857:     if (&Apache::lonmenu::check_for_rcrs()) {
                   2858:         push(@links,['/adm/requestcourse','rcrs-22x22',&mt('Request course')]);
                   2859:     }
                   2860:     if ($env{'form.state'} eq 'queued') {
                   2861:         push(@links,["javascript:rolesView('noqueued');",'selfenrl-queue-22x22',&mt('Hide queued')]);
                   2862:     } else {
                   2863:         push(@links,["javascript:rolesView('queued');",'selfenrl-queue-22x22',&mt('Show queued')]);
                   2864:     }
1.279     raeburn  2865:     if ($env{'user.adv'}) {
                   2866:         if ($env{'form.display'} eq 'showall') {
1.290     raeburn  2867:             push(@links,["javascript:rolesView('noshowall');",'edit-redo-22x22',&mt('Exclude expired')]);
1.279     raeburn  2868:         } else {
1.290     raeburn  2869:             push(@links,["javascript:rolesView('showall');",'edit-undo-22x22',&mt('Include expired')]);
1.279     raeburn  2870:         }
1.274     raeburn  2871:     }
1.302     raeburn  2872:     unless ($cattype eq 'none') {
1.291     raeburn  2873:         push(@links,['/adm/coursecatalog','ccat-22x22',&mt('Course catalog')]);
1.290     raeburn  2874:     }
1.314     raeburn  2875:     my $funcs;
                   2876:     if ($env{'browser.mobile'}) {
                   2877:         my @functions;
                   2878:         foreach my $link (@links) {
                   2879:             push(@functions,[$link->[0],$link->[2]]);
                   2880:         }
                   2881:         my $title = 'Display options';
                   2882:         if ($env{'user.adv'}) {
                   2883:             $title = 'Roles options';
                   2884:         }
                   2885:         $funcs = &Apache::lonmenu::create_submenu('','',$title,\@functions,1,'LC_breadcrumbs_hoverable');
                   2886:         $funcs = '<ol class="LC_primary_menu LC_floatright">'.$funcs.'</ol>';
                   2887:     } else {
                   2888:         $funcs = &Apache::lonhtmlcommon::start_funclist();
                   2889:         foreach my $link (@links) {
                   2890:             $funcs .= &Apache::lonhtmlcommon::add_item_funclist(
                   2891:                           '<a href="'.$link->[0].'" class="LC_menubuttons_link">'.
                   2892:                           '<img src="/res/adm/pages/'.$link->[1].'.png" class="LC_icon" alt="'.$link->[2].'" />'.
                   2893:                           $link->[2].'</a>');
                   2894:         }
                   2895:         $funcs .= &Apache::lonhtmlcommon::end_funclist();
                   2896:         $funcs = &Apache::loncommon::head_subbox($funcs);
1.274     raeburn  2897:     }
1.314     raeburn  2898:     return $funcs;
1.274     raeburn  2899: }
                   2900: 
                   2901: sub get_queued {
                   2902:     my ($output,%reqcrs);
                   2903:     my ($types,$typenames) = &Apache::loncommon::course_types();
                   2904:     my %statusinfo = &Apache::lonnet::dump('courserequests',$env{'user.domain'},
                   2905:                                            $env{'user.name'},'^status:');
                   2906:     foreach my $key (keys(%statusinfo)) {
                   2907:         next unless (($statusinfo{$key} eq 'approval') || ($statusinfo{$key} eq 'pending'));
1.297     raeburn  2908:         (undef,my($cdom,$cnum)) = split(/:/,$key);
1.274     raeburn  2909:         my $requestkey = $cdom.'_'.$cnum;
                   2910:         if ($requestkey =~ /^($match_domain)_($match_courseid)$/) {
                   2911:             my %history = &Apache::lonnet::restore($requestkey,'courserequests',
                   2912:                                                    $env{'user.domain'},$env{'user.name'});
                   2913:             next if ((exists($history{'status'})) && ($history{'status'} eq 'created'));
                   2914:             my $reqtime = $history{'reqtime'};
                   2915:             my $lastupdate = $history{'timestamp'};
                   2916:             my $showtype = $history{'crstype'};
                   2917:             if (defined($typenames->{$history{'crstype'}})) {
                   2918:                 $showtype = $typenames->{$history{'crstype'}};
                   2919:             }
                   2920:             my $description;
                   2921:             if (ref($history{'details'}) eq 'HASH') {
                   2922:                 $description = $history{details}{'cdescr'};
                   2923:             }
                   2924:             @{$reqcrs{$reqtime}} = ($description,$showtype); 
                   2925:         }
                   2926:     }
                   2927:     my @sortedtimes = sort {$a <=> $b} (keys(%reqcrs));
                   2928:     if (@sortedtimes > 0) {
                   2929:         $output .= '<p><b>'.&mt('Course/Community requests').'</b><br />'.
                   2930:                    &Apache::loncommon::start_data_table().
                   2931:                    &Apache::loncommon::start_data_table_header_row().
                   2932:                    '<th>'.&mt('Date requested').'</th>'.
                   2933:                    '<th>'.&mt('Course title').'</th>'.
                   2934:                    '<th>'.&mt('Course type').'</th>';
                   2935:                    &Apache::loncommon::end_data_table_header_row();
                   2936:         foreach my $reqtime (@sortedtimes) {
                   2937:             next unless (ref($reqcrs{$reqtime}) eq 'ARRAY');
                   2938:             $output .= &Apache::loncommon::start_data_table_row().
                   2939:                        '<td>'.&Apache::lonlocal::locallocaltime($reqtime).'</td>'.
                   2940:                        '<td>'.join('</td><td>',@{$reqcrs{$reqtime}}).'</td>'.
                   2941:                        &Apache::loncommon::end_data_table_row();
                   2942:         }
                   2943:         $output .= &Apache::loncommon::end_data_table().
                   2944:                    '<br /></p>';
                   2945:     }
                   2946:     my $queuedselfenroll = &Apache::loncoursequeueadmin::queued_selfenrollment(1);
                   2947:     if ($queuedselfenroll) {
                   2948:         $output .= '<p><b>'.&mt('Enrollment requests').'</b><br />'.
                   2949:                    $queuedselfenroll.'<br /></p>';
                   2950:     }
                   2951:     if ($env{'environment.canrequest.author'}) {
                   2952:         unless (&Apache::loncoursequeueadmin::is_active_author()) {
                   2953:             my $requestauthor;
                   2954:             my ($status,$timestamp) = split(/:/,$env{'environment.requestauthorqueued'});
                   2955:             if (($status eq 'approval') || ($status eq 'approved')) {
                   2956:                 $output .= '<p><b>'.&mt('Author role request').'</b><br />';
                   2957:                 if ($status eq 'approval') {
1.294     bisitz   2958:                     $output .= &mt('A request for Authoring Space submitted on [_1] is awaiting approval',
1.274     raeburn  2959:                                   &Apache::lonlocal::locallocaltime($timestamp));
                   2960:                 } elsif ($status eq 'approved') {
                   2961:                     my %roleshash =
                   2962:                         &Apache::lonnet::get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',
                   2963:                                                       ['active'],['au'],[$env{'user.domain'}]);
                   2964:                     if (keys(%roleshash)) {
                   2965:                         $output .= '<span class="LC_info">'.
                   2966:                                    &mt('Your request for an author role has been approved.').'<br />'.
                   2967:                                    &mt('Use the "Check for changes" link to update your list of roles.').
                   2968:                                    '</span>';
                   2969:                     }
                   2970:                 }
                   2971:                 $output .= '</p>';
                   2972:             }
                   2973:         }
                   2974:     }
                   2975:     unless ($output) {
                   2976:         if ($env{'environment.canrequest.author'} || $env{'environment.canrequest.official'} ||
                   2977:             $env{'environment.canrequest.unofficial'} || $env{'environment.canrequest.community'}) {
                   2978:             $output = &mt('No requests for courses, communities or authoring currently queued');
                   2979:         } else {
                   2980:             $output = &mt('No enrollment requests currently queued awaiting approval');
                   2981:         }
                   2982:     }
                   2983:     return '<div class="LC_left_float"><fieldset><legend>'.&mt('Queued requests').'</legend>'.
                   2984:            $output.'</fieldset></div><br clear="all" />';
                   2985: }
                   2986: 
1.1       harris41 2987: 1;
                   2988: __END__
1.32      harris41 2989: 
                   2990: =head1 NAME
                   2991: 
                   2992: Apache::lonroles - User Roles Screen
                   2993: 
                   2994: =head1 SYNOPSIS
                   2995: 
                   2996: Invoked by /etc/httpd/conf/srm.conf:
                   2997: 
                   2998:  <Location /adm/roles>
                   2999:  PerlAccessHandler       Apache::lonacc
                   3000:  SetHandler perl-script
                   3001:  PerlHandler Apache::lonroles
                   3002:  ErrorDocument     403 /adm/login
                   3003:  ErrorDocument	  500 /adm/errorhandler
                   3004:  </Location>
1.64      bowersj2 3005: 
                   3006: =head1 OVERVIEW
                   3007: 
                   3008: =head2 Choosing Roles
                   3009: 
                   3010: C<lonroles> is a handler that allows a user to switch roles in
                   3011: mid-session. LON-CAPA attempts to work with "No Role Specified", the
                   3012: default role that a user has before selecting a role, as widely as
                   3013: possible, but certain handlers for example need specification which
                   3014: course they should act on, etc. Both in this scenario, and when the
                   3015: handler determines via C<lonnet>'s C<&allowed> function that a certain
                   3016: action is not allowed, C<lonroles> is used as error handler. This
                   3017: allows the user to select another role which may have permission to do
1.246     droeschl 3018: what they were trying to do.
1.64      bowersj2 3019: 
                   3020: =begin latex
                   3021: 
                   3022: \begin{figure}
                   3023: \begin{center}
                   3024: \includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen}
                   3025:   \caption{\label{Sample_Roles_Screen}Sample Roles Screen} 
                   3026: \end{center}
                   3027: \end{figure}
                   3028: 
                   3029: =end latex
                   3030: 
                   3031: =head2 Role Initialization
                   3032: 
                   3033: 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 3034: 
                   3035: =head1 INTRODUCTION
                   3036: 
                   3037: This module enables a user to select what role he wishes to
                   3038: operate under (instructor, student, teaching assistant, course
                   3039: coordinator, etc).  These roles are pre-established by the actions
                   3040: of upper-level users.
                   3041: 
                   3042: This is part of the LearningOnline Network with CAPA project
                   3043: described at http://www.lon-capa.org.
                   3044: 
                   3045: =head1 HANDLER SUBROUTINE
                   3046: 
                   3047: This routine is called by Apache and mod_perl.
                   3048: 
                   3049: =over 4
                   3050: 
                   3051: =item *
                   3052: 
                   3053: Roles Initialization (yes/no)
                   3054: 
                   3055: =item *
                   3056: 
                   3057: Get Error Message from Environment
                   3058: 
                   3059: =item *
                   3060: 
                   3061: Who is this?
                   3062: 
                   3063: =item *
                   3064: 
                   3065: Generate Page Output
                   3066: 
                   3067: =item *
                   3068: 
                   3069: Choice or no choice
                   3070: 
                   3071: =item *
                   3072: 
                   3073: Table
                   3074: 
                   3075: =item *
                   3076: 
                   3077: Privileges
                   3078: 
                   3079: =back
                   3080: 
                   3081: =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.