[BACK]Return to lonroles.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / auth

Diff for /loncom/auth/lonroles.pm between versions 1.231.4.11 and 1.267

version 1.231.4.11, 2010/01/18 19:08:03 version 1.267, 2012/06/01 16:00:29
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 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::loncoursequeueadmin;
 use GDBM_File;  use GDBM_File;
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
 use HTML::Entities;  use HTML::Entities;
     
   
 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 $navwindow;  
     if ($launch_nav eq 'on') {  
  $navwindow.=&Apache::lonnavdisplay::launch_win('now',undef,undef,  
        ($url =~ m-^/adm/whatsnew-));  
     } else {  
  $navwindow.=&Apache::lonnavmaps::close();  
     }  
   
       # Breadcrumbs
       my $brcrum = [{'href' => $url,
                      'text' => 'Switching Role'},];
     my $start_page = &Apache::loncommon::start_page('Switching Role',undef,      my $start_page = &Apache::loncommon::start_page('Switching Role',undef,
                                                     {'redirect' => [1,$url]});                                                      {'redirect' => [1,$url],
                                                        'bread_crumbs' => $brcrum,});
     my $end_page   = &Apache::loncommon::end_page();      my $end_page   = &Apache::loncommon::end_page();
   
 # Note to style police:   # Note to style police: 
