Diff for /loncom/auth/lonroles.pm between versions 1.83 and 1.104

version 1.83, 2004/01/27 22:54:59 version 1.104, 2004/11/09 18:18:02
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # (Directory Indexer  
 # (Login Screen  
 # YEAR=1999  
 # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer)  
 # 11/23 Gerd Kortemeyer)  
 # YEAR=2000  
 # 1/14,03/06,06/01,07/22,07/24,07/25,  
 # 09/04,09/06,09/28,09/29,09/30,10/2,10/5,10/26,10/28,  
 # 12/08,12/28,  
 # YEAR=2001  
 # 01/15/01 Gerd Kortemeyer  
 # 03/02,05/03,05/25,05/30,06/01,07/06,08/06 Gerd Kortemeyer  
 # 12/29 Gerd Kortemeyer  
 #  
 ###  ###
   
 package Apache::lonroles;  package Apache::lonroles;
Line 50  use Apache::Constants qw(:common); Line 36  use Apache::Constants qw(:common);
 use Apache::File();  use Apache::File();
 use Apache::lonmenu;  use Apache::lonmenu;
 use Apache::loncommon;  use Apache::loncommon;
   use Apache::lonhtmlcommon;
 use Apache::lonannounce;  use Apache::lonannounce;
 use Apache::lonlocal;  use Apache::lonlocal;
   
 sub redirect_user {  sub redirect_user {
     my ($r,$title,$url,$msg) = @_;      my ($r,$title,$url,$msg,$launch_nav) = @_;
     $msg = $title if (! defined($msg));      $msg = $title if (! defined($msg));
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     &Apache::loncommon::no_cache($r);      &Apache::loncommon::no_cache($r);
     $r->send_http_header;      $r->send_http_header;
     my $swinfo=&Apache::lonmenu::rawconfig();      my $swinfo=&Apache::lonmenu::rawconfig();
       my $navwindow;
       if ($launch_nav eq 'on') {
    $navwindow.=&Apache::lonnavmaps::launch_win('now');
       } else {
    $navwindow.=&Apache::lonnavmaps::close();
       }
     my $bodytag=&Apache::loncommon::bodytag('Switching Role');      my $bodytag=&Apache::loncommon::bodytag('Switching Role');
     $r->print (<<ENDREDIR);  # Note to style police: 
   # This must only replace the spaces, nothing else, or it bombs elsewhere.
       $url=~s/ /\%20/g;
       $r->print(<<ENDREDIR);
 <head><title>$title</title>  <head><title>$title</title>
 <meta HTTP-EQUIV="Refresh" CONTENT="1; url=$url">  <meta HTTP-EQUIV="Refresh" CONTENT="1; url=$url">
 </head>  </head>
 <html>  <html>
 $bodytag  $bodytag
 <script>  <script type="text/javascript">
 $swinfo  $swinfo
 </script>  </script>
   $navwindow
 <h1>$msg</h1>  <h1>$msg</h1>
   <a href="$url">Continue</a>
 </body>  </body>
 </html>  </html>
 ENDREDIR  ENDREDIR
Line 84  sub handler { Line 82  sub handler {
     my $now=time;      my $now=time;
     my $then=$ENV{'user.login.time'};      my $then=$ENV{'user.login.time'};
     my $envkey;      my $envkey;
       my $dcselect='';
   
   
 # ================================================================== Roles Init  # ================================================================== Roles Init
   
     if ($ENV{'form.selectrole'}) {      if ($ENV{'form.selectrole'}) {
           if ($ENV{'form.dcselected'}) {
               my $dcdom = $ENV{'form.dcselected'};
               my $dckey = 'user.role.dc./'.$dcdom.'/';
               if ($ENV{$dckey}) {
                   my ($dcstart,$dcend)=split(/\./,$ENV{$dckey});
                   my $active_dc = 1;
                   if ($dcstart) {
                       if ($dcstart>$then) {
                           $active_dc = 0;
                       }
                   }
                   if ($dcend) {
                       if ($dcend < $then) {
                           $active_dc = 0;
                       }
                   }
                   if ($active_dc) {
                       $dcselect = $dcdom;
                   }
               }
           }
  if ($ENV{'request.course.id'}) {   if ($ENV{'request.course.id'}) {
     my %temp=('logout_'.$ENV{'request.course.id'} => time);      my %temp=('logout_'.$ENV{'request.course.id'} => time);
     &Apache::lonnet::put('email_status',\%temp);      &Apache::lonnet::put('email_status',\%temp);
         }      &Apache::lonnet::delenv('user.state.'.$ENV{'request.course.id'});
    }
  &Apache::lonnet::appenv("request.course.id"   => '',   &Apache::lonnet::appenv("request.course.id"   => '',
  "request.course.fn"   => '',   "request.course.fn"   => '',
  "request.course.uri"  => '',   "request.course.uri"  => '',
Line 102  sub handler { Line 122  sub handler {
  "request.role.domain" => $ENV{'user.domain'});   "request.role.domain" => $ENV{'user.domain'});
         foreach $envkey (keys %ENV) {          foreach $envkey (keys %ENV) {
             next if ($envkey!~/^user\.role\./);              next if ($envkey!~/^user\.role\./);
     my (undef,undef,$role,@pwhere)=split(/\./,$envkey);              my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
             my $where=join('.',@pwhere);              &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
             my $trolecode=$role.'.'.$where;  
             if ($ENV{'form.'.$trolecode}) {              if ($ENV{'form.'.$trolecode}) {
  my ($tstart,$tend)=split(/\./,$ENV{$envkey});  
  my $tstatus='is';  
  if ($tstart) {  
     if ($tstart>$then) {   
  $tstatus='future';  
     }  
  }  
  if ($tend) {  
     if ($tend<$then) { $tstatus='expired'; }  
     if ($tend<$now) { $tstatus='will_not'; }  
  }  
  if ($tstatus eq 'is') {   if ($tstatus eq 'is') {
     $where=~s/^\///;      $where=~s/^\///;
     my ($cdom,$cnum,$csec)=split(/\//,$where);      my ($cdom,$cnum,$csec)=split(/\//,$where);
 # check for keyed access  # check for keyed access
     if (($role eq 'st') &&       if (($role eq 'st') && 
                        ($ENV{'course.'.$cdom.'_'.$cnum.'.keyaccess'} eq 'yes')) {                         ($ENV{'course.'.$cdom.'_'.$cnum.'.keyaccess'} eq 'yes')) {
          unless (&Apache::lonnet::validate_access_key(  # who is key authority?
    my $authdom=$cdom;
    my $authnum=$cnum;
    if ($ENV{'course.'.$cdom.'_'.$cnum.'.keyauth'}) {
       ($authnum,$authdom)=
    split(/\W/,$ENV{'course.'.$cdom.'_'.$cnum.'.keyauth'});
    }
   # check with key authority
    unless (&Apache::lonnet::validate_access_key(
      $ENV{'environment.key.'.$cdom.'_'.$cnum},       $ENV{'environment.key.'.$cdom.'_'.$cnum},
      $cdom,$cnum)) {       $authdom,$authnum)) {
 # there is no valid key  # there is no valid key
      if ($ENV{'form.newkey'}) {       if ($ENV{'form.newkey'}) {
 # student attempts to register a new key  # student attempts to register a new key
    &Apache::loncommon::content_type($r,'text/html');
    &Apache::loncommon::no_cache($r);
    $r->send_http_header;
    my $swinfo=&Apache::lonmenu::rawconfig();
    my $bodytag=&Apache::loncommon::bodytag
       ('Verifying Access Key to Unlock this Course');
    my $buttontext=&mt('Enter Course');
    my $message=&mt('Successfully registered key');
    my $assignresult=
        &Apache::lonnet::assign_access_key(
        $ENV{'form.newkey'},
        $authdom,$authnum,
        $cdom,$cnum,
                                                        $ENV{'user.domain'},
        $ENV{'user.name'},
         'Assigned from '.$ENV{'REMOTE_ADDR'}.' at '.localtime().' for '.
                                                        $trolecode);
    unless ($assignresult eq 'ok') {
        $assignresult=~s/^error\:\s*//;
        $message=&mt($assignresult).
        '<br /><a href="/adm/logout">'.
        &mt('Logout').'</a>';
        $buttontext=&mt('Re-Enter Key');
    }
    $r->print(<<ENDENTEREDKEY);
   <head><title>Verifying Course Access Key</title>
   </head>
   <html>
   $bodytag
   <script>
   $swinfo
   </script>
   <form method="post">
   <input type="hidden" name="selectrole" value="1" />
   <input type="hidden" name="$trolecode" value="1" />
   <font size="+2">$message</font><br />
   <input type="submit" value="$buttontext" />
   </form>
   </body></html>
   ENDENTEREDKEY
                                    return OK;
      } else {       } else {
 # print form to enter a new key  # print form to enter a new key
  &Apache::loncommon::content_type($r,'text/html');   &Apache::loncommon::content_type($r,'text/html');
Line 146  $bodytag Line 203  $bodytag
 $swinfo  $swinfo
 </script>  </script>
 <form method="post">  <form method="post">
 <input type="hidden" name="selectrole" value="$ENV{'form.selectrole'}" />  <input type="hidden" name="selectrole" value="1" />
   <input type="hidden" name="$trolecode" value="1" />
 <input type="text" size="20" name="newkey" value="$ENV{'form.newkey'}" />  <input type="text" size="20" name="newkey" value="$ENV{'form.newkey'}" />
 <input type="submit" value="Enter key" />  <input type="submit" value="Enter key" />
 </form>  </form>
Line 156  ENDENTERKEY Line 214  ENDENTERKEY
      }       }
  }   }
      }       }
                     my $tadv=0;      &Apache::lonnet::log($ENV{'user.domain'},
                     if (($trolecode!~/^st/) &&    $ENV{'user.name'},
                         ($trolecode!~/^ta/) &&    $ENV{'user.home'},
                         ($trolecode!~/^cm/)) { $tadv=1; }   "Role ".$trolecode);
       
     &Apache::lonnet::appenv(      &Apache::lonnet::appenv(
                                            'request.role'        => $trolecode,     'request.role'        => $trolecode,
    'request.role.adv'    => $tadv,  
    'request.role.domain' => $cdom,     'request.role.domain' => $cdom,
    'request.course.sec'  => $csec);     'request.course.sec'  => $csec);
                       my $tadv=0;
       if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
       &Apache::lonnet::appenv('request.role.adv'    => $tadv);
   
     my $msg=&mt('Entering course ...');      my $msg=&mt('Entering course ...');
   
     if (($cnum) && ($role ne 'ca')) {      if (($cnum) && ($role ne 'ca')) {
Line 200  ENDENTERKEY Line 262  ENDENTERKEY
   '.course.helper.not.run'}) {    '.course.helper.not.run'}) {
  $furl = "/adm/helper/course.initialization.helper";   $furl = "/adm/helper/course.initialization.helper";
     }      }
                               # Check to see if the user is a DC coming from the
                               # course selection page
                               my $dcflag = 0;
                               if ($ENV{'form.dccourse'}) {
                                   my $formaction = '/adm/roles/';
                                   my ($dcdom,$pickedcourse) = split/_/,$courseid;
                                   if ($ENV{'user.role.dc./'.$dcdom.'/'}) {
                                       &Apache::lonhtmlcommon::store_recent('cc_pickby_dc_'.$dcdom,
                                       $courseid,$formaction);
                                   }
                               }
                             #                              #
                             # Send the user to the course they selected                              # Send the user to the course they selected
                             &redirect_user($r,&mt('Entering Course'),                              &redirect_user($r,&mt('Entering Course'),
                                            $furl,$msg);                                             $furl,$msg,
      $ENV{'environment.remotenavmap'});
                             return OK;                              return OK;
  }   }
     }      }
Line 222  ENDENTERKEY Line 296  ENDENTERKEY
                                        $redirect_url);                                         $redirect_url);
                         return OK;                          return OK;
                     }                      }
                       if ($role eq 'dc') {
                           unless ($dcselect) {
                               my $redirect_url = '/adm/menu/';
                               &redirect_user($r,&mt('Loading Domain Coordinator Menu'),
                                          $redirect_url);
                               return OK;
                           }
                       }
  }   }
             }              }
         }          }
