--- loncom/interface/lonmenu.pm	2016/10/26 14:51:44	1.456
+++ loncom/interface/lonmenu.pm	2016/10/27 21:06:13	1.457
@@ -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 @@ sub roles_selector {
     } 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 @@ sub roles_selector {
         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 @@ sub roles_selector {
         }
     }
     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 @@ sub roles_selector {
                         $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 @@ sub roles_selector {
     }
     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 @@ sub get_all_courseroles {
     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 @@ sub jump_to_role {
         }
     }
     my $checkroles = 0;
-    if ($priv && ref($courseprivs) eq 'HASH') {
-        my (%disallowed,%allowed,@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("','",@disallow)."');\n".
+            $js .= "    var disallow = new Array('".join("','",keys(%disallowed))."');\n".
                    "    var rolecheck = 1;\n";
         }
     }
@@ -2460,13 +2537,13 @@ END
 
 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') {