--- loncom/auth/lonroles.pm 2008/03/12 02:47:34 1.186
+++ loncom/auth/lonroles.pm 2011/02/24 23:29:10 1.260
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.186 2008/03/12 02:47:34 raeburn Exp $
+# $Id: lonroles.pm,v 1.260 2011/02/24 23:29:10 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;
@@ -41,26 +137,25 @@ use Apache::lonannounce;
use Apache::lonlocal;
use Apache::lonpageflip();
use Apache::lonnavdisplay();
+use Apache::loncoursequeueadmin;
use GDBM_File;
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::lonnavdisplay::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:
@@ -68,11 +163,7 @@ sub redirect_user {
$url=~s/ /\%20/g;
$r->print(<
-$swinfo
-
-$navwindow
-$msg
+$msg
$end_page
ENDREDIR
return;
@@ -84,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.
- '
'.&mt('Continue').' '.
- &Apache::loncommon::end_page());
+ '
'.&mt('Continue').' '
+ );
+ $r->print(&Apache::loncommon::end_page());
}
sub handler {
@@ -99,21 +202,60 @@ sub handler {
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 = ''.$checkingtxt.'
';
+ $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'};
# ================================================================== Roles Init
if ($env{'form.selectrole'}) {
+
+ my $locknum=&Apache::lonnet::get_locks();
+ if ($locknum) { return 409; }
+
if ($env{'form.newrole'}) {
$env{'form.'.$env{'form.newrole'}}=1;
}
if ($env{'request.course.id'}) {
# Check if user is CC trying to select a course role
if ($env{'form.switchrole'}) {
- if (!defined($env{'user.role.'.$env{'form.switchrole'}})) {
- &adhoc_course_role($then);
+ my $switch_is_active;
+ 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 < $update) {
+ $switch_is_active = 1;
+ }
+ }
+ }
+ unless ($switch_is_active) {
+ &adhoc_course_role($refresh,$update,$then);
}
}
my %temp=('logout_'.$env{'request.course.id'} => time);
@@ -130,34 +272,64 @@ sub handler {
# Check if user is a DC trying to enter a course or author space and needs privs to be created
if ($numdc > 0) {
foreach my $envkey (keys %env) {
-# Is this an ad-hoc CC-role?
- if (my ($domain,$coursenum) =
- ($envkey =~ m-^form\.cc\./($match_domain)/($match_courseid)$-)) {
+# Is this an ad-hoc Coordinator role?
+ if (my ($ccrole,$domain,$coursenum) =
+ ($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {
if ($dcroles{$domain}) {
- &check_privs($domain,$coursenum,$then,$now,'cc');
+ &Apache::lonnet::check_adhoc_privs($domain,$coursenum,
+ $update,$refresh,$now,$ccrole);
}
last;
}
-# Is this a recent ad-hoc CA-role?
+# Is this an ad-hoc CA-role?
if (my ($domain,$user) =
($envkey =~ m-^form\.ca\./($match_domain)/($match_username)$-)) {
- if (($dcroles{$domain}) && (&is_author_homeserver($user,$domain))) {
- &check_privs($domain,$user,$then,$now,'ca');
- } else {
+ if (($domain eq $env{'user.domain'}) && ($user eq $env{'user.name'})) {
delete($env{$envkey});
+ $env{'form.au./'.$domain.'/'} = 1;
+ my ($server_status,$home) = &check_author_homeserver($user,$domain);
+ if ($server_status eq 'switchserver') {
+ my $trolecode = 'au./'.$domain.'/';
+ my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode;
+ $r->internal_redirect($switchserver);
+ }
+ last;
+ }
+ if (my ($castart,$caend) = ($env{'user.role.ca./'.$domain.'/'.$user} =~ /^(\d*)\.(\d*)$/)) {
+ if (((($castart) && ($castart < $now)) || !$castart) &&
+ ((!$caend) || (($caend) && ($caend > $now)))) {
+ my ($server_status,$home) = &check_author_homeserver($user,$domain);
+ if ($server_status eq 'switchserver') {
+ my $trolecode = 'ca./'.$domain.'/'.$user;
+ my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode;
+ $r->internal_redirect($switchserver);
+ }
+ last;
+ }
+ }
+ # Check if author blocked ca-access
+ my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],$domain,$user);
+ if ($blocked{'domcoord.author'} eq 'blocked') {
+ delete($env{$envkey});
+ $env{'user.error.msg'}=':::1:User '.$user.' in domain '.$domain.' blocked domain coordinator access';
+ last;
}
- last;
- }
-# Is this a new ad-hoc CA-role?
- if (my ($domain) =
- ($envkey =~ m-^form\.adhocca\./($match_domain)$-)) {
if ($dcroles{$domain}) {
- my $user=$env{'form.adhoccauname.'.$domain};
- if (!$user) { $user=$env{'form.adhoccaunamerecent.'.$domain} };
- if (($user) && ($user=~/$match_username/) && (&is_author_homeserver($user,$domain))) {
- &check_privs($domain,$user,$then,$now,'ca');
- $env{'form.ca./'.$domain.'/'.$user}=1;
- }
+ 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,$update,
+ $refresh,$now,'ca');
+ if ($server_status eq 'switchserver') {
+ my $trolecode = 'ca./'.$domain.'/'.$user;
+ my $switchserver = '/adm/switchserver?'
+ .'otherserver='.$home.'&role='.$trolecode;
+ $r->internal_redirect($switchserver);
+ }
+ } else {
+ delete($env{$envkey});
+ }
+ } else {
+ delete($env{$envkey});
}
last;
}
@@ -167,11 +339,48 @@ sub handler {
foreach $envkey (keys %env) {
next if ($envkey!~/^user\.role\./);
my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
- &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+ &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
+ \$trolecode,\$tstatus,\$tstart,\$tend);
if ($env{'form.'.$trolecode}) {
if ($tstatus eq 'is') {
$where=~s/^\///;
my ($cdom,$cnum,$csec)=split(/\//,$where);
+ if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {
+ my $home = $env{'course.'.$cdom.'_'.$cnum.'.home'};
+ my @ids = &Apache::lonnet::current_machine_ids();
+ unless ($loncaparev eq '' && $home && grep(/^\Q$home\E$/,@ids)) {
+ my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
+ if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
+ my ($switchserver,$switchwarning) =
+ &check_release_required($loncaparev,$cdom.'_'.$cnum,$trolecode,$curr_reqd_hash{'internal.releaserequired'});
+ if ($switchwarning ne '' || $switchserver ne '') {
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
+ $r->send_http_header;
+ my $end_page=&Apache::loncommon::end_page();
+ $r->print(&Apache::loncommon::start_page('Selected course unavailable on this server').
+ '');
+ if ($switchwarning) {
+ $r->print($switchwarning.'');
+ if (&Apache::loncommon::show_course()) {
+ $r->print(&mt('Display courses'));
+ } else {
+ $r->print(&mt('Display roles'));
+ }
+ $r->print(' ');
+ } elsif ($switchserver) {
+ $r->print(&mt('This course requires a newer version of LON-CAPA than is installed on this server.').
+ ' '.
+ ''.
+ &mt('Switch Server').
+ ' ');
+ }
+ $r->print('
'.&Apache::loncommon::end_page());
+ return OK;
+ }
+ }
+ }
+ }
# check for course groups
my %coursegroups = &Apache::lonnet::get_active_groups(
$env{'user.domain'},$env{'user.name'},$cdom, $cnum);
@@ -219,8 +428,11 @@ sub handler {
$cdom,$cnum,
$env{'user.domain'},
$env{'user.name'},
- 'Assigned from '.$ENV{'REMOTE_ADDR'}.' at '.localtime().' for '.
- $trolecode);
+ &mt('Assigned from [_1] at [_2] for [_3]'
+ ,$ENV{'REMOTE_ADDR'}
+ ,&Apache::lonlocal::locallocaltime()
+ ,$trolecode)
+ );
unless ($assignresult eq 'ok') {
$assignresult=~s/^error\:\s*//;
$message=&mt($assignresult).
@@ -231,12 +443,14 @@ sub handler {
$r->print(<
+//
-
$end_page
@@ -254,9 +468,11 @@ ENDENTEREDKEY
$r->print(<
+//
-');
+ if ($countfuture) {
+ $r->print(&mt('The following [quant,_1,role,roles] will become active in the future:',$countfuture));
+ my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,
+ $nochoose);
+ &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,
+ \%roletext);
+ my $tremark='';
+ my $tbg;
+ if ($env{'request.role'} eq 'cm') {
+ $tbg="LC_roles_selected";
+ $tremark=&mt('Currently selected.').' ';
+ } else {
+ $tbg="LC_roles_is";
+ }
+ $r->print(&Apache::loncommon::start_data_table_row()
+ .' '
+ .''
+ .&mt('No role specified')
+ .' '
+ .''.$tremark.' '
+ .&Apache::loncommon::end_data_table_row()
+ );
+
+ $r->print(&Apache::loncommon::end_data_table());
+ }
+ $r->print(&Apache::loncommon::end_page());
+ return OK;
+ }
+# ----------------------------------------------------------------------- Table
+
+ if ($numdc > 0) {
+ $r->print(&coursepick_jscript());
+ $r->print(&Apache::loncommon::coursebrowser_javascript().
+ &Apache::loncommon::authorbrowser_javascript());
+ }
+
+ unless ((!&Apache::loncommon::show_course()) || ($nochoose) || ($countactive==1)) {
+ $r->print("".&mt('Select a Course to Enter')." \n");
+ }
+ if ($env{'form.destinationurl'}) {
+ $r->print(' ');
+ if ($env{'form.destsymb'} ne '') {
+ $r->print(' ');
+ }
}
- my (%roletext,%sortrole,%roleclass);
- my $countactive=0;
- my $inrole=0;
- my $possiblerole='';
- foreach $envkey (sort keys %env) {
+ my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,$nochoose);
+ if ($env{'environment.recentroles'}) {
+ my %recent_roles =
+ &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
+ my $output='';
+ foreach my $role (sort(keys(%recent_roles))) {
+ if (ref($roletext{'user.role.'.$role}) eq 'ARRAY') {
+ $output.= &Apache::loncommon::start_data_table_row().
+ $roletext{'user.role.'.$role}->[0].
+ &Apache::loncommon::end_data_table_row();
+ if ($roletext{'user.role.'.$role}->[1] ne '') {
+ $output .= &Apache::loncommon::continue_data_table_row().
+ $roletext{'user.role.'.$role}->[1].
+ &Apache::loncommon::end_data_table_row();
+ }
+ if ($role =~ m{dc\./($match_domain)/}
+ && $dcroles{$1}) {
+ $output .= &adhoc_roles_row($1,'recent');
+ }
+ } elsif ($numdc > 0) {
+ unless ($role =~/^error\:/) {
+ my ($roletext,$role_text_end) = &display_cc_role('user.role.'.$role);
+ if ($roletext) {
+ $output.= &Apache::loncommon::start_data_table_row().
+ $roletext.
+ &Apache::loncommon::end_data_table_row();
+ if ($role_text_end) {
+ $output .= &Apache::loncommon::continue_data_table_row().
+ $role_text_end.
+ &Apache::loncommon::end_data_table_row();
+ }
+ }
+ }
+ }
+ }
+ if ($output) {
+ $r->print(&Apache::loncommon::start_data_table_empty_row()
+ .''
+ .$recent
+ .' '
+ .&Apache::loncommon::end_data_table_empty_row()
+ );
+ $r->print($output);
+ $doheaders ++;
+ }
+ }
+ &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,\%roletext);
+ if ($countactive > 1) {
+ my $tremark='';
+ my $tbg;
+ if ($env{'request.role'} eq 'cm') {
+ $tbg="LC_roles_selected";
+ $tremark=&mt('Currently selected.').' ';
+ } else {
+ $tbg="LC_roles_is";
+ }
+ $r->print(&Apache::loncommon::start_data_table_row());
+ unless ($nochoose) {
+ if ($env{'request.role'} ne 'cm') {
+ $r->print(' ');
+ } else {
+ $r->print(' ');
+ }
+ }
+ $r->print(''
+ .&mt('No role specified')
+ .' '
+ .''.$tremark.' '
+ .&Apache::loncommon::end_data_table_row()
+ );
+ }
+ $r->print(&Apache::loncommon::end_data_table());
+ unless ($nochoose) {
+ $r->print("\n");
+ }
+# ------------------------------------------------------------ Privileges Info
+ if (($advanced) && (($env{'user.error.msg'}) || ($error))) {
+ $r->print(''.&mt('Current Privileges').' ');
+ $r->print(&privileges_info());
+ }
+ $r->print(&Apache::lonnet::getannounce());
+ if ($advanced) {
+ my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
+ $r->print(''
+ .&mt('This LON-CAPA server is version [_1]',$r->dir_config('lonVersion'))
+ .' '
+ .''.&mt('Logout').' '
+ .''
+ .&mt('Course/Community Catalog')
+ .'
');
+ }
+ $r->print(&Apache::loncommon::end_page());
+ return OK;
+}
+
+sub gather_roles {
+ 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'};
+ my @ids = &Apache::lonnet::current_machine_ids();
+ foreach my $envkey (sort(keys(%env))) {
my $button = 1;
my $switchserver='';
- my $roletext;
- my $sortkey;
+ my $switchwarning;
+ my ($role_text,$role_text_end,$sortkey);
if ($envkey=~/^user\.role\./) {
- my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend,$tfont);
- &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+ my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
+ &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
+ \$trolecode,\$tstatus,\$tstart,\$tend);
next if (!defined($role) || $role eq '' || $role =~ /^gr/);
$tremark='';
$tpstart=' ';
$tpend=' ';
- $tfont='#000000';
- if ($tstart) {
- $tpstart=&Apache::lonlocal::locallocaltime($tstart);
- }
- if ($tend) {
- $tpend=&Apache::lonlocal::locallocaltime($tend);
- }
if ($env{'request.role'} eq $trolecode) {
- $tstatus='selected';
+ $tstatus='selected';
}
my $tbg;
- if (($tstatus eq 'is')
- || ($tstatus eq 'selected')
- || ($tstatus eq 'will')
- || ($tstatus eq 'future')
+ if (($tstatus eq 'is')
+ || ($tstatus eq 'selected')
+ || ($tstatus eq 'future')
|| ($env{'form.showall'})) {
+ my $timezone = &role_timezone($where,$timezones);
+ if ($tstart) {
+ $tpstart=&Apache::lonlocal::locallocaltime($tstart,$timezone);
+ }
+ if ($tend) {
+ $tpend=&Apache::lonlocal::locallocaltime($tend,$timezone);
+ }
if ($tstatus eq 'is') {
- $tbg='#77FF77';
- $tfont='#003300';
- $possiblerole=$trolecode;
- $countactive++;
+ $tbg='LC_roles_is';
+ $possiblerole=$trolecode;
+ $countactive++;
} elsif ($tstatus eq 'future') {
- $tbg='#FFFF77';
+ $tbg='LC_roles_future';
$button=0;
- } elsif ($tstatus eq 'will') {
- $tbg='#FFAA77';
- $tremark.=&mt('Active at next login. ');
+ $futureroles->{$trolecode} = $tstart.':'.$tend;
+ $countfuture ++;
} elsif ($tstatus eq 'expired') {
- $tbg='#FF7777';
- $tfont='#330000';
+ $tbg='LC_roles_expired';
$button=0;
} elsif ($tstatus eq 'will_not') {
- $tbg='#AAFF77';
- $tremark.=&mt('Expired after logout. ');
+ $tbg='LC_roles_will_not';
+ $tremark.=&mt('Expired after logout.').' ';
} elsif ($tstatus eq 'selected') {
- $tbg='#11CC55';
- $tfont='#002200';
- $inrole=1;
- $countactive++;
- $tremark.=&mt('Currently selected. ');
+ $tbg='LC_roles_selected';
+ $inrole=1;
+ $countactive++;
+ $tremark.=&mt('Currently selected.').' ';
}
my $trole;
if ($role =~ /^cr\//) {
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
- if ($tremark) { $tremark.=' '; }
- $tremark.=&mt('Defined by ').$rauthor.
- &mt(' at ').$rdomain.'.';
- }
- $trole=Apache::lonnet::plaintext($role);
+ if ($tremark) { $tremark.=' '; }
+ $tremark.=&mt('Customrole defined by [_1].',$rauthor.':'.$rdomain);
+ }
+ $trole=Apache::lonnet::plaintext($role);
my $ttype;
my $twhere;
my ($tdom,$trest,$tsection)=
@@ -571,222 +1039,328 @@ ENDHEADER
# First, Co-Authorship roles
if (($role eq 'ca') || ($role eq 'aa')) {
my $home = &Apache::lonnet::homeserver($trest,$tdom);
- my $allowed=0;
- my @ids=&Apache::lonnet::current_machine_ids();
- foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
+ my $allowed=0;
+ foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
if (!$allowed) {
- $button=0;
- $switchserver='otherserver='.$home.'&role='.$trolecode;
+ $button=0;
+ $switchserver='otherserver='.$home.'&role='.$trolecode;
}
#next if ($home eq 'no_host');
$home = &Apache::lonnet::hostname($home);
$ttype='Construction Space';
$twhere=&mt('User').': '.$trest.' '.&mt('Domain').
- ': '.$tdom.' '.
+ ': '.$tdom.' '.
' '.&mt('Server').': '.$home;
$env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
- $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$trest.'/');
- $sortkey=$role."$trest:$tdom";
+ $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$trest.'/');
+ $sortkey=$role."$trest:$tdom";
} elsif ($role eq 'au') {
# Authors
my $home = &Apache::lonnet::homeserver
($env{'user.name'},$env{'user.domain'});
- my $allowed=0;
- my @ids=&Apache::lonnet::current_machine_ids();
- foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
+ my $allowed=0;
+ foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
if (!$allowed) {
- $button=0;
- $switchserver='otherserver='.$home.'&role='.$trolecode;
+ $button=0;
+ $switchserver='otherserver='.$home.'&role='.$trolecode;
}
#next if ($home eq 'no_host');
$home = &Apache::lonnet::hostname($home);
$ttype='Construction Space';
$twhere=&mt('Domain').': '.$tdom.' '.&mt('Server').
- ': '.$home;
+ ': '.$home;
$env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
- $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/');
- $sortkey=$role;
+ $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/');
+ $sortkey=$role;
} elsif ($trest) {
my $tcourseid=$tdom.'_'.$trest;
$ttype = &Apache::loncommon::course_type($tcourseid);
- $trole = &Apache::lonnet::plaintext($role,$ttype);
+ $trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);
if ($env{'course.'.$tcourseid.'.description'}) {
+ my $home=$env{'course.'.$tcourseid.'.home'};
$twhere=$env{'course.'.$tcourseid.'.description'};
- $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
+ $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
+ $twhere = &HTML::Entities::encode($twhere,'"<>&');
unless ($twhere eq &mt('Currently not available')) {
- $twhere.=' '.
- &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom,$tfont).
- ' ';
- }
+ $twhere.=' '.
+ &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
+ ' ';
+ unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') {
+ my $required = $env{'course.'.$tcourseid.'.internal.releaserequired'};
+ if ($required ne '') {
+ ($switchserver,$switchwarning) =
+ &check_release_required($loncaparev,$tcourseid,$trolecode,$required);
+ if ($switchserver || $switchwarning) {
+ $button = 0;
+ }
+ }
+ }
+ }
} else {
my %newhash=&Apache::lonnet::coursedescription($tcourseid);
if (%newhash) {
- $sortkey=$role."\0".$tdom."\0".$newhash{'description'}.
- "\0".$envkey;
- $twhere=$newhash{'description'}.
- ' '.
- &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom,$tfont).
- ' ';
+ $sortkey=$role."\0".$tdom."\0".$newhash{'description'}.
+ "\0".$envkey;
+ $twhere=&HTML::Entities::encode($newhash{'description'},'"<>&').
+ ' '.
+ &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
+ ' ';
$ttype = $newhash{'type'};
- $trole = &Apache::lonnet::plaintext($role,$ttype);
+ $trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);
+ my $home = $newhash{'home'};
+ unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') {
+ my $required = $newhash{'internal.releaserequired'};
+ if ($required ne '') {
+ ($switchserver,$switchwarning) =
+ &check_release_required($loncaparev,$tcourseid,$trolecode,$required);
+ if ($switchserver || $switchwarning) {
+ $button = 0;
+ }
+ }
+ }
} else {
$twhere=&mt('Currently not available');
$env{'course.'.$tcourseid.'.description'}=$twhere;
- $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
+ $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
$ttype = 'Unavailable';
}
}
if ($tsection) {
$twhere.=' '.&mt('Section').': '.$tsection;
- }
- if ($role ne 'st') { $twhere.=" ".&mt('Domain').":".$tdom; }
+ }
+ if ($role ne 'st') { $twhere.=" ".&mt('Domain').":".$tdom; }
} elsif ($tdom) {
$ttype='Domain';
$twhere=$tdom;
- $sortkey=$role.$twhere;
+ $sortkey=$role.$twhere;
} else {
$ttype='System';
$twhere=&mt('system wide');
- $sortkey=$role.$twhere;
+ $sortkey=$role.$twhere;
}
- $roletext.=&build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$tfont,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver);
- $roletext{$envkey}=$roletext;
- if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
- $sortrole{$sortkey}=$envkey;
- $roleclass{$envkey}=$ttype;
- }
+ ($role_text,$role_text_end) =
+ &build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,
+ $advanced,$tremark,$tbg,$trole,$twhere,$tpstart,
+ $tpend,$nochoose,$button,$switchserver,$reinit,$switchwarning);
+ $roletext->{$envkey}=[$role_text,$role_text_end];
+ if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
+ $sortrole->{$sortkey}=$envkey;
+ $roleclass->{$envkey}=$ttype;
+ }
}
}
-# No active roles
- if ($countactive==0) {
- if ($inrole) {
- $r->print(''.&mt('Currently no additional roles or courses').' ');
- } else {
- $r->print(''.&mt('Currently no active roles or courses').' ');
- }
- $r->print(''.&Apache::loncommon::end_page());
- return OK;
-# Is there only one choice?
- } elsif (($countactive==1) && ($env{'request.role'} eq 'cm')) {
- $r->print(''.&mt('Please stand by.').' '.
- ' '.
- ' ');
- $r->print("\n");
- $r->rflush();
- $r->print('');
- $r->print(&Apache::loncommon::end_page());
- return OK;
- }
-# More than one possible role
-# ----------------------------------------------------------------------- Table
- unless ((!&Apache::lonmenu::show_course()) || ($nochoose)) {
- $r->print("".&mt('Select a Course to Enter')." \n");
- }
- $r->print(' ');
- unless ($nochoose) {
- $r->print("\n");
- }
-# ------------------------------------------------------------ Privileges Info
- if (($advanced) && (($env{'user.error.msg'}) || ($error))) {
- $r->print('Current Privileges ');
- $r->print(&privileges_info());
- }
- $r->print(&Apache::lonnet::getannounce());
- if ($advanced) {
- $r->print('This is LON-CAPA '.
- $r->dir_config('lonVersion').' '.
- ''.&mt('Logout').'
');
+sub requestcourse_advice {
+ my ($r) = @_;
+ my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
+ my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
+ my (%can_request,%request_doms);
+ &Apache::lonnet::check_can_request($env{'user.domain'},\%can_request,\%request_doms);
+ if (keys(%request_doms) > 0) {
+ my ($types,$typename) = &Apache::loncommon::course_types();
+ if ((ref($types) eq 'ARRAY') && (ref($typename) eq 'HASH')) {
+ $r->print(''.&mt('Request creation of a course or community').' '.
+ ''.&mt('You have rights to request the creation of courses and/or communities in the following domain(s):').'
');
+ my (@reqdoms,@reqtypes);
+ foreach my $type (sort(keys(%request_doms))) {
+ push(@reqtypes,$type);
+ if (ref($request_doms{$type}) eq 'ARRAY') {
+ my $domstr = join(', ',map { &Apache::lonnet::domain($_) } sort(@{$request_doms{$type}}));
+ $r->print(
+ ''
+ .&mt('[_1]'.$typename->{$type}.'[_2] in domain: [_3]',
+ '',
+ ' ',
+ ''.$domstr.' ')
+ .' '
+ );
+ foreach my $dom (@{$request_doms{$type}}) {
+ unless (grep(/^\Q$dom\E/,@reqdoms)) {
+ push(@reqdoms,$dom);
+ }
+ }
+ }
+ }
+ my @showtypes;
+ foreach my $type (@{$types}) {
+ if (grep(/^\Q$type\E$/,@reqtypes)) {
+ push(@showtypes,$type);
+ }
+ }
+ my $requrl = '/adm/requestcourse';
+ if (@reqdoms == 1) {
+ $requrl .= '?showdom='.$reqdoms[0];
+ }
+ if (@showtypes > 0) {
+ $requrl.=(($requrl=~/\?/)?'&':'?').'crstype='.$showtypes[0];
+ }
+ if (@reqdoms == 1 || @showtypes > 0) {
+ $requrl .= '&state=crstype&action=new';
+ }
+ $r->print(' '.&mt('Use the [_1]request form[_2] to submit a request for creation of a new course or community.','',' ').'');
+ }
}
- $r->print(&Apache::loncommon::end_page());
- return OK;
+ return;
}
sub privileges_info {
@@ -824,7 +1398,7 @@ sub privileges_info {
$ttype='System';
$twhere='/';
}
- $output .= "\n".$ttype.': '.$twhere.' '."\n'.
+ ' '.
+ ' '.
+ ''.
+ &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))) {
+ $msg .= '';
+ if (!@changed_roles) {
+ $msg .= '';
+ if (&Apache::loncommon::show_course()) {
+ $msg .= &mt('No new courses or communities');
+ } else {
+ $msg .= &mt('No role changes');
+ }
+ $msg .= ' ';
+ }
+ if ($hasgroups && !(keys(%changed_groups)) && !(grep(/gr/,@changed_roles))) {
+ $msg .= ''.&mt('No changes in course/community groups').' ';
+ }
+ $msg .= ' ';
+ if (!@changed_roles && !(keys(%changed_groups))) {
+ 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}).' ';
+ }
+ }
+ if ($groupmsg) {
+ $changemsg .= ''.
+ &mt('Courses with new groups').' '.
+ '';
+ }
+ }
+ if (keys(%newrole) > 0) {
+ $changemsg .= ''.&mt('New roles').
+ '';
+ foreach my $item (sort(keys(%newrole))) {
+ $changemsg .= ''.
+ &mt('[_1] with status: [_2].',
+ $item,$newrole{$item}).' ';
+ }
+ $changemsg .= ' ';
+ }
+ if (keys(%customprivchg) > 0) {
+ $changemsg .= ''.
+ &mt('Custom roles with privilege changes').
+ '';
+ foreach my $item (sort(keys(%customprivchg))) {
+ $changemsg .= ''.$item.' ';
+ }
+ $changemsg .= ' ';
+ }
+ if (keys(%rolechange) > 0) {
+ $changemsg .= ''.
+ &mt('Existing roles with status changes').' '.
+ '';
+ foreach my $item (sort(keys(%rolechange))) {
+ $changemsg .= ''.
+ &mt('[_1] status now: [_2].',$item,
+ $rolechange{$item}).' ';
+ }
+ $changemsg .= ' ';
+ }
+ if (keys(%deletedroles) > 0) {
+ $changemsg .= ''.
+ &mt('Existing roles deleted').' '.
+ '';
+ foreach my $item (sort(keys(%deletedroles))) {
+ $changemsg .= ''.$item.' ';
+ }
+ $changemsg .= ' ';
+ }
+ }
+ 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 .= ''.
+ &mt('Course: [_1], groups: [_2].',$key,
+ join(', ',@showgroups)).
+ ' ';
+ }
+ }
+ }
+ }
+ if (keys(%groupchange) > 0) {
+ $groupchgmsg .= ''.
+ &mt('Existing course/community groups with status changes').' '.
+ '';
+ foreach my $crs (sort(keys(%groupchange))) {
+ if (ref($groupchange{$crs}) eq 'HASH') {
+ $groupchgmsg .= ''.&mt('Course/Community: [_1]',''.$crs.' ');
+ foreach my $group (sort(keys(%{$groupchange{$crs}}))) {
+ $groupchgmsg .= ''.&mt('Group: [_1] status now: [_2].',''.$group.' ',$groupchange{$crs}{$group}).' ';
+ }
+ $groupchgmsg .= ' ';
+ }
+ }
+ $groupchgmsg .= ' ';
+ }
+ if ($groupchgmsg) {
+ $changemsg .= ''.
+ &mt('Courses with changes in groups').' '.
+ '';
+ }
+ }
+ if ($changemsg) {
+ $msg .= '';
+ }
+ &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$/,@rolecodes)) {
+ push(@rolecodes,$role);
+ }
+ }
+ unless(grep(/^\Qcm\E$/,@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$/,@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(':',@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__
@@ -1221,8 +2514,7 @@ course they should act on, etc. Both in
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. C can also be accessed via the
-B button in the Remote Control.
+what they were trying to do.
=begin latex