Line 236  ENDENTERKEY Line 318  ENDENTERKEY
     return OK if $r->header_only;      return OK if $r->header_only;
   
     my $swinfo=&Apache::lonmenu::rawconfig();      my $swinfo=&Apache::lonmenu::rawconfig();
       my $setDCchoice = &dc_script();
     my $bodytag=&Apache::loncommon::bodytag('User Roles');      my $bodytag=&Apache::loncommon::bodytag('User Roles');
     my $helptag='<table><tr><td>'.&Apache::loncommon::help_open_topic      my $helptag='<table><tr><td>'.&Apache::loncommon::help_open_menu('','General Intro','General_Intro','User Roles',1,undef,undef,undef,undef,,&mt("Click here for help")).'</td></td></tr></table>';
      ("General_Intro",&mt("Click here for help")).'</td><td>'.  
       &Apache::loncommon::help_open_faq(1,&mt('Click here for FAQ')).'</td><td>'.  
       &Apache::loncommon::help_open_bug('',&mt('Click here to report bugs')).'</td></tr></table>';  
     $r->print(<<ENDHEADER);      $r->print(<<ENDHEADER);
 <html>  <html>
 <head>  <head>
Line 251  $helptag<br /> Line 331  $helptag<br />
 <script>  <script>
 $swinfo  $swinfo
 window.focus();  window.focus();
   $setDCchoice
 </script>  </script>
 ENDHEADER  ENDHEADER
   
