--- loncom/auth/lonroles.pm	2015/04/20 12:11:02	1.269.2.23
+++ loncom/auth/lonroles.pm	2016/10/27 22:53:48	1.269.2.28
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # User Roles Screen
 #
-# $Id: lonroles.pm,v 1.269.2.23 2015/04/20 12:11:02 raeburn Exp $
+# $Id: lonroles.pm,v 1.269.2.28 2016/10/27 22:53:48 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -260,7 +260,8 @@ sub handler {
 
     my $envkey;
     my %dcroles = ();
-    my $numdc = &check_fordc(\%dcroles,$update,$then);
+    my %dhroles = ();
+    my ($numdc,$numdh,$numadhoc) = &check_for_adhoc(\%dcroles,\%dhroles,$update,$then);
     my $loncaparev = $r->dir_config('lonVersion');
 
 # ================================================================== Roles Init
@@ -269,8 +270,15 @@ sub handler {
         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 role trying to enter a course
+            if ($env{'form.newrole'} =~ m{^cr/($match_domain)/\1\-domainconfig/\w+\./\1/$match_courseid$}) {
+                if ($dhroles{$1}) {
+                    $custom_adhoc = 1;
+                }
+            }
 	}
 	if ($env{'request.course.id'}) {
             # Check if user is CC trying to select a course role
@@ -301,75 +309,129 @@ sub handler {
 				 "request.role"                => 'cm',
                                  "request.role.adv"            => $env{'user.adv'},
 				 "request.role.domain"         => $env{'user.domain'}});
-# 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 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});
+# 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)$}) {
+            my $cdom = $1;
+            my $rolename = $2;
+            my $cnum = $3;
+            if ($custom_adhoc) {
+                my %adhocroles = &Apache::lonnet::userenvironment($env{'user.domain'},$env{'user.name'},
+                                                                  'adhocroles.'.$cdom);
+                if (keys(%adhocroles)) {
+                    my @adhoc = split(',',$adhocroles{'adhocroles.'.$cdom});
+                    if (grep(/^\Q$rolename\E$/,@adhoc)) {
+                        if (&Apache::lonnet::check_adhoc_privs($cdom,$cnum,$update,$refresh,$now,
+                                                               "cr/$cdom/$cdom".'-domainconfig/'.$rolename)) {
+                            &Apache::lonnet::appenv({"environment.internal.$cdom.$cnum.cr/$cdom/$cdom".'-domainconfig/'."$rolename.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;
+            }
+        } 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)) {
+                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;
                     }
-                    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.'&amp;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';
+                        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.'&amp;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.'&amp;role='.$trolecode;
+                                    $r->internal_redirect($switchserver);
+                                    return OK;
+                                }
+                            } else {
+                                delete($env{$envkey});
+                            }
+                        } else {
+                            delete($env{$envkey});
+                        }
                         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.'&amp;role='.$trolecode;
-                                $r->internal_redirect($switchserver);
-                                return OK;
+                }
+                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$/,@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});
                         }
-                    } else {
-                        delete($env{$envkey});
+                        last;
                     }
-                    last;
-                }
+                } 
             }
         }
 
@@ -710,6 +772,12 @@ ENDENTERKEY
                                        $redirect_url);
                         return OK;
                     }
