[LON-CAPA-cvs] cvs: loncom(loncapaMITrelate_1) /auth lonroles.pm
raeburn
raeburn at source.lon-capa.org
Tue Feb 7 19:22:15 EST 2012
raeburn Wed Feb 8 00:22:15 2012 EDT
Modified files: (Branch: loncapaMITrelate_1)
/loncom/auth lonroles.pm
Log:
- Customization for MITrelate
- Backport 1.260, 1.264.
-------------- next part --------------
Index: loncom/auth/lonroles.pm
diff -u loncom/auth/lonroles.pm:1.256.2.6 loncom/auth/lonroles.pm:1.256.2.6.2.1
--- loncom/auth/lonroles.pm:1.256.2.6 Tue Sep 27 20:33:34 2011
+++ loncom/auth/lonroles.pm Wed Feb 8 00:22:15 2012
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.256.2.6 2011/09/27 20:33:34 raeburn Exp $
+# $Id: lonroles.pm,v 1.256.2.6.2.1 2012/02/08 00:22:15 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -57,8 +57,7 @@
handler determines via C<lonnet>'s C<&allowed> function that a certain
action is not allowed, C<lonroles> 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. C<lonroles> can also be accessed via the
-B<CRS> button in the Remote Control.
+what they were trying to do.
=begin latex
@@ -218,12 +217,33 @@
my $now=time;
my $then=$env{'user.login.time'};
my $refresh=$env{'user.refresh.time'};
+ my $update=$env{'user.update.time'};
if (!$refresh) {
$refresh = $then;
}
+ if (!$update) {
+ $update = $then;
+ }
+
+# -------------------------------------------------------- Check for new roles
+ my $updateresult;
+ if ($env{'form.doupdate'}) {
+ my $show_course=&Apache::loncommon::show_course();
+ my $checkingtxt;
+ if ($show_course) {
+ $checkingtxt = &mt('Checking for new courses ...');
+ } else {
+ $checkingtxt = &mt('Checking for new roles ...');
+ }
+ $updateresult = '<span class="LC_info">'.$checkingtxt.'</span>';
+ $updateresult .= &update_session_roles();
+ &Apache::lonnet::appenv({'user.update.time' => $now});
+ $update = $now;
+ }
+
my $envkey;
my %dcroles = ();
- my $numdc = &check_fordc(\%dcroles,$then);
+ my $numdc = &check_fordc(\%dcroles,$update,$then);
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
my $loncaparev = $Apache::lonnet::perlvar{'lonVersion'};
@@ -243,13 +263,13 @@
if (defined($env{'user.role.'.$env{'form.switchrole'}})) {
my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}});
if (!$end || $end > $now) {
- if (!$start || $start < $refresh) {
+ if (!$start || $start < $update) {
$switch_is_active = 1;
}
}
}
unless ($switch_is_active) {
- &adhoc_course_role($refresh,$then);
+ &adhoc_course_role($refresh,$update,$then);
}
}
my %temp=('logout_'.$env{'request.course.id'} => time);
@@ -271,7 +291,7 @@
($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {
if ($dcroles{$domain}) {
&Apache::lonnet::check_adhoc_privs($domain,$coursenum,
- $then,$refresh,$now,$ccrole);
+ $update,$refresh,$now,$ccrole);
}
last;
}
@@ -311,7 +331,7 @@
if ($dcroles{$domain}) {
my ($server_status,$home) = &check_author_homeserver($user,$domain);
if (($server_status eq 'ok') || ($server_status eq 'switchserver')) {
- &Apache::lonnet::check_adhoc_privs($domain,$user,$then,
+ &Apache::lonnet::check_adhoc_privs($domain,$user,$update,
$refresh,$now,'ca');
if ($server_status eq 'switchserver') {
my $trolecode = 'ca./'.$domain.'/'.$user;
@@ -333,7 +353,7 @@
foreach $envkey (keys %env) {
next if ($envkey!~/^user\.role\./);
my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
- &Apache::lonnet::role_status($envkey,$then,$refresh,$now,\$role,\$where,
+ &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
\$trolecode,\$tstatus,\$tstart,\$tend);
if ($env{'form.'.$trolecode}) {
if ($tstatus eq 'is') {
@@ -675,6 +695,13 @@
alert('$standby');
}
}
+
+function setToUpdate(thisform) {
+ thisform.doupdate.value='1';
+ thisform.selectrole.value='';
+ thisform.submit();
+}
+
// ]]>
</script>
ENDHEADER
@@ -737,13 +764,14 @@
}
# -------------------------------------------------------- Choice or no choice?
if ($nochoose) {
- $r->print("<h2>".&mt('Sorry ...')."</h2>\n<span class='LC_error'>".
- &mt('This action is currently not authorized.').'</span>'.
- &Apache::loncommon::end_page());
- return OK;
+ $r->print("<h2>".&mt('Sorry ...')."</h2>\n<span class='LC_error'>".
+ &mt('This action is currently not authorized.').'</span>'.
+ &Apache::loncommon::end_page());
+ return OK;
} else {
+ $r->print($updateresult);
if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
- $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
+ $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
}
$r->print('<form method="post" name="rolechoice" action="'.(($fn)?$fn:$r->uri).'">');
$r->print('<input type="hidden" name="orgurl" value="'.$fn.'" />');
@@ -753,23 +781,45 @@
$r->rflush();
my (%roletext,%sortrole,%roleclass,%futureroles,%timezones);
- my ($countactive,$countfuture,$inrole,$possiblerole) =
- &gather_roles($then,$refresh,$now,$reinit,$nochoose,\%roletext,\%sortrole,\%roleclass,
+ my ($countactive,$countfuture,$inrole,$possiblerole) =
+ &gather_roles($update,$refresh,$now,$reinit,$nochoose,\%roletext,\%sortrole,\%roleclass,
\%futureroles,\%timezones,$loncaparev);
-
$refresh = $now;
&Apache::lonnet::appenv({'user.refresh.time' => $refresh});
+ my $updatebutton = &mt('Check for role changes');
+ my $show_course=&Apache::loncommon::show_course();
+ if ($show_course) {
+ $updatebutton = &mt('Check for new courses');
+ }
+ my $do_update;
+ unless (($env{'form.source'} eq 'login') || ($env{'form.doupdate'})) {
+ $do_update = '<input type="hidden" name="doupdate" value="" />'.
+ '<input type="button" name="update" value="'.
+ $updatebutton.'" onclick="javascript:setToUpdate(this.form)" />';
+ }
if ($env{'user.adv'}) {
- $r->print('<p><label><input type="checkbox" name="showall"');
- if ($env{'form.showall'}) { $r->print(' checked="checked" '); }
- $r->print(' />'.&mt('Show all roles').'</label>'
- .' <input type="submit" value="'.&mt('Update display').'" />'
- .'</p>');
+ my $showall = '<label><input type="checkbox" name="showall"';
+ if ($env{'form.showall'}) {
+ $showall .= ' checked="checked" ';
+ }
+ $showall .= ' />'.&mt('Show all roles').'</label> '.
+ '<input type="submit" value="'.&mt('Update display').'" />';
+ if ($do_update) {
+ $r->print('<div class="LC_left_float"><fieldset>'.
+ '<legend>'. &mt('Display').'</legend>'.
+ $showall.'</fieldset></div>'.
+ '<div class="LC_left_float"><fieldset><legend>'.
+ &mt('Changes?').'</legend>'.
+ $do_update.'</fieldset></div><br clear="all" />');
+ } else {
+ $r->print($showall);
+ }
} else {
+ $r->print('<p>'.$do_update.'</p>');
if ($countactive > 0) {
$r->print(&Apache::loncoursequeueadmin::queued_selfenrollment());
my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
- my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
+ my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
$r->print(
'<p>'
.&mt('[_1]Visit the [_2]Course/Community Catalog[_3]'
@@ -941,7 +991,7 @@
}
sub gather_roles {
- my ($then,$refresh,$now,$reinit,$nochoose,$roletext,$sortrole,$roleclass,$futureroles,$timezones,$loncaparev) = @_;
+ my ($update,$refresh,$now,$reinit,$nochoose,$roletext,$sortrole,$roleclass,$futureroles,$timezones,$loncaparev) = @_;
my ($countactive,$countfuture,$inrole,$possiblerole) = (0,0,0,'');
my $advanced = $env{'user.adv'};
my $tryagain = $env{'form.tryagain'};
@@ -953,7 +1003,7 @@
my ($role_text,$role_text_end,$sortkey);
if ($envkey=~/^user\.role\./) {
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
- &Apache::lonnet::role_status($envkey,$then,$refresh,$now,\$role,\$where,
+ &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
\$trolecode,\$tstatus,\$tstart,\$tend);
next if (!defined($role) || $role eq '' || $role =~ /^gr/);
$tremark='';
@@ -1497,7 +1547,7 @@
}
sub check_fordc {
- my ($dcroles,$then) = @_;
+ my ($dcroles,$update,$then) = @_;
my $numdc = 0;
if ($env{'user.adv'}) {
foreach my $envkey (sort keys %env) {
@@ -1505,8 +1555,12 @@
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++;
@@ -1518,19 +1572,19 @@
}
sub adhoc_course_role {
- my ($refresh,$then) = @_;
+ 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,$then,$crstype)) {
+ 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<$then)) {
+ ($end && $end<$update)) {
$setprivs = 1;
}
}
@@ -1573,7 +1627,7 @@
}
sub check_forcc {
- my ($cdom,$cnum,$refresh,$then,$crstype) = @_;
+ my ($cdom,$cnum,$refresh,$update,$then,$crstype) = @_;
my ($is_cc,$ccrole);
if ($crstype eq 'Community') {
$ccrole = 'co';
@@ -1586,8 +1640,12 @@
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 <$then) { $is_cc = 0; }
+ if ($tend && $tend <$limit) { $is_cc = 0; }
}
}
}
@@ -1818,6 +1876,644 @@
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, at newsec,$oldsec,$currrole_expired, at 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, at 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,$refresh,$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$/, at 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,$refresh,$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$/, at 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$/, at 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, at 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$/, at 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$/, at changed_roles)) {
+ push(@changed_roles,$role);
+ }
+ $deletedroles{$rolekey} = 1;
+ }
+ }
+ }
+ if (($oldsec) && (@newsec > 0)) {
+ if (@newsec > 1) {
+ $msg = '<div 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.').'</div>';
+ } 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 = '<p><form name="reselectrole" action="/adm/roles" method="post" />'.
+ '<input type="hidden" name="newrole" value="" />'.
+ '<input type="hidden" name="selectrole" value="1" />'.
+ '<span class="LC_info">'.
+ &mt('Your section has changed for your current [_1] role in [_2].',$rolename,$coursedesc).'</span><br />';
+ my $button = '<input type="button" name="sectionchanged" value="'.
+ &mt('Re-Select').'" onclick="javascript:enterrole(this.form,'."'$newrole','sectionchanged'".')" />';
+ 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 .= '</form></p>';
+ }
+ } elsif ($currrole_expired) {
+ $msg .= '<div class="LC_warning">';
+ if (&Apache::loncommon::show_course()) {
+ $msg .= &mt('Your role in the current course has expired.');
+ } else {
+ $msg .= &mt('Your current role has expired.');
+ }
+ $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.').'</div>';
+ }
+ 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/, at changed_roles))) {
+ $groupsmsg = &mt('No changes in course/community groups');
+ }
+ if (!@changed_roles && !(keys(%changed_groups))) {
+ if (($msg ne '') || ($groupsmsg ne '')) {
+ $msg .= '<ul>';
+ if ($rolesmsg) {
+ $msg .= '<li>'.$rolesmsg.'</li>';
+ }
+ if ($groupsmsg) {
+ $msg .= '<li>'.$groupsmsg.'</li>';
+ }
+ $msg .= '</ul>';
+ } else {
+ $msg = ' <span class="LC_cusr_emph">'.$rolesmsg.'</span><br />';
+ }
+ 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 .= '<li>'.
+ &mt('[_1] with status: [_2].',
+ $item,$newgroup{$item}).'</li>';
+ }
+ }
+ if ($groupmsg) {
+ $changemsg .= '<li>'.
+ &mt('Courses with new groups').'</li>'.
+ '<ul>'.$groupmsg.'</ul></li>';
+ }
+ }
+ if (keys(%newrole) > 0) {
+ $changemsg .= '<li>'.&mt('New roles').
+ '<ul>';
+ foreach my $item (sort(keys(%newrole))) {
+ $changemsg .= '<li>'.
+ &mt('[_1] with status: [_2].',
+ $item,$newrole{$item}).'</li>';
+ }
+ $changemsg .= '</ul></li>';
+ }
+ if (keys(%customprivchg) > 0) {
+ $changemsg .= '<li>'.
+ &mt('Custom roles with privilege changes').
+ '<ul>';
+ foreach my $item (sort(keys(%customprivchg))) {
+ $changemsg .= '<li>'.$item.'</li>';
+ }
+ $changemsg .= '</ul></li>';
+ }
+ if (keys(%rolechange) > 0) {
+ $changemsg .= '<li>'.
+ &mt('Existing roles with status changes').'</li>'.
+ '<ul>';
+ foreach my $item (sort(keys(%rolechange))) {
+ $changemsg .= '<li>'.
+ &mt('[_1] status now: [_2].',$item,
+ $rolechange{$item}).'</li>';
+ }
+ $changemsg .= '</ul></li>';
+ }
+ if (keys(%deletedroles) > 0) {
+ $changemsg .= '<li>'.
+ &mt('Existing roles deleted').'</li>'.
+ '<ul>';
+ foreach my $item (sort(keys(%deletedroles))) {
+ $changemsg .= '<li>'.$item.'</li>';
+ }
+ $changemsg .= '</ul></li>';
+ }
+ }
+ if ((keys(%changed_groups) > 0) || (keys(%groupchange) > 0)) {
+ my $groupchgmsg;
+ foreach my $key (sort(keys(%changed_groups))) {
+ my $crs = 'gr/'.$key;
+ $crs =~ s/_/\//;
+ if (&is_active_course($crs,$refresh,$update,\%roleshash)) {
+ if (ref($changed_groups{$key}) eq 'HASH') {
+ my @showgroups;
+ foreach my $group (sort(keys(%{$changed_groups{$key}}))) {
+ if ($changed_groups{$key}{$group} eq 'active') {
+ push(@showgroups,$group);
+ }
+ }
+ if (@showgroups > 0) {
+ $groupchgmsg .= '<li>'.
+ &mt('Course: [_1], groups: [_2].',$key,
+ join(', ', at showgroups)).
+ '</li>';
+ }
+ }
+ }
+ }
+ if (keys(%groupchange) > 0) {
+ $groupchgmsg .= '<li>'.
+ &mt('Existing course/community groups with status changes').'</li>'.
+ '<ul>';
+ foreach my $crs (sort(keys(%groupchange))) {
+ if (ref($groupchange{$crs}) eq 'HASH') {
+ $groupchgmsg .= '<li>'.&mt('Course/Community: [_1]','<b>'.$crs.'</b><ul>');
+ foreach my $group (sort(keys(%{$groupchange{$crs}}))) {
+ $groupchgmsg .= '<li>'.&mt('Group: [_1] status now: [_2].','<b>'.$group.'</b>',$groupchange{$crs}{$group}).'</li>';
+ }
+ $groupchgmsg .= '</ul></li>';
+ }
+ }
+ $groupchgmsg .= '</ul></li>';
+ }
+ if ($groupchgmsg) {
+ $changemsg .= '<li>'.
+ &mt('Courses with changes in groups').'</li>'.
+ '<ul>'.$groupchgmsg.'</ul></li>';
+ }
+ }
+ if ($changemsg) {
+ $msg .= '<ul>'.$changemsg.'</ul>';
+ }
+ &Apache::lonnet::set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles);
+ my ($curr_is_adv,$curr_role_adv,$curr_author,$curr_role_author);
+ $curr_author = $env{'user.author'};
+ if (($env{'request.role'} =~/^au/) || ($env{'request.role'} =~/^ca/) ||
+ ($env{'request.role'} =~/^aa/)) {
+ $curr_role_author=1;
+ }
+ $curr_is_adv = $env{'user.adv'};
+ $curr_role_adv = $env{'request.role.adv'};
+ if (keys(%userroles) > 0) {
+ foreach my $role (@changed_roles) {
+ unless(grep(/^\Q$role\E$/, at rolecodes)) {
+ push(@rolecodes,$role);
+ }
+ }
+ unless(grep(/^\Qcm\E$/, at rolecodes)) {
+ push(@rolecodes,'cm');
+ }
+ &Apache::lonnet::appenv(\%userroles,\@rolecodes);
+ }
+ my %newenv;
+ if (&Apache::lonnet::is_advanced_user($env{'user.domain'},$env{'user.name'})) {
+ unless ($curr_is_adv) {
+ $newenv{'user.adv'} = 1;
+ }
+ } elsif ($curr_is_adv && !$curr_role_adv) {
+ &Apache::lonnet::delenv('user.adv');
+ }
+ my %authorroleshash =
+ &Apache::lonnet::get_my_roles('','','userroles',['active'],['au','ca','aa']);
+ if (keys(%authorroleshash)) {
+ unless ($curr_author) {
+ $newenv{'user.author'} = 1;
+ }
+ } elsif ($curr_author && !$curr_role_author) {
+ &Apache::lonnet::delenv('user.author');
+ }
+ if ($env{'request.course.id'}) {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my (@activecrsgroups,$crsgroupschanged);
+ if ($env{'request.course.groups'}) {
+ @activecrsgroups = split(/:/,$env{'request.course.groups'});
+ foreach my $item (keys(%deletedroles)) {
+ if ($item =~ m{^gr\./\Q$cdom\E/\Q$cnum\E/(\w+)$}) {
+ if (grep(/^\Q$1\E$/, at activecrsgroups)) {
+ $crsgroupschanged = 1;
+ last;
+ }
+ }
+ }
+ }
+ unless ($crsgroupschanged) {
+ foreach my $item (keys(%newgroup)) {
+ if ($item =~ m{^gr\./\Q$cdom\E/\Q$cnum\E/(\w+)$}) {
+ if ($newgroup{$item} eq 'active') {
+ $crsgroupschanged = 1;
+ last;
+ }
+ }
+ }
+ }
+ if ((ref($changed_groups{$env{'request.course.id'}}) eq 'HASH') ||
+ (ref($groupchange{"/$cdom/$cnum"}) eq 'HASH') ||
+ ($crsgroupschanged)) {
+ my %grouproles = &Apache::lonnet::get_my_roles('','','userroles',
+ ['active'],['gr'],[$cdom],1);
+ my @activegroups;
+ foreach my $item (keys(%grouproles)) {
+ next unless($item =~ /^\Q$cnum\E:\Q$cdom\E/);
+ my $group;
+ my ($crsn,$crsd,$role,$remainder) = split(/:/,$item,4);
+ if ($remainder =~ /:/) {
+ (my $other,$group) = ($remainder =~ /^([\w:]+):([^:]+)$/);
+ } else {
+ $group = $remainder;
+ }
+ if ($group ne '') {
+ push(@activegroups,$group);
+ }
+ }
+ $newenv{'request.course.groups'} = join(':', at activegroups);
+ }
+ }
+ if (keys(%newenv)) {
+ &Apache::lonnet::appenv(\%newenv);
+ }
+ return $msg;
+}
+
+sub curr_role_status {
+ my ($start,$end,$refresh,$update) = @_;
+ if (($start) && ($start<0)) { return 'deleted' };
+ my $status = 'active';
+ if (($end) && ($end<=$update)) {
+ $status = 'previous';
+ }
+ if (($start) && ($refresh<$start)) {
+ $status = 'future';
+ }
+ return $status;
+}
+
+sub gather_roleprivs {
+ my ($allroles,$allgroups,$userroles,$area,$role,$tstart,$tend,$status) = @_;
+ return unless ((ref($allroles) eq 'HASH') && (ref($allgroups) eq 'HASH') && (ref($userroles) eq 'HASH'));
+ if (($area ne '') && ($role ne '')) {
+ &Apache::lonnet::userrolelog($role,$env{'user.name'},$env{'user.domain'},
+ $area,$tstart,$tend);
+ my $spec=$role.'.'.$area;
+ $userroles->{'user.role.'.$spec} = $tstart.'.'.$tend;
+ my ($tdummy,$tdomain,$trest)=split(/\//,$area);
+ if ($status eq 'active') {
+ if ($role =~ /^cr\//) {
+ &Apache::lonnet::custom_roleprivs($allroles,$role,$tdomain,$trest,$spec,$area);
+ } elsif ($role eq 'gr') {
+ my %rolehash = &Apache::lonnet::get('roles',[$area.'_'.$role],
+ $env{'user.domain'},
+ $env{'user.name'});
+ my ($trole) = split(/_/,$rolehash{$area.'_'.$role},2);
+ (undef,my $group_privs) = split(/\//,$trole);
+ $group_privs = &unescape($group_privs);
+ &Apache::lonnet::group_roleprivs($allgroups,$area,$group_privs,$tend,$tstart);
+ } else {
+ &Apache::lonnet::standard_roleprivs($allroles,$role,$tdomain,$spec,$trest,$area);
+ }
+ }
+ }
+ return;
+}
+
+sub is_active_course {
+ my ($rolekey,$refresh,$update,$roleshashref) = @_;
+ return unless(ref($roleshashref) eq 'HASH');
+ my ($role,$cdom,$cnum) = split(/\//,$rolekey);
+ my $is_active;
+ foreach my $key (keys(%{$roleshashref})) {
+ if ($key =~ /^\Q$cnum\E:\Q$cdom\E:/) {
+ my ($tstart,$tend) = split(/:/,$roleshashref->{$key});
+ my $status = &curr_role_status($tstart,$tend,$refresh,$update);
+ if ($status eq 'active') {
+ $is_active = 1;
+ last;
+ }
+ }
+ }
+ return $is_active;
+}
+
1;
__END__
@@ -1849,8 +2545,7 @@
handler determines via C<lonnet>'s C<&allowed> function that a certain
action is not allowed, C<lonroles> 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. C<lonroles> can also be accessed via the
-B<CRS> button in the Remote Control.
+what they were trying to do.
=begin latex
More information about the LON-CAPA-cvs
mailing list