Line 269  ENDHEADER Line 350  ENDHEADER
     my $tryagain=$ENV{'form.tryagain'};      my $tryagain=$ENV{'form.tryagain'};
   
 # -------------------------------------------------------- Generate Page Output  # -------------------------------------------------------- Generate Page Output
   # -------------------------------------------------------- Domain Coordinator? 
       if ($dcselect ne '') {
           &choosecourse_display($r,$dcselect,$then,$now);
           return OK;
       }
   
 # --------------------------------------------------------------- Error Header?  # --------------------------------------------------------------- Error Header?
     if ($error) {      if ($error) {
  $r->print("<h1>LON-CAPA Access Control</h1>");   $r->print("<h1>LON-CAPA Access Control</h1>");
Line 306  ENDHEADER Line 393  ENDHEADER
       "<br />\n");        "<br />\n");
     $r->print(&mt(      $r->print(&mt(
       "Author and Co-Author roles may not be available on servers other than your home server."));        "Author and Co-Author roles may not be available on servers other than your home server."));
         } else {  
     $r->print("<h2>".&mt('Select a Course to Enter')."</h2>\n");  
         }          }
         if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {          if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
        $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};         $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
         }          }
         $r->print('<form method=post action="'.(($fn)?$fn:$r->uri).'">');          $r->print('<form method="post" name="rolechoice" action="'.(($fn)?$fn:$r->uri).'">');
         $r->print('<input type=hidden name=orgurl value="'.$fn.'">');          $r->print('<input type=hidden name=orgurl value="'.$fn.'">');
         $r->print('<input type=hidden name=selectrole value=1>');          $r->print('<input type=hidden name=selectrole value=1>');
     }      }