+                    if ($role eq 'dh') {
+                        my $redirect_url = '/adm/menu/';
+                        &redirect_user($r,&mt('Loading Domain Helpdesk Menu'),
+                                       $redirect_url);
+                        return OK;
+                    }
                     if ($role eq 'sc') {
                         my $redirect_url = '/adm/grades?command=scantronupload';
                         &redirect_user($r,&mt('Loading Data Upload Page'),
@@ -746,14 +814,20 @@ ENDENTERKEY
     my $showcount = &roles_from_env(\%roles_in_env,$update); 
 
     my $swinfo=&Apache::lonmenu::rawconfig();
-    my $start_page=&Apache::loncommon::start_page($pagetitle,undef,{bread_crumbs=>$brcrum});
     my %domdefs=&Apache::lonnet::get_domain_defaults($env{'user.domain'}); 
     my $cattype = 'std';
     if ($domdefs{'catauth'}) {
         $cattype = $domdefs{'catauth'};
     }
     my $funcs = &get_roles_functions($showcount,$cattype);
-    $standby=~s/\n/\\n/g;
+    my $crumbsright;
+    if ($env{'browser.mobile'}) {
+        $crumbsright = $funcs;
+        undef($funcs);
+    }
+    my $start_page=&Apache::loncommon::start_page($pagetitle,undef,{bread_crumbs=>$brcrum,
+                                                                    bread_crumbs_component=>$crumbsright});
+    &js_escape(\$standby);
     my $noscript='<br /><span class="LC_error">'.&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.').'<br />'.&mt('As this is not the case, most functionality in the system will be unavailable.').'</span><br />';
 
     $r->print(<<ENDHEADER);
@@ -951,7 +1025,7 @@ ENDHEADER
     }
 # ----------------------------------------------------------------------- Table
 
-    if ($numdc > 0) {
+    if (($numdc > 0) || (($numdh > 0) && ($numadhoc > 0))) {
         $r->print(&coursepick_jscript());
         $r->print(&Apache::loncommon::coursebrowser_javascript().
                   &Apache::loncommon::authorbrowser_javascript());
@@ -984,9 +1058,12 @@ ENDHEADER
                                $roletext{'user.role.'.$role}->[1].
                                &Apache::loncommon::end_data_table_row();
                 }
-                if ($role =~ m{dc\./($match_domain)/} 
+                if ($role =~ m{^dc\./($match_domain)/$} 
 		    && $dcroles{$1}) {
 		    $output .= &adhoc_roles_row($1,'recent');
+                } elsif ($role =~ m{^dh\./($match_domain)/$}
+                         && ($env{'environment.adhocroles.'.$1} ne '')) {
+                    $output .= &adhoc_customroles_row($1,'recent');
                 }
 	    } elsif ($numdc > 0) {
                 unless ($role =~/^error\:/) {
@@ -1328,7 +1405,7 @@ sub roletable_headers {
     my $doheaders;
     if ((ref($sortrole) eq 'HASH') && (ref($roleclass) eq 'HASH')) {
         $r->print('<br />'
-                 .&Apache::loncommon::start_data_table()
+                 .&Apache::loncommon::start_data_table('LC_textsize_mobile')
                  .&Apache::loncommon::start_data_table_header_row()
         );
         if (!$nochoose) { $r->print('<th>&nbsp;</th>'); }
@@ -1377,12 +1454,15 @@ sub print_rolerows {
                                            &Apache::loncommon::end_data_table_row();
                             }
                         }
-                        if ($sortrole->{$which} =~ m-dc\./($match_domain)/-) {
+                        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\./($match_domain)/}) &&
+                                 ($env{'environment.adhocroles.'.$1} ne '')) {
+                            $output .= &adhoc_customroles_row($1,'');
                         }
                     }
                 }
@@ -1639,29 +1719,42 @@ sub check_author_homeserver {
     }
 }
 
