Diff for /loncom/interface/loncommon.pm between versions 1.478 and 1.486

version 1.478, 2006/11/29 22:02:47 version 1.486, 2006/12/05 01:51:48
Line 65  use Apache::lonhtmlcommon(); Line 65  use Apache::lonhtmlcommon();
 use Apache::loncoursedata();  use Apache::loncoursedata();
 use Apache::lontexconvert();  use Apache::lontexconvert();
 use Apache::lonclonecourse();  use Apache::lonclonecourse();
 use LONCAPA;  use LONCAPA qw(:DEFAULT :match);
   
 my $readit;  my $readit;
   
Line 157  BEGIN { Line 157  BEGIN {
     opendir(DIR,$designdir);      opendir(DIR,$designdir);
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
  if ($filename!~/\.tab$/) { next; }   if ($filename!~/\.tab$/) { next; }
  my ($domain)=($filename=~/^(\w+)\./);   my ($domain)=($filename=~/^($match_domain)\./);
  {   {
     my $designfile = $designdir.'/'.$filename;      my $designfile = $designdir.'/'.$filename;
     if ( open (my $fh,"<$designfile") ) {      if ( open (my $fh,"<$designfile") ) {
Line 2804  sub maketime { Line 2804  sub maketime {
 #########################################  #########################################
   
 sub findallcourses {  sub findallcourses {
     my ($roles) = @_;      my ($roles,$uname,$udom) = @_;
     my %roles;      my %roles;
     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }      if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
     my %courses;      my %courses;
     my $now=time;      my $now=time;
     foreach my $key (keys(%env)) {      if (!defined($uname)) {
  if ( $key=~m{^user\.role\.(\w+)\./(\w+)/(\w+)/?(\w*)$} ||          $uname = $env{'user.name'};
              $key=~m{^user\.role\.(cr/\w+/\w+/\w+)\./(\w+)/(\w+)}) {      }
     my ($role,$domain,$id,$sec) = ($1,$2,$3,$4);      if (!defined($udom)) {
     next if ($role eq 'ca' || $role eq 'aa');          $udom = $env{'user.domain'};
     next if (%roles && !exists($roles{$role}));      }
     my ($starttime,$endtime)=split(/\./,$env{$key});      if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
             my $active=1;          my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
             if ($starttime) {          if (!%roles) {
  if ($now<$starttime) { $active=0; }              %roles = (
             }                         cc => 1,
             if ($endtime) {                         in => 1,
                 if ($now>$endtime) { $active=0; }                         ep => 1,
             }                         ta => 1,
             if ($active) {                         cr => 1,
                 if ($sec eq '') {                         st => 1,
                     $sec = 'none';               );
           }
           foreach my $entry (keys(%roleshash)) {
               my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
               if ($trole =~ /^cr/) { 
                   next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
               } else {
                   next if (!exists($roles{$trole}));
               }
               if ($tend) {
                   next if ($tend < $now);
               }
               if ($tstart) {
                   next if ($tstart > $now);
               }
               my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role,$realsec);
               (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
               if ($secpart eq '') {
                   ($cnum,$role) = split(/_/,$cnumpart); 
                   $sec = 'none';
                   $realsec = '';
               } else {
                   $cnum = $cnumpart;
                   ($sec,$role) = split(/_/,$secpart);
                   $realsec = $sec;
               }   
               $courses{$cdom.'_'.$cnum}{$sec} = $trole.'/'.$cdom.'/'.$cnum.'/'.$realsec;
           }
       } else {
           foreach my $key (keys(%env)) {
       if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                    $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
           my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
           next if ($role eq 'ca' || $role eq 'aa');
           next if (%roles && !exists($roles{$role}));
           my ($starttime,$endtime)=split(/\./,$env{$key});
                   my $active=1;
                   if ($starttime) {
       if ($now<$starttime) { $active=0; }
                   }
                   if ($endtime) {
                       if ($now>$endtime) { $active=0; }
                   }
                   if ($active) {
                       if ($sec eq '') {
                           $sec = 'none';
                       }
                       $courses{$cdom.'_'.$cnum}{$sec} = 
                                        $role.'/'.$cdom.'/'.$cnum.'/'.$sec;
                 }                  }
                 $courses{$domain.'_'.$id}{$sec} = 1;  
             }              }
         }          }
     }      }
Line 2837  sub findallcourses { Line 2884  sub findallcourses {
 ###############################################  ###############################################
   
 sub blockcheck {  sub blockcheck {
     my ($setters,$activity) = @_;      my ($setters,$activity,$uname,$udom) = @_;
     # Retrieve active student roles and active course coordinator/instructor roles      # Retrieve active course roles - course coordinator, instructor, exam proctor, ta, student or custom role.
   
     my %live_courses = &findallcourses();      my %live_courses = &findallcourses(undef,$uname,$udom);
   
     # Retrieve blocking times and identity of blocker for active courses      # Retrieve blocking times and identity of blocker for active courses
     # unless user has 'evb' privilege.      # of specified user, unless user has 'evb' privilege.
   
     my $startblock = 0;      my $startblock = 0;
     my $endblock = 0;      my $endblock = 0;
   
     foreach my $course (keys(%live_courses)) {      foreach my $course (keys(%live_courses)) {
         my $cdom = $env{'course.'.$course.'.domain'};          my ($cdom,$cnum);
         my $cnum = $env{'course.'.$course.'.num'};          if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
         my $noblock = 0;              $cdom = $env{'course.'.$course.'.domain'};
               $cnum = $env{'course.'.$course.'.num'};
           } else {
              ($cdom,$cnum) = split(/_/,$course); 
           }
           my $no_ownblock = 0;
           my $no_userblock = 0;
         foreach my $sec (keys(%{$live_courses{$course}})) {          foreach my $sec (keys(%{$live_courses{$course}})) {
             my $role = 'cm./'.$cdom.'/'.$cnum;              my $checkrole = 'cm./'.$cdom.'/'.$cnum;
             if ($sec ne 'none') {              if ($sec ne 'none') {
                 $role .= '/'.$sec;                  $checkrole .= '/'.$sec;
             }              }
             if (&Apache::lonnet::allowed('evb',undef,undef,$role)) {              if ((defined($uname) && ($uname ne $env{'user.name'})) ||
                 $noblock = 1;                   (defined($udom) && ($udom ne $env{'user.domain'}))) { 
                 last;                  my ($trole,$tdom,$tnum,$tsec);
                   my $entry = $live_courses{$course}{$sec};
                   if ($entry =~ /^cr/) {
                       ($trole,$tdom,$tnum,$tsec) = 
                         ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   } else {
                       ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   }
                   my ($spec,$area,$trest,%allroles,%userroles);
                   $area = '/'.$tdom.'/'.$tnum;
                   $trest = $tnum;
                   if ($tsec ne '') {
                       $area .= '/'.$tsec;
                       $trest .= '/'.$tsec;
                   }
                   $spec = $trole.'.'.$area;
                   if ($trole =~ /^cr/) {
                       &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                                                         $tdom,$spec,$trest,$area);
                   } else {
                       &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                                                          $tdom,$spec,$trest,$area);
                   }
                   my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                       if ($1) {
                           $no_userblock = 1;
                           last;
                       }
                   }
                } else {
                   if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                       $no_ownblock = 1;
                       last;
                   }
             }              }
         }          }
         # if they have the evb priv and are currently not playing student          # if they have the evb priv and are currently not playing student
         next if (($noblock) &&          next if (($no_ownblock) &&
                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));                   ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
           next if ($no_userblock);
   
         $setters->{$course} = {};          $setters->{$course} = {};
         $setters->{$course}{'staff'} = [];          $setters->{$course}{'staff'} = [];
Line 3118  sub bodytag { Line 3206  sub bodytag {
  # role and realm   # role and realm
     my ($role,$realm) = split(/\./,$env{'request.role'},2);      my ($role,$realm) = split(/\./,$env{'request.role'},2);
     if ($role  eq 'ca') {      if ($role  eq 'ca') {
         my ($rdom,$rname) = ($realm =~ m-^/(\w+)/(\w+)$-);          my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
         $realm = &plainname($rname,$rdom).':'.$rdom;          $realm = &plainname($rname,$rdom).':'.$rdom;
     }       } 
 # realm  # realm
Line 3624  table.LC_whatsnew tr.LC_empty_row td { Line 3712  table.LC_whatsnew tr.LC_empty_row td {
 table.LC_whatsnew tr.LC_empty_row td {  table.LC_whatsnew tr.LC_empty_row td {
   padding: 4ex    padding: 4ex
 }  }
   
   
 table.LC_whatsnew {  table.LC_whatsnew {
 }  }
   
Line 5138  sub record_sep { Line 5224  sub record_sep {
             $i++;              $i++;
         }          }
     } else {      } else {
         my @allfields=split(/\,/,$record);          my @allfields;
           if ($env{'form.upfiletype'} eq 'semisv') {
               @allfields=split(/;/,$record);
           } else {
               @allfields=split(/\,/,$record);
           }
         my $i=0;          my $i=0;
         my $j;          my $j;
         for ($j=0;$j<=$#allfields;$j++) {          for ($j=0;$j<=$#allfields;$j++) {
Line 5176  the file type. Line 5267  the file type.
 sub upfile_select_html {  sub upfile_select_html {
     my %Types = (      my %Types = (
                  csv   => &mt('CSV (comma separated values, spreadsheet)'),                   csv   => &mt('CSV (comma separated values, spreadsheet)'),
                    semisv => &mt('Semicolon separated values'),
                  space => &mt('Space separated'),                   space => &mt('Space separated'),
                  tab   => &mt('Tabulator separated'),                   tab   => &mt('Tabulator separated'),
 #                 xml   => &mt('HTML/XML'),  #                 xml   => &mt('HTML/XML'),
Line 6015  sub construct_course { Line 6107  sub construct_course {
 #  #
 # Check if created correctly  # Check if created correctly
 #  #
     ($$crsudom,$$crsunum)=($$courseid=~/^\/(\w+)\/(\w+)$/);      ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);      my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
     $outcome .= &mt('Created on').': '.$crsuhome.'<br>';      $outcome .= &mt('Created on').': '.$crsuhome.'<br>';
 #  #
Line 6024  sub construct_course { Line 6116  sub construct_course {
     my $cloneid='';      my $cloneid='';
     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {      if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
  $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};   $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
         my ($clonecrsudom,$clonecrsunum)=($cloneid=~/^\/(\w+)\/(\w+)$/);          my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
  my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);   my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
  if ($clonehome eq 'no_host') {   if ($clonehome eq 'no_host') {
     $outcome .=      $outcome .=

Removed from v.1.478  
changed lines
  Added in v.1.486


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