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

Diff for /loncom/interface/loncommon.pm between versions 1.417 and 1.419

version 1.417, 2006/07/03 03:54:29 version 1.419, 2006/07/04 21:31:02
Line 3512  sub headtag { Line 3512  sub headtag {
     my $function = $args->{'function'} || &get_users_function();      my $function = $args->{'function'} || &get_users_function();
     my $domain   = $args->{'domain'}   || &determinedomain();      my $domain   = $args->{'domain'}   || &determinedomain();
     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);      my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
     my $url = join(':',$env{'user.name'},$env{'user.domain'},time(),      my $url = join(':',$env{'user.name'},$env{'user.domain'},
    #$env{'environment.color.timestamp'},     #time(),
      $env{'environment.color.timestamp'},
    $function,$domain,$bgcolor);     $function,$domain,$bgcolor);
   
     $url = '/adm/css/'.&escape($url).'.css';      $url = '/adm/css/'.&escape($url).'.css';
Line 3961  sub check_user_status { Line 3962  sub check_user_status {
   
 Determines all the sections for a course including  Determines all the sections for a course including
 sections with students and sections containing other roles.  sections with students and sections containing other roles.
 Incoming parameters: domain, course number,   Incoming parameters: 
 reference to array containing roles for which sections should   
 be gathered (optional). If the third argument is undefined,  1. domain
 sections are gathered for any role.  2. course number 
   3. reference to array containing roles for which sections should 
   be gathered (optional).
   4. reference to array containing status types for which sections 
   should be gathered (optional).
   
   If the third argument is undefined, sections are gathered for any role. 
   If the fourth argument is undefined, sections are gathered for any status.
   Permissible values are 'active' or 'future' or 'previous'.
     
 Returns section hash (keys are section IDs, values are  Returns section hash (keys are section IDs, values are
 number of users in each section), subject to the  number of users in each section), subject to the
 optional roles filter.  optional roles filter, optional status filter 
   
 =cut  =cut
   
 ###############################################  ###############################################
 sub get_sections {  sub get_sections {
     my ($cdom,$cnum,$possible_roles) = @_;      my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
     if (!defined($cdom) || !defined($cnum)) {      if (!defined($cdom) || !defined($cnum)) {
         my $cid =  $env{'request.course.id'};          my $cid =  $env{'request.course.id'};
   
Line 3985  sub get_sections { Line 3994  sub get_sections {
     }      }
   
     my %sectioncount;      my %sectioncount;
       my $now = time;
   
     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {      if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
  my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);   my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
  my $sec_index = &Apache::loncoursedata::CL_SECTION();   my $sec_index = &Apache::loncoursedata::CL_SECTION();
  my $status_index = &Apache::loncoursedata::CL_STATUS();   my $status_index = &Apache::loncoursedata::CL_STATUS();
           my $start_index = &Apache::loncoursedata::CL_START();
           my $end_index = &Apache::loncoursedata::CL_END();
           my $status;
  while (my ($student,$data) = each(%$classlist)) {   while (my ($student,$data) = each(%$classlist)) {
     my ($section,$status) = ($data->[$sec_index],      my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
      $data->[$status_index]);                       $data->[$status_index],
     unless ($section eq '-1' || $section =~ /^\s*$/) {                                                       $data->[$start_index],
  $sectioncount{$section}++;                                                       $data->[$end_index]);
               if ($stu_status eq 'Active') {
                   $status = 'active';
               } elsif ($end < $now) {
                   $status = 'previous';
               } elsif ($start > $now) {
                   $status = 'future';
               } 
       if ($section ne '-1' && $section !~ /^\s*$/) {
                   if ((!defined($possible_status)) || (($status ne '') && 
                       (grep/^\Q$status\E$/,@{$possible_status}))) { 
       $sectioncount{$section}++;
                   }
     }      }
  }   }
     }      }
Line 4003  sub get_sections { Line 4028  sub get_sections {
  if ($user !~ /^(\w{2})/) { next; }   if ($user !~ /^(\w{2})/) { next; }
  my ($role) = ($user =~ /^(\w{2})/);   my ($role) = ($user =~ /^(\w{2})/);
  if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }   if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
  my $section;   my ($section,$status);
  if ($role eq 'cr' &&   if ($role eq 'cr' &&
     $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {      $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
     $section=$1;      $section=$1;
  }   }
  if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }   if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
  if (!defined($section) || $section eq '-1') { next; }   if (!defined($section) || $section eq '-1') { next; }
  $sectioncount{$section}++;          my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
           if ($end == -1 && $start == -1) {
               next; #deleted role
           }
           if (!defined($possible_status)) { 
               $sectioncount{$section}++;
           } else {
               if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   $status = 'active';
               } elsif ($end < $now) {
                   $status = 'future';
               } elsif ($start > $now) {
                   $status = 'previous';
               }
               if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   $sectioncount{$section}++;
               }
           }
     }      }
     return %sectioncount;      return %sectioncount;
 }  }
