--- loncom/auth/lonroles.pm 2006/06/26 21:41:09 1.160
+++ loncom/auth/lonroles.pm 2012/08/15 16:56:52 1.273
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.160 2006/06/26 21:41:09 albertel Exp $
+# $Id: lonroles.pm,v 1.273 2012/08/15 16:56:52 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -27,6 +27,102 @@
#
###
+=pod
+
+=head1 NAME
+
+Apache::lonroles - User Roles Screen
+
+=head1 SYNOPSIS
+
+Invoked by /etc/httpd/conf/srm.conf:
+
+
+ PerlAccessHandler Apache::lonacc
+ SetHandler perl-script
+ PerlHandler Apache::lonroles
+ ErrorDocument 403 /adm/login
+ ErrorDocument 500 /adm/errorhandler
+
+
+=head1 OVERVIEW
+
+=head2 Choosing Roles
+
+C is a handler that allows a user to switch roles in
+mid-session. LON-CAPA attempts to work with "No Role Specified", the
+default role that a user has before selecting a role, as widely as
+possible, but certain handlers for example need specification which
+course they should act on, etc. Both in this scenario, and when the
+handler determines via C's C<&allowed> function that a certain
+action is not allowed, C is used as error handler. This
+allows the user to select another role which may have permission to do
+what they were trying to do.
+
+=begin latex
+
+\begin{figure}
+\begin{center}
+\includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen}
+ \caption{\label{Sample_Roles_Screen}Sample Roles Screen}
+\end{center}
+\end{figure}
+
+=end latex
+
+=head2 Role Initialization
+
+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'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.
+
+=head1 INTRODUCTION
+
+This module enables a user to select what role he wishes to
+operate under (instructor, student, teaching assistant, course
+coordinator, etc). These roles are pre-established by the actions
+of upper-level users.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head1 HANDLER SUBROUTINE
+
+This routine is called by Apache and mod_perl.
+
+=over 4
+
+=item *
+
+Roles Initialization (yes/no)
+
+=item *
+
+Get Error Message from Environment
+
+=item *
+
+Who is this?
+
+=item *
+
+Generate Page Output
+
+=item *
+
+Choice or no choice
+
+=item *
+
+Table
+
+=item *
+
+Privileges
+
+=back
+
+=cut
+
+
package Apache::lonroles;
use strict;
@@ -40,26 +136,26 @@ use Apache::lonhtmlcommon;
use Apache::lonannounce;
use Apache::lonlocal;
use Apache::lonpageflip();
+use Apache::lonnavdisplay();
+use Apache::loncoursequeueadmin;
use GDBM_File;
-use LONCAPA;
+use LONCAPA qw(:DEFAULT :match);
+use HTML::Entities;
sub redirect_user {
- my ($r,$title,$url,$msg,$launch_nav) = @_;
+ my ($r,$title,$url,$msg) = @_;
$msg = $title if (! defined($msg));
&Apache::loncommon::content_type($r,'text/html');
&Apache::loncommon::no_cache($r);
$r->send_http_header;
- my $swinfo=&Apache::lonmenu::rawconfig();
- my $navwindow;
- if ($launch_nav eq 'on') {
- $navwindow.=&Apache::lonnavmaps::launch_win('now',undef,undef,
- ($url =~ m-^/adm/whatsnew-));
- } else {
- $navwindow.=&Apache::lonnavmaps::close();
- }
+
+ # Breadcrumbs
+ my $brcrum = [{'href' => $url,
+ 'text' => 'Switching Role'},];
my $start_page = &Apache::loncommon::start_page('Switching Role',undef,
- {'redirect' => [1,$url],});
+ {'redirect' => [1,$url],
+ 'bread_crumbs' => $brcrum,});
my $end_page = &Apache::loncommon::end_page();
# Note to style police:
@@ -67,11 +163,7 @@ sub redirect_user {
$url=~s/ /\%20/g;
$r->print(<
-$swinfo
-
-$navwindow
-
$msg
+
$msg
$end_page
ENDREDIR
return;
@@ -83,13 +175,25 @@ sub error_page {
&Apache::loncommon::no_cache($r);
$r->send_http_header;
return OK if $r->header_only;
- $r->print(&Apache::loncommon::start_page('Problems during Course Initialization').
- ''.
- '
'.&mt('The following problems occurred:').
+ # Breadcrumbs
+ my $brcrum = [{'href' => $dest,
+ 'text' => 'Problems during Course Initialization'},];
+ $r->print(&Apache::loncommon::start_page('Problems during Course Initialization',
+ undef,
+ {'bread_crumbs' => $brcrum,})
+ );
+ $r->print(
+ ''.
+ '
'.&mt('The following problems occurred:').
+ ' '.
$error.
- '
'
+ .&Apache::loncommon::end_data_table_empty_row()
+ );
+ }
+ $r->print($output);
+ }
+ }
}
- my $tremark='';
- my $tfont='#003300';
- if ($env{'request.role'} eq 'cm') {
- $r->print('
');
- $tremark=&mt('Currently selected. ');
- $tfont='#002200';
+}
+
+sub findcourse_advice {
+ my ($r) = @_;
+ my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
+ my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
+ if (&Apache::lonnet::auto_run(undef,$env{'user.domain'})) {
+ $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).'
+
+
'.&mt('The course has yet to be created.').'
+
'.&mt('Automatic enrollment of registered students has not been enabled for the course.').'
+
'.&mt('You are in a section of course for which automatic enrollment in the corresponding LON-CAPA course is not active.').'
+
'.&mt('The start date for automated enrollment has yet to be reached.').'
+
'.&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.').'
+
');
} else {
- $r->print('
');
- }
- unless ($nochoose) {
- if ($env{'request.role'} ne 'cm') {
- $r->print('
');
- } else {
- $r->print('
');
- }
+ $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.').' ');
}
- $r->print('
'.&mt('No role specified').
- '
'.$tremark.
- '
'."\n");
+ $r->print('
'.&mt('Self-Enrollment').'
'.
+ '
'.&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.','','',$domdesc).' ');
+ $r->print(&mt('You can search for courses and communities which permit self-enrollment, if you would like to enroll in one.').'
'.&mt('Use the [_1]request form[_2] to submit a request for creation of a new course or community.','','').'');
+ }
}
-# ------------------------------------------------------------ Privileges Info
- if (($advanced) && (($env{'user.error.msg'}) || ($error))) {
- $r->print('
');
- foreach (sort split(/:/,$env{$envkey})) {
- if ($_) {
- my ($prv,$restr)=split(/\&/,$_);
- my $trestr='';
- if ($restr ne 'F') {
- my $i;
- $trestr.=' (';
- for ($i=0;$iprint('
'.
- Apache::lonnet::plaintext($prv).$trestr.
- '
');
+sub privileges_info {
+ my ($which) = @_;
+ my $output;
+
+ $which ||= $env{'request.role'};
+
+ foreach my $envkey (sort(keys(%env))) {
+ next if ($envkey!~/^user\.priv\.\Q$which\E\.(.*)/);
+
+ my $where=$1;
+ my $ttype;
+ my $twhere;
+ my (undef,$tdom,$trest,$tsec)=split(m{/},$where);
+ if ($trest) {
+ if ($env{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
+ $ttype='Construction Space';
+ $twhere='User: '.$trest.', Domain: '.$tdom;
+ } else {
+ $ttype= &Apache::loncommon::course_type($tdom.'_'.$trest);
+ $twhere=$env{'course.'.$tdom.'_'.$trest.'.description'};
+ if ($tsec) {
+ my $sec_type = 'Section';
+ if (exists($env{"user.role.gr.$where"})) {
+ $sec_type = 'Group';
}
+ $twhere.=' ('.$sec_type.': '.$tsec.')';
}
- $r->print('
';
}
- return $roletext;
+ return ($roletext,$roletext_end);
}
-sub check_privs {
- my ($cdom,$cnum,$then,$now) = @_;
- my $cckey = 'user.role.cc./'.$cdom.'/'.$cnum;
- if ($env{$cckey}) {
- my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend,$tfont);
- &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
- unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
- &set_privileges($cdom,$cnum);
- }
+sub check_needs_switchserver {
+ my ($possiblerole) = @_;
+ my $needs_switchserver;
+ my ($role,$where) = split(/\./,$possiblerole,2);
+ my (undef,$tdom,$twho) = split(/\//,$where);
+ my ($server_status,$home);
+ if (($role eq 'ca') || ($role eq 'aa')) {
+ ($server_status,$home) = &check_author_homeserver($twho,$tdom);
+ } else {
+ ($server_status,$home) = &check_author_homeserver($env{'user.name'},
+ $env{'user.domain'});
+ }
+ if ($server_status eq 'switchserver') {
+ $needs_switchserver = 1;
+ }
+ return $needs_switchserver;
+}
+
+sub check_author_homeserver {
+ my ($uname,$udom)=@_;
+ if (($uname eq '') || ($udom eq '')) {
+ return ('fail','');
+ }
+ my $home = &Apache::lonnet::homeserver($uname,$udom);
+ if (&Apache::lonnet::host_domain($home) ne $udom) {
+ return ('fail',$home);
+ }
+ my @ids=&Apache::lonnet::current_machine_ids();
+ if (grep(/^\Q$home\E$/,@ids)) {
+ return ('ok',$home);
} else {
- &set_privileges($cdom,$cnum);
+ return ('switchserver',$home);
}
}
sub check_fordc {
- my ($dcroles,$then) = @_;
+ my ($dcroles,$update,$then) = @_;
my $numdc = 0;
if ($env{'user.adv'}) {
foreach my $envkey (sort keys %env) {
- if ($envkey=~/^user\.role\.dc\.\/(\w+)\/$/) {
+ if ($envkey=~/^user\.role\.dc\.\/($match_domain)\/$/) {
my $dcdom = $1;
my $livedc = 1;
my ($tstart,$tend)=split(/\./,$env{$envkey});
- if ($tstart && $tstart>$then) { $livedc = 0; }
- if ($tend && $tend <$then) { $livedc = 0; }
+ my $limit = $update;
+ if ($env{'request.role'} eq 'dc./'.$dcdom.'/') {
+ $limit = $then;
+ }
+ if ($tstart && $tstart>$limit) { $livedc = 0; }
+ if ($tend && $tend <$limit) { $livedc = 0; }
if ($livedc) {
$$dcroles{$dcdom} = $envkey;
$numdc++;
@@ -899,12 +1630,143 @@ sub check_fordc {
return $numdc;
}
+sub adhoc_course_role {
+ my ($refresh,$update,$then) = @_;
+ my ($cdom,$cnum,$crstype);
+ $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ $crstype = &Apache::loncommon::course_type();
+ if (&check_forcc($cdom,$cnum,$refresh,$update,$then,$crstype)) {
+ my $setprivs;
+ if (!defined($env{'user.role.'.$env{'form.switchrole'}})) {
+ $setprivs = 1;
+ } else {
+ my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}});
+ if (($start && ($start>$refresh || $start == -1)) ||
+ ($end && $end<$update)) {
+ $setprivs = 1;
+ }
+ }
+ if ($setprivs) {
+ if ($env{'form.switchrole'} =~ m-^(in|ta|ep|ad|st|cr)([\w/]*)\./\Q$cdom\E/\Q$cnum\E/?(\w*)$-) {
+ my $role = $1;
+ my $custom_role = $2;
+ my $usec = $3;
+ if ($role eq 'cr') {
+ if ($custom_role =~ m-^/$match_domain/$match_username/\w+$-) {
+ $role .= $custom_role;
+ } else {
+ return;
+ }
+ }
+ my (%userroles,%newrole,%newgroups,%group_privs);
+ my %cgroups =
+ &Apache::lonnet::get_active_groups($env{'user.domain'},
+ $env{'user.name'},$cdom,$cnum);
+ foreach my $group (keys(%cgroups)) {
+ $group_privs{$group} =
+ $env{'user.priv.cc./'.$cdom.'/'.$cnum.'./'.$cdom.'/'.$cnum.'/'.$group};
+ }
+ $newgroups{'/'.$cdom.'/'.$cnum} = \%group_privs;
+ my $area = '/'.$cdom.'/'.$cnum;
+ my $spec = $role.'.'.$area;
+ if ($usec ne '') {
+ $spec .= '/'.$usec;
+ $area .= '/'.$usec;
+ }
+ &Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,$area);
+ &Apache::lonnet::set_userprivs(\%userroles,\%newrole,\%newgroups);
+ my $adhocstart = $refresh-1;
+ $userroles{'user.role.'.$spec} = $adhocstart.'.';
+ &Apache::lonnet::appenv(\%userroles,[$role,'cm']);
+ }
+ }
+ }
+ return;
+}
+
+sub check_forcc {
+ my ($cdom,$cnum,$refresh,$update,$then,$crstype) = @_;
+ my ($is_cc,$ccrole);
+ if ($crstype eq 'Community') {
+ $ccrole = 'co';
+ } else {
+ $ccrole = 'cc';
+ }
+ if (&Apache::lonnet::is_course($cdom,$cnum)) {
+ my $envkey = 'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum;
+ if (defined($env{$envkey})) {
+ $is_cc = 1;
+ my ($tstart,$tend)=split(/\./,$env{$envkey});
+ my $limit = $update;
+ if ($env{'request.role'} eq $ccrole.'./'.$cdom.'/'.$cnum) {
+ $limit = $then;
+ }
+ if ($tstart && $tstart>$refresh) { $is_cc = 0; }
+ if ($tend && $tend <$limit) { $is_cc = 0; }
+ }
+ }
+ return $is_cc;
+}
+
+sub check_release_required {
+ my ($loncaparev,$tcourseid,$trolecode,$required) = @_;
+ my ($switchserver,$warning);
+ if ($required ne '') {
+ my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
+ my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
+ if ($reqdmajor ne '' && $reqdminor ne '') {
+ my $otherserver;
+ if (($major eq '' && $minor eq '') ||
+ (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
+ my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'});
+ my $switchlcrev =
+ &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
+ $userdomserver);
+ my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
+ if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
+ (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
+ my $cdom = $env{'course.'.$tcourseid.'.domain'};
+ if ($cdom ne $env{'user.domain'}) {
+ my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom);
+ my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
+ my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
+ my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
+ my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
+ my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
+ my $canhost =
+ &Apache::lonnet::can_host_session($env{'user.domain'},
+ $coursedomserver,
+ $remoterev,
+ $udomdefaults{'remotesessions'},
+ $defdomdefaults{'hostedsessions'});
+
+ if ($canhost) {
+ $otherserver = $coursedomserver;
+ } else {
+ $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).' '. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
+ }
+ } else {
+ $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).' '.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
+ }
+ } else {
+ $otherserver = $userdomserver;
+ }
+ }
+ if ($otherserver ne '') {
+ $switchserver = 'otherserver='.$otherserver.'&role='.$trolecode;
+ }
+ }
+ }
+ return ($switchserver,$warning);
+}
+
sub courselink {
- my ($dcdom,$rowtype,$selecttype) = @_;
+ my ($dcdom,$rowtype) = @_;
my $courseform=&Apache::loncommon::selectcourse_link
('rolechoice','dccourse'.$rowtype.'_'.$dcdom,
'dcdomain'.$rowtype.'_'.$dcdom,'coursedesc'.$rowtype.'_'.
- $dcdom,$dcdom,undef,$selecttype);
+ $dcdom,$dcdom,undef,'Course/Community');
my $hiddenitems = ''.
''.
''.
@@ -913,8 +1775,13 @@ sub courselink {
}
sub coursepick_jscript {
+ my %lt = &Apache::lonlocal::texthash(
+ 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.",
+ youc => 'You can only use this screen to select courses and communities in the current domain.',
+ );
my $verify_script = <<"END";
-
END
return $verify_script;
}
-sub processpick {
- my $process_pick = <<"END";
-
-END
- return $process_pick;
+sub coauthorlink {
+ my ($dcdom,$rowtype) = @_;
+ my $coauthorform=&Apache::loncommon::selectauthor_link('rolechoice',$dcdom);
+ my $hiddenitems = '';
+ return $coauthorform.$hiddenitems;
}
sub display_cc_role {
my $rolekey = shift;
- my $roletext;
+ my ($roletext,$roletext_end);
my $advanced = $env{'user.adv'};
my $tryagain = $env{'form.tryagain'};
unless ($rolekey =~/^error\:/) {
- if ($rolekey =~ m-^user\.role.cc\./(\w+)/(\w+)$-) {
- my $tcourseid = $1.'_'.$2;
- my $trolecode = 'cc./'.$1.'/'.$2;
+ if ($rolekey =~ m{^user\.role\.(cc|co)\./($match_domain)/($match_courseid)$}) {
+ my $ccrole = $1;
+ my $tdom = $2;
+ my $trest = $3;
+ my $tcourseid = $tdom.'_'.$trest;
+ my $trolecode = $ccrole.'./'.$tdom.'/'.$trest;
my $twhere;
my $ttype;
- my $tbg='#77FF77';
- my $tfont='#003300';
+ my $tbg='LC_roles_is';
my %newhash=&Apache::lonnet::coursedescription($tcourseid);
if (%newhash) {
$twhere=$newhash{'description'}.
- ' '.
- &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$2,$1,$tfont).
- '';
+ ' '.
+ &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
+ '';
$ttype = $newhash{'type'};
} else {
$twhere=&mt('Currently not available');
$env{'course.'.$tcourseid.'.description'}=$twhere;
}
- my $trole = &Apache::lonnet::plaintext('cc',$ttype);
- $twhere.=" ".&mt('Domain').":".$1;
- $roletext = &build_roletext($trolecode,$1,$2,'is',$tryagain,$advanced,'',$tbg,$tfont,$trole,$twhere,'','','',1,'');
+ my $trole = &Apache::lonnet::plaintext($ccrole,$ttype,$tcourseid);
+ $twhere.=" ".&mt('Domain').":".$tdom;
+ ($roletext,$roletext_end) = &build_roletext($trolecode,$tdom,$trest,'is',$tryagain,$advanced,'',$tbg,$trole,$twhere,'','','',1,'');
}
}
- return ($roletext);
+ return ($roletext,$roletext_end);
}
-sub allcourses_row {
+sub adhoc_roles_row {
my ($dcdom,$rowtype) = @_;
- my $output = '
'.
- '
';
- foreach my $type ('Course','Group') {
- my $selectlink = &courselink($dcdom,$rowtype,$type);
- my $ccrole = &Apache::lonnet::plaintext('cc',$type);
- $output.= ''.$ccrole.''.
- ' '.$selectlink.''.
- ' from '.&mt('Domain').' '.$dcdom.' ';
- }
- $output .= '
'."\n";
+ my $output = &Apache::loncommon::continue_data_table_row()
+ .'
'
+ .&mt('[_1]Ad hoc[_2] roles in domain [_3] --'
+ ,'','',$dcdom)
+ .' ';
+ my $selectcclink = &courselink($dcdom,$rowtype);
+ my $ccrole = &Apache::lonnet::plaintext('co',undef,undef,1);
+ my $carole = &Apache::lonnet::plaintext('ca');
+ my $selectcalink = &coauthorlink($dcdom,$rowtype);
+ $output.=$ccrole.': '.$selectcclink
+ .' | '.$carole.': '.$selectcalink.'
'
+ .&Apache::loncommon::end_data_table_row();
return $output;
}
@@ -1026,29 +1879,6 @@ sub recent_filename {
return 'nohist_recent_'.&escape($area);
}
-sub set_privileges {
- my ($dcdom,$pickedcourse) = @_;
- my $area = '/'.$dcdom.'/'.$pickedcourse;
- my $role = 'cc';
- my $spec = $role.'.'.$area;
- my %userroles = &Apache::lonnet::set_arearole($role,$area,'','',$dcdom,$env{'user.name'});
- my %ccrole = ();
- &Apache::lonnet::standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
- my ($author,$adv)= &Apache::lonnet::set_userprivs(\%userroles,\%ccrole);
- &Apache::lonnet::appenv(%userroles);
- &Apache::lonnet::log($env{'user.domain'},
- $env{'user.name'},
- $env{'user.home'},
- "Role ".$role);
- &Apache::lonnet::appenv(
- 'request.role' => $spec,
- 'request.role.domain' => $dcdom,
- 'request.course.sec' => '');
- my $tadv=0;
- if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
- &Apache::lonnet::appenv('request.role.adv' => $tadv);
-}
-
sub courseloadpage {
my ($courseid) = @_;
my $startpage;
@@ -1066,6 +1896,644 @@ sub courseloadpage {
return $startpage;
}
+sub update_session_roles {
+ my $then=$env{'user.login.time'};
+ my $refresh=$env{'user.refresh.time'};
+ if (!$refresh) {
+ $refresh = $then;
+ }
+ my $update = $env{'user.update.time'};
+ if (!$update) {
+ $update = $then;
+ }
+ my $now = time;
+ my %roleshash =
+ &Apache::lonnet::get_my_roles('','','userroles',
+ ['active','future','previous'],
+ undef,undef,1);
+ my ($msg,@newsec,$oldsec,$currrole_expired,@changed_roles,
+ %changed_groups,%dbroles,%deletedroles,%allroles,%allgroups,
+ %userroles,%checkedgroup,%crprivs,$hasgroups,%rolechange,
+ %groupchange,%newrole,%newgroup,%customprivchg,%groups_roles,
+ @rolecodes);
+ my @possroles = ('cr','st','ta','ad','ep','in','co','cc');
+ my %courseroles;
+ foreach my $item (keys(%roleshash)) {
+ my ($uname,$udom,$role,$remainder) = split(/:/,$item,4);
+ my ($tstart,$tend) = split(/:/,$roleshash{$item});
+ my ($section,$group,@group_privs);
+ if ($role =~ m{^gr/(\w*)$}) {
+ $role = 'gr';
+ my $priv = $1;
+ next if ($tstart eq '-1');
+ if (&curr_role_status($tstart,$tend,$refresh,$now) eq 'active') {
+ if ($priv ne '') {
+ push(@group_privs,$priv);
+ }
+ }
+ if ($remainder =~ /:/) {
+ (my $additional_privs,$group) =
+ ($remainder =~ /^([\w:]+):([^:]+)$/);
+ if ($additional_privs ne '') {
+ if (&curr_role_status($tstart,$tend,$refresh,$now) eq 'active') {
+ push(@group_privs,split(/:/,$additional_privs));
+ @group_privs = sort(@group_privs);
+ }
+ }
+ } else {
+ $group = $remainder;
+ }
+ } else {
+ $section = $remainder;
+ }
+ my $where = "/$udom/$uname";
+ if ($section ne '') {
+ $where .= "/$section";
+ } elsif ($group ne '') {
+ $where .= "/$group";
+ }
+ my $rolekey = "$role.$where";
+ my $envkey = "user.role.$rolekey";
+ $dbroles{$envkey} = 1;
+ if (($env{'request.role'} eq $rolekey) && ($role ne 'st')) {
+ if (&curr_role_status($tstart,$tend,$refresh,$now) ne 'active') {
+ $currrole_expired = 1;
+ }
+ }
+ if ($env{$envkey} eq '') {
+ my $status_in_db =
+ &curr_role_status($tstart,$tend,$now,$now);
+ &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
+ if (($role eq 'st') && ($env{'request.role'} =~ m{^\Q$role\E\.\Q/$udom/$uname\E})) {
+ if ($status_in_db eq 'active') {
+ if ($section eq '') {
+ push(@newsec,'none');
+ } else {
+ push(@newsec,$section);
+ }
+ }
+ } else {
+ unless (grep(/^\Q$role\E$/,@changed_roles)) {
+ push(@changed_roles,$role);
+ }
+ if ($status_in_db ne 'previous') {
+ if ($role eq 'gr') {
+ $newgroup{$rolekey} = $status_in_db;
+ if ($status_in_db eq 'active') {
+ unless (ref($courseroles{$udom}) eq 'HASH') {
+ %{$courseroles{$udom}} =
+ &Apache::lonnet::get_my_roles('','','userroles',
+ ['active'],\@possroles,
+ [$udom],1);
+ }
+ &Apache::lonnet::get_groups_roles($udom,$uname,
+ $courseroles{$udom},
+ \@rolecodes,\%groups_roles);
+ }
+ } else {
+ $newrole{$rolekey} = $status_in_db;
+ }
+ }
+ }
+ } else {
+ my ($currstart,$currend) = split(/\./,$env{$envkey});
+ if ($role eq 'gr') {
+ if (&curr_role_status($currstart,$currend,$refresh,$update) ne 'previous') {
+ $hasgroups = 1;
+ }
+ }
+ if (($currstart ne $tstart) || ($currend ne $tend)) {
+ my $status_in_env =
+ &curr_role_status($currstart,$currend,$refresh,$update);
+ my $status_in_db =
+ &curr_role_status($tstart,$tend,$now,$now);
+ if ($status_in_env ne $status_in_db) {
+ if ($status_in_env eq 'active') {
+ if ($role eq 'st') {
+ if ($env{'request.role'} eq $rolekey) {
+ my $switchsection;
+ unless (ref($courseroles{$udom}) eq 'HASH') {
+ %{$courseroles{$udom}} =
+ &Apache::lonnet::get_my_roles('','','userroles',
+ ['active'],
+ \@possroles,[$udom],1);
+ }
+ foreach my $crsrole (keys(%{$courseroles{$udom}})) {
+ if ($crsrole =~ /^\Q$uname\E:\Q$udom\E:st/) {
+ $switchsection = 1;
+ last;
+ }
+ }
+ if ($switchsection) {
+ if ($section eq '') {
+ $oldsec = 'none';
+ } else {
+ $oldsec = $section;
+ }
+ &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
+ } else {
+ $currrole_expired = 1;
+ next;
+ }
+ }
+ }
+ unless ($rolekey eq $env{'request.role'}) {
+ if ($role eq 'gr') {
+ &Apache::lonnet::delete_env_groupprivs($where,\%courseroles,\@possroles);
+ } else {
+ &Apache::lonnet::delenv("user.priv.$rolekey",undef,[$role]);
+ &Apache::lonnet::delenv("user.priv.cm.$where",undef,['cm']);
+ }
+ &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
+ }
+ } elsif ($status_in_db eq 'active') {
+ if (($role eq 'st') &&
+ ($env{'request.role'} =~ m{^\Q$role\E\.\Q/$udom/$uname\E})) {
+ if ($section eq '') {
+ push(@newsec,'none');
+ } else {
+ push(@newsec,$section);
+ }
+ } elsif ($role eq 'gr') {
+ unless (ref($courseroles{$udom}) eq 'HASH') {
+ %{$courseroles{$udom}} =
+ &Apache::lonnet::get_my_roles('','','userroles',
+ ['active'],
+ \@possroles,[$udom],1);
+ }
+ &Apache::lonnet::get_groups_roles($udom,$uname,
+ $courseroles{$udom},
+ \@rolecodes,\%groups_roles);
+ }
+ &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
+ }
+ unless (grep(/^\Q$role\E$/,@changed_roles)) {
+ push(@changed_roles,$role);
+ }
+ if ($role eq 'gr') {
+ $groupchange{"/$udom/$uname"}{$group} = $status_in_db;
+ } else {
+ $rolechange{$rolekey} = $status_in_db;
+ }
+ }
+ } else {
+ if ($role eq 'gr') {
+ unless ($checkedgroup{$where}) {
+ my $status_in_db =
+ &curr_role_status($tstart,$tend,$refresh,$now);
+ if ($tstart eq '-1') {
+ $status_in_db = 'deleted';
+ }
+ unless (ref($courseroles{$udom}) eq 'HASH') {
+ %{$courseroles{$udom}} =
+ &Apache::lonnet::get_my_roles('','','userroles',
+ ['active'],
+ \@possroles,[$udom],1);
+ }
+ if (ref($courseroles{$udom}) eq 'HASH') {
+ foreach my $item (keys(%{$courseroles{$udom}})) {
+ next unless ($item =~ /^\Q$uname\E/);
+ my ($cnum,$cdom,$crsrole,$crssec) = split(/:/,$item);
+ my $area = '/'.$cdom.'/'.$cnum;
+ if ($crssec ne '') {
+ $area .= '/'.$crssec;
+ }
+ my $crsrolekey = $crsrole.'.'.$area;
+ my $currprivs = $env{'user.priv.'.$crsrole.'.'.$area.'.'.$where};
+ $currprivs =~ s/^://;
+ $currprivs =~ s/\&F$//;
+ my @curr_grp_privs = split(/\&F:/,$currprivs);
+ @curr_grp_privs = sort(@curr_grp_privs);
+ my @diffs;
+ if (@group_privs > 0 || @curr_grp_privs > 0) {
+ @diffs = &Apache::loncommon::compare_arrays(\@group_privs,\@curr_grp_privs);
+ }
+ if (@diffs == 0) {
+ last;
+ } else {
+ unless(grep(/^\Qgr\E$/,@rolecodes)) {
+ push(@rolecodes,'gr');
+ }
+ &gather_roleprivs(\%allroles,\%allgroups,
+ \%userroles,$where,$role,
+ $tstart,$tend,$status_in_db);
+ if ($status_in_db eq 'active') {
+ &Apache::lonnet::get_groups_roles($udom,$uname,
+ $courseroles{$udom},
+ \@rolecodes,\%groups_roles);
+ }
+ $changed_groups{$udom.'_'.$uname}{$group} = $status_in_db;
+ last;
+ }
+ }
+ }
+ $checkedgroup{$where} = 1;
+ }
+ } elsif ($role =~ /^cr/) {
+ my $status_in_db =
+ &curr_role_status($tstart,$tend,$refresh,$now);
+ my ($rdummy,$rest) = split(/\//,$role,2);
+ my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
+ my %currpriv;
+ unless (exists($crprivs{$rest})) {
+ my ($rdomain,$rauthor,$rrole)=split(/\//,$rest);
+ my $homsvr=&Apache::lonnet::homeserver($rauthor,$rdomain);
+ if (&Apache::lonnet::hostname($homsvr) ne '') {
+ my ($rdummy,$roledef)=
+ &Apache::lonnet::get('roles',["rolesdef_$rrole"],
+ $rdomain,$rauthor);
+ if (($rdummy ne 'con_lost') && ($roledef ne '')) {
+ my $i = 0;
+ my @scopes = ('sys','dom','crs');
+ my @privs = split(/\_/,$roledef);
+ foreach my $priv (@privs) {
+ my ($blank,@prv) = split(/:/,$priv);
+ @prv = map { $_ .= (/\&\w+$/ ? '':'&F') } @prv;
+ if (@prv) {
+ $priv = ':'.join(':',sort(@prv));
+ }
+ $crprivs{$rest}{$scopes[$i]} = $priv;
+ $i++;
+ }
+ }
+ }
+ }
+ $currpriv{sys} = $env{"user.priv.$rolekey./"};
+ $currpriv{dom} = $env{"user.priv.$rolekey./$udom/"};
+ $currpriv{crs} = $env{"user.priv.$rolekey.$where"};
+ if (keys(%crprivs)) {
+ if (($crprivs{$rest}{sys} ne $currpriv{sys}) ||
+ ($crprivs{$rest}{dom} ne $currpriv{dom})
+ ||
+ ($crprivs{$rest}{crs} ne $currpriv{crs})) {
+ &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
+ unless (grep(/^\Q$role\E$/,@changed_roles)) {
+ push(@changed_roles,$role);
+ }
+ my $status_in_env =
+ &curr_role_status($currstart,$currend,$refresh,$update);
+ if ($status_in_env eq 'active') {
+ $customprivchg{$rolekey} = $status_in_env;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ foreach my $envkey (keys(%env)) {
+ next unless ($envkey =~ /^user\.role\./);
+ next if ($dbroles{$envkey});
+ next if ($envkey eq 'user.role.'.$env{'request.role'});
+ my ($currstart,$currend) = split(/\./,$env{$envkey});
+ my $status_in_env =
+ &curr_role_status($currstart,$currend,$refresh,$update);
+ my ($rolekey) = ($envkey =~ /^user\.role\.(.+)$/);
+ my ($role,$rest)=split(/\./,$rolekey,2);
+ if (&Apache::lonnet::delenv($envkey,undef,[$role])) {
+ if ($status_in_env eq 'active') {
+ if ($role eq 'gr') {
+ &Apache::lonnet::delete_env_groupprivs($rest,\%courseroles,
+ \@possroles);
+ } else {
+ &Apache::lonnet::delenv("user.priv.$rolekey",undef,[$role]);
+ &Apache::lonnet::delenv("user.priv.cm.$rest",undef,['cm']);
+ }
+ unless (grep(/^\Q$role\E$/,@changed_roles)) {
+ push(@changed_roles,$role);
+ }
+ $deletedroles{$rolekey} = 1;
+ }
+ }
+ }
+ if (($oldsec) && (@newsec > 0)) {
+ if (@newsec > 1) {
+ $msg = '
'.&mt('The section has changed for your current role. Log-out and log-in again to select a role for the new section.').'
';
+ } else {
+ my $newrole = $env{'request.role'};
+ if ($newsec[0] eq 'none') {
+ $newrole =~ s{(/[^/])$}{};
+ } elsif ($oldsec eq 'none') {
+ $newrole .= '/'.$newsec[0];
+ } else {
+ $newrole =~ s{([^/]+)$}{$newsec[0]};
+ }
+ my $coursedesc = $env{'course.'.$env{'request.course.id'}.'.description'};
+ my ($curr_role) = ($env{'request.role'} =~ m{^(\w+)\./$match_domain/$match_courseid});
+ my %temp=('logout_'.$env{'request.course.id'} => time);
+ &Apache::lonnet::put('email_status',\%temp);
+ &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'});
+ &Apache::lonnet::appenv({"request.course.id" => '',
+ "request.course.fn" => '',
+ "request.course.uri" => '',
+ "request.course.sec" => '',
+ "request.role" => 'cm',
+ "request.role.adv" => $env{'user.adv'},
+ "request.role.domain" => $env{'user.domain'}});
+ my $rolename = &Apache::loncommon::plainname($curr_role);
+ $msg = ''.
+ ''.
+ ''.
+ ''.
+ &mt('Your section has changed for your current [_1] role in [_2].',$rolename,$coursedesc).' ';
+ my $button = '';
+ if ($newsec[0] eq 'none') {
+ $msg .= &mt('[_1] to continue with your new section-less role.',$button);
+ } else {
+ $msg .= &mt('[_1] to continue with your new role in section ([_2]).',$button,$newsec[0]);
+ }
+ $msg .= '';
+ }
+ } elsif ($currrole_expired) {
+ $msg .= '
';
+ if (&Apache::loncommon::show_course()) {
+ $msg .= &mt('Your role in the current course has expired.');
+ } else {
+ $msg .= &mt('Your current role has expired.');
+ }
+ $msg .= ' '.&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.').'
';
+ }
+ if (!@changed_roles || !(keys(%changed_groups))) {
+ my ($rolesmsg,$groupsmsg);
+ if (!@changed_roles) {
+ if (&Apache::loncommon::show_course()) {
+ $rolesmsg = &mt('No new courses or communities');
+ } else {
+ $rolesmsg = &mt('No role changes');
+ }
+ }
+ if ($hasgroups && !(keys(%changed_groups)) && !(grep(/gr/,@changed_roles))) {
+ $groupsmsg = &mt('No changes in course/community groups');
+ }
+ if (!@changed_roles && !(keys(%changed_groups))) {
+ if (($msg ne '') || ($groupsmsg ne '')) {
+ $msg .= '
';
+ if ($rolesmsg) {
+ $msg .= '
'.$rolesmsg.'
';
+ }
+ if ($groupsmsg) {
+ $msg .= '
'.$groupsmsg.'
';
+ }
+ $msg .= '
';
+ } else {
+ $msg = ' '.$rolesmsg.' ';
+ }
+ return $msg;
+ }
+ }
+ my $changemsg;
+ if (@changed_roles > 0) {
+ if (keys(%newgroup) > 0) {
+ my $groupmsg;
+ foreach my $item (sort(keys(%newgroup))) {
+ if (&is_active_course($item,$refresh,$update,\%roleshash)) {
+ $groupmsg .= '
'.
+ &mt('[_1] with status: [_2].',
+ $item,$newgroup{$item}).'