Line 167  sub redirect_user { Line 163  sub redirect_user {
     $url=~s/ /\%20/g;      $url=~s/ /\%20/g;
     $r->print(<<ENDREDIR);      $r->print(<<ENDREDIR);
 $start_page  $start_page
 <script type="text/javascript">  
 // <![CDATA[  
 $swinfo  
 // ]]>  
 </script>  
 $navwindow  
 <p>$msg</p>  <p>$msg</p>
 $end_page  $end_page
 ENDREDIR  ENDREDIR
Line 185  sub error_page { Line 175  sub error_page {
     &Apache::loncommon::no_cache($r);      &Apache::loncommon::no_cache($r);
     $r->send_http_header;      $r->send_http_header;
     return OK if $r->header_only;      return OK if $r->header_only;
     $r->print(&Apache::loncommon::start_page('Problems during Course Initialization').      # 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">'.          '<script type="text/javascript">'.
         '// <![CDATA['.          '// <![CDATA['.
         &Apache::lonmenu::rawconfig().          &Apache::lonmenu::rawconfig().
         '// ]]>'.          '// ]]>'.
         '</script>'.          '</script>'.
       '<p class="LC_error">'.&mt('The following problems occurred:').        '<p class="LC_error">'.&mt('The following problems occurred:').
               '<br />'.            '<br />'.
       $error.        $error.
       '</p><br /><a href="'.$dest.'">'.&mt('Continue').'</a>'.        '</p><br /><a href="'.$dest.'">'.&mt('Continue').'</a>'
               &Apache::loncommon::end_page());      );
       $r->print(&Apache::loncommon::end_page());
 }  }
   
 sub handler {  sub handler {
Line 205  sub handler { Line 203  sub handler {
     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;
       }
   
   # -------------------------------------------------------- Check for new roles
       my $updateresult;
       if ($env{'form.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 = '<span class="LC_info">'.$checkingtxt.'</span>';
           $updateresult .= &update_session_roles();
           &Apache::lonnet::appenv({'user.update.time'  => $now});
           $update = $now;
       }
   
     my $envkey;      my $envkey;
     my %dcroles = ();      my %dcroles = ();
     my $numdc = &check_fordc(\%dcroles,$then);      my $numdc = &check_fordc(\%dcroles,$update,$then);
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
       my $loncaparev = $Apache::lonnet::perlvar{'lonVersion'};
   
 # ================================================================== Roles Init  # ================================================================== Roles Init
     if ($env{'form.selectrole'}) {      if ($env{'form.selectrole'}) {
Line 225  sub handler { Line 245  sub handler {
  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);
Line 248  sub handler { Line 277  sub handler {
     ($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {      ($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {
                     if ($dcroles{$domain}) {                      if ($dcroles{$domain}) {
                         &Apache::lonnet::check_adhoc_privs($domain,$coursenum,                          &Apache::lonnet::check_adhoc_privs($domain,$coursenum,
                                                            $then,$refresh,$now,$ccrole);                                                             $update,$refresh,$now,$ccrole);
                     }                      }
                     last;                      last;
                 }                  }
Line 261  sub handler { Line 290  sub handler {
                         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 = 'au./'.$domain.'/';                              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);
                         }                          }
                         last;                          last;
Line 272  sub handler { Line 301  sub handler {
                             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 = 'ca./'.$domain.'/'.$user;
                                 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);
                             }                              }
                             last;                              last;
Line 288  sub handler { Line 317  sub handler {
                     if ($dcroles{$domain}) {                      if ($dcroles{$domain}) {
                         my ($server_status,$home) = &check_author_homeserver($user,$domain);                          my ($server_status,$home) = &check_author_homeserver($user,$domain);
                         if (($server_status eq 'ok') || ($server_status eq 'switchserver')) {                          if (($server_status eq 'ok') || ($server_status eq 'switchserver')) {
                             &Apache::lonnet::check_adhoc_privs($domain,$user,$then,                              &Apache::lonnet::check_adhoc_privs($domain,$user,$update,
                                                                $refresh,$now,'ca');                                                                 $refresh,$now,'ca');
                             if ($server_status eq 'switchserver') {                              if ($server_status eq 'switchserver') {
                                 my $trolecode = 'ca./'.$domain.'/'.$user;                                   my $trolecode = 'ca./'.$domain.'/'.$user; 
                                 my $switchserver = '/adm/switchserver?'                                  my $switchserver = '/adm/switchserver?'
                                                   .'otherserver='.$home.'&role='.$trolecode;                                                    .'otherserver='.$home.'&amp;role='.$trolecode;
                                 $r->internal_redirect($switchserver);                                  $r->internal_redirect($switchserver);
                             }                              }
                         } else {                          } else {
Line 310  sub handler { Line 339  sub handler {
         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) =
                                       &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;
                                       my $end_page=&Apache::loncommon::end_page();
                                       $r->print(&Apache::loncommon::start_page('Selected course unavailable on this server').
                                                 '<p class="LC_warning">');
                                       if ($switchwarning) {
                                           $r->print($switchwarning.'<br /><a href="/adm/roles">');
                                           if (&Apache::loncommon::show_course()) {
                                               $r->print(&mt('Display courses'));
                                           } else {
                                               $r->print(&mt('Display roles'));
                                           }
                                           $r->print('</a>');
                                       } elsif ($switchserver) {
           $r->print(&mt('This course requires a newer version of LON-CAPA than is installed on this server.').
                                                     '<br />'.
                                                     '<a href="/adm/switchserver?'.$switchserver.'">'.
                                                     &mt('Switch Server').
                                                     '</a>');
                                       }
                                       $r->print('</p>'.&Apache::loncommon::end_page());
                                       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 451  ENDENTERKEY Line 516  ENDENTERKEY
                             if (($ferr) && ($tadv)) {                              if (($ferr) && ($tadv)) {
  &error_page($r,$ferr,$dest);   &error_page($r,$ferr,$dest);
     } else {      } else {
                                   if ($dest =~ m{^/adm/coursedocs\?folderpath}) {
                                       if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { 
                                           my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
                                           &update_content_constraints($cdom,$cnum,$chome,$cdom.'_'.$cnum);
                                       }
                                   }
  $r->internal_redirect($dest);   $r->internal_redirect($dest);
     }      }
     return OK;      return OK;
Line 480  ENDENTERKEY Line 551  ENDENTERKEY
  }   }
  $courseid =~ s/\//_/;   $courseid =~ s/\//_/;
  if ((($role eq 'cc') || ($role eq 'co'))    if ((($role eq 'cc') || ($role eq 'co')) 
                                       && ($env{'course.' . $courseid .'.course.helper.not.run'})) {                                       && ($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'}) {
Line 490  ENDENTERKEY Line 561  ENDENTERKEY
                                             my $esc_symb = &HTML::Entities::encode($env{'form.destsymb'},'"<>&');                                              my $esc_symb = &HTML::Entities::encode($env{'form.destsymb'},'"<>&');
                                             $dest .= '?symb='.$esc_symb;                                              $dest .= '?symb='.$esc_symb;
                                         }                                          }
                                         &redirect_user($r,&mt('Entering [_1]',                                          &redirect_user($r, &mt('Entering [_1]',
                                                       $env{'course.'.$courseid.'.description'}),                                                         $env{'course.'.$courseid.'.description'}),
                                                $dest,$msg,                                                         $dest, $msg);
                                                $env{'environment.remotenavmap'});  
                                         return OK;                                          return OK;
                                     }                                      }
     if (&Apache::lonnet::allowed('whn',      if (&Apache::lonnet::allowed('whn',
Line 506  ENDENTERKEY Line 576  ENDENTERKEY
  unless ($startpage eq 'firstres') {            unless ($startpage eq 'firstres') {         
     $msg = &mt('Entering [_1] ...',      $msg = &mt('Entering [_1] ...',
        $env{'course.'.$courseid.'.description'});         $env{'course.'.$courseid.'.description'});
     &redirect_user($r,&mt('New in course'),      &redirect_user($r, &mt('New in course'),
    '/adm/whatsnew?refpage=start',$msg,                                         '/adm/whatsnew?refpage=start', $msg);
    $env{'environment.remotenavmap'});  
     return OK;      return OK;
  }   }
     }      }
Line 520  ENDENTERKEY Line 589  ENDENTERKEY
  }   }
                                 $msg = &mt('Entering [_1] ...',                                  $msg = &mt('Entering [_1] ...',
    $env{'course.'.$courseid.'.description'});     $env{'course.'.$courseid.'.description'});
  &redirect_user($r,&mt('Entering [_1]',   &redirect_user($r, &mt('Entering [_1]',
       $env{'course.'.$courseid.'.description'}),                                 $env{'course.'.$courseid.'.description'}),
        $furl,$msg,                                 $furl, $msg);
        $env{'environment.remotenavmap'});  
     }      }
     return OK;      return OK;
  }   }
Line 533  ENDENTERKEY Line 601  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 Construction Space'),
Line 606  function enterrole (thisform,rolecode,bu Line 673  function enterrole (thisform,rolecode,bu
  thisform.submit();   thisform.submit();
     } else {      } else {
        alert('$standby');         alert('$standby');
     }         }
 }  }
   
   function setToUpdate(thisform) {
       thisform.doupdate.value='1';
       thisform.selectrole.value='';
       thisform.submit();
   }
   
 // ]]>  // ]]>
 </script>  </script>
 ENDHEADER  ENDHEADER
Line 659  ENDHEADER Line 733  ENDHEADER
             if ($reinit) {              if ($reinit) {
                 $r->print(                  $r->print(
  '<h3><span class="LC_error">'.   '<h3><span class="LC_error">'.
  &mt('As your session file for the course or community has expired, you will need to re-select the course.').'</span></h3>');   &mt('As your session file for the course or community has expired, you will need to re-select it.').'</span></h3>');
             } else {              } else {
         $r->print(          $r->print(
  '<h3><span class="LC_error">'.   '<h3><span class="LC_error">'.
Line 668  ENDHEADER Line 742  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());    &Apache::loncommon::end_page());
  return OK;   return OK;
     } else {      } else {
           $r->print($updateresult); 
         if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {          if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
        $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};         $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
         }          }
Line 683  ENDHEADER Line 757  ENDHEADER
         $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->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,\%roletext,\%sortrole,\%roleclass,
                       \%futureroles,\%timezones);                        \%futureroles,\%timezones,$loncaparev);
   
     $refresh = $now;      $refresh = $now;
     &Apache::lonnet::appenv({'user.refresh.time'  => $refresh});      &Apache::lonnet::appenv({'user.refresh.time'  => $refresh});
       my $updatebutton = &mt('Check for role changes');
       my $show_course=&Apache::loncommon::show_course();
       if ($show_course) {
           $updatebutton = &mt('Check for new courses');
       }
       my $do_update;
       unless (($env{'form.source'} eq 'login') || ($env{'form.doupdate'})) {
           $do_update = '<input type="hidden" name="doupdate" value="" />'.
                        '<input type="button" name="update" value="'.
                        $updatebutton.'" onclick="javascript:setToUpdate(this.form)" />';
       }
     if ($env{'user.adv'}) {      if ($env{'user.adv'}) {
         if ($env{'form.showall'}) { $r->print(' checked="checked" '); }          my $showall = '<label><input type="checkbox" name="showall"';
         $r->print(' />'.&mt('Show all roles').'</label>'          if ($env{'form.showall'}) { 
                  .' <input type="submit" value="'.&mt('Update display').'" />'              $showall .= ' checked="checked" ';
                  .'</p>');          }
           $showall .= ' />'.&mt('Show all roles').'</label>&nbsp;'.
                       '<input type="submit" value="'.&mt('Update display').'" />';
           if ($do_update) {
               $r->print('<div class="LC_left_float"><fieldset>'.
                         '<legend>'. &mt('Display').'</legend>'.
                         $showall.'</fieldset></div>'.
                         '<div class="LC_left_float"><fieldset><legend>'.
                         &mt('Changes?').'</legend>'.
                         $do_update.'</fieldset></div><br clear="all" />');
           } else {
               $r->print($showall);
           }
     } else {      } else {
           $r->print('<p>'.$do_update.'</p>');
         if ($countactive > 0) {          if ($countactive > 0) {
             $r->print(&Apache::loncoursequeueadmin::queued_selfenrollment());              $r->print(&Apache::loncoursequeueadmin::queued_selfenrollment());
             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]'
Line 726  ENDHEADER Line 823  ENDHEADER
     $r->print('<h2>'.&mt('Currently no active roles, courses or communities').'</h2>');      $r->print('<h2>'.&mt('Currently no active roles, courses or communities').'</h2>');
  }   }
         &findcourse_advice($r);          &findcourse_advice($r);
         &requestcourse_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));
Line 757  ENDHEADER Line 854  ENDHEADER
  return OK;   return OK;
     }      }
 # ----------------------------------------------------------------------- Table  # ----------------------------------------------------------------------- Table
   
       if ($numdc > 0) {
           $r->print(&coursepick_jscript());
           $r->print(&Apache::loncommon::coursebrowser_javascript().
                     &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 768  ENDHEADER Line 872  ENDHEADER
                       $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 ($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 802  ENDHEADER Line 919  ENDHEADER
             $doheaders ++;              $doheaders ++;
  }   }
     }      }
   
     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);      &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,\%roletext);
     if ($countactive > 1) {      if ($countactive > 1) {
         my $tremark='';          my $tremark='';
Line 843  ENDHEADER Line 954  ENDHEADER
  $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>'
Line 859  ENDHEADER Line 975  ENDHEADER
 }  }
   
 sub gather_roles {  sub gather_roles {
     my ($then,$refresh,$now,$reinit,$nochoose,$roletext,$sortrole,$roleclass,$futureroles,$timezones) = @_;      my ($update,$refresh,$now,$reinit,$nochoose,$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'};
       my @ids = &Apache::lonnet::current_machine_ids();
     foreach my $envkey (sort(keys(%env))) {      foreach my $envkey (sort(keys(%env))) {
         my $button = 1;          my $button = 1;
         my $switchserver='';          my $switchserver='';
           my $switchwarning;
         my ($role_text,$role_text_end,$sortkey);          my ($role_text,$role_text_end,$sortkey);
         if ($envkey=~/^user\.role\./) {          if ($envkey=~/^user\.role\./) {
             my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);              my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
             &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);
             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 890  sub gather_roles { Line 1001  sub gather_roles {
                 || ($tstatus eq 'selected')                  || ($tstatus eq 'selected')
                 || ($tstatus eq 'future')                  || ($tstatus eq 'future')
                 || ($env{'form.showall'})) {                  || ($env{'form.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 915  sub gather_roles { Line 1033  sub gather_roles {
                 if ($role =~ /^cr\//) {                  if ($role =~ /^cr\//) {
                     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);                      my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
                     if ($tremark) { $tremark.='<br />'; }                      if ($tremark) { $tremark.='<br />'; }
                     $tremark.=&mt('Defined by [_1] at [_2].',$rauthor,$rdomain);                      $tremark.=&mt('Customrole defined by [_1].',$rauthor.':'.$rdomain);
                 }                  }
                 $trole=Apache::lonnet::plaintext($role);                  $trole=Apache::lonnet::plaintext($role);
                 my $ttype;                  my $ttype;
Line 926  sub gather_roles { Line 1044  sub gather_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);
Line 946  sub gather_roles { Line 1063  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);
Line 965  sub gather_roles { Line 1081  sub gather_roles {
                     $ttype = &Apache::loncommon::course_type($tcourseid);                      $ttype = &Apache::loncommon::course_type($tcourseid);
                     $trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);                      $trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid);
                     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) = 
                                           &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,$tcourseid);                              $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) =
                                           &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;
Line 1006  sub gather_roles { Line 1145  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);
                 $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 1026  sub role_timezone { Line 1165  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 1041  sub role_timezone { Line 1186  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 1114  sub print_rolerows { Line 1259  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-dc\./($match_domain)/-) {
                             if (ref($dcroles) eq 'HASH') {                              if (ref($dcroles) eq 'HASH') {
Line 1175  sub requestcourse_advice { Line 1322  sub requestcourse_advice {
     &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>'.              $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>');                        '<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(                      $r->print(
Line 1213  sub requestcourse_advice { Line 1360  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>');              $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>');
         }          }
     }      }
Line 1276  sub privileges_info { Line 1423  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,$tpstart,$tpend,$nochoose,$button,$switchserver,$reinit,$switchwarning) = @_;
     my ($roletext,$roletext_end);      my ($roletext,$roletext_end);
     my $is_dc=($trolecode =~ m/^dc\./);      my $is_dc=($trolecode =~ m/^dc\./);
     my $rowspan=($is_dc) ? ''      my $rowspan=($is_dc) ? ''
Line 1294  sub build_roletext { Line 1441  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 1377  sub check_author_homeserver { Line 1531  sub check_author_homeserver {
 }  }
   
 sub check_fordc {  sub check_fordc {
     my ($dcroles,$then) = @_;      my ($dcroles,$update,$then) = @_;
     my $numdc = 0;      my $numdc = 0;
     if ($env{'user.adv'}) {      if ($env{'user.adv'}) {
         foreach my $envkey (sort keys %env) {          foreach my $envkey (sort keys %env) {
Line 1385  sub check_fordc { Line 1539  sub check_fordc {
                 my $dcdom = $1;                  my $dcdom = $1;
                 my $livedc = 1;                  my $livedc = 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 'dc./'.$dcdom.'/') {
                       $limit = $then;
                   }
                   if ($tstart && $tstart>$limit) { $livedc = 0; }
                   if ($tend   && $tend  <$limit) { $livedc = 0; }
                 if ($livedc) {                  if ($livedc) {
                     $$dcroles{$dcdom} = $envkey;                      $$dcroles{$dcdom} = $envkey;
                     $numdc++;                      $numdc++;
Line 1398  sub check_fordc { Line 1556  sub check_fordc {
 }  }
   
 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;                  $setprivs = 1;
             }              }
         }          }
Line 1453  sub adhoc_course_role { Line 1611  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 check_release_required {
       my ($loncaparev,$tcourseid,$trolecode,$required) = @_;
       my ($switchserver,$warning);
       if ($required ne '') {
           my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
           my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
           if ($reqdmajor ne '' && $reqdminor ne '') {
               my $otherserver;
               if (($major eq '' && $minor eq '') || 
                   (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
                   my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'});
                   my $switchlcrev = 
                       &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
                                                              $userdomserver);
                   my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
                   if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) || 
                       (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
                       my $cdom = $env{'course.'.$tcourseid.'.domain'};
                       if ($cdom ne $env{'user.domain'}) {
                           my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom); 
                           my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
                           my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                           my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
                           my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
                           my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
                           my $canhost =
                               &Apache::lonnet::can_host_session($env{'user.domain'},
                                                                 $coursedomserver,
                                                                 $remoterev,
                                                                 $udomdefaults{'remotesessions'},
                                                                 $defdomdefaults{'hostedsessions'});
   
                           if ($canhost) {
                               $otherserver = $coursedomserver;
                           } else {
                               $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).'<br />'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
                           }
                       } else {
                           $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).'<br />'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
                       }
                   } else {
                       $otherserver = $userdomserver;
                   }
               }
               if ($otherserver ne '') {
                   $switchserver = 'otherserver='.$otherserver.'&amp;role='.$trolecode;
               }
           }
       }
       return ($switchserver,$warning);
   }
   
   sub update_content_constraints {
       my ($cdom,$cnum,$chome,$cid) = @_;
       my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
       my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'}); 
       my %checkresponsetypes;
       foreach my $key (keys(%Apache::lonnet::needsrelease)) {
           my ($item,$name,$value) = split(/:/,$key);
           if ($item eq 'resourcetag') {
               if ($name eq 'responsetype') {
                   $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
               }
           }
       }
       my $navmap = Apache::lonnavmaps::navmap->new();
       if (defined($navmap)) {
           my %allresponses;
           foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
               my %responses = $res->responseTypes();
               foreach my $key (keys(%responses)) {
                   next unless(exists($checkresponsetypes{$key}));
                   $allresponses{$key} += $responses{$key};
               }
           }
           foreach my $key (keys(%allresponses)) {
               my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
               if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { 
                   ($reqdmajor,$reqdminor) = ($major,$minor);
               } 
           }
           undef($navmap);
       }
       unless (($reqdmajor eq '') && ($reqdminor eq '')) {
           &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
       }
       return;
   }
   
 sub courselink {  sub courselink {
     my ($dcdom,$rowtype) = @_;      my ($dcdom,$rowtype) = @_;
     my $courseform=&Apache::loncommon::selectcourse_link      my $courseform=&Apache::loncommon::selectcourse_link
Line 1542  sub display_cc_role { Line 1791  sub display_cc_role {
     my $advanced = $env{'user.adv'};      my $advanced = $env{'user.adv'};
     my $tryagain = $env{'form.tryagain'};      my $tryagain = $env{'form.tryagain'};
     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 $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 {
Line 1561  sub display_cc_role { Line 1812  sub display_cc_role {
                 $env{'course.'.$tcourseid.'.description'}=$twhere;                  $env{'course.'.$tcourseid.'.description'}=$twhere;
             }              }
             my $trole = &Apache::lonnet::plaintext($ccrole,$ttype,$tcourseid);              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,'');
         }          }
     }      }
     return ($roletext,$roletext_end);      return ($roletext,$roletext_end);
Line 1580  sub adhoc_roles_row { Line 1831  sub adhoc_roles_row {
     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;
 }  }
Line 1607  sub courseloadpage { Line 1858  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,$refresh,$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,$refresh,$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 ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
                       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++;
                                   }
                               }
                           }
                       }
                       $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);
                               }
                               my $status_in_env =
                                   &curr_role_status($currstart,$currend,$refresh,$update);
                               if ($status_in_env eq 'active') {
                                   $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(/\./,$rolekey,2);
           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 = '<div 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.').'</div>';
           } 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 .= '<div 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.').'</div>';
       }
       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 /><br />';
               }
               return $msg;
           }
       }
       my $changemsg;
       if (@changed_roles > 0) {
           if (keys(%newgroup) > 0) {
               my $groupmsg;
               foreach my $item (sort(keys(%newgroup))) {
                   if (&is_active_course($item,$refresh,$update,\%roleshash)) {
                       $groupmsg .= '<li>'.
                                    &mt('[_1] with status: [_2].',
                                    $item,$newgroup{$item}).'</li>';
                   }
               }
               if ($groupmsg) {
                   $changemsg .= '<li>'.
                                 &mt('Courses with new groups').'</li>'.
                                 '<ul>'.$groupmsg.'</ul></li>';
               }
           }
           if (keys(%newrole) > 0) {
               $changemsg .= '<li>'.&mt('New roles').
                             '<ul>';
               foreach my $item (sort(keys(%newrole))) {
                   $changemsg .= '<li>'.
                                 &mt('[_1] with status: [_2].',
                                 $item,$newrole{$item}).'</li>';
               }
               $changemsg .= '</ul></li>';
           }
           if (keys(%customprivchg) > 0) {
               $changemsg .= '<li>'.
                             &mt('Custom roles with privilege changes').
                             '<ul>';
               foreach my $item (sort(keys(%customprivchg))) {
                   $changemsg .= '<li>'.$item.'</li>';
               }
               $changemsg .= '</ul></li>';
           }
           if (keys(%rolechange) > 0) {
               $changemsg .= '<li>'.
                             &mt('Existing roles with status changes').'</li>'.
                             '<ul>';
               foreach my $item (sort(keys(%rolechange))) {
                   $changemsg .= '<li>'.
                                 &mt('[_1] status now: [_2].',$item,
                                 $rolechange{$item}).'</li>';
               }
               $changemsg .= '</ul></li>';
           }
           if (keys(%deletedroles) > 0) {
               $changemsg .= '<li>'.
                             &mt('Existing roles deleted').'</li>'.
                             '<ul>';
               foreach my $item (sort(keys(%deletedroles))) {
                   $changemsg .= '<li>'.$item.'</li>';
               }
               $changemsg .= '</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))) {
                   if (ref($groupchange{$crs}) eq 'HASH') {
                       $groupchgmsg .= '<li>'.&mt('Course/Community: [_1]','<b>'.$crs.'</b><ul>');
                       foreach my $group (sort(keys(%{$groupchange{$crs}}))) {
                           $groupchgmsg .= '<li>'.&mt('Group: [_1] status now: [_2].','<b>'.$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>';
       }
       &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);
       }
       return $msg;
   }
   
   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;
   }
   
 1;  1;
 __END__  __END__
   
Line 1638  course they should act on, etc. Both in Line 2527  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.231.4.11  
changed lines
  Added in v.1.267

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