Line 4049  of the possibility of multiple values fo Line 4091  of the possibility of multiple values fo
 sub get_course_users {  sub get_course_users {
     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_;      my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_;
     my %idx = ();      my %idx = ();
       my %seclists;
   
     $idx{udom} = &Apache::loncoursedata::CL_SDOM();      $idx{udom} = &Apache::loncoursedata::CL_SDOM();
     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();      $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
Line 4065  sub get_course_users { Line 4108  sub get_course_users {
         foreach my $student (keys(%{$classlist})) {          foreach my $student (keys(%{$classlist})) {
             my $match = 0;              my $match = 0;
             my $secmatch = 0;              my $secmatch = 0;
               my $section = $$classlist{$student}[$idx{section}];
               if ($section eq '') {
                   $section = 'none';
               }
             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {              if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
                 if (grep/^all$/,@{$sections}) {                  if (grep/^all$/,@{$sections}) {
                     $secmatch = 1;                      $secmatch = 1;
Line 4073  sub get_course_users { Line 4120  sub get_course_users {
                         $secmatch = 1;                          $secmatch = 1;
                     }                      }
                 } else {                    } else {  
     if (grep(/^\Q$$classlist{$student}[$idx{section}]\E$/,      if (grep(/^\Q$section\E$/,@{$sections})) {
     @{$sections})) {  
         $secmatch = 1;          $secmatch = 1;
                     }                      }
  }   }
                 if (!$secmatch) {                  if (!$secmatch) {
                     next;                      next;
                 }                  }
             }               }
               push (@{$seclists{$student}},$section); 
             if (defined($$types{'active'})) {              if (defined($$types{'active'})) {
                 if ($$classlist{$student}[$idx{status}] eq 'Active') {                  if ($$classlist{$student}[$idx{status}] eq 'Active') {
                     push(@{$$users{st}{$student}},'active');                      push(@{$$users{st}{$student}},'active');
Line 4130  sub get_course_users { Line 4177  sub get_course_users {
                         next;                          next;
                     }                      }
                 }                  }
                   if ($usec eq '') {
                       $usec = 'none';
                   }
                 if ($uname ne '' && $udom ne '') {                  if ($uname ne '' && $udom ne '') {
                     my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role,                      my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role,
                                                     $usec);                                                      $usec);
                     foreach my $type (keys(%{$types})) {                       foreach my $type (keys(%{$types})) { 
                         if ($status eq $type) {                          if ($status eq $type) {
                             @{$$users{$role}{$user}} = $type;                              if (!grep/^\Q$type\E$/,@{$$users{$role}{$user}}) {
                                   push(@{$$users{$role}{$user}},$type);
                               }
                             $match = 1;                              $match = 1;
                         }                          }
                     }                      }
                     if (($match) && (ref($userdata) eq 'HASH') &&                      if (($match) && (ref($userdata) eq 'HASH')) {
                         (!exists($$userdata{$uname.':'.$udom}))) {                          if (!exists($$userdata{$uname.':'.$udom})) {
  &get_user_info($udom,$uname,\%idx,$userdata);      &get_user_info($udom,$uname,\%idx,$userdata);
                           }
                           if (!grep/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}}) {
                               push(@{$seclists{$uname.':'.$udom}},$usec);
                           }
                     }                      }
                 }                  }
             }              }
Line 4155  sub get_course_users { Line 4211  sub get_course_users {
                     if (defined($userdata) &&                       if (defined($userdata) && 
  !exists($$userdata{$owner.':'.$cdom})) {   !exists($$userdata{$owner.':'.$cdom})) {
  &get_user_info($cdom,$owner,\%idx,$userdata);   &get_user_info($cdom,$owner,\%idx,$userdata);
                           if (!grep/^none$/,@{$seclists{$owner.':'.$cdom}}) {
                               push(@{$seclists{$owner.':'.$cdom}},'none');
                           }
     }      }
                 }                  }
             }              }
         }          }
           foreach my $user (keys(%seclists)) {
               @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
               $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
           }
     }      }
     return;      return;
 }  }
Removed from v.1.417  
changed lines
  Added in v.1.419

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