Line 322  ENDHEADER Line 407  ENDHEADER
  if ($ENV{'form.showall'}) { $r->print(' checked'); }   if ($ENV{'form.showall'}) { $r->print(' checked'); }
  $r->print('><input type=submit value="'.&mt('Display').'">');   $r->print('><input type=submit value="'.&mt('Display').'">');
     }      }
 # ----------------------------------------------------------------------- Table  
     $r->print('<br /><table><tr>');      my %dcroles = ();
     unless ($nochoose) { $r->print('<th>&nbsp;</th>'); }      my $numdc = &check_fordc(\%dcroles,$then);
     $r->print('<th>'.&mt('User Role').'</th><th colspan=2>'.&mt('Extent').  
          '</th><th>'.&mt('Start').'</th><th>'.&mt('End').'</th><th>'.  
       &mt('Remark').'</th></tr>'."\n");  
   
     my (%roletext,%sortrole,%roleclass);      my (%roletext,%sortrole,%roleclass);
       my $countactive=0;
       my $inrole=0;
       my $possiblerole='';
     foreach $envkey (sort keys %ENV) {      foreach $envkey (sort keys %ENV) {
         my $button = 1;          my $button = 1;
         my $switchserver='';          my $switchserver='';
  my $roletext;   my $roletext;
  my $sortkey;   my $sortkey;
         if ($envkey=~/^user\.role\./) {          if ($envkey=~/^user\.role\./) {
     my (undef,undef,$role,@pwhere)=split(/\./,$envkey);              my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend,$tfont);
               &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
             next if (!defined($role) || $role eq '');              next if (!defined($role) || $role eq '');
             my $where=join('.',@pwhere);              $tremark='';
             my $trolecode=$role.'.'.$where;              $tpstart='&nbsp;';
             my ($tstart,$tend)=split(/\./,$ENV{$envkey});              $tpend='&nbsp;';
             my $tremark='';              $tfont='#000000';
             my $tstatus='is';  
             my $tpstart='&nbsp;';  
             my $tpend='&nbsp;';  
             my $tfont='#000000';  
             if ($tstart) {              if ($tstart) {
  if ($tstart>$then) {   
                     $tstatus='future';  
                     if ($tstart<$now) { $tstatus='will'; }  
                 }  
                 $tpstart=&Apache::lonlocal::locallocaltime($tstart);                  $tpstart=&Apache::lonlocal::locallocaltime($tstart);
             }              }
             if ($tend) {              if ($tend) {
                 if ($tend<$then) {   
                     $tstatus='expired';   
                 } elsif ($tend<$now) {   
                     $tstatus='will_not';   
                 }  
                 $tpend=&Apache::lonlocal::locallocaltime($tend);                  $tpend=&Apache::lonlocal::locallocaltime($tend);
             }              }
             if ($ENV{'request.role'} eq $trolecode) {              if ($ENV{'request.role'} eq $trolecode) {
Line 370  ENDHEADER Line 443  ENDHEADER
                 if ($tstatus eq 'is') {                  if ($tstatus eq 'is') {
                     $tbg='#77FF77';                      $tbg='#77FF77';
                     $tfont='#003300';                      $tfont='#003300';
       $possiblerole=$trolecode;
       $countactive++;
                 } elsif ($tstatus eq 'future') {                  } elsif ($tstatus eq 'future') {
                     $tbg='#FFFF77';                      $tbg='#FFFF77';
                     $button=0;                      $button=0;
Line 386  ENDHEADER Line 461  ENDHEADER
                 } elsif ($tstatus eq 'selected') {                  } elsif ($tstatus eq 'selected') {
                     $tbg='#11CC55';                      $tbg='#11CC55';
                     $tfont='#002200';                      $tfont='#002200';
       $inrole=1;
       $countactive++;
                     $tremark.=&mt('Currently selected. ');                      $tremark.=&mt('Currently selected. ');
                 }                  }
                 my $trole;                  my $trole;
Line 413  ENDHEADER Line 490  ENDHEADER
                          $Apache::lonnet::hostname{$home}.                           $Apache::lonnet::hostname{$home}.
                          '/adm/login?domain='.$ENV{'user.domain'}.                           '/adm/login?domain='.$ENV{'user.domain'}.
   '&username='.$ENV{'user.name'}.    '&username='.$ENV{'user.name'}.
                           '&firsturl=/priv/'.$trest);                            '&firsturl=/priv/'.$trest.'/');
                     }                      }
                     #next if ($home eq 'no_host');                      #next if ($home eq 'no_host');
                     $home = $Apache::lonnet::hostname{$home};                      $home = $Apache::lonnet::hostname{$home};
Line 437  ENDHEADER Line 514  ENDHEADER
                          $Apache::lonnet::hostname{$home}.                           $Apache::lonnet::hostname{$home}.
                           '/adm/login?domain='.$ENV{'user.domain'}.                            '/adm/login?domain='.$ENV{'user.domain'}.
    '&username='.$ENV{'user.name'}.     '&username='.$ENV{'user.name'}.
                            '&firsturl=/priv/'.$ENV{'user.name'});                             '&firsturl=/priv/'.$ENV{'user.name'}.'/');
                     }                      }
                     #next if ($home eq 'no_host');                      #next if ($home eq 'no_host');
                     $home = $Apache::lonnet::hostname{$home};                      $home = $Apache::lonnet::hostname{$home};
