--- loncom/auth/lonroles.pm 2008/05/20 18:19:28 1.194
+++ loncom/auth/lonroles.pm 2014/05/31 12:49:12 1.308
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.194 2008/05/20 18:19:28 www Exp $
+# $Id: lonroles.pm,v 1.308 2014/05/31 12:49:12 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -27,12 +27,108 @@
#
###
+=pod
+
+=head1 NAME
+
+Apache::lonroles - User Roles Screen
+
+=head1 SYNOPSIS
+
+Invoked by /etc/httpd/conf/srm.conf:
+
+ $msg '.&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:').
+ '$msg
+
'.
$error.
- '
'.&mt('Continue').''.
- &Apache::loncommon::end_page());
+ '
');
+ 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('
' + .&mt('This LON-CAPA server is version [_1]',$r->dir_config('lonVersion')) + .'
'); + } + $r->print(&Apache::loncommon::end_page()); + return OK; +} + +sub roles_from_env { + my ($roleshash,$update) = @_; + my $count = 0; + if (ref($roleshash) eq 'HASH') { + foreach my $envkey (keys(%env)) { + if ($envkey =~ m{^user\.role\.(\w+)[./]}) { + next if ($1 eq 'gr'); + $roleshash->{$envkey} = $env{$envkey}; + my ($start,$end) = split(/\./,$env{$envkey}); + unless ($end && $end<$update) { + $count ++; + } + } + } + } + return $count; +} + +sub gather_roles { + my ($update,$refresh,$now,$reinit,$nochoose,$roles_in_env,$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(); + if (ref($roles_in_env) eq 'HASH') { + foreach my $envkey (sort(keys(%{$roles_in_env}))) { + my $button = 1; + my $switchserver=''; + my $switchwarning; + my ($role_text,$role_text_end,$sortkey,$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') - || ($env{'form.showall'})) { + if (($tstatus eq 'is') + || ($tstatus eq 'selected') + || ($tstatus eq 'future') + || ($env{'form.display'} eq '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; - $futureroles{$trolecode} = $tstart.':'.$tend; + $futureroles->{$trolecode} = $tstart.':'.$tend; $countfuture ++; - } elsif ($tstatus eq 'will') { - $tbg='#FFAA77'; - $tremark.=&mt('Active at next login. '); - $roles_nextlogin{$trolecode} = $tstart.':'.$tend; - $countwill ++; } 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.='This is LON-CAPA '.
- $r->dir_config('lonVersion').'
'.
- ''.&mt('Logout').'
'); } - $r->print(' | '.&mt('User Role').' | '.&mt('Extent') - .' | '.&mt('Start').' | '.&mt('End') - .' | '.&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) { @@ -819,7 +1361,7 @@ sub roletable_headers { } sub roletypes { - my @types = ('Domain','Construction Space','Course','Unavailable','System'); + my @types = ('Domain','Authoring Space','Course','Community','Unavailable','System'); return @types; } @@ -832,7 +1374,16 @@ sub print_rolerows { foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) { if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) { if (ref($roletext) eq 'HASH') { - $output.=$roletext->{$sortrole->{$which}}; + 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-dc\./($match_domain)/-) { if (ref($dcroles) eq 'HASH') { if ($dcroles->{$1}) { @@ -845,9 +1396,12 @@ sub print_rolerows { } if ($output) { if ($doheaders > 0) { - $r->print("|||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|
". - &mt($type)." | ' + .&mt($type) + .' | ' + .&Apache::loncommon::end_data_table_empty_row() + ); } $r->print($output); } @@ -856,9 +1410,10 @@ sub print_rolerows { } sub findcourse_advice { - my ($r) = @_; + my ($r,$cattype) = @_; my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description'); - if (&check_autoenroll($env{'user.domain'})) { + my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); + if (&Apache::lonnet::auto_run(undef,$env{'user.domain'})) { $r->print(&mt('If you were expecting to see an active role listed for a particular course in the [_1] domain, it may be missing for one of the following reasons:',$domdesc).'||||||||||||
'.&mt('Switch Server').' | '; + $roletext.='' + .'' + .&mt('Switch Server') + .' | '; } else { - $roletext.=(''); + $roletext.=(' | '); + } + if ($switchwarning) { + if ($tremark eq '') { + $tremark = $switchwarning; + } else { + $tremark .= ' | '. + ' | '; } elsif ($tryagain) { $roletext.= - ''. + ' | '; } elsif ($advanced) { $roletext.= - ''. + ' | '; + } elsif ($reinit) { + $roletext.= + ''. + ' | '; } else { - $roletext.=''; + $roletext.= + ' | '. + ' | '; } } if ($trolecode !~ m/^(dc|ca|au|aa)\./) { $tremark.=&Apache::lonannounce::showday(time,1, &Apache::lonannounce::readcalendar($tdom.'_'.$trest)); } - $roletext.=''.$trole. - ' | '.$twhere. - ' | '.$tpstart. - ' | '.$tpend. - ' | '.$trole.' | ' + .''.$twhere.' | ' + .''.$tpstart.' | ' + .''.$tpend.' | '; if (!$is_dc) { - $roletext.='
'.$tremark. - ' | |||||||||||||
'. + $tremark.' '. + ' | '; } - return $roletext; + return ($roletext,$roletext_end); } sub check_author_homeserver { @@ -1023,22 +1646,8 @@ sub check_author_homeserver { } } -sub check_privs { - my ($cdom,$cnum,$then,$now,$checkrole) = @_; - my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; - if ($env{$cckey}) { - my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend,$tfont); - &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); - unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { - &set_privileges($cdom,$cnum,$checkrole); - } - } else { - &set_privileges($cdom,$cnum,$checkrole); - } -} - sub check_fordc { - my ($dcroles,$then) = @_; + my ($dcroles,$update,$then) = @_; my $numdc = 0; if ($env{'user.adv'}) { foreach my $envkey (sort keys %env) { @@ -1046,8 +1655,12 @@ sub check_fordc { 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++; @@ -1059,43 +1672,61 @@ sub check_fordc { } sub adhoc_course_role { - my ($then) = @_; - my ($cdom,$cnum); - my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - if (&check_forcc($cdom,$cnum,$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,$update,$then,$crstype)) { my $setprivs; - if (!defined($env{'user.role.'.$env{'form.selectrole'}})) { + if (!defined($env{'user.role.'.$env{'form.switchrole'}})) { $setprivs = 1; } else { - my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.selectrole'}}); - if (($start && ($start>$then || $start == -1)) || - ($end && $end<$then)) { + my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}}); + if (($start && ($start>$refresh || $start == -1)) || + ($end && $end<$update)) { $setprivs = 1; } - } + } + unless ($setprivs) { + if (!exists($env{'user.priv.'.$env{'form.switchrole'}.'./'})) { + $setprivs = 1; + } + } if ($setprivs) { - if ($env{'form.switchrole'} =~ m-^(in|ta|ep|ad|st|cr)([\w/]*)\./\Q$cdom\E/\Q$cnum\E(/?\w*)$-) { + if ($env{'form.switchrole'} =~ m-^(in|ta|ep|ad|st|cr)(.*?)\./\Q$cdom\E/\Q$cnum\E/?(\w*)$-) { my $role = $1; my $custom_role = $2; my $usec = $3; if ($role eq 'cr') { - if ($custom_role =~ m-^$match_domain/$match_courseid/\w+$-) { + if ($custom_role =~ m-^/$match_domain/$match_username/\w+$-) { $role .= $custom_role; } else { return; } } - my (%userroles,%newrole,%newgroups); + my (%userroles,%newrole,%newgroups,%group_privs); + my %cgroups = + &Apache::lonnet::get_active_groups($env{'user.domain'}, + $env{'user.name'},$cdom,$cnum); + foreach my $group (keys(%cgroups)) { + $group_privs{$group} = + $env{'user.priv.cc./'.$cdom.'/'.$cnum.'./'.$cdom.'/'.$cnum.'/'.$group}; + } + $newgroups{'/'.$cdom.'/'.$cnum} = \%group_privs; my $area = '/'.$cdom.'/'.$cnum; my $spec = $role.'.'.$area; if ($usec ne '') { $spec .= '/'.$usec; $area .= '/'.$usec; } - &Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,$area); - &Apache::lonnet::set_userprivs(\%userroles,\%newrole,%newgroups); - my $adhocstart = $then-1; + if ($role =~ /^cr/) { + &Apache::lonnet::custom_roleprivs(\%newrole,$role,$cdom,$cnum,$spec,$area); + } else { + &Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,$area); + } + &Apache::lonnet::set_userprivs(\%userroles,\%newrole,\%newgroups); + my $adhocstart = $refresh-1; $userroles{'user.role.'.$spec} = $adhocstart.'.'; &Apache::lonnet::appenv(\%userroles,[$role,'cm']); } @@ -1105,28 +1736,87 @@ sub adhoc_course_role { } sub check_forcc { - my ($cdom,$cnum,$then) = @_; - my $is_cc; - if ($cdom ne '' && $cnum ne '') { - if (&Apache::lonnet::is_course($cdom,$cnum)) { - my $envkey = 'user.role.cc./'.$cdom.'/'.$cnum; - if (defined($env{$envkey})) { - $is_cc = 1; - my ($tstart,$tend)=split(/\./,$env{$envkey}); - if ($tstart && $tstart>$then) { $is_cc = 0; } - if ($tend && $tend <$then) { $is_cc = 0; } + my ($cdom,$cnum,$refresh,$update,$then,$crstype) = @_; + my ($is_cc,$ccrole); + if ($crstype eq 'Community') { + $ccrole = 'co'; + } else { + $ccrole = 'cc'; + } + if (&Apache::lonnet::is_course($cdom,$cnum)) { + my $envkey = 'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum; + if (defined($env{$envkey})) { + $is_cc = 1; + my ($tstart,$tend)=split(/\./,$env{$envkey}); + my $limit = $update; + if ($env{'request.role'} eq $ccrole.'./'.$cdom.'/'.$cnum) { + $limit = $then; } + if ($tstart && $tstart>$refresh) { $is_cc = 0; } + if ($tend && $tend <$limit) { $is_cc = 0; } } } return $is_cc; } +sub check_release_required { + my ($loncaparev,$tcourseid,$trolecode,$required) = @_; + my ($switchserver,$warning); + if ($required ne '') { + my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/); + my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); + if ($reqdmajor ne '' && $reqdminor ne '') { + my $otherserver; + if (($major eq '' && $minor eq '') || + (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) { + my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1); + my $switchlcrev = + &Apache::lonnet::get_server_loncaparev($env{'user.domain'}, + $userdomserver); + my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); + if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) || + (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) { + my $cdom = $env{'course.'.$tcourseid.'.domain'}; + if ($cdom ne $env{'user.domain'}) { + my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1); + my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname); + my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); + my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom); + my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'}); + my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver); + my $canhost = + &Apache::lonnet::can_host_session($env{'user.domain'}, + $coursedomserver, + $remoterev, + $udomdefaults{'remotesessions'}, + $defdomdefaults{'hostedsessions'}); + + if ($canhost) { + $otherserver = $coursedomserver; + } else { + $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).'|||||||||||||
| |||||||||||||
'.&mt('Date requested').' | '. + ''.&mt('Course title').' | '. + ''.&mt('Course type').' | '; + &Apache::loncommon::end_data_table_header_row(); + foreach my $reqtime (@sortedtimes) { + next unless (ref($reqcrs{$reqtime}) eq 'ARRAY'); + $output .= &Apache::loncommon::start_data_table_row(). + ''.&Apache::lonlocal::locallocaltime($reqtime).' | '. + ''.join(' | ',@{$reqcrs{$reqtime}}).' | '. + &Apache::loncommon::end_data_table_row(); + } + $output .= &Apache::loncommon::end_data_table(). + '