-sub check_fordc {
-    my ($dcroles,$update,$then) = @_;
+sub check_for_adhoc {
+    my ($dcroles,$dhroles,$update,$then) = @_;
     my $numdc = 0;
+    my $numdh = 0;
+    my $numadhoc = 0;
+    my $num_custom_adhoc = 0;
     if ($env{'user.adv'}) {
         foreach my $envkey (sort(keys(%env))) {
-            if ($envkey=~/^user\.role\.dc\.\/($match_domain)\/$/) {
-                my $dcdom = $1;
-                my $livedc = 1;
+            if ($envkey=~/^user\.role\.(dc|dh)\.\/($match_domain)\/$/) {
+                my $role = $1;
+                my $roledom = $2;
+                my $liverole = 1;
                 my ($tstart,$tend)=split(/\./,$env{$envkey});
                 my $limit = $update;
-                if ($env{'request.role'} eq 'dc./'.$dcdom.'/') {
+                if ((($role eq 'dc') && ($env{'request.role'} eq 'dc./'.$roledom.'/')) ||
+                    (($role eq 'dh') && ($env{'request.role'} eq 'dh./'.$roledom.'/'))) {
                     $limit = $then;
                 }
-                if ($tstart && $tstart>$limit) { $livedc = 0; }
-                if ($tend   && $tend  <$limit) { $livedc = 0; }
-                if ($livedc) {
-                    $$dcroles{$dcdom} = $envkey;
-                    $numdc++;
+                if ($tstart && $tstart>$limit) { $liverole = 0; }
+                if ($tend   && $tend  <$limit) { $liverole = 0; }
+                if ($liverole) {
+                    if ($role eq 'dc') {
+                        $dcroles->{$roledom} = $envkey;
+                        $numdc++;
+                    } else {
+                        $dhroles->{$roledom} = $envkey;
+                        if ($env{'environment.adhocroles.'.$roledom} ne '') {
+                            $numadhoc ++;
+                        }
+                        $numdh++;
+                    }
                 }
             }
         }
     }
-    return $numdc;
+    return ($numdc,$numdh,$numadhoc);
 }
 
 sub adhoc_course_role {
@@ -1753,23 +1846,25 @@ sub check_forcc {
 }
 
 sub courselink {
-    my ($dcdom,$rowtype) = @_;
+    my ($roledom,$rowtype,$role) = @_;
     my $courseform=&Apache::loncommon::selectcourse_link
-                   ('rolechoice','dccourse'.$rowtype.'_'.$dcdom,
-                    'dcdomain'.$rowtype.'_'.$dcdom,'coursedesc'.$rowtype.'_'.
-                    $dcdom,$dcdom,undef,'Course/Community');
-    my $hiddenitems = '<input type="hidden" name="dcdomain'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'.
-                      '<input type="hidden" name="origdom'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'.
-                      '<input type="hidden" name="dccourse'.$rowtype.'_'.$dcdom.'" value="" />'.
-                      '<input type="hidden" name="coursedesc'.$rowtype.'_'.$dcdom.'" value="" />';
+                   ('rolechoice','course'.$rowtype.'_'.$roledom.'_'.$role,
+                    'domain'.$rowtype.'_'.$roledom.'_'.$role,
+                    'coursedesc'.$rowtype.'_'.$roledom.'_'.$role,
+                    $roledom.':'.$role,undef,'Course/Community');
+    my $hiddenitems = '<input type="hidden" name="domain'.$rowtype.'_'.$roledom.'_'.$role.'" value="'.$roledom.'" />'.
+                      '<input type="hidden" name="origdom'.$rowtype.'_'.$roledom.'_'.$role.'" value="'.$roledom.'" />'.
+                      '<input type="hidden" name="course'.$rowtype.'_'.$roledom.'_'.$role.'" value="" />'.
+                      '<input type="hidden" name="coursedesc'.$rowtype.'_'.$roledom.'_'.$role.'" value="" />';
     return $courseform.$hiddenitems;
 }
 
 sub coursepick_jscript {
-    my %lt = &Apache::lonlocal::texthash(
+    my %js_lt = &Apache::lonlocal::texthash(
                   plsu => "Please use the 'Select Course/Community' link to open a separate pick course window where you may select the course or community you wish to enter.",
                   youc => 'You can only use this screen to select courses and communities in the current domain.',
              );
+    &js_escape(\%js_lt);
     my $verify_script = <<"END";
 <script type="text/javascript">
 // <![CDATA[
@@ -1786,11 +1881,11 @@ function verifyCoursePick(caller) {
             }
         }
         else {
-            alert("$lt{'plsu'}");
+            alert("$js_lt{'plsu'}");
         }
     }
     else {
-        alert("$lt{'youc'}")
+        alert("$js_lt{'youc'}")
     }
 }
 function getIndex(caller) {
@@ -1851,11 +1946,12 @@ sub display_cc_role {
 sub adhoc_roles_row {
     my ($dcdom,$rowtype) = @_;
     my $output = &Apache::loncommon::continue_data_table_row()
-                 .' <td colspan="5">'
+                 .' <td colspan="5" class="LC_textsize_mobile">'
                  .&mt('[_1]Ad hoc[_2] roles in domain [_3] --'
                      ,'<span class="LC_cusr_emph">','</span>',$dcdom)
                  .' ';
-    my $selectcclink = &courselink($dcdom,$rowtype);
+    my $role = 'cc';
+    my $selectcclink = &courselink($dcdom,$rowtype,$role);
     my $ccrole = &Apache::lonnet::plaintext('co',undef,undef,1);
     my $carole = &Apache::lonnet::plaintext('ca');
     my $selectcalink = &coauthorlink($dcdom,$rowtype);
@@ -1865,6 +1961,25 @@ sub adhoc_roles_row {
     return $output;
 }
 
+sub adhoc_customroles_row {
+    my ($dhdom,$rowtype) = @_;
+    my $output = &Apache::loncommon::continue_data_table_row()
+                 .' <td colspan="5" class="LC_textsize_mobile">'
+                 .&mt('[_1]Ad hoc[_2] course/community roles in domain [_3] --',
+                      '<span class="LC_cusr_emph">','</span>',$dhdom);
+    my @customroles = split(/,/,$env{'environment.adhocroles.'.$dhdom});
+    my $count = 0;
+    foreach my $role (@customroles) {
+        next if (($role eq '') || ($role =~ /\W/));
+        $output .= ' '.$role.': '.&courselink($dhdom,$rowtype,$role).' |';
+        $count ++;
+    }
+    if ($count) {
+        return $output;
+    }
+    return;
+}
+
 sub recent_filename {
     my $area=shift;
     return 'nohist_recent_'.&escape($area);
@@ -2693,15 +2808,30 @@ sub get_roles_functions {
     unless ($cattype eq 'none') {
         push(@links,['/adm/coursecatalog','ccat-22x22',&mt('Course catalog')]);
     }
-    my $funcs = &Apache::lonhtmlcommon::start_funclist();
-    foreach my $link (@links) {
-        $funcs .= &Apache::lonhtmlcommon::add_item_funclist(
-                      '<a href="'.$link->[0].'" class="LC_menubuttons_link">'.
-                      '<img src="/res/adm/pages/'.$link->[1].'.png" class="LC_icon" alt="'.$link->[2].'" />'.
-                      $link->[2].'</a>');
+    my $funcs;
+    if ($env{'browser.mobile'}) {
+        my @functions;
+        foreach my $link (@links) {
+            push(@functions,[$link->[0],$link->[2]]);
+        }
+        my $title = 'Display options';
+        if ($env{'user.adv'}) {
+            $title = 'Roles options';
+        }
+        $funcs = &Apache::lonmenu::create_submenu('','',$title,\@functions,1,'LC_breadcrumbs_hoverable');
+        $funcs = '<ol class="LC_primary_menu LC_floatright">'.$funcs.'</ol>';
+    } else {
+        $funcs = &Apache::lonhtmlcommon::start_funclist();
+        foreach my $link (@links) {
+            $funcs .= &Apache::lonhtmlcommon::add_item_funclist(
+                          '<a href="'.$link->[0].'" class="LC_menubuttons_link">'.
+                          '<img src="/res/adm/pages/'.$link->[1].'.png" class="LC_icon" alt="'.$link->[2].'" />'.
+                          $link->[2].'</a>');
+        }
+        $funcs .= &Apache::lonhtmlcommon::end_funclist();
+        $funcs = &Apache::loncommon::head_subbox($funcs);
     }
-    $funcs .= &Apache::lonhtmlcommon::end_funclist();
-    return &Apache::loncommon::head_subbox($funcs);
+    return $funcs;
 }
 
 sub get_queued {