Line 530  ENDHEADER Line 607  ENDHEADER
     }      }
         }          }
     }      }
   # No active roles
       if ($countactive==0) {
    if ($inrole) {
       $r->print('<h2>'.&mt('Currently no additional roles or courses').'</h2>');
    } else {
       $r->print('<h2>'.&mt('Currently no active roles or courses').'</h2>');
    }
    $r->print('</form></body></html>');
    return OK;
   # Is there only one choice?
       } elsif (($countactive==1) && ($ENV{'request.role'} eq 'cm')) {
    $r->print('<h3>'.&mt('Please stand by.').'</h3>'.
       '<input type="hidden" name="'.$possiblerole.'" value="1" />');
    $r->print("</form>\n");
    $r->rflush();
    $r->print('<script>document.forms.rolechoice.submit();</script>');
    $r->print('</body></html>');
    return OK;
       }
   # More than one possible role
   # ----------------------------------------------------------------------- Table
       unless (($advanced) || ($nochoose)) {
    $r->print("<h2>".&mt('Select a Course to Enter')."</h2>\n");
       }
       $r->print('<br /><table><tr>');
       unless ($nochoose) { $r->print('<th>&nbsp;</th>'); }
       $r->print('<th>'.&mt('User Role').'</th><th colspan=2>'.&mt('Extent').
            '</th><th>'.&mt('Start').'</th><th>'.&mt('End').'</th><th>'.
         &mt('Remarks and Calendar Announcements').'</th></tr>'."\n");
     my $doheaders=-1;      my $doheaders=-1;
     foreach my $type ('Construction Space','Course','Domain','System') {      foreach my $type ('Construction Space','Course','Domain','System') {
  my $haverole=0;   my $haverole=0;
Line 540  ENDHEADER Line 646  ENDHEADER
  }   }
  if ($haverole) { $doheaders++; }   if ($haverole) { $doheaders++; }
     }      }
     foreach my $type ('Construction Space','Course','Domain','System') {      if ($numdc > 0) {
  my $output;           $r->print('<tr bgcolor="#BBffBB">'.
  foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {                        '<td align="center" colspan="7">'.
     if ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/) {                         '<input type="hidden" name="all_cc_roles" value="1"/>'.
  $output.=&mt($roletext{$sortrole{$which}});                        '<input type="hidden" name="dcselected" value=""/>'.
                         &mt('Domain').'</td>');
            foreach my $dcdom (keys %dcroles) {
                my $output = $roletext{$dcroles{$dcdom}};
                my $ccrole = Apache::lonnet::plaintext('cc');
                if ($ENV{'request.role'} =~ m-cc\./$dcdom/-) {
                    $output.=$roletext{'user.role.'.$ENV{'request.role'}};
                }
                $r->print($output);
                $r->print('<tr bgcolor="#77FF77">');
                $r->print('<td><input type="button" value="'.
                         &mt('Select').'" name="dcpick_'.$dcdom.'/" '.
                         'onClick="setDCchoice('."'$dcdom'".')"></td>'.
                         '<td><font color="#002200">'.
                         $ccrole.'</font></td><td>'.&mt('Course').'</td>'.
                         '<td><font color="#002200"><b>'.&mt('All courses').'</b>'.
                         '<br />'.&mt('Domain').':'.$dcdom.'</font>'.
                         '<td colspan="4"><font color="#002200">'.
                         &mt('Course Coordinator access to all courses in domain').
                         ': <b>'.$dcdom.'</b></font></td></tr>'."\n");
            }
            foreach my $type ('Construction Space','Course','Domain','System') {
                my $output;
                foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {
                   my $skiprole = 0;
                   foreach my $dcdom (keys %dcroles) {
                       if ($sortrole{$which} =~ m-(dc|cc)\./$dcdom/-) {
                           $skiprole = 1;
                           last;
                       }
                   }
                   if (($roleclass{$sortrole{$which}} =~ /^\Q$type\E/) && (!$skiprole)) {
                       $output.=$roletext{$sortrole{$which}};
                   }
               }
               if ($output) {
                   if ($doheaders > 0) {
                       $r->print("<tr bgcolor='#BBffBB'>".
                             "<td align='center' colspan='7'>".&mt($type)."</td>
   ");
                   }
                   $r->print($output);
               }
           }
       } else {
           foreach my $type ('Construction Space','Course','Domain','System') {
       my $output;
       foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {
           if ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/) { 
       $output.=$roletext{$sortrole{$which}};
           }
     }      }
  }      if ($output) {
  if ($output) {          if ($doheaders > 0) {
     if ($doheaders > 0) {      $r->print("<tr bgcolor='#BBffBB'>".
  $r->print("<tr bgcolor='#BBffBB'>".        "<td align='center' colspan='7'>".&mt($type)."</td>");
   "<td align='center' colspan='7'>".&mt($type)."</td>");          }
           $r->print($output);    
     }      }
     $r->print($output);              }
  }  
     }      }
     my $tremark='';      my $tremark='';
     my $tfont='#003300';      my $tfont='#003300';
