Diff for /loncom/auth/lonroles.pm between versions 1.240.2.5 and 1.269.2.39.2.2

version 1.240.2.5, 2009/12/24 18:28:54 version 1.269.2.39.2.2, 2022/01/16 17:32:44
Line 57  course they should act on, etc. Both in Line 57  course they should act on, etc. Both in
 handler determines via C<lonnet>'s C<&allowed> function that a certain  handler determines via C<lonnet>'s C<&allowed> function that a certain
 action is not allowed, C<lonroles> is used as error handler. This  action is not allowed, C<lonroles> is used as error handler. This
 allows the user to select another role which may have permission to do  allows the user to select another role which may have permission to do
 what they were trying to do. C<lonroles> can also be accessed via the  what they were trying to do.
 B<CRS> button in the Remote Control.   
   
 =begin latex  =begin latex
   
Line 129  package Apache::lonroles; Line 128  package Apache::lonroles;
 use strict;  use strict;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::lonuserstate();  use Apache::lonuserstate();
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common REDIRECT);
 use Apache::File();  use Apache::File();
 use Apache::lonmenu;  use Apache::lonmenu;
 use Apache::loncommon;  use Apache::loncommon;
Line 138  use Apache::lonannounce; Line 137  use Apache::lonannounce;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonpageflip();  use Apache::lonpageflip();
 use Apache::lonnavdisplay();  use Apache::lonnavdisplay();
 use Apache::lonmainmenu();  use Apache::loncoursequeueadmin;
   use Apache::longroup;
   use Apache::lonrss;
 use GDBM_File;  use GDBM_File;
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
 use HTML::Entities;  use HTML::Entities;
     
   sub start_loading_course {
       my ($r,$title) = @_;
       &Apache::loncommon::content_type($r,'text/html');
       &Apache::loncommon::no_cache($r);
       $r->send_http_header;
       my $swinfo=&Apache::lonmenu::rawconfig();
       # Breadcrumbs
       my $brcrum = [{'href' => '',
                      'text' => $title},];
       my $start_page = &Apache::loncommon::start_page($title,undef,
                                                       {'bread_crumbs' => $brcrum,
                                                        'bread_crumbs_nomenu' => 1,
                                                        'links_disabled' => 1});
       $r->print(<<ENDREDIR);
   $start_page
   <script type="text/javascript">
   // <![CDATA[
   $swinfo
   
   document.body.addEventListener('click', function (event) {
     // filter out clicks on any other elements
     if (event.target.nodeName == 'A' && event.target.getAttribute('aria-disabled') == 'true') {
       event.preventDefault();
     }
   });
   // ]]>
   </script>
   ENDREDIR
       return;
   }
   
   sub finish_loading_course {
       my ($r,$msg,$url) = @_;
       my $link = '<div id="LC_course_loaded" style="display:none"><a href="'.$url.'">'.&mt('Continue').'</a></div>';
       my $end_page = &Apache::loncommon::end_page();
       my $js_url = &js_escape($url);
       my $remote_js;
       if ($env{'environment.remote'} eq 'on') {
           my ($menucoll,$deeplinkmenu,$menuref) = &Apache::loncommon::menucoll_in_effect();
           if ($menucoll) {
               &Apache::lonnet::put('environment',{'remote' => 'off'});
               &Apache::lonnet::appenv({'environment.remote' => 'off'});
               my $menu_name = &Apache::lonmenu::get_menu_name();
               $remote_js = <<ENDCLOSE;
   window.status='Accessing Remote Control';
   menu=window.open("/adm/rat/empty.html","$menu_name",
                    "height=350,width=150,scrollbars=no,menubar=no");
   window.status='Disabling Remote Control';
   menu.active=0;
   menu.autologout=0;
   window.status='Closing Remote Control';
   menu.close();
   window.status='Done.';
   ENDCLOSE
           }
       }
       $r->print(<<END);
   $msg
   <script type="text/javascript">
   // <![CDATA[
   \$(document).ready(function() {
       \$("#LC_course_loaded").css("display","block");
       \$('.isDisabled > a').removeAttr("aria-disabled");
       \$('.isDisabled').removeClass("isDisabled");
       $remote_js
       var url = "$js_url";
       \$(location).attr('href',url);
   });
   </script>
   $link
   $end_page
   END
       return;
   }
   
 sub redirect_user {  sub redirect_user {
     my ($r,$title,$url,$msg,$launch_nav) = @_;      my ($r,$title,$url,$msg) = @_;
     $msg = $title if (! defined($msg));      $msg = $title if (! defined($msg));
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     &Apache::loncommon::no_cache($r);      &Apache::loncommon::no_cache($r);
     $r->send_http_header;      $r->send_http_header;
     my $swinfo=&Apache::lonmenu::rawconfig();      my $swinfo=&Apache::lonmenu::rawconfig();
     my $navwindow;  
     if ($launch_nav eq 'on') {  
  $navwindow.=&Apache::lonnavdisplay::launch_win('now',undef,undef,  
        ($url =~ m-^/adm/whatsnew-));  
     } else {  
  $navwindow.=&Apache::lonnavmaps::close();  
     }  
   
     # Breadcrumbs      # Breadcrumbs
     my $brcrum = [{'href' => $url,      my $brcrum = [{'href' => $url,
Line 177  $start_page Line 245  $start_page
 $swinfo  $swinfo
 // ]]>  // ]]>
 </script>  </script>
 $navwindow  
 <p>$msg</p>  <p>$msg</p>
 $end_page  $end_page
 ENDREDIR  ENDREDIR
Line 186  ENDREDIR Line 253  ENDREDIR
   
 sub error_page {  sub error_page {
     my ($r,$error,$dest)=@_;      my ($r,$error,$dest)=@_;
     &Apache::loncommon::content_type($r,'text/html');      my %lt = &Apache::lonlocal::texthash(
     &Apache::loncommon::no_cache($r);          pdc => 'Problems during Course Initialization',
     $r->send_http_header;          tfp => 'The following problems occurred:',
     return OK if $r->header_only;          con => 'Continue',
     # 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(  
         '<script type="text/javascript">'.  
         '// <![CDATA['.  
         &Apache::lonmenu::rawconfig().  
         '// ]]>'.  
         '</script>'.  
       '<p class="LC_error">'.&mt('The following problems occurred:').  
           '<br />'.  
       $error.  
       '</p><br /><a href="'.$dest.'">'.&mt('Continue').'</a>'  
     );      );
     $r->print(&Apache::loncommon::end_page());      my $end_page = &Apache::loncommon::end_page();
       $dest = &HTML::Entities::encode($dest,'"<>&');
       $r->print(<<END);
   <h3>$lt{'pdc'}</h3>
   <p class="LC_error">$lt{'tfp'}
   <br />
   $error
   </p><br /><a href="$dest">$lt{'con'}</a>
   $end_page
   END
       return;
 }  }
   
 sub handler {  sub handler {
   
     my $r = shift;      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 $now=time;
     my $then=$env{'user.login.time'};      my $then=$env{'user.login.time'};
     my $refresh=$env{'user.refresh.time'};      my $refresh=$env{'user.refresh.time'};
       my $update=$env{'user.update.time'};
     if (!$refresh) {      if (!$refresh) {
         $refresh = $then;          $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 $envkey;
     my %dcroles = ();      my %dcroles = ();
     my $numdc = &check_fordc(\%dcroles,$then);      my %helpdeskroles = (); 
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});      my ($numdc,$numhelpdesk,$numadhoc) =
     my $custommenu = &Apache::loncommon::needs_gci_custom();          &check_for_adhoc(\%dcroles,\%helpdeskroles,$update,$then);
       my $loncaparev = $r->dir_config('lonVersion');
   
 # ================================================================== Roles Init  # ================================================================== Roles Init
     if ($env{'form.selectrole'}) {      if ($env{'form.selectrole'}) {
Line 233  sub handler { Line 459  sub handler {
         my $locknum=&Apache::lonnet::get_locks();          my $locknum=&Apache::lonnet::get_locks();
         if ($locknum) { return 409; }          if ($locknum) { return 409; }
   
           my $custom_adhoc;
         if ($env{'form.newrole'}) {          if ($env{'form.newrole'}) {
             $env{'form.'.$env{'form.newrole'}}=1;              $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'}) {   if ($env{'request.course.id'}) {
             # Check if user is CC trying to select a course role              # Check if user is CC trying to select a course role
             if ($env{'form.switchrole'}) {              if ($env{'form.switchrole'}) {
                 if (!defined($env{'user.role.'.$env{'form.switchrole'}})) {                  my $switch_is_active;
                     &adhoc_course_role($refresh,$then);                  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);      my %temp=('logout_'.$env{'request.course.id'} => time);
     &Apache::lonnet::put('email_status',\%temp);      &Apache::lonnet::put('email_status',\%temp);
     &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'});      &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'});
  }   }
  &Apache::lonnet::appenv({"request.course.id"   => '',   &Apache::lonnet::appenv({"request.course.id"           => '',
  "request.course.fn"   => '',   "request.course.fn"           => '',
  "request.course.uri"  => '',   "request.course.uri"          => '',
  "request.course.sec"  => '',   "request.course.sec"          => '',
  "request.role"        => 'cm',                                   "request.course.tied"         => '',
                                  "request.role.adv"    => $env{'user.adv'},                                   "request.course.timechecked"  => '',
  "request.role.domain" => $env{'user.domain'}});   "request.role"                => 'cm',
 # Check if user is a DC trying to enter a course or author space and needs privs to be created                                   "request.role.adv"            => $env{'user.adv'},
         if ($numdc > 0) {   "request.role.domain"         => $env{'user.domain'}});
             foreach my $envkey (keys %env) {  # Check if Domain Helpdesk role trying to enter a course needs privs to be created
 # Is this an ad-hoc Coordinator role?          if ($env{'form.newrole'} =~ m{^cr/($match_domain)/\1\-domainconfig/(\w+)\./\1/($match_courseid)(?:/(\w+)|$)}) {
                 if (my ($ccrole,$domain,$coursenum) =              my $cdom = $1;
     ($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {              my $rolename = $2;
                     if ($dcroles{$domain}) {              my $cnum = $3;
                         &Apache::lonnet::check_adhoc_privs($domain,$coursenum,              my $sec = $4;
                                                            $then,$refresh,$now,$ccrole);              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});
                           }
                     }                      }
                     last;  
                 }                  }
 # Is this an ad-hoc CA-role?              }
                 if (my ($domain,$user) =          } elsif (($numdc > 0) || ($numhelpdesk > 0)) {
     ($envkey =~ m-^form\.ca\./($match_domain)/($match_username)$-)) {  # Check if user is a DC trying to enter a course or author space and needs privs to be created
                     if (($domain eq $env{'user.domain'}) && ($user eq $env{'user.name'})) {  # Check if user is a DH or DA trying to enter a course and needs privs to be created
                         delete($env{$envkey});              foreach my $envkey (keys(%env)) {
                         $env{'form.au./'.$domain.'/'} = 1;                  if ($numdc) {
                         my ($server_status,$home) = &check_author_homeserver($user,$domain);  # Is this an ad-hoc Coordinator role?
                         if ($server_status eq 'switchserver') {                      if (my ($ccrole,$domain,$coursenum) =
                             my $trolecode = 'au./'.$domain.'/';          ($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {
                             my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode;                          if ($dcroles{$domain}) {
                             $r->internal_redirect($switchserver);                              if (&Apache::lonnet::check_adhoc_privs($domain,$coursenum,
                                                                      $update,$refresh,$now,$ccrole)) {
                                   &Apache::lonnet::appenv({"environment.internal.$domain.$coursenum.$ccrole.adhoc" => time});
                               }
                         }                          }
                         last;                          last;
                     }                      }
                     if (my ($castart,$caend) = ($env{'user.role.ca./'.$domain.'/'.$user} =~ /^(\d*)\.(\d*)$/)) {  # Is this an ad-hoc CA-role?
                         if (((($castart) && ($castart < $now)) || !$castart) &&                       if (my ($domain,$user) =
                             ((!$caend) || (($caend) && ($caend > $now)))) {          ($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);                              my ($server_status,$home) = &check_author_homeserver($user,$domain);
                             if ($server_status eq 'switchserver') {                              if ($server_status eq 'switchserver') {
                                 my $trolecode = 'ca./'.$domain.'/'.$user;                                  my $trolecode = 'au./'.$domain.'/';
                                 my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode;                                  my $switchserver = '/adm/switchserver?otherserver='.$home.'&amp;role='.$trolecode;
                                 $r->internal_redirect($switchserver);                                  $r->internal_redirect($switchserver);
                                   return OK;
                             }                              }
                             last;                              last;
                         }                          }
                     }                          if (my ($castart,$caend) = ($env{'user.role.ca./'.$domain.'/'.$user} =~ /^(\d*)\.(\d*)$/)) {
                     # Check if author blocked ca-access                              if (((($castart) && ($castart < $now)) || !$castart) && 
                     my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],$domain,$user);                                  ((!$caend) || (($caend) && ($caend > $now)))) {
                     if ($blocked{'domcoord.author'} eq 'blocked') {                                  my ($server_status,$home) = &check_author_homeserver($user,$domain);
                         delete($env{$envkey});                                  if ($server_status eq 'switchserver') {
                         $env{'user.error.msg'}=':::1:User '.$user.' in domain '.$domain.' blocked domain coordinator access';                                      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;                          last;
                     }                      }
                     if ($dcroles{$domain}) {                  }
                         my ($server_status,$home) = &check_author_homeserver($user,$domain);                  if ($numhelpdesk) {
                         if (($server_status eq 'ok') || ($server_status eq 'switchserver')) {  # Is this an ad hoc custom role in a course/community?
                             &Apache::lonnet::check_adhoc_privs($domain,$user,$then,                      if (my ($domain,$rolename,$coursenum,$sec) = ($envkey =~ m{^form\.cr/($match_domain)/\1\-domainconfig/(\w+)\./\1/($match_courseid)(?:/(\w+)|$)})) {
                                                                $refresh,$now,'ca');                          if ($helpdeskroles{$domain}) {
                             if ($server_status eq 'switchserver') {                              my ($possroles,$description) = &Apache::lonnet::get_my_adhocroles($domain.'_'.$coursenum,1);
                                 my $trolecode = 'ca./'.$domain.'/'.$user;                               if (ref($possroles) eq 'ARRAY') {
                                 my $switchserver = '/adm/switchserver?'                                  if (grep(/^\Q$rolename\E$/,@{$possroles})) {
                                                   .'otherserver='.$home.'&role='.$trolecode;                                      if (&Apache::lonnet::check_adhoc_privs($domain,$coursenum,$update,$refresh,$now,
                                 $r->internal_redirect($switchserver);                                                                             "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 {                          } else {
                             delete($env{$envkey});                              delete($env{$envkey});
                         }                          }
                     } else {                          last;
                         delete($env{$envkey});  
                     }                      }
                     last;                  } 
                 }  
             }              }
         }          }
         if (($env{'form.cm'}) && ($env{'form.orgurl'})) {   
             $r->internal_redirect($env{'form.orgurl'});          foreach $envkey (keys(%env)) {
         }  
         foreach $envkey (keys %env) {  
             next if ($envkey!~/^user\.role\./);              next if ($envkey!~/^user\.role\./);
             my ($where,$trolecode,$role,$tstatus,$tend,$tstart);              my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
             &Apache::lonnet::role_status($envkey,$then,$refresh,$now,\$role,\$where,              &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
                                          \$trolecode,\$tstatus,\$tstart,\$tend);                                           \$trolecode,\$tstatus,\$tstart,\$tend);
             if ($env{'form.'.$trolecode}) {              if ($env{'form.'.$trolecode}) {
  if ($tstatus eq 'is') {   if ($tstatus eq 'is') {
     $where=~s/^\///;      $where=~s/^\///;
     my ($cdom,$cnum,$csec)=split(/\//,$where);      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  # check for course groups
                     my %coursegroups = &Apache::lonnet::get_active_groups(                      my %coursegroups = &Apache::lonnet::get_active_groups(
                           $env{'user.domain'},$env{'user.name'},$cdom, $cnum);                            $env{'user.domain'},$env{'user.name'},$cdom, $cnum);
Line 372  sub handler { Line 683  sub handler {
  my $end_page=&Apache::loncommon::end_page();   my $end_page=&Apache::loncommon::end_page();
  my $buttontext=&mt('Enter Course');   my $buttontext=&mt('Enter Course');
  my $message=&mt('Successfully registered key');   my $message=&mt('Successfully registered key');
                                    my $ip = &Apache::lonnet::get_requestor_ip();
  my $assignresult=   my $assignresult=
      &Apache::lonnet::assign_access_key(       &Apache::lonnet::assign_access_key(
      $env{'form.newkey'},       $env{'form.newkey'},
Line 380  sub handler { Line 692  sub handler {
                                                      $env{'user.domain'},                                                       $env{'user.domain'},
      $env{'user.name'},       $env{'user.name'},
                                                      &mt('Assigned from [_1] at [_2] for [_3]'                                                       &mt('Assigned from [_1] at [_2] for [_3]'
                                                         ,$ENV{'REMOTE_ADDR'}                                                          ,$ip
                                                         ,&Apache::lonlocal::locallocaltime()                                                          ,&Apache::lonlocal::locallocaltime()
                                                         ,$trolecode)                                                          ,$trolecode)
                                                      );                                                       );
Line 439  ENDENTERKEY Line 751  ENDENTERKEY
  $env{'user.name'},   $env{'user.name'},
  $env{'user.home'},   $env{'user.home'},
  "Role ".$trolecode);   "Role ".$trolecode);
       
     &Apache::lonnet::appenv(      &Apache::lonnet::appenv(
    {'request.role'        => $trolecode,     {'request.role'        => $trolecode,
     'request.role.domain' => $cdom,      'request.role.domain' => $cdom,
Line 448  ENDENTERKEY Line 760  ENDENTERKEY
                     my $tadv=0;                      my $tadv=0;
   
     if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {      if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {
                         my $msg;                          if ($role =~ m{^\Qcr/$cdom/$cdom\E\-domainconfig/(\w+)$}) {
                         if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }                              my $rolename = $1;
                         &Apache::lonnet::appenv({'request.role.adv'=>$tadv});                              my %domdef = &Apache::lonnet::get_domain_defaults($cdom);
  my ($furl,$ferr)=                              if (ref($domdef{'adhocroles'}) eq 'HASH') {
     &Apache::lonuserstate::readmap($cdom.'/'.$cnum);                                  if (ref($domdef{'adhocroles'}{$rolename}) eq 'HASH') {
                                       &Apache::lonnet::appenv({'request.role.desc' => $domdef{'adhocroles'}{$rolename}{'desc'}});
                                   }
                               }
                           }
                           my $crstype = &Apache::loncommon::course_type($cdom.'_'.$cnum);
                           $crstype = lc($crstype);
                           my $preamble = '<div id="LC_update_'.$cdom.'_'.$cnum.'" class="LC_info">'.
                                          '<br />'.
                                          &mt("Please be patient while your $crstype loads").
                                          '<br /></div>'.
                                          '<div style="padding:0;clear:both;margin:0;border:0"></div>';
                           my $closure = <<ENDCLOSE;
   <script type="text/javascript">
   // <![CDATA[
   \$("#LC_update_${cdom}_${cnum}").hide('slow');
   // ]]>
   </script>
   ENDCLOSE
                           my $title = &mt("Loading $crstype");
                           &start_loading_course($r,$title);
                           my %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($r,undef,$preamble);
                           &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Loading ...'));
                           $r->rflush();
                           my ($msg,$blockcrit,$critmsg_check);
                           $critmsg_check = 1;
                           $blockcrit = &Apache::loncommon::blocking_status('alert',$clientip,$cnum,$cdom,undef,1);
                           if ($blockcrit) {
                               my $checkrole = "cm./$cdom/$cnum";
                               if ($csec ne '') {
                                   $checkrole .= "/$csec";
                               }
                               unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                                       ($trolecode !~ m{^st\./$cdom/$cnum})) {
                                   $critmsg_check = 0;
                               }
                           }
                           my ($furl,$ferr)=
                               &Apache::lonuserstate::readmap($cdom.'/'.$cnum,$critmsg_check);
                           &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Finished!'));
                           &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
                           $r->print($closure);
                           $r->rflush();
                           if ($ferr) {
                               $furl = '/adm/roles?tryagain=1';
                           } else {
                               &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
                               unless (($env{'form.switchrole'}) ||
                                       ($env{"environment.internal.$cdom.$cnum.$role.adhoc"})) {
                                   &Apache::lonnet::put('nohist_crslastlogin',
                                       {$env{'user.name'}.':'.$env{'user.domain'}.
                                        ':'.$csec.':'.$role => $now},$cdom,$cnum);
                               }
                               if (($env{"environment.internal.$cdom.$cnum.$role.adhoc"}) &&
                                   (&Apache::lonnet::allowed('vxc',$cdom.'_'.$cnum))) {
                                   my $owner = $env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'};
                                   my @coowners = split(/,/,$env{'course.'.$env{'request.course.id'}.'.internal.co-owners'});
                                   my %auaccess;
                                   foreach my $user ($owner,@coowners) {
                                       my ($cpname,$cpdom) = split(/:/,$user);
                                       my %auroles = &Apache::lonnet::get_my_roles($cpname,$cpdom,'userroles',undef,['au','ca','aa'],[$cdom]);
                                       foreach my $key (keys(%auroles)) {
                                           my ($auname,$audom,$aurole) = split(/:/,$key);
                                           if ($aurole eq 'au') {
                                               $auaccess{$cpname} = 1;
                                           } else {
                                               $auaccess{$auname} = 1;
                                           }
                                       }
                                   }
                                   &Apache::lonnet::appenv({'request.course.adhocsrcaccess' => join(',',sort(keys(%auaccess))) });
                               }
                               my ($feeds,$syllabus_time);
                               &Apache::lonrss::advertisefeeds($cnum,$cdom,undef,\$feeds);
                               &Apache::lonnet::appenv({'request.course.feeds' => $feeds});
                               &Apache::lonnet::get_numsuppfiles($cnum,$cdom,1);
                               unless ($env{'course.'.$cdom.'_'.$cnum.'.updatedsyllabus'}) {
                                   unless (($env{'course.'.$cdom.'_'.$cnum.'.externalsyllabus'}) ||
                                           ($env{'course.'.$cdom.'_'.$cnum.'.uploadedsyllabus'})) {
                                       my %syllabus=&Apache::lonnet::dump('syllabus',$cdom,$cnum);
                                       $syllabus_time = $syllabus{'uploaded.lastmodified'};
                                       if ($syllabus_time) {
                                           &Apache::lonnet::appenv({'request.course.syllabustime' => $syllabus_time});
                                       }
                                   }
                               }
                           }
  if (($env{'form.orgurl'}) &&    if (($env{'form.orgurl'}) && 
     ($env{'form.orgurl'}!~/^\/adm\/flip/)) {      ($env{'form.orgurl'}!~/^\/adm\/flip/) &&
                               ($env{'form.orgurl'} ne '/adm/roles')) {
     my $dest=$env{'form.orgurl'};      my $dest=$env{'form.orgurl'};
                             if ($env{'form.symb'}) {                              if ($env{'form.symb'}) {
                                 if ($dest =~ /\?/) {                                  if ($dest =~ /\?/) {
                                     $dest .= '&';                                      $dest .= '&';
                                 } else {                                  } else {
                                     $dest .= '?'                                      $dest .= '?';
                                 }                                  }
                                 $dest .= 'symb='.$env{'form.symb'};                                  $dest .= 'symb='.$env{'form.symb'};
                             }                              }
       if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
       &Apache::lonnet::appenv({'request.role.adv'=>$tadv});
                               if ($ferr) {
                                   if ($env{'form.orgurl'}) {
                                       $furl .= '&orgurl='.&HTML::Entities::encode($env{'form.orgurl'},'<>&"');
                                   }
                                   if ($env{'form.symb'}) {
                                       $furl .= '&symb='.&HTML::Entities::encode($env{'form.symb'},'<>&"');
                                   }
                               }
                             if (($ferr) && ($tadv)) {                              if (($ferr) && ($tadv)) {
  &error_page($r,$ferr,$dest);                                  &error_page($r,$ferr,$furl);
     } else {      } else {
  $r->internal_redirect($dest);                                  if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                                       if (($env{'form.orgurl'} ne '') && ($env{'form.symb'} ne '')) {
                                           unless (&Apache::lonnet::symbverify($env{'form.symb'},$env{'form.orgurl'})) {
                                               $dest=$env{'form.orgurl'};
                                           }
                                       }
                                   }
                                   if ($dest =~ m{^/adm/coursedocs\?folderpath}) {
                                       if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { 
                                           my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
                                           &Apache::loncommon::update_content_constraints($cdom,$cnum,$chome,
                                                                                          $cdom.'_'.$cnum);
                                       }
                                   }
                                   if ($ferr) {
                                       if (!$env{'request.course.id'}) {
                                           &Apache::lonnet::appenv(
                                              {"request.course.id"  => $cdom.'_'.$cnum});
                                           $r->print('<p class="LC_error">'.
                                                     &mt('Could not initialize [_1] at this time.',
                                                         $env{'course.'.$cdom.'_'.$cnum.'.description'}).
                                                     '</p>'.
                                                     '<p><a href="'.$furl.'">'.
                                                     &mt('Please try again.').'</a></p>'.
                                                     &Apache::loncommon::end_page());
                                       }
                                   } else {
                                       $msg = '<p>'.&mt('Entering [_1] ...',
                                                        $env{'course.'.$cdom.'_'.$cnum.'.description'}).
                                              '</p>';
                                       &finish_loading_course($r,$msg,$dest);
                                   }
     }      }
                               $r->rflush();
     return OK;      return OK;
  } else {   } else {
     if (!$env{'request.course.id'}) {      if (!$env{'request.course.id'}) {
  &Apache::lonnet::appenv(   &Apache::lonnet::appenv(
       {"request.course.id"  => $cdom.'_'.$cnum});        {"request.course.id"  => $cdom.'_'.$cnum});
  $furl='/adm/roles?tryagain=1';                              }
                 $msg='<p><span class="LC_error">'      if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
                     .&mt('Could not initialize [_1] at this time.',      &Apache::lonnet::appenv({'request.role.adv'=>$tadv});
                          $env{'course.'.$cdom.'_'.$cnum.'.description'})                              if ($ferr) {
                     .'</span></p>'                                  if ($tadv) {
                     .'<p>'.&mt('Please try again.').'</p>'                                      &error_page($r,$ferr,$furl);
                     .'<p>'.$ferr.'</p>';                                  } else {
     }                                      $r->print('<p class="LC_error">'.
                                                 &mt('Could not initialize [_1] at this time.',
     if (($ferr) && ($tadv)) {                                                    $env{'course.'.$cdom.'_'.$cnum.'.description'}).
  &error_page($r,$ferr,$furl);                                                '</p>'.
                                                 '<p><a href="'.$furl.'">'.&mt('Please try again.').'</a></p>'.
                                                 &Apache::loncommon::end_page());
                                   }
     } else {      } else {
  # Check to see if the user is a CC entering a course    # Check to see if the user is a CC entering a course 
  # for the first time   # for the first time
  my (undef, undef, $role, $courseid) = split(/\./, $envkey);   if ((($role eq 'cc') || ($role eq 'co')) 
  if (substr($courseid, 0, 1) eq '/') {                                      && ($env{'course.'.$cdom.'_'.$cnum.'.course.helper.not.run'})) { 
     $courseid = substr($courseid, 1);  
  }  
  $courseid =~ s/\//_/;  
  if (($cdom ne 'gcitest') && (($role eq 'cc') || ($role eq 'co'))   
                                     && ($env{'course.' . $courseid .'.course.helper.not.run'})) {   
     $furl = "/adm/helper/course.initialization.helper";      $furl = "/adm/helper/course.initialization.helper";
     # Send the user to the course they selected      # Send the user to the course they selected
  } elsif ($env{'request.course.id'}) {   } elsif ($env{'request.course.id'}) {
                                     if ($env{'form.destinationurl'}) {                                      my ($dest,$destsymb,$checkenc);
                                         my $dest = $env{'form.destinationurl'};                                      $dest = $env{'form.destinationurl'};
                                         if ($env{'form.destsymb'} ne '') {                                      $destsymb = $env{'form.destsymb'};
                                             my $esc_symb = &HTML::Entities::encode($env{'form.destsymb'},'"<>&');                                      if ($dest ne '') {
                                             $dest .= '?symb='.$esc_symb;                                          if ($env{'form.switchrole'}) {
                                               if ($destsymb ne '') {
                                                   if ($destsymb !~ m{^/enc/}) {
                                                       unless ($env{'request.role.adv'}) {
                                                           $checkenc = 1;
                                                       }
                                                   }
                                               }
                                               if (($dest =~ m{^\Q/public/$cdom/$cnum/syllabus\E.*(\?|\&)usehttp=1}) ||
                                                   ($dest =~ m{^\Q/adm/wrapper/ext/\E(?!https:)})) {
                                                   if ($ENV{'SERVER_PORT'} == 443) {
                                                       my $hostname = $r->hostname();
                                                       unless ((&Apache::lonnet::uses_sts()) ||
                                                               (&Apache::lonnet::waf_allssl($hostname))) {
                                                           if ($hostname ne '') {
                                                               $dest = 'http://'.$hostname.$dest;
                                                           }
                                                       }
                                                   }
                                               }
                                               if ($dest =~ m{^/enc/}) {
                                                   if ($env{'request.role.adv'}) {
                                                       $dest = &Apache::lonenc::unencrypted($dest);
                                                       if ($destsymb eq '') {
                                                           ($destsymb) = ($dest =~ /(?:\?|\&)symb=([^\&]*)/); 
                                                           $destsymb = &unescape($destsymb);
                                                       }
                                                   }
                                               } else {
                                                   if ($destsymb eq '') {
                                                       ($destsymb) = ($dest =~ /(?:\?|\&)symb=([^\&]+)/);
                                                       $destsymb = &unescape($destsymb);
                                                   }
                                                   unless ($env{'request.role.adv'}) {
                                                       $checkenc = 1;
                                                   }
                                               }
                                               if (($checkenc) && ($destsymb ne '')) {
                                                   my ($encstate,$unencsymb,$res);
                                                   $unencsymb = &Apache::lonnet::symbclean($destsymb);
                                                   (undef,undef,$res) = &Apache::lonnet::decode_symb($unencsymb);
                                                   &Apache::lonnet::symbverify($unencsymb,$res,\$encstate);
                                                   if ($encstate) {
                                                       if (($dest ne '') && ($dest !~ m{^/enc/})) {
                                                           $dest=&Apache::lonenc::encrypted($dest);
                                                       }
                                                   }
                                               }
                                           }
                                           unless (($dest =~ m{^/enc/}) || ($dest =~ /(\?|\&)symb=.+___\d+___.+/)) { 
                                               if (($destsymb ne '') && ($destsymb !~ m{^/enc/})) {
                                                   my $esc_symb = &escape($destsymb);
                                                   $dest .= (($dest =~/\?/)? '&':'?').'symb='.$esc_symb;
                                               }
                                           }
                                           $msg = '<p>'.&mt('Entering [_1] ...',
                                                            $env{'course.'.$cdom.'_'.$cnum.'.description'}).
                                                  '</p>';
                                           if ($env{'form.ttoken'}) {
                                               $dest .= (($dest =~/\?/)? '&':'?').'ttoken='.$env{'form.ttoken'};
                                         }                                          }
                                         &redirect_user($r,&mt('Entering [_1]',                                          &finish_loading_course($r,$msg,$dest);
                                                       $env{'course.'.$courseid.'.description'}),                                          $r->rflush();
                                                $dest,$msg,  
                                                $env{'environment.remotenavmap'});  
                                         return OK;                                          return OK;
                                     }                                      }
     if (&Apache::lonnet::allowed('whn',      if (&Apache::lonnet::allowed('whn',
Line 516  ENDENTERKEY Line 1012  ENDENTERKEY
     $env{'request.course.id'}.'/'      $env{'request.course.id'}.'/'
     .$env{'request.course.sec'})      .$env{'request.course.sec'})
  ) {   ) {
  my $startpage = &courseloadpage($courseid);   my $startpage = &courseloadpage($env{'request.course.id'});
  unless (($startpage eq 'firstres') || ($cdom eq 'gcitest')) {   unless ($startpage eq 'firstres') {         
     $msg = &mt('Entering [_1] ...',      $msg = '<p>'.&mt('Entering [_1] ...',
        $env{'course.'.$courseid.'.description'});               $env{'course.'.$cdom.'_'.$cnum.'.description'}).
     &redirect_user($r,&mt('New in course'),                                                     '</p>';
    '/adm/whatsnew?refpage=start',$msg,                                              &finish_loading_course($r,$msg,'/adm/whatsnew?refpage=start');
    $env{'environment.remotenavmap'});                                              $r->rflush();
     return OK;                                              return OK;
  }   }
     }      }
  }   }
 # Are we allowed to look at the first resource?                                  # Are we allowed to look at the first resource?
  if ($furl !~ m|^/adm/|) {                                  #
 # Guess not ...                                  # $furl returned by lonuserstate::readmap() has format:
     $furl=&Apache::lonpageflip::first_accessible_resource();                                  # $url?symb=escaped($symb). If the resource has the
  }                                  # encrypturl parameter in effect, the entire string
                                 if (($cdom eq 'gcitest') && ($custommenu)) {                                  # $url?symb=escaped($symb) is encrypted as a string
                                     $furl = '/adm/navmaps';                                  # beginning /enc/.
                                   #
                                   my ($access,$unencfurl,$unencsymb);
                                   if ($furl =~ m{^(.+)(?:\?|\&)symb=([^&]+)(?:$|&)}) {
                                       my ($poss_url,$poss_symb) = ($1,$2);
                                       $unencsymb = &unescape($poss_symb);
                                       $unencfurl = $poss_url;
                                   } elsif ($furl =~ m{^/enc/}) {
                                       my $unenc = &Apache::lonenc::unencrypted($furl);
                                       if ($unenc =~ m{^(.+)(?:\?|\&)symb=([^&]+)(?:$|&)}) {
                                           ($unencfurl,$unencsymb) = ($1,$2);
                                           $unencsymb = &unescape($unencsymb);
                                       } else {
                                           $unencfurl = $unenc;
                                       }
                                   } else {
                                       $unencfurl = $furl;
                                 }                                  }
                                 $msg = &mt('Entering [_1] ...',                                  if ($unencsymb) {
    $env{'course.'.$courseid.'.description'});                                      my $symb = &Apache::lonnet::symbclean($unencsymb);
  &redirect_user($r,&mt('Entering [_1]',                                      if (($symb ne '') && (&Apache::lonnet::symbverify($symb,$unencfurl))) {
       $env{'course.'.$courseid.'.description'}),                                          $access = &Apache::lonnet::allowed('bre',$unencfurl,$symb);
        $furl,$msg,                                      } else {
        $env{'environment.remotenavmap'});                                          $access = &Apache::lonnet::allowed('bre',$unencfurl);
                                       }
                                   } else {
                                       $access = &Apache::lonnet::allowed('bre',$unencfurl);
                                   }
                                   if ((!$access) || ($access eq 'B') || ($access eq 'D')) {
                                       $furl = &Apache::lonpageflip::first_accessible_resource();
                                       if ($furl eq '') {
                                           $furl = '/adm/navmaps?showOnlyHomework=1';
                                       }
                                   }
                                   $msg = '<p>'.&mt('Entering [_1] ...',
            $env{'course.'.$cdom.'_'.$cnum.'.description'}).
                                          '</p>';
                                   &finish_loading_course($r,$msg,$furl);
     }      }
     return OK;                              $r->rflush();
                               return OK;
  }   }
     }      }
                     #                      #
Line 550  ENDENTERKEY Line 1077  ENDENTERKEY
                     if ($role =~ /^(au|ca|aa)$/) {                      if ($role =~ /^(au|ca|aa)$/) {
                         my $redirect_url = '/priv/';                          my $redirect_url = '/priv/';
                         if ($role eq 'au') {                          if ($role eq 'au') {
                             $redirect_url.=$env{'user.name'};                              $redirect_url.=$env{'user.domain'}.'/'.$env{'user.name'};
                         } else {                          } else {
                             $where =~ /\/(.*)$/;                              $redirect_url .= $where;
                             $redirect_url .= $1;  
                         }                          }
                         $redirect_url .= '/';                          $redirect_url .= '/';
                         &redirect_user($r,&mt('Entering Construction Space'),                          &redirect_user($r,&mt('Entering Authoring Space'),
                                        $redirect_url);                                         $redirect_url);
                         return OK;                          return OK;
                     }                      }
Line 566  ENDENTERKEY Line 1092  ENDENTERKEY
                                        $redirect_url);                                         $redirect_url);
                         return OK;                          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 'da') {
                           my $redirect_url = '/adm/menu/';
                           &redirect_user($r,&mt('Loading Domain Helpdesk Assistant Menu'),
                                          $redirect_url);
                           return OK;
                       }
                     if ($role eq 'sc') {                      if ($role eq 'sc') {
                         my $redirect_url = '/adm/grades?command=scantronupload';                          my $redirect_url = '/adm/grades?command=scantronupload';
                         &redirect_user($r,&mt('Loading Data Upload Page'),                          &redirect_user($r,&mt('Loading Data Upload Page'),
Line 577  ENDENTERKEY Line 1115  ENDENTERKEY
         }          }
     }      }
   
   
 # =============================================================== No Roles Init  # =============================================================== No Roles Init
   
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
Line 584  ENDENTERKEY Line 1123  ENDENTERKEY
     $r->send_http_header;      $r->send_http_header;
     return OK if $r->header_only;      return OK if $r->header_only;
   
     my ($crumbtext,$pagetitle,$recent,$show_course);      my $crumbtext = 'User Roles';
     my $noscript='<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 />';      my $pagetitle = 'My Roles';
     if ($custommenu) {      my $recent = &mt('Recent Roles');
         my $start_page = &Apache::loncommon::start_page('Main Menu',undef,      my $standby = &mt('Role selected. Please stand by.');
                                                         {'bread_crumbs' => 1});      my $show_course=&Apache::loncommon::show_course();
         $r->print(<<"ENDCUSTOM");      if ($show_course) {
 $start_page          $crumbtext = 'Courses';
 <br />          $pagetitle = 'My Courses';
 <noscript>          $recent = &mt('Recent Courses');
 $noscript          $standby = &mt('Course selected. Please stand by.');
 </noscript>      }
 ENDCUSTOM      if (($norolelist) && ((split(/:/,$env{'user.error.msg'}))[2])) {
     } else {          $crumbtext = 'Access Denied';
         $crumbtext = 'User Roles';          $pagetitle = 'Unauthorized';
         $pagetitle = 'My Roles';      }
         $recent = &mt('Recent Roles');      my $brcrum =[{href=>"/adm/roles",text=>$crumbtext}];
         $show_course=&Apache::loncommon::show_course();  
         if ($show_course) {      my %roles_in_env;
             $crumbtext = 'Courses';      my $showcount = &roles_from_env(\%roles_in_env,$update); 
             $pagetitle = 'My Courses';  
             $recent = &mt('Recent Courses');      my $swinfo=&Apache::lonmenu::rawconfig();
         }      my %domdefs=&Apache::lonnet::get_domain_defaults($env{'user.domain'}); 
         my $brcrum =[{href=>"/adm/roles",text=>$crumbtext}];      my $cattype = 'std';
         my $swinfo=&Apache::lonmenu::rawconfig();      if ($domdefs{'catauth'}) {
         my $start_page=&Apache::loncommon::start_page($pagetitle,undef,{bread_crumbs=>$brcrum});          $cattype = $domdefs{'catauth'};
         my $standby=&mt('Role selected. Please stand by.');      }
         $standby=~s/\n/\\n/g;      my ($funcs,$crumbsright);
         $r->print(<<ENDHEADER);      unless (($norolelist) && ((split(/:/,$env{'user.error.msg'}))[2])) {
           $funcs = &get_roles_functions($showcount,$cattype);
           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);
 $start_page  $start_page
 <br />  $funcs
 <noscript>  <noscript>
 $noscript  $noscript
 </noscript>  </noscript>
Line 633  function enterrole (thisform,rolecode,bu Line 1184  function enterrole (thisform,rolecode,bu
  thisform.submit();   thisform.submit();
     } else {      } else {
        alert('$standby');         alert('$standby');
     }         }
   }
   
   function rolesView (caller) {
       if ((caller == 'showall') || (caller == 'noshowall')) {
           document.rolechoice.display.value = caller;
       } else {
           if ((caller == 'doupdate') || (caller == 'requestauthor') ||
               (caller == 'queued')) {
               document.rolechoice.state.value = caller;
           }
       }
       document.rolechoice.selectrole.value='';
       document.rolechoice.submit();
 }  }
   
 // ]]>  // ]]>
 </script>  </script>
 ENDHEADER  ENDHEADER
     }  
   
 # ------------------------------------------ Get Error Message from Environment  # ------------------------------------------ Get Error Message from Environment
   
Line 696  ENDHEADER Line 1260  ENDHEADER
     }      }
         }          }
     }      }
 # -------------------------------------------------------- Choice or no choice?  
     if ($nochoose) {      if ($nochoose) {
  $r->print("<h2>".&mt('Sorry ...')."</h2>\n<span class='LC_error'>".   $r->print("<h2>".&mt('Sorry ...')."</h2>\n<span class='LC_error'>".
   &mt('This action is currently not authorized.').'</span>'.    &mt('This action is currently not authorized.').'</span>');
   &Apache::loncommon::end_page());          if ($error && $norolelist) {
               $r->print('<br /><br /><h4><span class="LC_error">'.
                         &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.').
                        '</span></h4>'.
                        '<h4><span class="LC_error">'.
                        &mt('You may need to login to LON-CAPA directly, or re-launch from a different external system.').
                        '</span></h4>');
           }
    $r->print(&Apache::loncommon::end_page());
  return OK;   return OK;
     } else {      } else {
           if ($updateresult || $reqauthor || $hotlist) {
               my $showresult = '<div>';
               if ($updateresult) {
                   $showresult .= &Apache::lonhtmlcommon::confirm_success($updateresult);
               }
               if ($reqauthor) {
                   $showresult .= &Apache::lonhtmlcommon::confirm_success($reqauthor);
               }
               if ($hotlist) {
                   $showresult .= $hotlist;
               }
               $showresult .= '</div>';
               $r->print($showresult);
           } elsif ($env{'form.state'} eq 'queued') {
               $r->print(&get_queued());
           }
         if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {          if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
        $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};         $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
         }          }
         unless ($custommenu) {          my $display = ($env{'form.display'} =~ /^(showall)$/);
             $r->print('<form method="post" name="rolechoice" action="'.(($fn)?$fn:$r->uri).'">');          $r->print('<form method="post" name="rolechoice" action="'.(($fn)?$fn:$r->uri).'">');
             $r->print('<input type="hidden" name="orgurl" value="'.$fn.'" />');          $r->print('<input type="hidden" name="orgurl" value="'.$fn.'" />');
             $r->print('<input type="hidden" name="selectrole" value="1" />');          $r->print('<input type="hidden" name="selectrole" value="1" />');
             $r->print('<input type="hidden" name="newrole" value="" />');          $r->print('<input type="hidden" name="newrole" value="" />');
           $r->print('<input type="hidden" name="display" value="'.$display.'" />');
           $r->print('<input type="hidden" name="state" value="" />');
           if ($blocked_by_ip) {
               my $blocked_role = 'student';
               if ($blocked_type eq 'Community') {
                   $blocked_role = 'member';
               }
               $r->print('<h3><span class="LC_error">'.
                         &mt('The [_1] you selected is not available for access with a [_2] role from your current IP address: [_3].',
                             lc($blocked_type),$blocked_role,$clientip).
                         '</span></h3>');
         }          }
     }      }
       $r->rflush();
   
     my (%roletext,%sortrole,%roleclass,%futureroles,%timezones);      my (%roletext,%sortrole,%roleclass,%futureroles,%timezones);
     my ($countactive,$countfuture,$inrole,$possiblerole) =       my ($countactive,$countfuture,$inrole,$possiblerole) = 
         &gather_roles($then,$refresh,$now,$reinit,$nochoose,\%roletext,\%sortrole,\%roleclass,          &gather_roles($update,$refresh,$now,$reinit,$nochoose,\%roles_in_env,\%roletext,
                       \%futureroles,\%timezones);                        \%sortrole,\%roleclass,\%futureroles,\%timezones,$loncaparev);
   
     $refresh = $now;      $refresh = $now;
     &Apache::lonnet::appenv({'user.refresh.time'  => $refresh});      &Apache::lonnet::appenv({'user.refresh.time'  => $refresh});
     if ($custommenu) {      if ((($cattype eq 'std') || ($cattype eq 'domonly')) && (!$env{'user.adv'})) {
         if ($env{'form.destinationurl'} eq '/adm/gci_info') {  
             $r->print(&gci_info_page()).  
             &Apache::loncommon::end_page();  
             return OK;  
         }  
         my %courses = &Apache::loncommon::existing_gcitest_courses();  
         $env{'browser.interface'}='faketextual';  
         $env{'environment.remote'}='off';  
         my $numcourses = keys(%courses);  
         my $switcher;  
         if ($numcourses > 0) {  
             $switcher = &Apache::lonmainmenu::gcitest_switcher(%courses);  
             my $current;  
             if ($env{'request.course.id'}) {  
                 $current = 'cc./'.$env{'course.'.$env{'request.course.id'}.'.domain'}.  
                            '/'.$env{'course.'.$env{'request.course.id'}.'.num'};  
             }  
             my $switcher_js = &Apache::lonmainmenu::gcitest_switcher_js($current,$numcourses);  
             $r->print(<<"ENDSCRIPT");  
 <script type="text/javascript">  
 // <![CDATA[  
 $switcher_js  
 // ]]>  
 </script>  
 ENDSCRIPT  
         }  
         $r->print(&Apache::lonmenu::inlinemenu('gcicustom',$switcher).  
                   &Apache::loncommon::end_page());  
         return OK;  
     }  
     if ($env{'user.adv'}) {  
         $r->print('<p><label><input type="checkbox" name="showall"');  
         if ($env{'form.showall'}) { $r->print(' checked="checked" '); }  
         $r->print(' />'.&mt('Show all roles').'</label>'  
                  .' <input type="submit" value="'.&mt('Update display').'" />'  
                  .'</p>');  
     } else {  
         if ($countactive > 0) {          if ($countactive > 0) {
             &queued_selfenrollment($r);  
             my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');              my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
             my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');               my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); 
             $r->print(              $r->print(
                 '<p>'                  '<p>'
                .&mt('[_1]Visit the [_2]Course/Community Catalog[_3]'                 .&mt('[_1]Visit the [_2]Course/Community Catalog[_3][_4]'
                    .' to view all [_4] LON-CAPA courses and communities.'                     .' to view all [_5] LON-CAPA courses and communities.'
                    ,'<b>'                     ,'<b>'
                    ,'<a href="/adm/coursecatalog?showdom='.$esc_dom.'">'                     ,'<a href="/adm/coursecatalog?showdom='.$esc_dom.'">'
                    ,'</a></b>',$domdesc)                     ,'</a>'
                      ,'</b>'
                      ,'"'.$domdesc.'"')
                .'<br />'                 .'<br />'
                .&mt('If a course or community is [_1]not[_2] in your list of current courses and communities below,'                 .&mt('If a course or community is [_1]not[_2] in your list of current courses and communities below,'
                    .' you may be able to enroll if self-enrollment is permitted.'                     .' you may be able to enroll if self-enrollment is permitted.'
Line 779  ENDSCRIPT Line 1341  ENDSCRIPT
         }          }
     }      }
   
       if ($norolelist) {
           if ($env{'request.role'}) {
               my ($roletext,$role_text_end) = &display_curr_role($env{'request.role'});
               if ($roletext) {
                   $r->print(&Apache::loncommon::start_data_table('LC_textsize_mobile').
                             &Apache::loncommon::start_data_table_row().
                             $roletext.
                             &Apache::loncommon::end_data_table_row());
                   if ($role_text_end) {
                       $r->print(&Apache::loncommon::continue_data_table_row().
                                 $role_text_end.
                                 &Apache::loncommon::end_data_table_row());
                   }
                   $r->print(&Apache::loncommon::end_data_table());
               }
           }
           $r->print(&Apache::loncommon::end_page());
           return OK;
       }
   
 # No active roles  # No active roles
     if ($countactive==0) {      if ($countactive==0) {
  if ($inrole) {          my $elapsed = 0;
     $r->print('<h2>'.&mt('Currently no additional roles, courses or communities').'</h2>');          if ($now && $update) {
  } else {              $elapsed = $now - $update;
     $r->print('<h2>'.&mt('Currently no active roles, courses or communities').'</h2>');          }
  }          &requestcourse_advice($r,$cattype,$inrole,$elapsed); 
         &findcourse_advice($r);  
         &requestcourse_advice($r);   
  $r->print('</form>');   $r->print('</form>');
         if ($countfuture) {          if ($countfuture) {
             $r->print(&mt('The following [quant,_1,role,roles] will become active in the future:',$countfuture));              $r->print(&mt('The following [quant,_1,role,roles] will become active in the future:',$countfuture));
             my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,              my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,
                                                $nochoose);                                                 $nochoose);
             &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,              &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,
                             \%roletext);                              \%roletext,$update,$then);
             my $tremark='';              my $tremark='';
             my $tbg;              my $tbg;
             if ($env{'request.role'} eq 'cm') {              if ($env{'request.role'} eq 'cm') {
Line 816  ENDSCRIPT Line 1396  ENDSCRIPT
         }          }
         $r->print(&Apache::loncommon::end_page());          $r->print(&Apache::loncommon::end_page());
  return OK;   return OK;
     } elsif ($countactive==1) { # Is there only one choice?  
         my $needs_switchserver;  
         if ($env{'user.author'}) {  
             $needs_switchserver = &check_needs_switchserver($possiblerole);  
         }  
         if ((!$needs_switchserver) && ($env{'request.role'} eq 'cm')) {  
             $r->print('<h3>'.&mt('Please stand by.').'</h3>'.  
                 '<input type="hidden" name="'.$possiblerole.'" value="1" />'.  
             '<noscript><br /><input type="submit" name="submit" value="'.&mt('Continue').'" /></noscript>');  
             $r->print("</form>\n");  
             $r->rflush();  
             $r->print('<script type="text/javascript">document.forms.rolechoice.submit();</script>');  
             $r->print(&Apache::loncommon::end_page());  
             return OK;  
         }  
         if ($needs_switchserver) {  
             $r->print("<h2>".&mt('Server Switch Required')."</h2>\n".  
                       &mt('Construction Space access is only available from '.  
                           'the home server of the corresponding Author.').'<br />'.  
                       &mt("Click the 'Switch Server' link to go there.").'<br />');  
         }  
     }      }
 # ----------------------------------------------------------------------- Table  # ----------------------------------------------------------------------- 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)) {      unless ((!&Apache::loncommon::show_course()) || ($nochoose) || ($countactive==1)) {
  $r->print("<h2>".&mt('Select a Course to Enter')."</h2>\n");   $r->print("<h2>".&mt('Select a Course to Enter')."</h2>\n");
     }      }
Line 850  ENDSCRIPT Line 1418  ENDSCRIPT
                       $env{'form.destsymb'}.'" />');                        $env{'form.destsymb'}.'" />');
         }          }
     }      }
   
     my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,$nochoose);      my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,$nochoose);
     if ($env{'environment.recentroles'}) {      if ($env{'environment.recentroles'}) {
         my %recent_roles =          my %recent_roles =
                &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});                 &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
  my $output='';   my $output='';
  foreach (sort(keys(%recent_roles))) {   foreach my $role (sort(keys(%recent_roles))) {
     if (ref($roletext{'user.role.'.$_}) eq 'ARRAY') {      if (ref($roletext{'user.role.'.$role}) eq 'ARRAY') {
  $output.= &Apache::loncommon::start_data_table_row().   $output.= &Apache::loncommon::start_data_table_row().
                           $roletext{'user.role.'.$_}->[0].                            $roletext{'user.role.'.$role}->[0].
                           &Apache::loncommon::end_data_table_row().  
                           &Apache::loncommon::continue_data_table_row().  
                           $roletext{'user.role.'.$_}->[1].  
                           &Apache::loncommon::end_data_table_row();                            &Apache::loncommon::end_data_table_row();
                 if ($_ =~ m-dc\./($match_domain)/-                   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}) {      && $dcroles{$1}) {
     $output .= &adhoc_roles_row($1,'recent');      $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) {      } elsif ($numdc > 0) {
                 unless ($_ =~/^error\:/) {                  unless ($role =~/^error\:/) {
                     $output.=&display_cc_role('user.role.'.$_);                      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) {   if ($output) {
     $r->print(&Apache::loncommon::start_data_table_empty_row()      $r->print(&Apache::loncommon::start_data_table_empty_row()
Line 884  ENDSCRIPT Line 1467  ENDSCRIPT
             $doheaders ++;              $doheaders ++;
  }   }
     }      }
       &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,\%roletext,$update,$then);
     if ($numdc > 0) {  
         $r->print(&coursepick_jscript());  
         $r->print(&Apache::loncommon::coursebrowser_javascript().  
                   &Apache::loncommon::authorbrowser_javascript());  
     }  
     &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,\%roletext);  
     if ($countactive > 1) {      if ($countactive > 1) {
         my $tremark='';          my $tremark='';
         my $tbg;          my $tbg;
Line 925  ENDSCRIPT Line 1502  ENDSCRIPT
  $r->print('<hr /><h2>'.&mt('Current Privileges').'</h2>');   $r->print('<hr /><h2>'.&mt('Current Privileges').'</h2>');
  $r->print(&privileges_info());   $r->print(&privileges_info());
     }      }
     $r->print(&Apache::lonnet::getannounce());      my $announcements = &Apache::lonnet::getannounce();
       $r->print(
           '<br />'.
           '<h2>'.&mt('Announcements').'</h2>'.
           $announcements
       ) unless (!$announcements);
     if ($advanced) {      if ($advanced) {
         my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');          my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
         $r->print('<p><small><i>'          $r->print('<p><small><i>'
                  .&mt('This LON-CAPA server is version [_1]',$r->dir_config('lonVersion'))                   .&mt('This LON-CAPA server is version [_1]',$r->dir_config('lonVersion'))
                  .'</i><br />'                   .'</i></small></p>');
                  .'<a href="/adm/logout">'.&mt('Logout').'</a>&nbsp;&nbsp;'  
                  .'<a href="/adm/coursecatalog?showdom='.$esc_dom.'">'  
                  .&mt('Course/Community Catalog')  
                  .'</a></small></p>');  
     }      }
     $r->print(&Apache::loncommon::end_page());      $r->print(&Apache::loncommon::end_page());
     return OK;      return OK;
 }  }
   
 sub gci_info_page {  sub roles_from_env {
     return <<"END";      my ($roleshash,$update) = @_;
 <h2>Welcome to the Geoscience Concept Inventory WebCenter</h2>      my $count = 0;
 <p>      if (ref($roleshash) eq 'HASH') {
 Use the tabs to navigate the WebCenter and...          foreach my $envkey (keys(%env)) {
 <ul>              if ($envkey =~ m{^user\.role\.(\w+)[./]}) {
 <li>Review and comment on existing GCI questions</li>                  next if ($1 eq 'gr');
 <li>Submit a GCI question of your own</li>                  $roleshash->{$envkey} = $env{$envkey};
 <li>Create an online test for your students</li>                  my ($start,$end) = split(/\./,$env{$envkey});
 </ul>                  unless ($end && $end<$update) {
 </p>                      $count ++;
 <p>For more information about writing and reviewing Concept Inventory questions                  }
 please refer to the <a href="/res/gci/gci/internal/pdfs/GCIWorkbook.pdf">GCI Workbook</a>.              }
           }
 END      }
       return $count;
 }  }
   
 sub gather_roles {  sub gather_roles {
     my ($then,$refresh,$now,$reinit,$nochoose,$roletext,$sortrole,$roleclass,$futureroles,$timezones) = @_;      my ($update,$refresh,$now,$reinit,$nochoose,$roles_in_env,$roletext,$sortrole,$roleclass,$futureroles,
           $timezones,$loncaparev) = @_;
     my ($countactive,$countfuture,$inrole,$possiblerole) = (0,0,0,'');      my ($countactive,$countfuture,$inrole,$possiblerole) = (0,0,0,'');
     my $advanced = $env{'user.adv'};      my $advanced = $env{'user.adv'};
     my $tryagain = $env{'form.tryagain'};      my $tryagain = $env{'form.tryagain'};
     foreach my $envkey (sort(keys(%env))) {      my @ids = &Apache::lonnet::current_machine_ids();
         my $button = 1;      if (ref($roles_in_env) eq 'HASH') {
         my $switchserver='';          my %adhocdesc;
         my ($role_text,$role_text_end,$sortkey);          foreach my $envkey (sort(keys(%{$roles_in_env}))) {
         if ($envkey=~/^user\.role\./) {              my $button = 1;
             my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);              my $switchserver='';
             &Apache::lonnet::role_status($envkey,$then,$refresh,$now,\$role,\$where,              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);                                           \$trolecode,\$tstatus,\$tstart,\$tend);
             next if (!defined($role) || $role eq '' || $role =~ /^gr/);              next if (!defined($role) || $role eq '' || $role =~ /^gr/);
             my $timezone = &role_timezone($where,$timezones);  
             $tremark='';              $tremark='';
             $tpstart='&nbsp;';              $tpstart='&nbsp;';
             $tpend='&nbsp;';              $tpend='&nbsp;';
             if ($tstart) {  
                 $tpstart=&Apache::lonlocal::locallocaltime($tstart,$timezone);  
             }  
             if ($tend) {  
                 $tpend=&Apache::lonlocal::locallocaltime($tend,$timezone);  
             }  
             if ($env{'request.role'} eq $trolecode) {              if ($env{'request.role'} eq $trolecode) {
                 $tstatus='selected';                  $tstatus='selected';
             }              }
Line 988  sub gather_roles { Line 1564  sub gather_roles {
             if (($tstatus eq 'is')              if (($tstatus eq 'is')
                 || ($tstatus eq 'selected')                  || ($tstatus eq 'selected')
                 || ($tstatus eq 'future')                  || ($tstatus eq 'future')
                 || ($env{'form.showall'})) {                  || ($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') {                  if ($tstatus eq 'is') {
                     $tbg='LC_roles_is';                      $tbg='LC_roles_is';
                     $possiblerole=$trolecode;                      $possiblerole=$trolecode;
Line 1013  sub gather_roles { Line 1596  sub gather_roles {
                 my $trole;                  my $trole;
                 if ($role =~ /^cr\//) {                  if ($role =~ /^cr\//) {
                     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);                      my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
                     if ($tremark) { $tremark.='<br />'; }                      unless ($rauthor eq $rdomain.'-domainconfig') {
                     $tremark.=&mt('Defined by [_1] at [_2].',$rauthor,$rdomain);                          if ($tremark) { $tremark.='<br />'; }
                           $tremark.=&mt('Custom role defined by [_1].',$rauthor.':'.$rdomain);
                       }
                 }                  }
                 $trole=Apache::lonnet::plaintext($role);                  $trole=Apache::lonnet::plaintext($role);
                 my $ttype;                  my $ttype;
                 my $twhere;                  my $twhere;
                   my $skipcal;
                 my ($tdom,$trest,$tsection)=                  my ($tdom,$trest,$tsection)=
                     split(/\//,Apache::lonnet::declutter($where));                      split(/\//,Apache::lonnet::declutter($where));
                 # First, Co-Authorship roles                  # First, Co-Authorship roles
                 if (($role eq 'ca') || ($role eq 'aa')) {                  if (($role eq 'ca') || ($role eq 'aa')) {
                     my $home = &Apache::lonnet::homeserver($trest,$tdom);                      my $home = &Apache::lonnet::homeserver($trest,$tdom);
                     my $allowed=0;                      my $allowed=0;
                     my @ids=&Apache::lonnet::current_machine_ids();  
                     foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }                      foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
                     if (!$allowed) {                      if (!$allowed) {
                         $button=0;                          $button=0;
                         $switchserver='otherserver='.$home.'&role='.$trolecode;                          $switchserver='otherserver='.$home.'&amp;role='.$trolecode;
                     }                      }
                     #next if ($home eq 'no_host');                      #next if ($home eq 'no_host');
                     $home = &Apache::lonnet::hostname($home);                      $home = &Apache::lonnet::hostname($home);
                     $ttype='Construction Space';                      $ttype='Authoring Space';
                     $twhere=&mt('User').': '.$trest.'<br />'.&mt('Domain').                      $twhere=&mt('User').': '.$trest.'<br />'.&mt('Domain').
                         ': '.$tdom.'<br />'.                          ': '.$tdom.'<br />'.
                         ' '.&mt('Server').':&nbsp;'.$home;                          ' '.&mt('Server').':&nbsp;'.$home;
Line 1045  sub gather_roles { Line 1630  sub gather_roles {
                     my $home = &Apache::lonnet::homeserver                      my $home = &Apache::lonnet::homeserver
                         ($env{'user.name'},$env{'user.domain'});                          ($env{'user.name'},$env{'user.domain'});
                     my $allowed=0;                      my $allowed=0;
                     my @ids=&Apache::lonnet::current_machine_ids();  
                     foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }                      foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
                     if (!$allowed) {                      if (!$allowed) {
                         $button=0;                          $button=0;
                         $switchserver='otherserver='.$home.'&role='.$trolecode;                          $switchserver='otherserver='.$home.'&amp;role='.$trolecode;
                     }                      }
                     #next if ($home eq 'no_host');                      #next if ($home eq 'no_host');
                     $home = &Apache::lonnet::hostname($home);                      $home = &Apache::lonnet::hostname($home);
                     $ttype='Construction Space';                      $ttype='Authoring Space';
                     $twhere=&mt('Domain').': '.$tdom.'<br />'.&mt('Server').                      $twhere=&mt('Domain').': '.$tdom.'<br />'.&mt('Server').
                         ':&nbsp;'.$home;                          ':&nbsp;'.$home;
                     $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';                      $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
Line 1062  sub gather_roles { Line 1646  sub gather_roles {
                 } elsif ($trest) {                  } elsif ($trest) {
                     my $tcourseid=$tdom.'_'.$trest;                      my $tcourseid=$tdom.'_'.$trest;
                     $ttype = &Apache::loncommon::course_type($tcourseid);                      $ttype = &Apache::loncommon::course_type($tcourseid);
                     $trole = &Apache::lonnet::plaintext($role,$ttype);                      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]','&nbsp;'.$rolename);
                           }
                       } else {
                           $trole = (split(/\//,$role,4))[-1];
                       }
                     if ($env{'course.'.$tcourseid.'.description'}) {                      if ($env{'course.'.$tcourseid.'.description'}) {
                           my $home=$env{'course.'.$tcourseid.'.home'};
                         $twhere=$env{'course.'.$tcourseid.'.description'};                          $twhere=$env{'course.'.$tcourseid.'.description'};
                         $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;                          $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
                           $twhere = &HTML::Entities::encode($twhere,'"<>&');
                         unless ($twhere eq &mt('Currently not available')) {                          unless ($twhere eq &mt('Currently not available')) {
                             $twhere.=' <span class="LC_fontsize_small">'.                              $twhere.=' <span class="LC_fontsize_small">'.
         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).          &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
                                     '</span>';                                      '</span>';
                               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 {                      } else {
                         my %newhash=&Apache::lonnet::coursedescription($tcourseid);                          my %newhash=&Apache::lonnet::coursedescription($tcourseid);
                         if (%newhash) {                          if (%newhash) {
                             $sortkey=$role."\0".$tdom."\0".$newhash{'description'}.                              $sortkey=$role."\0".$tdom."\0".$newhash{'description'}.
                                 "\0".$envkey;                                  "\0".$envkey;
                             $twhere=$newhash{'description'}.                              $twhere=&HTML::Entities::encode($newhash{'description'},'"<>&').
                               ' <span class="LC_fontsize_small">'.                                      ' <span class="LC_fontsize_small">'.
         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).                                       &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
                               '</span>';                                      '</span>';
                             $ttype = $newhash{'type'};                              $ttype = $newhash{'type'};
                             $trole = &Apache::lonnet::plaintext($role,$ttype);                              $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 {                          } else {
                             $twhere=&mt('Currently not available');                              $twhere=&mt('Currently not available');
                             $env{'course.'.$tcourseid.'.description'}=$twhere;                              $env{'course.'.$tcourseid.'.description'}=$twhere;
                             $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;                              $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
                             $ttype = 'Unavailable';                              $ttype = 'Unavailable';
                               $skipcal = 1;
                         }                          }
                     }                      }
                     if ($tsection) {                      if ($tsection) {
Line 1105  sub gather_roles { Line 1738  sub gather_roles {
                 ($role_text,$role_text_end) =                  ($role_text,$role_text_end) =
                     &build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,                      &build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,
                                     $advanced,$tremark,$tbg,$trole,$twhere,$tpstart,                                      $advanced,$tremark,$tbg,$trole,$twhere,$tpstart,
                                     $tpend,$nochoose,$button,$switchserver,$reinit);                                      $tpend,$nochoose,$button,$switchserver,$reinit,
                                       $switchwarning,$skipcal);
                 $roletext->{$envkey}=[$role_text,$role_text_end];                  $roletext->{$envkey}=[$role_text,$role_text_end];
                 if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}                  if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
                 $sortrole->{$sortkey}=$envkey;                  $sortrole->{$sortkey}=$envkey;
Line 1125  sub role_timezone { Line 1759  sub role_timezone {
             my $cnum = $2;              my $cnum = $2;
             if ($cdom && $cnum) {              if ($cdom && $cnum) {
                 if (!exists($timezones->{$cdom.'_'.$cnum})) {                  if (!exists($timezones->{$cdom.'_'.$cnum})) {
                     my %timehash =                      my $tz;
                         &Apache::lonnet::get('environment',['timezone'],$cdom,$cnum);                      if ($env{'course.'.$cdom.'_'.$cnum.'.description'}) {
                     if ($timehash{'timezone'} eq '') {                          $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})) {                          if (!exists($timezones->{$cdom})) {
                             my %domdefaults =                               my %domdefaults = 
                                 &Apache::lonnet::get_domain_defaults($cdom);                                  &Apache::lonnet::get_domain_defaults($cdom);
Line 1140  sub role_timezone { Line 1780  sub role_timezone {
                         $timezones->{$cdom.'_'.$cnum} = $timezones->{$cdom};                          $timezones->{$cdom.'_'.$cnum} = $timezones->{$cdom};
                     } else {                      } else {
                         $timezones->{$cdom.'_'.$cnum} =                           $timezones->{$cdom.'_'.$cnum} = 
                             &Apache::lonlocal::gettimezone($timehash{'timezone'});                              &Apache::lonlocal::gettimezone($tz);
                     }                      }
                 }                  }
                 $timezone = $timezones->{$cdom.'_'.$cnum};                  $timezone = $timezones->{$cdom.'_'.$cnum};
Line 1171  sub roletable_headers { Line 1811  sub roletable_headers {
     my $doheaders;      my $doheaders;
     if ((ref($sortrole) eq 'HASH') && (ref($roleclass) eq 'HASH')) {      if ((ref($sortrole) eq 'HASH') && (ref($roleclass) eq 'HASH')) {
         $r->print('<br />'          $r->print('<br />'
                  .&Apache::loncommon::start_data_table()                   .&Apache::loncommon::start_data_table('LC_textsize_mobile')
                  .&Apache::loncommon::start_data_table_header_row()                   .&Apache::loncommon::start_data_table_header_row()
         );          );
         if (!$nochoose) { $r->print('<th>&nbsp;</th>'); }          if (!$nochoose) { $r->print('<th>&nbsp;</th>'); }
Line 1197  sub roletable_headers { Line 1837  sub roletable_headers {
 }  }
   
 sub roletypes {  sub roletypes {
     my @types = ('Domain','Construction Space','Course','Community','Unavailable','System');      my @types = ('Domain','Authoring Space','Course','Community','Unavailable','System');
     return @types;       return @types; 
 }  }
   
 sub print_rolerows {  sub print_rolerows {
     my ($r,$doheaders,$roleclass,$sortrole,$dcroles,$roletext) = @_;      my ($r,$doheaders,$roleclass,$sortrole,$dcroles,$roletext,$update,$then) = @_;
     if ((ref($roleclass) eq 'HASH') && (ref($sortrole) eq 'HASH')) {      if ((ref($roleclass) eq 'HASH') && (ref($sortrole) eq 'HASH')) {
         my @types = &roletypes();          my @types = &roletypes();
         foreach my $type (@types) {          foreach my $type (@types) {
Line 1213  sub print_rolerows { Line 1853  sub print_rolerows {
                         if (ref($roletext->{$sortrole->{$which}}) eq 'ARRAY') {                          if (ref($roletext->{$sortrole->{$which}}) eq 'ARRAY') {
                             $output.= &Apache::loncommon::start_data_table_row().                              $output.= &Apache::loncommon::start_data_table_row().
                                       $roletext->{$sortrole->{$which}}->[0].                                        $roletext->{$sortrole->{$which}}->[0].
                                       &Apache::loncommon::end_data_table_row().  
                                       &Apache::loncommon::continue_data_table_row().  
                                       $roletext->{$sortrole->{$which}}->[1].  
                                       &Apache::loncommon::end_data_table_row();                                        &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 ($sortrole->{$which} =~ m{^user\.role\.dc\./($match_domain)/}) {
                             if (ref($dcroles) eq 'HASH') {                              if (ref($dcroles) eq 'HASH') {
                                 if ($dcroles->{$1}) {                                  if ($dcroles->{$1}) {
                                     $output .= &adhoc_roles_row($1,'');                                      $output .= &adhoc_roles_row($1,'');
                                 }                                  }
                             }                              }
                           } elsif ($sortrole->{$which} =~ m{^user\.role\.(dh|da)\./($match_domain)/}) {
                               $output .= &adhoc_customroles_row($1,$2,'',$update,$then);
                         }                          }
                     }                      }
                 }                  }
Line 1244  sub print_rolerows { Line 1888  sub print_rolerows {
 }  }
   
 sub findcourse_advice {  sub findcourse_advice {
     my ($r) = @_;      my ($r,$cattype,$elapsed) = @_;
     my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');      my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
     my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');      my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
     if (&Apache::lonnet::auto_run(undef,$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).'          $r->print('<p>'.&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).'
 <ul>  <ul>
  <li>'.&mt('The course has yet to be created.').'</li>   <li>'.&mt('The course has yet to be created.').'</li>
  <li>'.&mt('Automatic enrollment of registered students has not been enabled for the course.').'</li>   <li>'.&mt('Automatic enrollment of registered students has not been enabled for the course.').'</li>
  <li>'.&mt('You are in a section of course for which automatic enrollment in the corresponding LON-CAPA course is not active.').'</li>   <li>'.&mt('You are in a section of course for which automatic enrollment in the corresponding LON-CAPA course is not active.').'</li>
  <li>'.&mt('The start date for automated enrollment has yet to be reached.').'</li>   <li>'.&mt('The start date for automated enrollment has yet to be reached.').'</li>
  <li>'.&mt('You registered for the course recently and there is a time lag between the time you register, and the time this information becomes available for the update of LON-CAPA course rosters.').'</li>   <li>'.&mt('You registered for the course recently and there is a time lag between the time you register, and the time this information becomes available for the update of LON-CAPA course rosters.').'</li>
  </ul>');   <li>'.&mt('Automated enrollment added you to the course in the time since you last logged-in.').' '.&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.').'</li>
    </ul></p>');
     } else {      } else {
         $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.').'<br />');          $r->print('<p>'.&mt('If you were expecting to see an active role listed for a particular course, that course may not have been created yet.').'</p>');
           if ($elapsed > 600) {
               $r->print('<p>'.&mt('You may also have been assigned to a course in the time since you last logged-in, or checked for changes.').
                         '<br />'.
                         &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.').'</p>');
           }
       }
       if (($cattype eq 'std') || ($cattype eq 'domonly')) {
           $r->print('<h3>'.&mt('Self-Enrollment').'</h3>'.
                     '<p>'.&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.','<a href="/adm/coursecatalog?showdom='.$esc_dom.'">','</a>',$domdesc).'<br />');
           $r->print(&mt('You can search for courses and communities which permit self-enrollment, if you would like to enroll in one.').'</p>'.
           &Apache::loncoursequeueadmin::queued_selfenrollment());
     }      }
     $r->print('<h3>'.&mt('Self-Enrollment').'</h3>'.  
               '<p>'.&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.','<a href="/adm/coursecatalog?showdom='.$esc_dom.'">','</a>',$domdesc).'<br />');  
     $r->print(&mt('You can search for courses and communities which permit self-enrollment, if you would like to enroll in one.').'</p>');  
     &queued_selfenrollment($r);  
     return;      return;
 }  }
   
 sub requestcourse_advice {  sub requestcourse_advice {
     my ($r) = @_;      my ($r,$cattype,$inrole,$elapsed) = @_;
     my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');      my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
     my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');      my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&');
     my (%can_request,%request_doms);      my (%can_request,%request_doms,$output);
     &Apache::lonnet::check_can_request($env{'user.domain'},\%can_request,\%request_doms);      &Apache::lonnet::check_can_request($env{'user.domain'},\%can_request,\%request_doms);
     if (keys(%request_doms) > 0) {      if (keys(%request_doms) > 0) {
         my ($types,$typename) = &Apache::loncommon::course_types();          my ($types,$typename) = &Apache::loncommon::course_types();
         if ((ref($types) eq 'ARRAY') && (ref($typename) eq 'HASH')) {           if ((ref($types) eq 'ARRAY') && (ref($typename) eq 'HASH')) { 
             $r->print('<h3>'.&mt('Request creation of a course or community').'</h3>'.  
                       '<p>'.&mt('You have rights to request the creation of courses and/or communities in the following domain(s):').'<ul>');  
             my (@reqdoms,@reqtypes);              my (@reqdoms,@reqtypes);
             foreach my $type (sort(keys(%request_doms))) {              foreach my $type (sort(keys(%request_doms))) {
                 push(@reqtypes,$type);                   push(@reqtypes,$type); 
                 if (ref($request_doms{$type}) eq 'ARRAY') {                  if (ref($request_doms{$type}) eq 'ARRAY') {
                     my $domstr = join(', ',map { &Apache::lonnet::domain($_) } sort(@{$request_doms{$type}}));                      my $domstr = join(', ',map { &Apache::lonnet::domain($_) } sort(@{$request_doms{$type}}));
                     $r->print(                      $output .=
                         '<li>'                          '<li>'
                        .&mt('[_1]'.$typename->{$type}.'[_2] in domain: [_3]',                         .&mt('[_1]'.$typename->{$type}.'[_2] in domain: [_3]',
                             '<i>',                              '<i>',
                             '</i>',                              '</i>',
                             '<b>'.$domstr.'</b>')                              '<b>'.$domstr.'</b>')
                        .'</li>'                         .'</li>';
                     );  
                     foreach my $dom (@{$request_doms{$type}}) {                      foreach my $dom (@{$request_doms{$type}}) {
                         unless (grep(/^\Q$dom\E/,@reqdoms)) {                          unless (grep(/^\Q$dom\E/,@reqdoms)) {
                             push(@reqdoms,$dom);                              push(@reqdoms,$dom);
Line 1312  sub requestcourse_advice { Line 1961  sub requestcourse_advice {
             }              }
             if (@reqdoms == 1 || @showtypes > 0) {              if (@reqdoms == 1 || @showtypes > 0) {
                 $requrl .= '&state=crstype&action=new';                  $requrl .= '&state=crstype&action=new';
             }               }
             $r->print('</ul>'.&mt('Use the [_1]request form[_2] to submit a request for creation of a new course or community.','<a href="'.$requrl.'">','</a>').'</p>');              if ($output) {
         }                  $r->print('<h3>'.&mt('Request creation of a course or community').'</h3>'.
     }                            '<p>'.
     return;                            &mt('You have rights to request the creation of courses and/or communities in the following domain(s):').
 }                            '<ul>'.
                             $output.
 sub queued_selfenrollment {                            '</ul>'.
     my ($r) = @_;                            &mt('Use the [_1]request form[_2] to submit a request for creation of a new course or community.',
     my %selfenrollrequests = &Apache::lonnet::dump('selfenrollrequests');                                '<a href="'.$requrl.'">','</a>').
     my %reqs_by_date;                            '</p>');
     foreach my $item (keys(%selfenrollrequests)) {  
         if (ref($selfenrollrequests{$item}) eq 'HASH') {  
             if ($selfenrollrequests{$item}{'status'} eq 'request') {  
                 if ($selfenrollrequests{$item}{'timestamp'}) {  
                     push(@{$reqs_by_date{$selfenrollrequests{$item}{'timestamp'}}},$item);  
                 }  
             }   
         }  
     }  
     if (keys(%reqs_by_date)) {  
         my $rolename = &Apache::lonnet::plaintext('st');  
         $r->print('<b>'.&mt('Enrollment requests pending Course Coordinator approval').'</b><br />'.  
                   &Apache::loncommon::start_data_table().  
                   &Apache::loncommon::start_data_table_header_row().  
                   '<th>'.&mt('Date requested').'</th><th>'.&mt('Course title').'</th>'.  
                   '<th>'.&mt('User role').'</th><th>'.&mt('Section').'</th>'.  
                  &Apache::loncommon::end_data_table_header_row());  
         my @sorted = sort { $a <=> $b } (keys(%reqs_by_date));  
         foreach my $item (@sorted) {  
             if (ref($reqs_by_date{$item}) eq 'ARRAY') {  
                 foreach my $crs (@{$reqs_by_date{$item}}) {  
                     my %courseinfo = &Apache::lonnet::coursedescription($crs);  
                     my $usec = $selfenrollrequests{$crs}{'section'};  
                     if ($usec eq '') {  
                         $usec = &mt('No section');   
                     }  
                     $r->print(&Apache::loncommon::start_data_table_row().  
                              '<td>'.&Apache::lonlocal::locallocaltime($item).'</td>'.  
                              '<td>'.$courseinfo{'description'}.'</td>'.  
                              '<td>'.$rolename.'</td><td>'.$usec.'</td>'.  
                              &Apache::loncommon::end_data_table_row());  
                 }  
             }              }
         }          }
         $r->print(&Apache::loncommon::end_data_table());      } elsif (!$env{'user.adv'}) {
          if ($inrole) {
               $r->print('<h3>'.&mt('Currently no additional roles, courses or communities').'</h3>');
           } else {
               $r->print('<h3>'.&mt('Currently no active roles, courses or communities').'</h3>');
           }
           &findcourse_advice($r,$cattype,$elapsed);
     }      }
     return;      return;
 }  }
Line 1377  sub privileges_info { Line 2000  sub privileges_info {
  my (undef,$tdom,$trest,$tsec)=split(m{/},$where);   my (undef,$tdom,$trest,$tsec)=split(m{/},$where);
  if ($trest) {   if ($trest) {
     if ($env{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {      if ($env{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
  $ttype='Construction Space';   $ttype='Authoring Space';
  $twhere='User: '.$trest.', Domain: '.$tdom;   $twhere='User: '.$trest.', Domain: '.$tdom;
     } else {      } else {
  $ttype= &Apache::loncommon::course_type($tdom.'_'.$trest);   $ttype= &Apache::loncommon::course_type($tdom.'_'.$trest);
Line 1418  sub privileges_info { Line 2041  sub privileges_info {
 }  }
   
 sub build_roletext {  sub build_roletext {
     my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver,$reinit) = @_;      my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$trole,$twhere,
     my ($roletext,$roletext_end);          $tpstart,$tpend,$nochoose,$button,$switchserver,$reinit,$switchwarning,$skipcal) = @_;
     my $is_dc=($trolecode =~ m/^dc\./);      my ($roletext,$roletext_end,$poss_adhoc);
     my $rowspan=($is_dc) ? ''      if ($trolecode =~ m/^d(c|h|a)\./) {
           $poss_adhoc = 1;
       }
       my $rowspan=($poss_adhoc) ? ''
                          : ' rowspan="2" ';                           : ' rowspan="2" ';
   
     unless ($nochoose) {      unless ($nochoose) {
Line 1436  sub build_roletext { Line 2062  sub build_roletext {
             } else {              } else {
                 $roletext.=('<td'.$rowspan.' class="'.$tbg.'">&nbsp;</td>');                  $roletext.=('<td'.$rowspan.' class="'.$tbg.'">&nbsp;</td>');
             }              }
               if ($switchwarning) {
                   if ($tremark eq '') {
                       $tremark = $switchwarning;
                   } else {
                       $tremark .= '<br />'.$switchwarning;
                   }
               }
         } elsif ($tstatus eq 'is') {          } elsif ($tstatus eq 'is') {
             $roletext.='<td'.$rowspan.' class="'.$tbg.'">'.              $roletext.='<td'.$rowspan.' class="'.$tbg.'">'.
                         '<input name="'.$buttonname.'" type="button" value="'.                          '<input name="'.$buttonname.'" type="button" value="'.
Line 1467  sub build_roletext { Line 2100  sub build_roletext {
                         $trolecode."','".$buttonname.'\');" /></td>';                          $trolecode."','".$buttonname.'\');" /></td>';
         }          }
     }      }
     if ($trolecode !~ m/^(dc|ca|au|aa)\./) {      if (($trolecode !~ m/^(dc|ca|au|aa)\./) && (!$skipcal)) {
  $tremark.=&Apache::lonannounce::showday(time,1,   $tremark.=&Apache::lonannounce::showday(time,1,
  &Apache::lonannounce::readcalendar($tdom.'_'.$trest));   &Apache::lonannounce::readcalendar($tdom.'_'.$trest));
     }      }
Line 1475  sub build_roletext { Line 2108  sub build_roletext {
               .'<td>'.$twhere.'</td>'                .'<td>'.$twhere.'</td>'
               .'<td>'.$tpstart.'</td>'                .'<td>'.$tpstart.'</td>'
               .'<td>'.$tpend.'</td>';                .'<td>'.$tpend.'</td>';
     if (!$is_dc) {      unless ($poss_adhoc) {
         $roletext_end = '<td colspan="4">'.          $roletext_end = '<td colspan="4">'.
                         $tremark.'&nbsp;'.                          $tremark.'&nbsp;'.
                         '</td>';                          '</td>';
Line 1483  sub build_roletext { Line 2116  sub build_roletext {
     return ($roletext,$roletext_end);      return ($roletext,$roletext_end);
 }  }
   
 sub check_needs_switchserver {  
     my ($possiblerole) = @_;  
     my $needs_switchserver;  
     my ($role,$where) = split(/\./,$possiblerole,2);  
     my (undef,$tdom,$twho) = split(/\//,$where);  
     my ($server_status,$home);  
     if (($role eq 'ca') || ($role eq 'aa')) {  
         ($server_status,$home) = &check_author_homeserver($twho,$tdom);  
     } else {  
         ($server_status,$home) = &check_author_homeserver($env{'user.name'},  
                                                           $env{'user.domain'});  
     }  
     if ($server_status eq 'switchserver') {  
         $needs_switchserver = 1;  
     }  
     return $needs_switchserver;  
 }  
   
 sub check_author_homeserver {  sub check_author_homeserver {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     if (($uname eq '') || ($udom eq '')) {      if (($uname eq '') || ($udom eq '')) {
Line 1518  sub check_author_homeserver { Line 2133  sub check_author_homeserver {
     }      }
 }  }
   
 sub check_fordc {  sub check_for_adhoc {
     my ($dcroles,$then) = @_;      my ($dcroles,$helpdeskroles,$update,$then) = @_;
     my $numdc = 0;      my $numdc = 0;
     if ($env{'user.adv'}) {      my $numhelpdesk = 0;
         foreach my $envkey (sort keys %env) {      my $numadhoc = 0;
             if ($envkey=~/^user\.role\.dc\.\/($match_domain)\/$/) {      my $num_custom_adhoc = 0;
                 my $dcdom = $1;      if (($env{'user.adv'}) || ($env{'user.rar'})) {
                 my $livedc = 1;          foreach my $envkey (sort(keys(%env))) {
               if ($envkey=~/^user\.role\.(dc|dh|da)\.\/($match_domain)\/$/) {
                   my $role = $1;
                   my $roledom = $2;
                   my $liverole = 1;
                 my ($tstart,$tend)=split(/\./,$env{$envkey});                  my ($tstart,$tend)=split(/\./,$env{$envkey});
                 if ($tstart && $tstart>$then) { $livedc = 0; }                  my $limit = $update;
                 if ($tend   && $tend  <$then) { $livedc = 0; }                  if ($env{'request.role'} eq "$role./$roledom/") {
                 if ($livedc) {                      $limit = $then;
                     $$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 {
                           $helpdeskroles->{$roledom} = $envkey;
                           my %domdefaults = &Apache::lonnet::get_domain_defaults($roledom);
                           if (ref($domdefaults{'adhocroles'}) eq 'HASH') {
                               if (keys(%{$domdefaults{'adhocroles'}})) {
                                   $numadhoc ++;
                               }
                           }
                           $numhelpdesk++;
                       }
                 }                  }
             }              }
         }          }
     }      }
     return $numdc;      return ($numdc,$numhelpdesk,$numadhoc);
 }  }
   
 sub adhoc_course_role {  sub adhoc_course_role {
     my ($refresh,$then) = @_;      my ($refresh,$update,$then) = @_;
     my ($cdom,$cnum,$crstype);      my ($cdom,$cnum,$crstype);
     $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};      $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};      $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
     $crstype = &Apache::loncommon::course_type();      $crstype = &Apache::loncommon::course_type();
     if (&check_forcc($cdom,$cnum,$refresh,$then,$crstype)) {      if (&check_forcc($cdom,$cnum,$refresh,$update,$then,$crstype)) {
         my $setprivs;          my $setprivs;
         if (!defined($env{'user.role.'.$env{'form.switchrole'}})) {          if (!defined($env{'user.role.'.$env{'form.switchrole'}})) {
             $setprivs = 1;              $setprivs = 1;
         } else {          } else {
             my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}});              my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}});
             if (($start && ($start>$refresh || $start == -1)) ||              if (($start && ($start>$refresh || $start == -1)) ||
                 ($end && $end<$then)) {                  ($end && $end<$update)) {
                   $setprivs = 1;
               }
           }
           unless ($setprivs) {
               if (!exists($env{'user.priv.'.$env{'form.switchrole'}.'./'})) {
                 $setprivs = 1;                  $setprivs = 1;
             }              }
         }          }
         if ($setprivs) {          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 $role = $1;
                 my $custom_role = $2;                  my $custom_role = $2;
                 my $usec = $3;                  my $usec = $3;
Line 1572  sub adhoc_course_role { Line 2211  sub adhoc_course_role {
                 my %cgroups =                  my %cgroups =
                     &Apache::lonnet::get_active_groups($env{'user.domain'},                      &Apache::lonnet::get_active_groups($env{'user.domain'},
                                             $env{'user.name'},$cdom,$cnum);                                              $env{'user.name'},$cdom,$cnum);
                   my $ccrole;
                   if ($crstype eq 'Community') {
                       $ccrole = 'co';
                   } else {
                       $ccrole = 'cc';
                   }
                 foreach my $group (keys(%cgroups)) {                  foreach my $group (keys(%cgroups)) {
                     $group_privs{$group} =                      $group_privs{$group} =
                         $env{'user.priv.cc./'.$cdom.'/'.$cnum.'./'.$cdom.'/'.$cnum.'/'.$group};                          $env{'user.priv.'.$ccrole.'./'.$cdom.'/'.$cnum.'./'.$cdom.'/'.$cnum.'/'.$group};
                 }                  }
                 $newgroups{'/'.$cdom.'/'.$cnum} = \%group_privs;                  $newgroups{'/'.$cdom.'/'.$cnum} = \%group_privs;
                 my $area = '/'.$cdom.'/'.$cnum;                  my $area = '/'.$cdom.'/'.$cnum;
Line 1583  sub adhoc_course_role { Line 2228  sub adhoc_course_role {
                     $spec .= '/'.$usec;                      $spec .= '/'.$usec;
                     $area .= '/'.$usec;                      $area .= '/'.$usec;
                 }                  }
                 &Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,$area);                  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);                  &Apache::lonnet::set_userprivs(\%userroles,\%newrole,\%newgroups);
                 my $adhocstart = $refresh-1;                  my $adhocstart = $refresh-1;
                 $userroles{'user.role.'.$spec} = $adhocstart.'.';                  $userroles{'user.role.'.$spec} = $adhocstart.'.';
Line 1595  sub adhoc_course_role { Line 2244  sub adhoc_course_role {
 }  }
   
 sub check_forcc {  sub check_forcc {
     my ($cdom,$cnum,$refresh,$then,$crstype) = @_;      my ($cdom,$cnum,$refresh,$update,$then,$crstype) = @_;
     my ($is_cc,$ccrole);      my ($is_cc,$ccrole);
     if ($crstype eq 'Community') {      if ($crstype eq 'Community') {
         $ccrole = 'co';          $ccrole = 'co';
     } else {      } else {
         $ccrole = 'cc';          $ccrole = 'cc';
     }      }
     if ($cdom ne '' && $cnum ne '') {      if (&Apache::lonnet::is_course($cdom,$cnum)) {
         if (&Apache::lonnet::is_course($cdom,$cnum)) {          my $envkey = 'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum;
             my $envkey = 'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum;          if (defined($env{$envkey})) {
             if (defined($env{$envkey})) {              $is_cc = 1;
                 $is_cc = 1;              my ($tstart,$tend)=split(/\./,$env{$envkey});
                 my ($tstart,$tend)=split(/\./,$env{$envkey});              my $limit = $update;
                 if ($tstart && $tstart>$refresh) { $is_cc = 0; }              if ($env{'request.role'} eq $ccrole.'./'.$cdom.'/'.$cnum) {
                 if ($tend   && $tend  <$then) { $is_cc = 0; }                  $limit = $then;
             }              }
               if ($tstart && $tstart>$refresh) { $is_cc = 0; }
               if ($tend   && $tend  <$limit) { $is_cc = 0; }
         }          }
     }      }
     return $is_cc;      return $is_cc;
 }  }
   
 sub courselink {  sub courselink {
     my ($dcdom,$rowtype) = @_;      my ($roledom,$rowtype,$role) = @_;
     my $courseform=&Apache::loncommon::selectcourse_link      my $courseform=&Apache::loncommon::selectcourse_link
                    ('rolechoice','dccourse'.$rowtype.'_'.$dcdom,                     ('rolechoice','course'.$rowtype.'_'.$roledom.'_'.$role,
                     'dcdomain'.$rowtype.'_'.$dcdom,'coursedesc'.$rowtype.'_'.                      'domain'.$rowtype.'_'.$roledom.'_'.$role,
                     $dcdom,$dcdom,undef,'Course/Community');                      'coursedesc'.$rowtype.'_'.$roledom.'_'.$role,
     my $hiddenitems = '<input type="hidden" name="dcdomain'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'.                      $roledom.':'.$role,undef,'Course/Community');
                       '<input type="hidden" name="origdom'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'.      my $hiddenitems = '<input type="hidden" name="domain'.$rowtype.'_'.$roledom.'_'.$role.'" value="'.$roledom.'" />'.
                       '<input type="hidden" name="dccourse'.$rowtype.'_'.$dcdom.'" value="" />'.                        '<input type="hidden" name="origdom'.$rowtype.'_'.$roledom.'_'.$role.'" value="'.$roledom.'" />'.
                       '<input type="hidden" name="coursedesc'.$rowtype.'_'.$dcdom.'" value="" />';                        '<input type="hidden" name="course'.$rowtype.'_'.$roledom.'_'.$role.'" value="" />'.
                         '<input type="hidden" name="coursedesc'.$rowtype.'_'.$roledom.'_'.$role.'" value="" />';
     return $courseform.$hiddenitems;      return $courseform.$hiddenitems;
 }  }
   
 sub coursepick_jscript {  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.",                    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.',                    youc => 'You can only use this screen to select courses and communities in the current domain.',
              );               );
       &js_escape(\%js_lt);
     my $verify_script = <<"END";      my $verify_script = <<"END";
 <script type="text/javascript">  <script type="text/javascript">
 // <![CDATA[  // <![CDATA[
Line 1650  function verifyCoursePick(caller) { Line 2303  function verifyCoursePick(caller) {
             }              }
         }          }
         else {          else {
             alert("$lt{'plsu'}");              alert("$js_lt{'plsu'}");
         }          }
     }      }
     else {      else {
         alert("$lt{'youc'}")          alert("$js_lt{'youc'}")
     }      }
 }  }
 function getIndex(caller) {  function getIndex(caller) {
Line 1686  sub display_cc_role { Line 2339  sub display_cc_role {
     unless ($rolekey =~/^error\:/) {      unless ($rolekey =~/^error\:/) {
         if ($rolekey =~ m{^user\.role\.(cc|co)\./($match_domain)/($match_courseid)$}) {          if ($rolekey =~ m{^user\.role\.(cc|co)\./($match_domain)/($match_courseid)$}) {
             my $ccrole = $1;              my $ccrole = $1;
             my $tcourseid = $2.'_'.$3;              my $tdom = $2;
             my $trolecode = $1.'./'.$2.'/'.$3;              my $trest = $3;
               my $tcourseid = $tdom.'_'.$trest;
               my $trolecode = $ccrole.'./'.$tdom.'/'.$trest;
             my $twhere;              my $twhere;
             my $ttype;              my $ttype;
               my $skipcal;
             my $tbg='LC_roles_is';              my $tbg='LC_roles_is';
             my %newhash=&Apache::lonnet::coursedescription($tcourseid);              my %newhash=&Apache::lonnet::coursedescription($tcourseid);
             if (%newhash) {              if (%newhash) {
                 $twhere=$newhash{'description'}.                  $twhere=$newhash{'description'}.
                         ' <span style="LC_fontsize_small">'.                          ' <span class="LC_fontsize_small">'.
                         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$2,$1).                          &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
                         '</span>';                          '</span>';
                 $ttype = $newhash{'type'};                  $ttype = $newhash{'type'};
             } else {              } else {
                 $twhere=&mt('Currently not available');                  $twhere=&mt('Currently not available');
                 $env{'course.'.$tcourseid.'.description'}=$twhere;                  $env{'course.'.$tcourseid.'.description'}=$twhere;
                   $skipcal = 1; 
             }              }
             my $trole = &Apache::lonnet::plaintext($ccrole,$ttype);              my $trole = &Apache::lonnet::plaintext($ccrole,$ttype,$tcourseid);
             $twhere.="<br />".&mt('Domain').":".$1;              $twhere.="<br />".&mt('Domain').":".$tdom;
             ($roletext,$roletext_end) = &build_roletext($trolecode,$1,$2,'is',$tryagain,$advanced,'',$tbg,$trole,$twhere,'','','',1,'');              ($roletext,$roletext_end) = &build_roletext($trolecode,$tdom,$trest,'is',$tryagain,$advanced,'',$tbg,$trole,$twhere,'','','',1,'','','',$skipcal);
           }
       }
       return ($roletext,$roletext_end);
   }
   
   sub display_curr_role {
       my ($currentrole) = @_;
       my ($roletext,$roletext_end);
       my $advanced = $env{'user.adv'};
       my $tryagain = $env{'form.tryagain'};
       my ($role,$rest) = split(m{\./},$currentrole,2);
       unless (!defined($role) || $role eq '') {
           if ($rest =~ m{^($match_domain)/($match_courseid)(?:/(\w+)|$)}) {
               my $cdom = $1;
               my $cnum = $2;
               my $csec = $3;
               my $cid = $cdom.'_'.$cnum;
               my $ttype = $env{'course.'.$cid.'.type'};
               my $skipcal = 1;
               my $tbg='LC_roles_is';
               my $twhere = $env{'course.'.$cid.'.description'}.
                           ' <span class="LC_fontsize_small">'.
                           &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$cnum,$cdom).
                           '</span>';
               my $trole = &Apache::lonnet::plaintext($role,$ttype,$cid);
               if ($csec) {
                   $twhere.= '&nbsp; '.&mt('Section').':&nbsp;'.$csec;
               }
               if ($role ne 'st') {
                   $twhere.= '&nbsp; '.&mt('Domain').':&nbsp;'.$cdom;
               }
               ($roletext,$roletext_end) = &build_roletext($currentrole,$cdom,$cnum,'is',$tryagain,$advanced,'',$tbg,$trole,$twhere,'','','',1,'','','',$skipcal);
         }          }
     }      }
     return ($roletext,$roletext_end);      return ($roletext,$roletext_end);
Line 1713  sub display_cc_role { Line 2402  sub display_cc_role {
 sub adhoc_roles_row {  sub adhoc_roles_row {
     my ($dcdom,$rowtype) = @_;      my ($dcdom,$rowtype) = @_;
     my $output = &Apache::loncommon::continue_data_table_row()      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] --'                   .&mt('[_1]Ad hoc[_2] roles in domain [_3]'
                      ,'<span class="LC_cusr_emph">','</span>',$dcdom)                       ,'<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 $ccrole = &Apache::lonnet::plaintext('co',undef,undef,1);
     my $carole = &Apache::lonnet::plaintext('ca');      my $carole = &Apache::lonnet::plaintext('ca');
     my $selectcalink = &coauthorlink($dcdom,$rowtype);      my $selectcalink = &coauthorlink($dcdom,$rowtype);
     $output.=$ccrole.': '.$selectcclink      $output.=$ccrole.': '.$selectcclink
             .' | '.$carole.': '.$selectcalink              .' | '.$carole.': '.$selectcalink.'</td>'
             .&Apache::loncommon::end_data_table_row();              .&Apache::loncommon::end_data_table_row();
     return $output;      return $output;
 }  }
   
   sub adhoc_customroles_row {
       my ($role,$dhdom,$rowtype,$update,$then) = @_;
       my $liverole = 1;
       my ($tstart,$tend)=split(/\./,$env{"user.role.$role./$dhdom/"});
       my $limit = $update;
       if (($role eq 'dh') && ($env{'request.role'} eq 'dh./'.$dhdom.'/')) {
           $limit = $then;
       }
       if ($tstart && $tstart>$limit) { $liverole = 0; }
       if ($tend   && $tend  <$limit) { $liverole = 0; }
       return unless ($liverole);
       my %domdefaults = &Apache::lonnet::get_domain_defaults($dhdom);
       if (ref($domdefaults{'adhocroles'}) eq 'HASH') {
           if (scalar(keys(%{$domdefaults{'adhocroles'}})) > 0) {
               return &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)
                     .' -- '.&courselink($dhdom,$rowtype,$role);
           }
       }
       return;
   }
   
 sub recent_filename {  sub recent_filename {
     my $area=shift;      my $area=shift;
     return 'nohist_recent_'.&escape($area);      return 'nohist_recent_'.&escape($area);
Line 1749  sub courseloadpage { Line 2463  sub courseloadpage {
     return $startpage;      return $startpage;
 }  }
   
   sub update_session_roles {
       my $then=$env{'user.login.time'};
       my $refresh=$env{'user.refresh.time'};
       if (!$refresh) {
           $refresh = $then;
       }
       my $update = $env{'user.update.time'};
       if (!$update) {
           $update = $then;
       }
       my $now = time;
       my %roleshash =
           &Apache::lonnet::get_my_roles('','','userroles',
                                         ['active','future','previous'],
                                         undef,undef,1);
       my ($msg,@newsec,$oldsec,$currrole_expired,@changed_roles,
           %changed_groups,%dbroles,%deletedroles,%allroles,%allgroups,
           %userroles,%checkedgroup,%crprivs,$hasgroups,%rolechange,
           %groupchange,%newrole,%newgroup,%customprivchg,%groups_roles,
           @rolecodes);
       my @possroles = ('cr','st','ta','ad','ep','in','co','cc');
       my %courseroles;
       foreach my $item (keys(%roleshash)) {
           my ($uname,$udom,$role,$remainder) = split(/:/,$item,4);
           my ($tstart,$tend) = split(/:/,$roleshash{$item});
           my ($section,$group,@group_privs);
           if ($role =~ m{^gr/(\w*)$}) {
               $role = 'gr';
               my $priv = $1;
               next if ($tstart eq '-1');
               if (&curr_role_status($tstart,$tend,$refresh,$now) eq 'active') {
                   if ($priv ne '') {
                       push(@group_privs,$priv);
                   }
               }
               if ($remainder =~ /:/) {
                   (my $additional_privs,$group) =
                       ($remainder =~ /^([\w:]+):([^:]+)$/);
                   if ($additional_privs ne '') {
                       if (&curr_role_status($tstart,$tend,$refresh,$now) eq 'active') {
                           push(@group_privs,split(/:/,$additional_privs));
                           @group_privs = sort(@group_privs);
                       }
                   }
               } else {
                   $group = $remainder;
               }
           } else {
               $section = $remainder;
           }
           my $where = "/$udom/$uname";
           if ($section ne '') {
               $where .= "/$section";
           } elsif ($group ne '') {
               $where .= "/$group";
           }
           my $rolekey = "$role.$where";
           my $envkey = "user.role.$rolekey";
           $dbroles{$envkey} = 1;
           if (($env{'request.role'} eq $rolekey) && ($role ne 'st')) {
               if (&curr_role_status($tstart,$tend,$refresh,$now) ne 'active') {
                   $currrole_expired = 1;
               }
           }
           if ($env{$envkey} eq '') {
               my $status_in_db =
                   &curr_role_status($tstart,$tend,$now,$now);
                   &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
               if (($role eq 'st') && ($env{'request.role'} =~ m{^\Q$role\E\.\Q/$udom/$uname\E})) {
                   if ($status_in_db eq 'active') {
                       if ($section eq '') {
                           push(@newsec,'none');
                       } else {
                           push(@newsec,$section);
                       }
                   }
               } else {
                   unless (grep(/^\Q$role\E$/,@changed_roles)) {
                       push(@changed_roles,$role);
                   }
                   if ($status_in_db ne 'previous') {
                       if ($role eq 'gr') {
                           $newgroup{$rolekey} = $status_in_db;
                           if ($status_in_db eq 'active') {
                               unless (ref($courseroles{$udom}) eq 'HASH') {
                                   %{$courseroles{$udom}} =
                                       &Apache::lonnet::get_my_roles('','','userroles',
                                                                     ['active'],\@possroles,
                                                                     [$udom],1);
                               }
                               &Apache::lonnet::get_groups_roles($udom,$uname,
                                                                 $courseroles{$udom},
                                                                 \@rolecodes,\%groups_roles);
                           }
                       } else {
                           $newrole{$rolekey} = $status_in_db;
                       }
                   }
               }
           } else {
               my ($currstart,$currend) = split(/\./,$env{$envkey});
               if ($role eq 'gr') {
                   if (&curr_role_status($currstart,$currend,$refresh,$update) ne 'previous') {
                       $hasgroups = 1;
                   }
               }
               if (($currstart ne $tstart) || ($currend ne $tend)) {
                   my $status_in_env =
                       &curr_role_status($currstart,$currend,$refresh,$update);
                   my $status_in_db =
                       &curr_role_status($tstart,$tend,$now,$now);
                   if ($status_in_env ne $status_in_db) {
                       if ($status_in_env eq 'active') {
                           if ($role eq 'st') {
                               if ($env{'request.role'} eq $rolekey) {
                                   my $switchsection;
                                   unless (ref($courseroles{$udom}) eq 'HASH') {
                                       %{$courseroles{$udom}} =
                                           &Apache::lonnet::get_my_roles('','','userroles',
                                                                         ['active'],
                                                                         \@possroles,[$udom],1);
                                   }
                                   foreach my $crsrole (keys(%{$courseroles{$udom}})) {
                                       if ($crsrole =~ /^\Q$uname\E:\Q$udom\E:st/) {
                                           $switchsection = 1;
                                           last;
                                       }
                                   }
                                   if ($switchsection) {
                                       if ($section eq '') {
                                           $oldsec = 'none';
                                       } else {
                                           $oldsec = $section;
                                       }
                                       &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
                                   } else {
                                       $currrole_expired = 1;
                                       next;
                                   }
                               }
                           }
                           unless ($rolekey eq $env{'request.role'}) {
                               if ($role eq 'gr') {
                                   &Apache::lonnet::delete_env_groupprivs($where,\%courseroles,\@possroles);
                               } else {
                                   &Apache::lonnet::delenv("user.priv.$rolekey",undef,[$role]);
                                   &Apache::lonnet::delenv("user.priv.cm.$where",undef,['cm']);
                               }
                               &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
                           }
                       } elsif ($status_in_db eq 'active') {
                           if (($role eq 'st') &&
                               ($env{'request.role'} =~ m{^\Q$role\E\.\Q/$udom/$uname\E})) {
                               if ($section eq '') {
                                   push(@newsec,'none');
                               } else {
                                   push(@newsec,$section);
                               }
                           } elsif ($role eq 'gr') {
                               unless (ref($courseroles{$udom}) eq 'HASH') {
                                   %{$courseroles{$udom}} =
                                       &Apache::lonnet::get_my_roles('','','userroles',
                                                                     ['active'],
                                                                     \@possroles,[$udom],1);
                               }
                               &Apache::lonnet::get_groups_roles($udom,$uname,
                                                                 $courseroles{$udom},
                                                                 \@rolecodes,\%groups_roles);
                           }
                           &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
                       }
                       unless (grep(/^\Q$role\E$/,@changed_roles)) {
                           push(@changed_roles,$role);
                       }
                       if ($role eq 'gr') {
                           $groupchange{"/$udom/$uname"}{$group} = $status_in_db;
                       } else {
                           $rolechange{$rolekey} = $status_in_db;
                       }
                   }
               } else {
                   if ($role eq 'gr') {
                       unless ($checkedgroup{$where}) {
                           my $status_in_db =
                               &curr_role_status($tstart,$tend,$refresh,$now);
                           if ($tstart eq '-1') {
                               $status_in_db = 'deleted';
                           }
                           unless (ref($courseroles{$udom}) eq 'HASH') {
                               %{$courseroles{$udom}} =
                                   &Apache::lonnet::get_my_roles('','','userroles',
                                                                 ['active'],
                                                                 \@possroles,[$udom],1);
                           }
                           if (ref($courseroles{$udom}) eq 'HASH') {
                               foreach my $item (keys(%{$courseroles{$udom}})) {
                                   next unless ($item =~ /^\Q$uname\E/);
                                   my ($cnum,$cdom,$crsrole,$crssec) = split(/:/,$item);
                                   my $area = '/'.$cdom.'/'.$cnum;
                                   if ($crssec ne '') {
                                       $area .= '/'.$crssec;
                                   }
                                   my $crsrolekey = $crsrole.'.'.$area;
                                   my $currprivs = $env{'user.priv.'.$crsrole.'.'.$area.'.'.$where};
                                   $currprivs =~ s/^://;
                                   $currprivs =~ s/\&F$//;
                                   my @curr_grp_privs = split(/\&F:/,$currprivs);
                                   @curr_grp_privs = sort(@curr_grp_privs);
                                   my @diffs;
                                   if (@group_privs > 0 || @curr_grp_privs > 0) {
                                       @diffs = &Apache::loncommon::compare_arrays(\@group_privs,\@curr_grp_privs);
                                   }
                                   if (@diffs == 0) {
                                       last;
                                   } else {
                                       unless(grep(/^\Qgr\E$/,@rolecodes)) {
                                           push(@rolecodes,'gr');
                                       }
                                       &gather_roleprivs(\%allroles,\%allgroups,
                                                         \%userroles,$where,$role,
                                                         $tstart,$tend,$status_in_db);
                                       if ($status_in_db eq 'active') {
                                           &Apache::lonnet::get_groups_roles($udom,$uname,
                                                                             $courseroles{$udom},
                                                                             \@rolecodes,\%groups_roles);
                                       }
                                       $changed_groups{$udom.'_'.$uname}{$group} = $status_in_db;
                                       last;
                                   }
                               }
                           }
                           $checkedgroup{$where} = 1;
                       }
                   } elsif ($role =~ /^cr/) {
                       my $status_in_db =
                           &curr_role_status($tstart,$tend,$refresh,$now);
                       my ($rdummy,$rest) = split(/\//,$role,2);
                       my %currpriv;
                       unless (exists($crprivs{$rest})) {
                           my ($rdomain,$rauthor,$rrole)=split(/\//,$rest);
                           my $homsvr=&Apache::lonnet::homeserver($rauthor,$rdomain);
                           if (&Apache::lonnet::hostname($homsvr) ne '') {
                               my ($rdummy,$roledef)=
                               &Apache::lonnet::get('roles',["rolesdef_$rrole"],
                                                    $rdomain,$rauthor);
                               if (($rdummy ne 'con_lost') && ($roledef ne '')) {
                                   my $i = 0;
                                   my @scopes = ('sys','dom','crs');
                                   my @privs = split(/\_/,$roledef);
                                   foreach my $priv (@privs) {
                                       my ($blank,@prv) = split(/:/,$priv);
                                       @prv = map { $_ .= (/\&\w+$/ ? '':'&F') } @prv;
                                       if (@prv) {
                                           $priv = ':'.join(':',sort(@prv));
                                       }
                                       $crprivs{$rest}{$scopes[$i]} = $priv;
                                       $i++;
                                   }
                               }
                           }
                       }
                       my $status_in_env =
                           &curr_role_status($currstart,$currend,$refresh,$update);
                       if ($status_in_env eq 'active') {
                           $currpriv{sys} = $env{"user.priv.$rolekey./"};
                           $currpriv{dom} = $env{"user.priv.$rolekey./$udom/"};
                           $currpriv{crs} = $env{"user.priv.$rolekey.$where"};
                           if (keys(%crprivs)) {
                               if (($crprivs{$rest}{sys} ne $currpriv{sys}) ||
                                   ($crprivs{$rest}{dom} ne $currpriv{dom})
    ||
                                   ($crprivs{$rest}{crs} ne $currpriv{crs})) {
                                   &gather_roleprivs(\%allroles,\%allgroups,
                                                     \%userroles,$where,$role,
                                                     $tstart,$tend,$status_in_db);
                                   unless (grep(/^\Q$role\E$/,@changed_roles)) {
                                       push(@changed_roles,$role);
                                   }
                                   $customprivchg{$rolekey} = $status_in_env;
                               }
                           }
                       }
                   }
               }
           }
       }
       foreach my $envkey (keys(%env)) {
           next unless ($envkey =~ /^user\.role\./);
           next if ($dbroles{$envkey});
           next if ($envkey eq 'user.role.'.$env{'request.role'});
           my ($currstart,$currend) = split(/\./,$env{$envkey});
           my $status_in_env =
               &curr_role_status($currstart,$currend,$refresh,$update);
           my ($rolekey) = ($envkey =~ /^user\.role\.(.+)$/);
           my ($role,$rest)=split(m{\./},$rolekey,2);
           $rest = '/'.$rest; 
           if (&Apache::lonnet::delenv($envkey,undef,[$role])) {
               if ($status_in_env eq 'active') {
                   if ($role eq 'gr') {
                       &Apache::lonnet::delete_env_groupprivs($rest,\%courseroles,
                                                              \@possroles);
                   } else {
                       &Apache::lonnet::delenv("user.priv.$rolekey",undef,[$role]);
                       &Apache::lonnet::delenv("user.priv.cm.$rest",undef,['cm']);
                   }
                   unless (grep(/^\Q$role\E$/,@changed_roles)) {
                       push(@changed_roles,$role);
                   }
                   $deletedroles{$rolekey} = 1;
               }
           }
       }
       if (($oldsec) && (@newsec > 0)) {
           if (@newsec > 1) {
               $msg = '<p class="LC_warning">'.&mt('The section has changed for your current role. Log-out and log-in again to select a role for the new section.').'</p>';
           } 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 = '<p><form name="reselectrole" action="/adm/roles" method="post" />'.
                      '<input type="hidden" name="newrole" value="" />'.
                      '<input type="hidden" name="selectrole" value="1" />'.
                      '<span class="LC_info">'.
                      &mt('Your section has changed for your current [_1] role in [_2].',$rolename,$coursedesc).'</span><br />';
               my $button = '<input type="button" name="sectionchanged" value="'.
                            &mt('Re-Select').'" onclick="javascript:enterrole(this.form,'."'$newrole','sectionchanged'".')" />';
               if ($newsec[0] eq 'none') {
                   $msg .= &mt('[_1] to continue with your new section-less role.',$button);
               } else {
                   $msg .= &mt('[_1] to continue with your new role in section ([_2]).',$button,$newsec[0]);
               }
               $msg .= '</form></p>';
           }
       } elsif ($currrole_expired) {
           $msg .= '<p class="LC_warning">';
           if (&Apache::loncommon::show_course()) {
               $msg .= &mt('Your role in the current course has expired.');
           } else {
               $msg .= &mt('Your current role has expired.');
           }
           $msg .= '<br />'.&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.').'</p>';
       }
       &Apache::lonnet::set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles);
       my ($curr_is_adv,$curr_role_adv,$curr_author,$curr_role_author);
       $curr_author = $env{'user.author'};
       if (($env{'request.role'} =~/^au/) || ($env{'request.role'} =~/^ca/) ||
           ($env{'request.role'} =~/^aa/)) {
           $curr_role_author=1;
       }
       $curr_is_adv = $env{'user.adv'};
       $curr_role_adv = $env{'request.role.adv'};
       if (keys(%userroles) > 0) {
           foreach my $role (@changed_roles) {
               unless(grep(/^\Q$role\E$/,@rolecodes)) {
                   push(@rolecodes,$role);
               }
           }
           unless(grep(/^\Qcm\E$/,@rolecodes)) {
               push(@rolecodes,'cm');
           }
           &Apache::lonnet::appenv(\%userroles,\@rolecodes);
       }
       my %newenv;
       if (&Apache::lonnet::is_advanced_user($env{'user.domain'},$env{'user.name'})) {
           unless ($curr_is_adv) {
               $newenv{'user.adv'} = 1;
           }
       } elsif ($curr_is_adv && !$curr_role_adv) {
           &Apache::lonnet::delenv('user.adv');
       }
       my %authorroleshash =
           &Apache::lonnet::get_my_roles('','','userroles',['active'],['au','ca','aa']);
       if (keys(%authorroleshash)) {
           unless ($curr_author) {
               $newenv{'user.author'} = 1;
           }
       } elsif ($curr_author && !$curr_role_author) {
           &Apache::lonnet::delenv('user.author');
       }
       if ($env{'request.course.id'}) {
           my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
           my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
           my (@activecrsgroups,$crsgroupschanged);
           if ($env{'request.course.groups'}) {
               @activecrsgroups = split(/:/,$env{'request.course.groups'});
               foreach my $item (keys(%deletedroles)) {
                   if ($item =~ m{^gr\./\Q$cdom\E/\Q$cnum\E/(\w+)$}) {
                       if (grep(/^\Q$1\E$/,@activecrsgroups)) {
                           $crsgroupschanged = 1;
                           last;
                       }
                   }
               }
           }
           unless ($crsgroupschanged) {
               foreach my $item (keys(%newgroup)) {
                   if ($item =~ m{^gr\./\Q$cdom\E/\Q$cnum\E/(\w+)$}) {
                       if ($newgroup{$item} eq 'active') {
                           $crsgroupschanged = 1;
                           last;
                       }
                   }
               }
           }
           if ((ref($changed_groups{$env{'request.course.id'}}) eq 'HASH') ||
               (ref($groupchange{"/$cdom/$cnum"}) eq 'HASH') ||
               ($crsgroupschanged)) {
               my %grouproles =  &Apache::lonnet::get_my_roles('','','userroles',
                                                               ['active'],['gr'],[$cdom],1);
               my @activegroups;
               foreach my $item (keys(%grouproles)) {
                   next unless($item =~ /^\Q$cnum\E:\Q$cdom\E/);
                   my $group;
                   my ($crsn,$crsd,$role,$remainder) = split(/:/,$item,4);
                   if ($remainder =~ /:/) {
                       (my $other,$group) = ($remainder =~ /^([\w:]+):([^:]+)$/);
                   } else {
                       $group = $remainder;
                   }
                   if ($group ne '') {
                       push(@activegroups,$group);
                   }
               }
               $newenv{'request.course.groups'} = join(':',@activegroups);
           }
       }
       if (keys(%newenv)) {
           &Apache::lonnet::appenv(\%newenv);
       }
       if (!@changed_roles || !(keys(%changed_groups))) {
           my ($rolesmsg,$groupsmsg);
           if (!@changed_roles) {
               if (&Apache::loncommon::show_course()) {
                   $rolesmsg = &mt('No new courses or communities');
               } else {
                   $rolesmsg = &mt('No role changes');
               }
           }
           if ($hasgroups && !(keys(%changed_groups)) && !(grep(/gr/,@changed_roles))) {
               $groupsmsg = &mt('No changes in course/community groups');
           }
           if (!@changed_roles && !(keys(%changed_groups))) {
               if (($msg ne '') || ($groupsmsg ne '')) {
                   $msg .= '<ul>';
                   if ($rolesmsg) {
                       $msg .= '<li>'.$rolesmsg.'</li>';
                   }
                   if ($groupsmsg) {
                       $msg .= '<li>'.$groupsmsg.'</li>';
                   }
                   $msg .= '</ul>';
               } else {
                   $msg = '&nbsp;<span class="LC_cusr_emph">'.$rolesmsg.'</span><br />';
               }
               return $msg;
           }
       }
       my $changemsg;
       if (@changed_roles > 0) {
           if (keys(%newgroup) > 0) {
               my $groupmsg;
               my (%curr_groups,%groupdescs,$currcrs);
               foreach my $item (sort(keys(%newgroup))) {
                   if (&is_active_course($item,$refresh,$update,\%roleshash)) {
                       if ($item =~ m{^gr\./($match_domain/$match_courseid)/(\w+)$}) {
                           my ($cdom,$cnum) = split(/\//,$1);
                           my $group = $2;
                           if ($currcrs ne $cdom.'_'.$cnum) {
                               if ($currcrs) {
                                   $groupmsg .= '</ul><li>';
                               }
                               $groupmsg .= '<li><b>'.
                                            $env{'course.'.$cdom.'_'.$cnum.'.description'}.'</b><ul>';
                               $currcrs = $cdom.'_'.$cnum;
                           }
                           my $groupdesc;
                           unless (ref($curr_groups{$cdom.'_'.$cnum}) eq 'HASH') {
                               %{$curr_groups{$cdom.'_'.$cnum}} =
                                   &Apache::longroup::coursegroups($cdom,$cnum);
                           }
                           unless ((ref($groupdescs{$cdom.'_'.$cnum}) eq 'HASH') &&
                               ($groupdescs{$cdom.'_'.$cnum}{$group})) {
   
                               my %groupinfo =
                                   &Apache::longroup::get_group_settings($curr_groups{$cdom.'_'.$cnum}{$group});
                               $groupdescs{$cdom.'_'.$cnum}{$group} =
                                   &unescape($groupinfo{'description'});
                           }
                           $groupdesc = $groupdescs{$cdom.'_'.$cnum}{$group};
                           if ($groupdesc) {
                               $groupmsg .= '<li>'.
                                            &mt('[_1] with status: [_2].',
                                            '<b>'.$groupdesc.'</b>',$newgroup{$item}).'</li>';
                           }
                       }
                   }
                   if ($groupmsg) {
                       $groupmsg .= '</ul></li>';
                   }
               }
               if ($groupmsg) {
                   $changemsg .= '<li>'.
                                 &mt('Courses with new groups').'</li>'.
                                 '<ul>'.$groupmsg.'</ul></li>';
               }
           }
           if (keys(%newrole) > 0) {
               my $newmsg;
               foreach my $item (sort(keys(%newrole))) {
                   my $desc = &role_desc($item,$update,$refresh,$now);
                   if ($desc) {
                       $newmsg .= '<li>'.
                                  &mt('[_1] with status: [_2].',
                                  $desc,&mt($newrole{$item})).'</li>';
                   }
               }
               if ($newmsg) {
                   $changemsg .= '<li>'.&mt('New roles').
                                 '<ul>'.$newmsg.'</ul>'.
                                 '</li>';
               }
           }
           if (keys(%customprivchg) > 0) {
               my $privmsg;
               foreach my $item (sort(keys(%customprivchg))) {
                   my $desc = &role_desc($item,$update,$refresh,$now);
                   if ($desc) {
                       $privmsg .= '<li>'.$desc.'</li>';
                   }
               }
               if ($privmsg) {
                   $changemsg .= '<li>'.
                                 &mt('Custom roles with privilege changes').
                                 '<ul>'.$privmsg.'</ul>'.
                                 '</li>';
                }
           }
           if (keys(%rolechange) > 0) {
               my $rolemsg;
               foreach my $item (sort(keys(%rolechange))) {
                   my $desc = &role_desc($item,$update,$refresh,$now);  
                   if ($desc) {
                       $rolemsg .= '<li>'.
                                   &mt('[_1] status now: [_2].',$desc,
                                   $rolechange{$item}).'</li>';
                   }
               }
               if ($rolemsg) {
                   $changemsg .= '<li>'.
                                 &mt('Existing roles with status changes').'</li>'.
                                 '<ul>'.$rolemsg.'</ul>'.
                                 '</li>';
               }
           }
           if (keys(%deletedroles) > 0) {
               my $delmsg;
               foreach my $item (sort(keys(%deletedroles))) {
                   my $desc = &role_desc($item,$update,$refresh,$now);
                   if ($desc) {
                       $delmsg .= '<li>'.$desc.'</li>';
                   }
               }
               if ($delmsg) {
                   $changemsg .= '<li>'.
                                 &mt('Existing roles now expired').'</li>'.
                                 '<ul>'.$delmsg.'</ul>'.
                                 '</li>';
               }
           }
       }
       if ((keys(%changed_groups) > 0) || (keys(%groupchange) > 0)) {
           my $groupchgmsg;
           foreach my $key (sort(keys(%changed_groups))) {
               my $crs = 'gr/'.$key;
               $crs =~ s/_/\//;
               if (&is_active_course($crs,$refresh,$update,\%roleshash)) {
                   if (ref($changed_groups{$key}) eq 'HASH') {
                       my @showgroups;
                       foreach my $group (sort(keys(%{$changed_groups{$key}}))) {
                           if ($changed_groups{$key}{$group} eq 'active') {
                               push(@showgroups,$group);
                           }
                       }
                       if (@showgroups > 0) {
                           $groupchgmsg .= '<li>'.
                                           &mt('Course: [_1], groups: [_2].',$key,
                                           join(', ',@showgroups)).
                                           '</li>';
                       }
                   }
               }
           }
           if (keys(%groupchange) > 0) {
               $groupchgmsg .= '<li>'.
                             &mt('Existing course/community groups with status changes').'</li>'.
                             '<ul>';
               foreach my $crs (sort(keys(%groupchange))) {
                   my $cid = $crs;
                   $cid=~s{^/}{};
                   $cid=~s{/}{_};
                   my $crsdesc = $env{'course.'.$cid.'.description'};
                   my $cdom = $env{'course.'.$cid.'.domain'};
                   my $cnum = $env{'course.'.$cid.'.num'};
                   my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   my %groupdesc;
                   if (ref($groupchange{$crs}) eq 'HASH') {
                       $groupchgmsg .= '<li>'.&mt('Course/Community: [_1]','<b>'.$crsdesc.'</b><ul>');
                       foreach my $group (sort(keys(%{$groupchange{$crs}}))) {
                           unless ($groupdesc{$group}) {
                               my %groupinfo = &Apache::longroup::get_group_settings($curr_groups{$group});
                               $groupdesc{$group} =  &unescape($groupinfo{'description'});
                           }
                           $groupchgmsg .= '<li>'.&mt('Group: [_1] status now: [_2].','<b>'.$groupdesc{$group}.'</b>',$groupchange{$crs}{$group}).'</li>';
                       }
                       $groupchgmsg .= '</ul></li>';
                   }
               }
               $groupchgmsg .= '</ul></li>';
           }
           if ($groupchgmsg) {
               $changemsg .= '<li>'.
                             &mt('Courses with changes in groups').'</li>'.
                             '<ul>'.$groupchgmsg.'</ul></li>';
           }
       }
       if ($changemsg) {
           $msg .= '<ul>'.$changemsg.'</ul>';
       } else {
           if (&Apache::loncommon::show_course()) {
               $msg = &mt('No new courses or communities');
           } else {
               $msg = &mt('No role changes');
           }
       }
       return $msg;
   }
   
   sub role_desc {
       my ($item,$update,$refresh,$now) = @_;
       my ($where,$trolecode,$role,$tstatus,$tend,$tstart,$twhere,
           $trole,$tremark);
       &Apache::lonnet::role_status('user.role.'.$item,$update,$refresh,
                                    $now,\$role,\$where,\$trolecode,
                                    \$tstatus,\$tstart,\$tend);
       return unless ($role);
       if ($role =~ /^cr\//) {
           my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
           $tremark = &mt('Custom role defined by [_1].',$rauthor.':'.$rdomain);
       }
       $trole=Apache::lonnet::plaintext($role);
       my ($tdom,$trest,$tsection)=
           split(/\//,Apache::lonnet::declutter($where));
       if (($role eq 'ca') || ($role eq 'aa')) {
           my $home = &Apache::lonnet::homeserver($trest,$tdom);
           $home = &Apache::lonnet::hostname($home);
           $twhere=&mt('User').':&nbsp;'.$trest.'&nbsp; '.&mt('Domain').
                   ':&nbsp;'.$tdom.'&nbsp; '.&mt('Server').':&nbsp;'.$home;
       } elsif ($role eq 'au') {
           my $home = &Apache::lonnet::homeserver
                          ($env{'user.name'},$env{'user.domain'});
           $home = &Apache::lonnet::hostname($home);
           $twhere=&mt('Domain').':&nbsp;'.$tdom.'&nbsp; '.&mt('Server').
                           ':&nbsp;'.$home;
       } elsif ($trest) {
           my $tcourseid=$tdom.'_'.$trest;
           my $crstype = &Apache::loncommon::course_type($tcourseid);
           $trole = &Apache::lonnet::plaintext($role,$crstype,$tcourseid);
           if ($env{'course.'.$tcourseid.'.description'}) {
               $twhere=$env{'course.'.$tcourseid.'.description'};
           } else {
               my %newhash=&Apache::lonnet::coursedescription($tcourseid);
               if (%newhash) {
                   $twhere=$newhash{'description'};
               } else {
                   $twhere=&mt('Currently not available');
               }
           }
           if ($tsection) {
               $twhere.= '&nbsp; '.&mt('Section').':&nbsp;'.$tsection;
           }
           if ($role ne 'st') {
               $twhere.= '&nbsp; '.&mt('Domain').':&nbsp;'.$tdom;
           }
       } elsif ($tdom) {
           $twhere = &mt('Domain').':&nbsp;'.$tdom;
       }
       my $output;
       if ($trole) {
           $output = $trole;
           if ($twhere) {
               $output .= " -- $twhere";
           }
           if ($tremark) {
               $output .= '<br />'.$tremark;
           }
       }
       return $output;
   }
   
   sub curr_role_status {
       my ($start,$end,$refresh,$update) = @_;
       if (($start) && ($start<0)) { return 'deleted' };
       my $status = 'active';
       if (($end) && ($end<=$update)) {
           $status = 'previous';
       }
       if (($start) && ($refresh<$start)) {
           $status = 'future';
       }
       return $status;
   }
   
   sub gather_roleprivs {
       my ($allroles,$allgroups,$userroles,$area,$role,$tstart,$tend,$status) = @_;
       return unless ((ref($allroles) eq 'HASH') && (ref($allgroups) eq 'HASH') && (ref($userroles) eq 'HASH'));
       if (($area ne '') && ($role ne '')) {
           &Apache::lonnet::userrolelog($role,$env{'user.name'},$env{'user.domain'},
                                        $area,$tstart,$tend);
           my $spec=$role.'.'.$area;
           $userroles->{'user.role.'.$spec} = $tstart.'.'.$tend;
           my ($tdummy,$tdomain,$trest)=split(/\//,$area);
           if ($status eq 'active') { 
               if ($role =~ /^cr\//) {
                   &Apache::lonnet::custom_roleprivs($allroles,$role,$tdomain,$trest,$spec,$area);
               } elsif ($role eq 'gr') {
                   my %rolehash = &Apache::lonnet::get('roles',[$area.'_'.$role],
                                                       $env{'user.domain'},
                                                       $env{'user.name'});
                   my ($trole) = split(/_/,$rolehash{$area.'_'.$role},2);
                   (undef,my $group_privs) = split(/\//,$trole);
                   $group_privs = &unescape($group_privs);
                   &Apache::lonnet::group_roleprivs($allgroups,$area,$group_privs,$tend,$tstart);
               } else {
                   &Apache::lonnet::standard_roleprivs($allroles,$role,$tdomain,$spec,$trest,$area);
               }
           }
       }
       return;
   }
   
   sub is_active_course {
       my ($rolekey,$refresh,$update,$roleshashref) = @_;
       return unless(ref($roleshashref) eq 'HASH');
       my ($role,$cdom,$cnum) = split(/\//,$rolekey);
       my $is_active;
       foreach my $key (keys(%{$roleshashref})) {
           if ($key =~ /^\Q$cnum\E:\Q$cdom\E:/) {
               my ($tstart,$tend) = split(/:/,$roleshashref->{$key});
               my $status = &curr_role_status($tstart,$tend,$refresh,$update);
               if ($status eq 'active') {
                   $is_active = 1;
                   last;
               }
           }
       }
       return $is_active;
   }
   
   sub get_roles_functions {
       my ($rolescount,$cattype) = @_;
       my @links;
       push(@links,["javascript:rolesView('doupdate');",'start-here-22x22',&mt('Check for changes')]);
       if ($env{'environment.canrequest.author'}) {
           unless (&Apache::loncoursequeueadmin::is_active_author()) {
               push(@links,["javascript:rolesView('requestauthor');",'list-add-22x22',&mt('Request author role')]);
           }
       }
       if (($rolescount > 3) || ($env{'environment.recentroles'})) {
           push(@links,['/adm/preferences?action=changerolespref&amp;returnurl=/adm/roles','role_hotlist-22x22',&mt('Hotlist')]);
       }
       if (&Apache::lonmenu::check_for_rcrs()) {
           push(@links,['/adm/requestcourse','rcrs-22x22',&mt('Request course')]);
       }
       if ($env{'form.state'} eq 'queued') {
           push(@links,["javascript:rolesView('noqueued');",'selfenrl-queue-22x22',&mt('Hide queued')]);
       } else {
           push(@links,["javascript:rolesView('queued');",'selfenrl-queue-22x22',&mt('Show queued')]);
       }
       if ($env{'user.adv'}) {
           if ($env{'form.display'} eq 'showall') {
               push(@links,["javascript:rolesView('noshowall');",'edit-redo-22x22',&mt('Exclude expired')]);
           } else {
               push(@links,["javascript:rolesView('showall');",'edit-undo-22x22',&mt('Include expired')]);
           }
       }
       unless ($cattype eq 'none') {
           push(@links,['/adm/coursecatalog','ccat-22x22',&mt('Course catalog')]);
       }
       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);
       }
       return $funcs;
   }
   
   sub get_queued {
       my ($output,%reqcrs);
       my ($types,$typenames) = &Apache::loncommon::course_types();
       my %statusinfo = &Apache::lonnet::dump('courserequests',$env{'user.domain'},
                                              $env{'user.name'},'^status:');
       foreach my $key (keys(%statusinfo)) {
           next unless (($statusinfo{$key} eq 'approval') || ($statusinfo{$key} eq 'pending'));
           (undef,my($cdom,$cnum)) = split(/:/,$key);
           my $requestkey = $cdom.'_'.$cnum;
           if ($requestkey =~ /^($match_domain)_($match_courseid)$/) {
               my %history = &Apache::lonnet::restore($requestkey,'courserequests',
                                                      $env{'user.domain'},$env{'user.name'});
               next if ((exists($history{'status'})) && ($history{'status'} eq 'created'));
               my $reqtime = $history{'reqtime'};
               my $lastupdate = $history{'timestamp'};
               my $showtype = $history{'crstype'};
               if (defined($typenames->{$history{'crstype'}})) {
                   $showtype = $typenames->{$history{'crstype'}};
               }
               my $description;
               if (ref($history{'details'}) eq 'HASH') {
                   $description = $history{details}{'cdescr'};
               }
               @{$reqcrs{$reqtime}} = ($description,$showtype);
           }
       }
       my @sortedtimes = sort {$a <=> $b} (keys(%reqcrs));
       if (@sortedtimes > 0) {
           $output .= '<p><b>'.&mt('Course/Community requests').'</b><br />'.
                      &Apache::loncommon::start_data_table().
                      &Apache::loncommon::start_data_table_header_row().
                      '<th>'.&mt('Date requested').'</th>'.
                      '<th>'.&mt('Course title').'</th>'.
                      '<th>'.&mt('Course type').'</th>';
                      &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().
                          '<td>'.&Apache::lonlocal::locallocaltime($reqtime).'</td>'.
                          '<td>'.join('</td><td>',@{$reqcrs{$reqtime}}).'</td>'.
                          &Apache::loncommon::end_data_table_row();
           }
           $output .= &Apache::loncommon::end_data_table().
                      '<br /></p>';
       }
       my $queuedselfenroll = &Apache::loncoursequeueadmin::queued_selfenrollment(1);
       if ($queuedselfenroll) {
           $output .= '<p><b>'.&mt('Enrollment requests').'</b><br />'.
                      $queuedselfenroll.'<br /></p>';
       }
       if ($env{'environment.canrequest.author'}) {
           unless (&Apache::loncoursequeueadmin::is_active_author()) {
               my $requestauthor;
               my ($status,$timestamp) = split(/:/,$env{'environment.requestauthorqueued'});
               if (($status eq 'approval') || ($status eq 'approved')) {
                   $output .= '<p><b>'.&mt('Author role request').'</b><br />';
                   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 .= '<span class="LC_info">'.
                                      &mt('Your request for an author role has been approved.').'<br />'.
                                      &mt('Use the "Check for changes" link to update your list of roles.').
                                      '</span>';
                       }
                   }
                   $output .= '</p>';
               }
           }
       }
       unless ($output) {
           if ($env{'environment.canrequest.author'} || $env{'environment.canrequest.official'} ||
               $env{'environment.canrequest.unofficial'} || $env{'environment.canrequest.community'}) {
               $output = &mt('No requests for courses, communities or authoring currently queued');
           } else {
               $output = &mt('No enrollment requests currently queued awaiting approval');
           }
       }
       return '<div class="LC_left_float"><fieldset><legend>'.&mt('Queued requests').'</legend>'.
              $output.'</fieldset></div><br clear="all" />';
   }
   
 1;  1;
 __END__  __END__
   
Line 1780  course they should act on, etc. Both in Line 3412  course they should act on, etc. Both in
 handler determines via C<lonnet>'s C<&allowed> function that a certain  handler determines via C<lonnet>'s C<&allowed> function that a certain
 action is not allowed, C<lonroles> is used as error handler. This  action is not allowed, C<lonroles> is used as error handler. This
 allows the user to select another role which may have permission to do  allows the user to select another role which may have permission to do
 what they were trying to do. C<lonroles> can also be accessed via the  what they were trying to do.
 B<CRS> button in the Remote Control.   
   
 =begin latex  =begin latex
   

Removed from v.1.240.2.5  
changed lines
  Added in v.1.269.2.39.2.2


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>