# The LearningOnline Network with CAPA
# User Roles Screen
#
# $Id: lonroles.pm,v 1.269.2.39.2.3 2022/02/24 16:28:46 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###
=pod
=head1 NAME
Apache::lonroles - User Roles Screen
=head1 SYNOPSIS
Invoked by /etc/httpd/conf/srm.conf:
$msg $lt{'tfp'}
'.
&mt('Could not initialize [_1] at this time.',
$env{'course.'.$cdom.'_'.$cnum.'.description'}).
' '.&mt('Entering [_1] ...',
$env{'course.'.$cdom.'_'.$cnum.'.description'}).
' '.
&mt('Could not initialize [_1] at this time.',
$env{'course.'.$cdom.'_'.$cnum.'.description'}).
' '.&mt('Entering [_1] ...',
$env{'course.'.$cdom.'_'.$cnum.'.description'}).
' '.&mt('Entering [_1] ...',
$env{'course.'.$cdom.'_'.$cnum.'.description'}).
' '.&mt('Entering [_1] ...',
$env{'course.'.$cdom.'_'.$cnum.'.description'}).
' '
.&mt('This LON-CAPA server is version [_1]',$r->dir_config('lonVersion'))
.' '.&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).'
$error
$lt{'con'}
$end_page
END
return;
}
sub handler {
my $r = shift;
# Check for critical messages and redirect if present.
my ($redirect,$url) = &Apache::loncommon::critical_redirect(300,'roles');
if ($redirect) {
&Apache::loncommon::content_type($r,'text/html');
$r->header_out(Location => $url);
return REDIRECT;
}
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;
}
my ($norolelist,$blocked_by_ip,$blocked_type,$clientip);
$clientip = &Apache::lonnet::get_requestor_ip($r);
if (($env{'request.course.id'}) && ($env{'request.deeplink.login'})) {
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
my $deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom);
if ($deeplink_symb) {
my ($menucoll,$deeplinkmenu,$menuref) = &Apache::loncommon::menucoll_in_effect();
if (ref($menuref) eq 'HASH') {
unless (($menuref->{'role'}) || ($env{'request.role.adv'})) {
foreach my $envkey (keys(%env)) {
next unless ($envkey =~ /^form\./);
if ($envkey =~ m{\./($match_domain)/($match_courseid)(?:/(\w+)|$)}) {
unless (($1 eq $cdom) && ($2 eq $cnum)) {
delete($env{$envkey});
}
}
}
if ($env{'form.selectrole'}) {
if ($env{'form.switchrole'} =~ m{\./($match_domain)/($match_courseid)(?:/(\w+)|$)}) {
unless (($1 eq $cdom) && ($2 eq $cnum)) {
delete($env{'form.selectrole'});
delete($env{'form.switchrole'});
}
} elsif ($env{'form.newrole'} =~ m{\./($match_domain)/($match_courseid)(?:/(\w+)|$)}) {
unless (($1 eq $cdom) && ($2 eq $cnum)) {
delete($env{'form.selectrole'});
delete($env{'form.newrole'});
}
}
}
$norolelist = 1;
}
}
}
}
if ($env{'form.selectrole'}) {
my ($role,$cdom,$cnum,$rest);
if ($env{'form.switchrole'} =~ m{^(co|cc|in|ta|ep|ad|st|cr).*?\./($match_domain)/($match_courseid)(/(\w+)|$)}) {
($role,$cdom,$cnum,$rest) = ($1,$2,$3,$4);
} elsif ($env{'form.newrole'} =~ m{^(co|cc|in|ta|ep|ad|st|cr).*?\./($match_domain)/($match_courseid)(/(\w+)|$)}) {
($role,$cdom,$cnum,$rest) = ($1,$2,$3,$4);
}
if ($cdom ne '') {
my ($has_evb,$check_ipaccess,$showrole);
$showrole = 1;
my $checkrole = "cm./$cdom/$cnum";
if ($rest ne '') {
$checkrole .= "/$rest";
}
if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
($role ne 'st')) {
$has_evb = 1;
}
unless ($has_evb) {
my @machinedoms = &Apache::lonnet::current_machine_domains();
my $udom = $env{'user.domain'};
if ($udom eq $cdom) {
$check_ipaccess = 1;
} elsif (($udom ne '') && (grep(/^\Q$udom\E$/,@machinedoms))) {
$check_ipaccess = 1;
} else {
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
my $cprim = &Apache::lonnet::domain($cdom,'primary');
my $cintdom = &Apache::lonnet::internet_dom($cprim);
if (($cintdom ne '') && (ref($internet_names) eq 'ARRAY')) {
if (grep(/^\Q$cintdom\E$/,@{$internet_names})) {
$check_ipaccess = 1;
}
}
}
if ($check_ipaccess) {
my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$cdom);
unless (defined($cached)) {
my %domconfig =
&Apache::lonnet::get_dom('configuration',['ipaccess'],$cdom);
$ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$cdom,$domconfig{'ipaccess'},1800);
}
if (ref($ipaccessref) eq 'HASH') {
foreach my $id (keys(%{$ipaccessref})) {
if (ref($ipaccessref->{$id}) eq 'HASH') {
my $range = $ipaccessref->{$id}->{'ip'};
if ($range) {
my $type = 'exclude';
if (&Apache::lonnet::ip_match($clientip,$range)) {
$type = 'include';
}
if (ref($ipaccessref->{$id}->{'courses'}) eq 'HASH') {
if ($ipaccessref->{$id}->{'courses'}{$cdom.'_'.$cnum}) {
if ($type eq 'include') {
$showrole = 1;
last;
} else {
$showrole = 0;
}
} else {
if ($type eq 'include') {
$showrole = 0;
} else {
$showrole = 1;
}
}
}
}
}
}
}
}
}
unless ($showrole) {
$blocked_by_ip = 1;
$blocked_type = &Apache::loncommon::course_type($cdom.'_'.$cnum);
delete($env{'form.selectrole'});
delete($env{'form.newrole'});
}
}
}
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
# -------------------------------------------------- Check if setting hot list
my $hotlist;
if ($env{'form.action'} eq 'verify_and_change_rolespref') {
$hotlist = &Apache::lonpreferences::verify_and_change_rolespref($r);
}
# -------------------------------------------------------- Check for new roles
my $updateresult;
if ($env{'form.state'} eq '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;
&Apache::loncoursequeueadmin::reqauthor_check();
}
# -------------------------------------------------- Check for author requests
my $reqauthor;
if ($env{'form.state'} eq 'requestauthor') {
$reqauthor = &Apache::loncoursequeueadmin::process_reqauthor(\$update);
}
my $envkey;
my %dcroles = ();
my %helpdeskroles = ();
my ($numdc,$numhelpdesk,$numadhoc) =
&check_for_adhoc(\%dcroles,\%helpdeskroles,$update,$then);
my $loncaparev = $r->dir_config('lonVersion');
# ================================================================== Roles Init
if ($env{'form.selectrole'}) {
my $locknum=&Apache::lonnet::get_locks();
if ($locknum) { return 409; }
my $custom_adhoc;
if ($env{'form.newrole'}) {
$env{'form.'.$env{'form.newrole'}}=1;
# Check if this is a Domain Helpdesk or Domain Helpdesk Assistant role trying to enter a course
if ($env{'form.newrole'} =~ m{^cr/($match_domain)/\1\-domainconfig/\w+\./\1/$match_courseid$}) {
if ($helpdeskroles{$1}) {
$custom_adhoc = 1;
}
}
}
if ($env{'request.course.id'}) {
# Check if user is CC trying to select a course role
if ($env{'form.switchrole'}) {
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);
&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.course.tied" => '',
"request.course.timechecked" => '',
"request.role" => 'cm',
"request.role.adv" => $env{'user.adv'},
"request.role.domain" => $env{'user.domain'}});
# Check if Domain Helpdesk role trying to enter a course needs privs to be created
if ($env{'form.newrole'} =~ m{^cr/($match_domain)/\1\-domainconfig/(\w+)\./\1/($match_courseid)(?:/(\w+)|$)}) {
my $cdom = $1;
my $rolename = $2;
my $cnum = $3;
my $sec = $4;
if ($custom_adhoc) {
my ($possroles,$description) = &Apache::lonnet::get_my_adhocroles($cdom.'_'.$cnum,1);
if (ref($possroles) eq 'ARRAY') {
if (grep(/^\Q$rolename\E$/,@{$possroles})) {
if (&Apache::lonnet::check_adhoc_privs($cdom,$cnum,$update,$refresh,$now,
"cr/$cdom/$cdom".'-domainconfig/'.$rolename,undef,$sec)) {
&Apache::lonnet::appenv({"environment.internal.$cdom.$cnum.cr/$cdom/$cdom".'-domainconfig/'."$rolename.adhoc" => time});
}
}
}
}
} elsif (($numdc > 0) || ($numhelpdesk > 0)) {
# Check if user is a DC trying to enter a course or author space and needs privs to be created
# Check if user is a DH or DA trying to enter a course and needs privs to be created
foreach my $envkey (keys(%env)) {
if ($numdc) {
# Is this an ad-hoc Coordinator role?
if (my ($ccrole,$domain,$coursenum) =
($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {
if ($dcroles{$domain}) {
if (&Apache::lonnet::check_adhoc_privs($domain,$coursenum,
$update,$refresh,$now,$ccrole)) {
&Apache::lonnet::appenv({"environment.internal.$domain.$coursenum.$ccrole.adhoc" => time});
}
}
last;
}
# Is this an ad-hoc CA-role?
if (my ($domain,$user) =
($envkey =~ m-^form\.ca\./($match_domain)/($match_username)$-)) {
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);
return OK;
}
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);
return OK;
}
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;
}
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,$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);
return OK;
}
} else {
delete($env{$envkey});
}
} else {
delete($env{$envkey});
}
last;
}
}
if ($numhelpdesk) {
# Is this an ad hoc custom role in a course/community?
if (my ($domain,$rolename,$coursenum,$sec) = ($envkey =~ m{^form\.cr/($match_domain)/\1\-domainconfig/(\w+)\./\1/($match_courseid)(?:/(\w+)|$)})) {
if ($helpdeskroles{$domain}) {
my ($possroles,$description) = &Apache::lonnet::get_my_adhocroles($domain.'_'.$coursenum,1);
if (ref($possroles) eq 'ARRAY') {
if (grep(/^\Q$rolename\E$/,@{$possroles})) {
if (&Apache::lonnet::check_adhoc_privs($domain,$coursenum,$update,$refresh,$now,
"cr/$domain/$domain".'-domainconfig/'.$rolename,
undef,$sec)) {
&Apache::lonnet::appenv({"environment.internal.$domain.$coursenum.cr/$domain/$domain".
'-domainconfig/'."$rolename.adhoc" => time});
}
} else {
delete($env{$envkey});
}
} else {
delete($env{$envkey});
}
} else {
delete($env{$envkey});
}
last;
}
}
}
}
foreach $envkey (keys(%env)) {
next if ($envkey!~/^user\.role\./);
my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
&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) =
&Apache::loncommon::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;
$r->print(&Apache::loncommon::check_release_result($switchwarning,$switchserver));
return OK;
}
}
}
}
# check for course groups
my %coursegroups = &Apache::lonnet::get_active_groups(
$env{'user.domain'},$env{'user.name'},$cdom, $cnum);
my $cgrps = join(':',keys(%coursegroups));
# store role if recent_role list being kept
if ($env{'environment.recentroles'}) {
my %frozen_roles =
&Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
&Apache::lonhtmlcommon::store_recent('roles',
$trolecode,' ',$frozen_roles{$trolecode});
}
# check for keyed access
if (($role eq 'st') &&
($env{'course.'.$cdom.'_'.$cnum.'.keyaccess'} eq 'yes')) {
# who is key authority?
my $authdom=$cdom;
my $authnum=$cnum;
if ($env{'course.'.$cdom.'_'.$cnum.'.keyauth'}) {
($authnum,$authdom)=
split(/:/,$env{'course.'.$cdom.'_'.$cnum.'.keyauth'});
}
# check with key authority
unless (&Apache::lonnet::validate_access_key(
$env{'environment.key.'.$cdom.'_'.$cnum},
$authdom,$authnum)) {
# there is no valid key
if ($env{'form.newkey'}) {
# student attempts to register a new key
&Apache::loncommon::content_type($r,'text/html');
&Apache::loncommon::no_cache($r);
$r->send_http_header;
my $swinfo=&Apache::lonmenu::rawconfig();
my $start_page=&Apache::loncommon::start_page
('Verifying Access Key to Unlock this Course');
my $end_page=&Apache::loncommon::end_page();
my $buttontext=&mt('Enter Course');
my $message=&mt('Successfully registered key');
my $ip = &Apache::lonnet::get_requestor_ip();
my $assignresult=
&Apache::lonnet::assign_access_key(
$env{'form.newkey'},
$authdom,$authnum,
$cdom,$cnum,
$env{'user.domain'},
$env{'user.name'},
&mt('Assigned from [_1] at [_2] for [_3]'
,$ip
,&Apache::lonlocal::locallocaltime()
,$trolecode)
);
unless ($assignresult eq 'ok') {
$assignresult=~s/^error\:\s*//;
$message=&mt($assignresult).
'
'.
&mt('Logout').'';
$buttontext=&mt('Re-Enter Key');
}
$r->print(<
'.
&mt("Please be patient while your $crstype loads").
'
'.&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.').'
'.&mt('As this is not the case, most functionality in the system will be unavailable.').'
';
$r->print(<".&mt('LON-CAPA Access Control')."
");
$r->print("");
if ($priv ne '') {
$r->print(&mt('Access : ').&Apache::lonnet::plaintext($priv)."\n");
}
if ($fn ne '') {
$r->print(&mt('Resource: ').&Apache::lonenc::check_encrypt($fn)."\n");
}
if ($msg ne '') {
$r->print(&mt('Action : ').$msg."\n");
}
$r->print("
");
my $url=$fn;
my $last;
if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
&GDBM_READER(),0640)) {
$last=$hash{'last_known'};
untie(%hash);
}
if ($last) { $fn.='?symb='.&escape($last); }
&Apache::londocs::changewarning($r,undef,'You have modified your course recently, [_1] may fix this access problem.',
&Apache::lonenc::check_encrypt($fn));
} else {
if ($env{'user.error.msg'}) {
if ($reinit) {
$r->print(
''.
&mt('As your session file for the course or community has expired, you will need to re-select it.').'
');
} else {
$r->print(
''.
&mt('You need to choose another user role or enter a specific course or community for this function.').
'
');
}
}
}
if ($nochoose) {
$r->print("".&mt('Sorry ...')."
\n".
&mt('This action is currently not authorized.').'');
if ($error && $norolelist) {
$r->print(''.
&mt('As your session was launched from a web page external to LON-CAPA some course content may be unavailable, including the resource you were trying to access.').
'
'.
''.
&mt('You may need to login to LON-CAPA directly, or re-launch from a different external system.').
'
');
}
$r->print(&Apache::loncommon::end_page());
return OK;
} else {
if ($updateresult || $reqauthor || $hotlist) {
my $showresult = ' '
.''
.&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) || (($numhelpdesk > 0) && ($numadhoc > 0))) {
$r->print(&coursepick_jscript().
&Apache::loncommon::coursebrowser_javascript());
}
if ($numdc > 0) {
$r->print(&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 $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 ($role =~ m{^(dh|da)\./($match_domain)/$}) {
$output .= &adhoc_customroles_row($1,$2,'recent',$update,$then);
}
} 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,$update,$then);
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());
}
my $announcements = &Apache::lonnet::getannounce();
$r->print(
'
'.
''.&mt('Announcements').'
'.
$announcements
) unless (!$announcements);
if ($advanced) {
my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
$r->print('
'; }
$tremark.=&mt('Custom role defined by [_1].',$rauthor.':'.$rdomain);
}
}
$trole=Apache::lonnet::plaintext($role);
my $ttype;
my $twhere;
my $skipcal;
my ($tdom,$trest,$tsection)=
split(/\//,Apache::lonnet::declutter($where));
# First, Co-Authorship roles
if (($role eq 'ca') || ($role eq 'aa')) {
my $home = &Apache::lonnet::homeserver($trest,$tdom);
my $allowed=0;
foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
if (!$allowed) {
$button=0;
$switchserver='otherserver='.$home.'&role='.$trolecode;
}
#next if ($home eq 'no_host');
$home = &Apache::lonnet::hostname($home);
$ttype='Authoring Space';
$twhere=&mt('User').': '.$trest.'
'.&mt('Domain').
': '.$tdom.'
'.
' '.&mt('Server').': '.$home;
$env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
$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;
foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
if (!$allowed) {
$button=0;
$switchserver='otherserver='.$home.'&role='.$trolecode;
}
#next if ($home eq 'no_host');
$home = &Apache::lonnet::hostname($home);
$ttype='Authoring Space';
$twhere=&mt('Domain').': '.$tdom.'
'.&mt('Server').
': '.$home;
$env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
$tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/');
$sortkey=$role;
} elsif ($trest) {
my $tcourseid=$tdom.'_'.$trest;
$ttype = &Apache::loncommon::course_type($tcourseid);
if ($role !~ /^cr/) {
$trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);
} elsif ($role =~ m{^\Qcr/$tdom/$tdom\E\-domainconfig/(\w+)$}) {
my $rolename = $1;
my $desc;
if (ref($adhocdesc{$tdom}) eq 'HASH') {
$desc = $adhocdesc{$tdom}{$rolename};
} else {
my %domdef = &Apache::lonnet::get_domain_defaults($tdom);
if (ref($domdef{'adhocroles'}) eq 'HASH') {
foreach my $rolename (sort(keys(%{$domdef{'adhocroles'}}))) {
if (ref($domdef{'adhocroles'}{$rolename}) eq 'HASH') {
$adhocdesc{$tdom}{$rolename} = $domdef{'adhocroles'}{$rolename}{'desc'};
$desc = $adhocdesc{$tdom}{$rolename};
}
}
}
}
if ($desc ne '') {
$trole = $desc;
} else {
$trole = &mt('Helpdesk[_1]',' '.$rolename);
}
} else {
$trole = (split(/\//,$role,4))[-1];
}
if ($env{'course.'.$tcourseid.'.description'}) {
my $home=$env{'course.'.$tcourseid.'.home'};
$twhere=$env{'course.'.$tcourseid.'.description'};
$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).
'';
unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') {
my $required = $env{'course.'.$tcourseid.'.internal.releaserequired'};
if ($required ne '') {
($switchserver,$switchwarning) =
&Apache::loncommon::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=&HTML::Entities::encode($newhash{'description'},'"<>&').
' '.
&Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
'';
$ttype = $newhash{'type'};
$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) =
&Apache::loncommon::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;
$ttype = 'Unavailable';
$skipcal = 1;
}
}
if ($tsection) {
$twhere.='
'.&mt('Section').': '.$tsection;
}
if ($role ne 'st') { $twhere.="
".&mt('Domain').":".$tdom; }
} elsif ($tdom) {
$ttype='Domain';
$twhere=$tdom;
$sortkey=$role.$twhere;
} else {
$ttype='System';
$twhere=&mt('system wide');
$sortkey=$role.$twhere;
}
($role_text,$role_text_end) =
&build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,
$advanced,$tremark,$tbg,$trole,$twhere,$tpstart,
$tpend,$nochoose,$button,$switchserver,$reinit,
$switchwarning,$skipcal);
$roletext->{$envkey}=[$role_text,$role_text_end];
if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
$sortrole->{$sortkey}=$envkey;
$roleclass->{$envkey}=$ttype;
}
}
}
return ($countactive,$countfuture,$inrole,$possiblerole);
}
sub role_timezone {
my ($where,$timezones) = @_;
my $timezone;
if (ref($timezones) eq 'HASH') {
if ($where =~ m{^/($match_domain)/($match_courseid)}) {
my $cdom = $1;
my $cnum = $2;
if ($cdom && $cnum) {
if (!exists($timezones->{$cdom.'_'.$cnum})) {
my $tz;
if ($env{'course.'.$cdom.'_'.$cnum.'.description'}) {
$tz = $env{'course.'.$cdom.'_'.$cnum.'.timezone'};
} else {
my %timehash =
&Apache::lonnet::get('environment',['timezone'],$cdom,$cnum);
$tz = $timehash{'timezone'};
}
if ($tz eq '') {
if (!exists($timezones->{$cdom})) {
my %domdefaults =
&Apache::lonnet::get_domain_defaults($cdom);
if ($domdefaults{'timezone_def'} eq '') {
$timezones->{$cdom} = 'local';
} else {
$timezones->{$cdom} = $domdefaults{'timezone_def'};
}
}
$timezones->{$cdom.'_'.$cnum} = $timezones->{$cdom};
} else {
$timezones->{$cdom.'_'.$cnum} =
&Apache::lonlocal::gettimezone($tz);
}
}
$timezone = $timezones->{$cdom.'_'.$cnum};
}
} else {
my ($tdom) = ($where =~ m{^/($match_domain)});
if ($tdom) {
if (!exists($timezones->{$tdom})) {
my %domdefaults = &Apache::lonnet::get_domain_defaults($tdom);
if ($domdefaults{'timezone_def'} eq '') {
$timezones->{$tdom} = 'local';
} else {
$timezones->{$tdom} = $domdefaults{'timezone_def'};
}
}
$timezone = $timezones->{$tdom};
}
}
if ($timezone eq 'local') {
$timezone = undef;
}
}
return $timezone;
}
sub roletable_headers {
my ($r,$roleclass,$sortrole,$nochoose) = @_;
my $doheaders;
if ((ref($sortrole) eq 'HASH') && (ref($roleclass) eq 'HASH')) {
$r->print('
'
.&Apache::loncommon::start_data_table('LC_textsize_mobile')
.&Apache::loncommon::start_data_table_header_row()
);
if (!$nochoose) { $r->print(' '); }
$r->print(''.&mt('User Role').' '
.''.&mt('Extent').' '
.''.&mt('Start').' '
.''.&mt('End').' '
.&Apache::loncommon::end_data_table_header_row()
);
$doheaders=-1;
my @roletypes = &roletypes();
foreach my $type (@roletypes) {
my $haverole=0;
foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) {
if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) {
$haverole=1;
}
}
if ($haverole) { $doheaders++; }
}
}
return $doheaders;
}
sub roletypes {
my @types = ('Domain','Authoring Space','Course','Community','Unavailable','System');
return @types;
}
sub print_rolerows {
my ($r,$doheaders,$roleclass,$sortrole,$dcroles,$roletext,$update,$then) = @_;
if ((ref($roleclass) eq 'HASH') && (ref($sortrole) eq 'HASH')) {
my @types = &roletypes();
foreach my $type (@types) {
my $output;
foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) {
if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) {
if (ref($roletext) eq 'HASH') {
if (ref($roletext->{$sortrole->{$which}}) eq 'ARRAY') {
$output.= &Apache::loncommon::start_data_table_row().
$roletext->{$sortrole->{$which}}->[0].
&Apache::loncommon::end_data_table_row();
if ($roletext->{$sortrole->{$which}}->[1] ne '') {
$output .= &Apache::loncommon::continue_data_table_row().
$roletext->{$sortrole->{$which}}->[1].
&Apache::loncommon::end_data_table_row();
}
}
if ($sortrole->{$which} =~ m{^user\.role\.dc\./($match_domain)/}) {
if (ref($dcroles) eq 'HASH') {
if ($dcroles->{$1}) {
$output .= &adhoc_roles_row($1,'');
}
}
} elsif ($sortrole->{$which} =~ m{^user\.role\.(dh|da)\./($match_domain)/}) {
$output .= &adhoc_customroles_row($1,$2,'',$update,$then);
}
}
}
}
if ($output) {
if ($doheaders > 0) {
$r->print(&Apache::loncommon::start_data_table_empty_row()
.''
.&mt($type)
.' '
.&Apache::loncommon::end_data_table_empty_row()
);
}
$r->print($output);
}
}
}
}
sub findcourse_advice {
my ($r,$cattype,$elapsed) = @_;
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, that course may not have been created yet.').'
'); if ($elapsed > 600) { $r->print(''.&mt('You may also have been assigned to a course in the time since you last logged-in, or checked for changes.').
'
'.
&mt('If that is the case you can use the "Check for changes" link in the gray Functions bar to update the list of your available course roles.').'
'.&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('You have rights to request the creation of courses and/or communities in the following domain(s):'). '
'.&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).'';
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.').'
'.&mt('Course/Community requests').'
'.
&Apache::loncommon::start_data_table().
&Apache::loncommon::start_data_table_header_row().
'
'.&mt('Enrollment requests').'
'.
$queuedselfenroll.'
'.&mt('Author role request').'
';
if ($status eq 'approval') {
$output .= &mt('A request for Authoring Space submitted on [_1] is awaiting approval',
&Apache::lonlocal::locallocaltime($timestamp));
} elsif ($status eq 'approved') {
my %roleshash =
&Apache::lonnet::get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',
['active'],['au'],[$env{'user.domain'}]);
if (keys(%roleshash)) {
$output .= ''.
&mt('Your request for an author role has been approved.').'
'.
&mt('Use the "Check for changes" link to update your list of roles.').
'';
}
}
$output .= '