Line 637  ENDHEADER Line 793  ENDHEADER
     $r->print(&Apache::lonnet::getannounce());      $r->print(&Apache::lonnet::getannounce());
     if ($advanced) {      if ($advanced) {
  $r->print('<p><small><i>This is LON-CAPA '.   $r->print('<p><small><i>This is LON-CAPA '.
   $r->dir_config('lonVersion').'</i></small></p>');    $r->dir_config('lonVersion').'</i><br />'.
     '<a href="/adm/logout">'.&mt('Logout').'</a></small></p>');
     }      }
     $r->print("</body></html>\n");      $r->print("</body></html>\n");
     return OK;      return OK;
 }   }
   
   sub role_status {
       my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
       my @pwhere = ();
       if (exists($ENV{$rolekey}) && $ENV{$rolekey} ne '') {
           (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
           unless (!defined($$role) || $$role eq '') {
               $$where=join('.',@pwhere);
               $$trolecode=$$role.'.'.$$where;
               ($$tstart,$$tend)=split(/\./,$ENV{$rolekey});
               $$tstatus='is';
               if ($$tstart) {
                   if ($$tstart>$then) {
                       $$tstatus='future';
                       if ($$tstart<$now) { $$tstatus='will'; }
                   }
               }
               if ($$tend) {
                   if ($$tend<$then) {
                       $$tstatus='expired';
                   } elsif ($$tend<$now) {
                       $$tstatus='will_not';
                   }
               }
           }
       }
   }
   
   sub dc_script {
       my $response = (<<"END");
   function setDCchoice(caller) {
       var dcname = "dc./"+caller+"/"
       document.rolechoice.dcselected.value = caller
       document.rolechoice.elements[3].name = dcname
       document.rolechoice.submit()
   }
   END
       return $response;
   }
                                                                                    
   sub check_fordc {
       my ($dcroles,$then) = @_;
       my $numdc = 0;
       if ($ENV{'user.adv'}) {
           foreach my $envkey (sort keys %ENV) {
               if ($envkey=~/^user\.role\.dc\.\/(\w+)\/$/) {
                   my $dcdom = $1;
                   my $livedc = 1;
                   my ($tstart,$tend)=split(/\./,$ENV{$envkey});
                   if ($tstart) {
                       if ($tstart>$then) {
                           $livedc = 0;
                       }
                   }
                   if ($tend) {
                       if ($tend<$then) {
                           $livedc = 0;
                       }
                   }
                   if ($livedc) {
                       $$dcroles{$dcdom} = $envkey;
                       $numdc ++;
                   }
               }
           }
       }
       return $numdc;
   }
   
   sub choosecourse_display {
       my ($r,$dcdom,$then,$now) = @_;
       my $cb_jscript = &Apache::loncommon::coursebrowser_javascript($dcdom,'dom');
       my $verify_script = <<"END";
   <script>
   function verifyCoursePick() {
       var pickedCourse = document.roles.dccourse.value
       var pickedDomain = document.roles.dcdomain.value
       if (document.roles.dcdomain.value == document.roles.origdom.value) {
           if (pickedCourse != '') {
               var courseTarget = "cc./"+pickedDomain+"/"+pickedCourse
               document.roles.elements[0].value = 1
               document.roles.elements[0].name = courseTarget
               document.roles.selectrole.value = 1
               document.roles.submit()
           }
           else {
               alert("You must use the 'Select Course' link to open a separate pick course window which you can use to select the course you wish to enter");
           }
       }
       else {
           alert("You can only use this screen to select courses in the current domain")
       }
   }
   </script>
   END
       my $courseform=&Apache::loncommon::selectcourse_link
                        ('roles','dccourse','dcdomain','coursedesc');
       $r->print($cb_jscript.$verify_script);
       my $formaction='/adm/roles';
       $formaction=~s/\/+/\//g;
       my $crs;
       &select_recent_courses($r,$dcdom,$then,$now);
       $r->print('<br /><form name="roles" method="post" action="'.$formaction.'" />');
       $r->print('<h3>'.&mt('Choose a course from domain').': '.$dcdom.'</h3><font size="+1">'.$courseform.'</font><br /><br />'.
                 '<input type="hidden" name="chosencourse" value=""/>'.
                 'Course Title: <input type="text" size="20" name="coursedesc" value=""><br />'.
                 'Course ID: <input type="text" size="15" name="dccourse" />'.
                 '<input type="hidden" name="dcdomain" value="'.$dcdom.'" />'.
                 '<input type="hidden" name="origdom" value="'.$dcdom.'" />'.
                 '<input type="hidden" name="selectrole" value="" />'.
                 '<br /><br /><input type="button" name="proceed" value="'.&mt('Enter this course').'" onClick="verifyCoursePick()" />'.
                 '</form>');
       return;
   }
   
   sub select_recent_courses {
       my ($r,$dcdom,$then,$now)=@_;
       my $advanced = $ENV{'user.adv'};
       my $tryagain = $ENV{'form.tryagain'};
       my %recent=&Apache::lonnet::dump(&recent_filename('cc_pickby_dc_'.$dcdom));
       my $numrecent = 0;
       my $roletext = '<h3>'.&mt('Enter a recently visited course').'</h3>'.
                      '<form name="rolechoice" action="/adm/roles" method="post">'.
                      '<table><tr><th>&nbsp;</th>'.
                      '<th>'.&mt('User Role').'</th><th colspan=2>'.&mt('Extent').
                      '</th><th>'.&mt('Start').'</th><th>'.&mt('End').'</th><th>'.
                      &mt('Remarks and Calendar Announcements').'</th></tr>'."\n".
                      '<tr bgcolor="#BBffBB">'.
                      '<td align="center" colspan="7">'.
                      &mt('Domain').' - '.&mt('Recent courses accessed in this domain').
                       '</td></tr>'."\n";
       foreach my $courseid (sort keys %recent) {
           unless ($courseid =~/^error\:/) {
               my ($dom,$crs) = split/_/,$courseid;
               if ($dom eq $dcdom) {
                   $numrecent ++;
                   my $crskey = 'user.role.cc./'.$dom.'/'.$crs;
                   my ($where,$trolecode,$role,$tstatus,$tend,$tstart,$tbg,$tfont,$tremark,$inrole,$tpstart,$tpend);
                   my $button = 1;
                   &role_status($crskey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
                   if ($tstart) {
                       $tpstart=&Apache::lonlocal::locallocaltime($tstart);
                   }
                   if ($tend) {
                       $tpend=&Apache::lonlocal::locallocaltime($tend);
                   }
                   my $ttype = &mt('Course');
                   my $twhere;
                   if ($ENV{'course.'.$courseid.'.description'}) {
                       $twhere=$ENV{'course.'.$courseid.'.description'};
                   }
                   my ($tdom,$trest,$tsection)=
                       split(/\//,Apache::lonnet::declutter($where));
                   if ($ENV{'request.role'} eq $trolecode) {
                       $tstatus='selected';
                   }
                   if ($tstatus eq 'is') {
                       $tbg='#77FF77';
                       $tfont='#003300';
                   } elsif ($tstatus eq 'future') {
                       $tbg='#FFFF77';
                       $button=0;
                   } elsif ($tstatus eq 'will') {
                       $tbg='#FFAA77';
                       $tremark.=&mt('Active at next login. ');
                   } elsif ($tstatus eq 'expired') {
                       $tbg='#FF7777';
                       $tfont='#330000';
                       $button=0;
                   } elsif ($tstatus eq 'will_not') {
                       $tbg='#AAFF77';
                       $tremark.=&mt('Expired after logout. ');
                   } elsif ($tstatus eq 'selected') {
                       $tbg='#11CC55';
                       $tfont='#002200';
                       $inrole=1;
                       $tremark.=&mt('Currently selected. ');
                   }
                   my $trole=Apache::lonnet::plaintext($role);
                   $roletext.='<tr bgcolor='.$tbg.'>';
                   if (!$button) {
                       $roletext.=('<td>&nbsp;</td>');
                   } elsif ($tstatus eq 'is') {
                       $roletext.=('<td><input type=submit value="'.
                                 &mt('Select').'" name="'.
                                 $trolecode.'"></td>');
                   } elsif ($tryagain) {
                       $roletext.=
                           '<td><input type=submit value="'.
                           &mt('Try Selecting Again').'" name="'.$trolecode.'"></td>';
                   } elsif ($advanced) {
                       $roletext.=
                           '<td><input type=submit value="'.
                           &mt('Re-Initialize').'" name="'.$trolecode.'"></td>';
                   } else {
                       $roletext.='<td>&nbsp;</td>';
                   }
                   $tremark.=&Apache::lonannounce::showday(time,1,
                            &Apache::lonannounce::readcalendar($tdom.'_'.$trest));
                                                                                     
                   $roletext.='<td><font color="'.$tfont.'">'.$trole.
                         '</font></td><td><font color="'.$tfont.'">'.$ttype.
                         '</font></td><td><font color="'.$tfont.'">'.$twhere.
                         '</font></td><td><font color="'.$tfont.'">'.$tpstart.
                         '</font></td><td><font color="'.$tfont.'">'.$tpend.
                         '</font></td><td><font color="'.$tfont.'">'.$tremark.
                         '&nbsp;</font></td></tr>'."\n";
               }
           }
       }
       if ($numrecent > 0) {
           $r->print($roletext.'</table><input type="hidden" '.
                     'name="selectrole" value="1" /></form>'."\n");
       }
   }
   
   sub recent_filename {
       my $area=shift;
       return 'nohist_recent_'.&Apache::lonnet::escape($area);
   }
   
 1;  1;
 __END__  __END__

Removed from v.1.83  
changed lines
  Added in v.1.104


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