[LON-CAPA-cvs] cvs: loncom /auth lonroles.pm /interface lonmenu.pm

raeburn raeburn at source.lon-capa.org
Thu Oct 27 17:06:13 EDT 2016


raeburn		Thu Oct 27 21:06:13 2016 EDT

  Modified files:              
    /loncom/auth	lonroles.pm 
    /loncom/interface	lonmenu.pm 
  Log:
  - "Switch role" drop-down provided in course context to domain helpdesk
    ad hoc course roles:
    (a) if user has rights to use a single ad hoc role, but course has at
    least one section, or
    (b) user has rights to use more than one ad hoc role. 
  
  
-------------- next part --------------
Index: loncom/auth/lonroles.pm
diff -u loncom/auth/lonroles.pm:1.318 loncom/auth/lonroles.pm:1.319
--- loncom/auth/lonroles.pm:1.318	Thu Oct 20 19:53:58 2016
+++ loncom/auth/lonroles.pm	Thu Oct 27 21:06:00 2016
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # User Roles Screen
 #
-# $Id: lonroles.pm,v 1.318 2016/10/20 19:53:58 raeburn Exp $
+# $Id: lonroles.pm,v 1.319 2016/10/27 21:06:00 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -322,78 +322,113 @@
                     }
                 }
             }
-        } elsif ($numdc > 0) {
+        } elsif (($numdc > 0) || ($numdh > 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 trying to enter a course and needs privs to be created
             foreach my $envkey (keys(%env)) {
 # 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;
+                if ($numdc) {
+                    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;
                     }
-                    if (my ($castart,$caend) = ($env{'user.role.ca./'.$domain.'/'.$user} =~ /^(\d*)\.(\d*)$/)) {
-                        if (((($castart) && ($castart < $now)) || !$castart) && 
-                            ((!$caend) || (($caend) && ($caend > $now)))) {
+# 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 = 'ca./'.$domain.'/'.$user;
+                                my $trolecode = 'au./'.$domain.'/';
                                 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;
+                        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});
                         }
-                    } else {
-                        delete($env{$envkey});
+                        last;
                     }
-                    last;
                 }
