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

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