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

Diff for /loncom/interface/loncommon.pm between versions 1.473 and 1.488

version 1.473, 2006/11/23 00:04:09 version 1.488, 2006/12/06 11:36:52
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 1377  sub select_form { Line 1377  sub select_form {
     return $selectform;      return $selectform;
 }  }
   
   # For display filters
   
   sub display_filter {
       if (!$env{'form.show'}) { $env{'form.show'}=10; }
       if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
       return '<nobr><label>'.&mt('Records [_1]',
          &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
      (&mt('all'),10,20,50,100,1000,10000))).
      '</label></nobr> <nobr>'.
              &mt('Filter [_1]',
      &select_form($env{'form.displayfilter'},
    'displayfilter',
    ('currentfolder' => 'Current folder/page',
    'containing' => 'Containing phrase',
    'none' => 'None'))).
    '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></nobr>';
   }
   
 sub gradeleveldescription {  sub gradeleveldescription {
     my $gradelevel=shift;      my $gradelevel=shift;
     my %gradelevels=(0 => 'Not specified',      my %gradelevels=(0 => 'Not specified',
Line 2786  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+)} ) {          $uname = $env{'user.name'};
     my ($role,$domain,$id) = ($1,$2,$3);      }
     next if ($role eq 'ca' || $role eq 'aa');      if (!defined($udom)) {
     next if (%roles && !exists($roles{$role}));          $udom = $env{'user.domain'};
     my ($starttime,$endtime)=split(/\./,$env{$key});      }
             my $active=1;      if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
             if ($starttime) {          my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
  if ($now<$starttime) { $active=0; }          if (!%roles) {
               %roles = (
                          cc => 1,
                          in => 1,
                          ep => 1,
                          ta => 1,
                          cr => 1,
                          st => 1,
                );
           }
           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 ($endtime) {              if ($tend) {
                 if ($now>$endtime) { $active=0; }                  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;
                   }
             }              }
             if ($active) { $courses{$domain.'_'.$id}=1; }  
         }          }
     }      }
     return keys(%courses);      return %courses;
 }  }
   
 ###############################################  ###############################################
   
   sub blockcheck {
       my ($setters,$activity,$uname,$udom) = @_;
       # Retrieve active course roles - course coordinator, instructor, exam proctor, ta, student or custom role.
   
       my %live_courses = &findallcourses(undef,$uname,$udom);
   
       # Retrieve blocking times and identity of blocker for active courses
       # of specified user, unless user has 'evb' privilege.
   
       my $startblock = 0;
       my $endblock = 0;
   
       foreach my $course (keys(%live_courses)) {
           my ($cdom,$cnum);
           if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
               $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}})) {
               my $checkrole = 'cm./'.$cdom.'/'.$cnum;
               if ($sec ne 'none') {
                   $checkrole .= '/'.$sec;
               }
               if ((defined($uname) && ($uname ne $env{'user.name'})) ||
                    (defined($udom) && ($udom ne $env{'user.domain'}))) { 
                   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
           next if (($no_ownblock) &&
                    ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
           next if ($no_userblock);
   
           $setters->{$course} = {};
           $setters->{$course}{'staff'} = [];
           $setters->{$course}{'times'} = [];
           my %records = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
           foreach my $record (keys(%records)) {
               my ($start,$end) = ($record =~ m/^(\d+)____(\d+)$/);
               if ($start <= time && $end >= time) {
                   my ($staff_name,$staff_dom,$title,$blocks) =
                       &parse_block_record($records{$record});
                   if ($blocks->{$activity} eq 'on') {
                       push(@{$$setters{$course}{'staff'}}, [$staff_name,$staff_dom]);                    push(@{$$setters{$course}{'times'}}, [$start,$end]);
                       if ( ($startblock == 0) || ($startblock > $1) ) {
                           $startblock = $1;
                       }
                       if ( ($endblock == 0) || ($endblock < $2) ) {
                           $endblock = $2;
                       }
                   }
               }
           }
       }
       return ($startblock,$endblock);
   }
   
   sub parse_block_record {
       my ($record) = @_;
       my ($setuname,$setudom,$title,$blocks);
       if (ref($record) eq 'HASH') {
           ($setuname,$setudom) = split(/:/,$record->{'setter'});
           $title = &unescape($record->{'event'});
           $blocks = $record->{'blocks'};
       } else {
           my @data = split(/:/,$record,3);
           if (scalar(@data) eq 2) {
               $title = $data[1];
               ($setuname,$setudom) = split(/@/,$data[0]);
           } else {
               ($setuname,$setudom,$title) = @data;
           }
           $blocks = { 'com' => 'on' };
       }
       return ($setuname,$setudom,$title,$blocks);
   }
   
   sub build_block_table {
       my ($startblock,$endblock,$setters) = @_;
       my %lt = &Apache::lonlocal::texthash(
           'cacb' => 'Currently active communication blocks',
           'cour' => 'Course',
           'dura' => 'Duration',
           'blse' => 'Block set by'
       );
       my $output;
       $output = '<br />'.$lt{'cacb'}.':<br />';
       $output .= &start_data_table();
       $output .= '
   <tr>
    <th>'.$lt{'cour'}.'</th>
    <th>'.$lt{'dura'}.'</th>
    <th>'.$lt{'blse'}.'</th>
   </tr>
   ';
       foreach my $course (keys(%{$setters})) {
           my %courseinfo=&Apache::lonnet::coursedescription($course);
           for (my $i=0; $i<@{$$setters{$course}{staff}}; $i++) {
               my ($uname,$udom) = @{$$setters{$course}{staff}[$i]};
               my $fullname = &aboutmewrapper(&plainname($uname,$udom),$uname,$udom);
               my ($openblock,$closeblock) = @{$$setters{$course}{times}[$i]};
               $openblock = &Apache::lonlocal::locallocaltime($openblock);
               $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
               $output .= &Apache::loncommon::start_data_table_row().
                          '<td>'.$courseinfo{'description'}.'</td>'.
                          '<td>'.$openblock.' to '.$closeblock.'</td>'.
                          '<td>'.$fullname.'.</td>'.
                           &Apache::loncommon::end_data_table_row();
           }
       }
       $output .= &end_data_table();
   }
   
 ###############################################  ###############################################
   
 =pod  =pod
Line 2983  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 3489  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 5003  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 5041  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 5880  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 5889  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 .=
Line 6062  sub construct_course { Line 6289  sub construct_course {
 # if specified, key authority is not course, but user  # if specified, key authority is not course, but user
 # only active if keyaccess is yes  # only active if keyaccess is yes
     if ($args->{'keyauth'}) {      if ($args->{'keyauth'}) {
  $args->{'keyauth'}=~s/[^\w\@]//g;   my ($user,$domain) = split(':',$args->{'keyauth'});
  if ($args->{'keyauth'}) {   $user = &LONCAPA::clean_username($user);
     $cenv{'keyauth'}=$args->{'keyauth'};   $domain = &LONCAPA::clean_username($domain);
    if ($user ne '' && $domain ne '') {
       $cenv{'keyauth'}=$user.':'.$domain;
  }   }
     }      }
   
Removed from v.1.473  
changed lines
  Added in v.1.488

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