-            }
+                if ($numdh) {
+# Is this an ad hoc custom role in a course/community?
+                   if (my ($domain,$rolename,$coursenum) = ($envkey =~ m{^form\.cr/($match_domain)/\1\-domainconfig/(\w+)\./\1/($match_courseid)$})) {
+                       if ($dhroles{$domain}) { 
+                           my @adhoc; 
+                           if ($env{'environment.adhocroles.'.$domain}) {
+                               @adhoc = split(',',$env{'environment.adhocroles.'.$domain});
+                           } else {
+                               my %adhocroles = &Apache::lonnet::userenvironment($env{'user.domain'},$env{'user.name'},
+                                                                                 'adhocroles.'.$domain);
+                               if (keys(%adhocroles)) {
+                                   @adhoc = split(',',$adhocroles{'adhocroles.'.$domain});
+                               };
+                           }
+                           if ((@adhoc > 0) && ($rolename ne '')) {
+                               if (grep(/^\Q$rolename\E$/, at adhoc)) {
+                                   if (&Apache::lonnet::check_adhoc_privs($domain,$coursenum,$update,$refresh,$now,
+                                                                          "cr/$domain/$domain".'-domainconfig/'.$rolename)) {
+                                       &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);
Index: loncom/interface/lonmenu.pm
diff -u loncom/interface/lonmenu.pm:1.456 loncom/interface/lonmenu.pm:1.457
--- loncom/interface/lonmenu.pm:1.456	Wed Oct 26 14:51:44 2016
+++ loncom/interface/lonmenu.pm	Thu Oct 27 21:06:13 2016
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Routines to control the menu
 #
-# $Id: lonmenu.pm,v 1.456 2016/10/26 14:51:44 raeburn Exp $
+# $Id: lonmenu.pm,v 1.457 2016/10/27 21:06:13 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2095,7 +2095,7 @@
     } else {
         $ccrole = 'cc';
     }
-    my ($priv,$gotsymb,$destsymb);
+    my ($privref,$gotsymb,$destsymb);
     my $destinationurl = $ENV{'REQUEST_URI'};
     if ($destinationurl =~ /\?symb=/) {
         $gotsymb = 1;
@@ -2116,12 +2116,15 @@
         my $destination = $destinationurl;
         $destination =~ s/(\?.*)$//;
         if (exists($reqprivs->{$destination})) {
-            $priv = $reqprivs->{$destination};
+            if ($reqprivs->{$destination} =~ /,/) {
+                @{$privref} = split(/,/,$reqprivs->{$destination});
+            } else { 
+                $privref = [$reqprivs->{$destination}];
+            }
         }
     }
     if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
         my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
-        
         if ((($start) && ($start<0)) || 
             (($end) && ($end<$now))  ||
             (($start) && ($now<$start))) {
@@ -2131,7 +2134,9 @@
         }
     }
     if ($is_cc) {
-        &get_all_courseroles($cdom,$cnum,\%courseroles,\%seccount,\%courseprivs,$priv);
+        &get_all_courseroles($cdom,$cnum,\%courseroles,\%seccount,\%courseprivs);
+    } elsif ($env{'request.role'} =~ m{^\Qcr/$cdom/$cdom-domainconfig/\E(\w+)\.\Q/$cdom/$cnum\E}) {
+        &get_customadhoc_roles($cdom,$cnum,\%courseroles,\%seccount,\%courseprivs,$privref);
     } else {
         my %gotnosection;
         foreach my $item (keys(%env)) {
@@ -2147,7 +2152,7 @@
                         $gotnosection{$role} = 1;
                     }
                 }
-                if ($priv ne '') {
+                if ((ref($privref) eq 'ARRAY') && (@{$privref} > 0)) {
                     my $cnumsec = $cnum;
                     if ($sec ne '') {
                         $cnumsec .= "/$sec";
@@ -2185,7 +2190,7 @@
     }
     if ((keys(%seccount) > 1) || ($numdiffsec > 1)) {
         my @submenu;
-        $js = &jump_to_role($cdom,$cnum,\%seccount,\%courseroles,\%courseprivs,$priv);
+        $js = &jump_to_role($cdom,$cnum,\%seccount,\%courseroles,\%courseprivs,$privref);
         $form = 
             '<form name="rolechooser" method="post" action="'.$httphost.'/adm/roles">'."\n".
             '  <input type="hidden" name="destinationurl" value="'.
@@ -2307,8 +2312,83 @@
     return;
 }
 
+sub get_customadhoc_roles {
+    my ($cdom,$cnum,$courseroles,$seccount,$courseprivs,$privref) = @_;
+    unless ((ref($courseroles) eq 'HASH') && (ref($seccount) eq 'HASH') &&
+            (ref($courseprivs) eq 'HASH')) {
+        return;
+    }
+    if ($env{'environment.adhocroles.'.$cdom} ne '') { 
+        my @customroles = split(/,/,$env{'environment.adhocroles.'.$cdom});
+        if (@customroles > 1) {
+            if ($env{"user.role.dh./$cdom/"}) {
+                my ($start,$end)=split(/\./,$env{"user.role.dh./$cdom/"});
+                my $now = time; 
+                if (!($start && ($now<$start)) & !($end && ($now>$end))) {
+                    my $numsec = 1;
+                    my @sections;
+                    my ($allseclist,$cached) =
+                        &Apache::lonnet::is_cached_new('courseseclist',$cdom.'_'.$cnum);
+                    if (defined($cached)) {
+                        if ($allseclist ne '') {
+                            @sections = split(/,/,$allseclist);
+                            $numsec += scalar(@sections);
+                        }
+                    } else {
+                        my %sections_count = &Apache::loncommon::get_sections($cdom,$cnum);
+                        $numsec += scalar(keys(%sections_count));
+                        $allseclist = join(',',sort(keys(%sections_count)));
+                        &Apache::lonnet::do_cache_new('courseseclist',$cdom.'_'.$cnum,$allseclist);
+                    }
+                    my (%adhoc,$gotprivs);
+                    my $prefix = "cr/$cdom/$cdom".'-domainconfig';
+                    foreach my $role (@customroles) {
+                        next if (($role eq '') || ($role =~ /\W/));
+                        $seccount->{"$prefix/$role"} = $numsec;
+                        $courseroles->{"$prefix/$role"} = \@sections;
+                        if ((ref($privref) eq 'ARRAY') && (@{$privref} > 0)) {
+                            if (exists($env{"user.priv.$prefix/$role./$cdom/$cnum./"})) {
+                                $courseprivs->{"$prefix/$role./$cdom/$cnum./"} =
+                                    $env{"user.priv.$prefix/$role./$cdom/$cnum./"};
+                                $courseprivs->{"$prefix/$role./$cdom/$cnum./$cdom/"} =
+                                    $env{"user.priv.$prefix/$role./$cdom/$cnum./$cdom/"};
+                                $courseprivs->{"$prefix/$role./$cdom/$cnum./$cdom/$cnum"} =
+                                    $env{"user.priv.$prefix/$role./$cdom/$cnum./$cdom/$cnum"};
+                            } else {
+                                unless ($gotprivs) {
+                                    my ($adhocroles,$privscached) =
+                                        &Apache::lonnet::is_cached_new('adhocroles',$cdom);
+                                    if ((defined($privscached)) && (ref($adhocroles) eq 'HASH')) {
+                                        %adhoc = %{$adhocroles};
+                                    } else {
+                                        my $confname = &Apache::lonnet::get_domainconfiguser($cdom);
+                                        my %roledefs = &Apache::lonnet::dump('roles',$cdom,$confname,'rolesdef_');
+                                        foreach my $key (keys(%roledefs)) {
+                                            (undef,my $rolename) = split(/_/,$key);
+                                            if ($rolename ne '') {
+                                                $adhoc{$rolename} = $roledefs{$key};
+                                            }
+                                        }
+                                        &Apache::lonnet::do_cache_new('adhocroles',$cdom,\%adhoc);
+                                    }
+                                    $gotprivs = 1;
+                                }
+                                ($courseprivs->{"$prefix/$role./$cdom/$cnum./"},
+                                 $courseprivs->{"$prefix/$role./$cdom/$cnum./$cdom/"},
+                                 $courseprivs->{"$prefix/$role./$cdom/$cnum./$cdom/$cnum"}) =
+                                     split(/\_/,$adhoc{$role});
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return;
+}
+
 sub jump_to_role {
-    my ($cdom,$cnum,$seccount,$courseroles,$courseprivs,$priv) = @_;
+    my ($cdom,$cnum,$seccount,$courseroles,$courseprivs,$privref) = @_;
     my %lt = &Apache::lonlocal::texthash(
                 this => 'This role has section(s) associated with it.',
                 ente => 'Enter a specific section.',
@@ -2341,29 +2421,26 @@
         }
     }
     my $checkroles = 0;
-    if ($priv && ref($courseprivs) eq 'HASH') {
-        my (%disallowed,%allowed, at disallow);
+    if ((ref($privref) eq 'ARRAY') && (@{$privref} > 0) && (ref($courseprivs) eq 'HASH')) {
+        my %disallowed;
         foreach my $role (sort(keys(%{$courseprivs}))) {
             my $trole;
             if ($role =~ m{^(.+?)\Q./$cdom/$cnum\E}) {
                 $trole = $1;
             }
             if (($trole ne '') && ($trole ne 'cm')) {
-                if ($courseprivs->{$role} =~ /\Q:$priv\E($|:|\&\w+)/) {
-                    $allowed{$trole} = 1;
-                } else {
-                    $disallowed{$trole} = 1;
+                $disallowed{$trole} = 1;
+                foreach my $priv (@{$privref}) { 
+                    if ($courseprivs->{$role} =~ /\Q:$priv\E($|:|\&\w+)/) {
+                        delete($disallowed{$trole});
+                        last;
+                    }
                 }
             }
         }
-        foreach my $trole (keys(%disallowed)) {
-            unless ($allowed{$trole}) {
-                push(@disallow,$trole);
-            }
-        }
-        if (@disallow > 0) {
+        if (keys(%disallowed) > 0) {
             $checkroles = 1;
-            $js .= "    var disallow = new Array('".join("','", at disallow)."');\n".
+            $js .= "    var disallow = new Array('".join("','",keys(%disallowed))."');\n".
                    "    var rolecheck = 1;\n";
         }
     }
@@ -2460,13 +2537,13 @@
 
 sub required_privs {
     my $privs =  {
-             '/adm/parmset'      => 'opa',
-             '/adm/courseprefs'  => 'opa',
+             '/adm/parmset'      => 'opa,vpa',
+             '/adm/courseprefs'  => 'opa,vpa',
              '/adm/whatsnew'     => 'whn',
              '/adm/populate'     => 'cst',
              '/adm/trackstudent' => 'vsa',
-             '/adm/statistics'   => 'vgr',
-             '/adm/setblock'     => 'dcm',
+             '/adm/statistics'   => 'mgr,vgr',
+             '/adm/setblock'     => 'dcm,vcb',
              '/adm/coursedocs'   => 'mdc',
            };
     unless ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'spreadsheet') {


More information about the LON-CAPA-cvs mailing list