Diff for /loncom/interface/loncommon.pm between versions 1.282 and 1.289

version 1.282, 2005/11/08 02:12:24 version 1.289, 2005/11/15 15:40:58
Line 1149  sub domain_select { Line 1149  sub domain_select {
     } &get_domains;      } &get_domains;
     if ($multiple) {      if ($multiple) {
  $domains{''}=&mt('Any domain');   $domains{''}=&mt('Any domain');
  return &multiple_select_form($name,$value,4,%domains);   return &multiple_select_form($name,$value,4,\%domains);
     } else {      } else {
  return &select_form($name,$value,%domains);   return &select_form($name,$value,%domains);
     }      }
Line 1159  sub domain_select { Line 1159  sub domain_select {
   
 =pod  =pod
   
 =item * multiple_select_form($name,$value,$size,%hash)  =item * multiple_select_form($name,$value,$size,$hash,$order)
   
 Returns a string containing a <select> element int multiple mode  Returns a string containing a <select> element int multiple mode
   
Line 1168  Args: Line 1168  Args:
   $name - name of the <select> element    $name - name of the <select> element
   $value - sclara or array ref of values that should already be selected    $value - sclara or array ref of values that should already be selected
   $size - number of rows long the select element is    $size - number of rows long the select element is
   %hash - the elements should be 'option' => 'shown text'    $hash - the elements should be 'option' => 'shown text'
           (shown text should already have been &mt())            (shown text should already have been &mt())
     $order - (optional) array ref of the order to show the elments in
   
 =cut  =cut
   
 #-------------------------------------------  #-------------------------------------------
 sub multiple_select_form {  sub multiple_select_form {
     my ($name,$value,$size,%hash)=@_;      my ($name,$value,$size,$hash,$order)=@_;
     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);      my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
     my $output='';      my $output='';
     if (! defined($size)) {      if (! defined($size)) {
         $size = 4;          $size = 4;
         if (scalar(keys(%hash))<4) {          if (scalar(keys(%$hash))<4) {
             $size = scalar(keys(%hash));              $size = scalar(keys(%$hash));
         }          }
     }      }
     $output.="\n<select name='$name' size='$size' multiple='1'>";      $output.="\n<select name='$name' size='$size' multiple='1'>";
     foreach (sort(keys(%hash))) {      my @order = ref($order) ? @$order
         $output.='<option value="'.$_.'" ';                              : sort(keys(%$hash));
         $output.='selected="selected" ' if ($selected{$_});      foreach my $key (@order) {
         $output.='>'.$hash{$_}."</option>\n";          $output.='<option value="'.$key.'" ';
           $output.='selected="selected" ' if ($selected{$key});
           $output.='>'.$hash->{$key}."</option>\n";
     }      }
     $output.="</select>\n";      $output.="</select>\n";
     return $output;      return $output;
Line 2529  sub pgrdlink { Line 2533  sub pgrdlink {
 Inputs: $text $uname $udom $symb $target  Inputs: $text $uname $udom $symb $target
   
 Returns: A link to parmset.pm such as to see the PPRM view of a  Returns: A link to parmset.pm such as to see the PPRM view of a
 student andn resource  student and a specific resource
   
 =cut  =cut
   
Line 2770  sub bodytag { Line 2774  sub bodytag {
 <style type="text/css">  <style type="text/css">
 h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }  h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
 a:focus { color: red; background: yellow }   a:focus { color: red; background: yellow } 
   table.thinborder { border-collapse: collapse; }
   table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}
   form, .inline { display: inline; }
   .center { text-align: center; }
 </style>  </style>
 <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"  <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
 style="margin-top: 0px;$addstyle" $addentries>  style="margin-top: 0px;$addstyle" $addentries>
Line 2878  ENDROLE Line 2886  ENDROLE
     #      #
     return(<<ENDBODY);      return(<<ENDBODY);
 $bodytag  $bodytag
 <table width="100%" cellspacing="0" border="0" cellpadding="0">  <table class="thinborder" width="100%" cellspacing="0" border="0" cellpadding="0">
 <tr><td bgcolor="$sidebg">  <tr><td bgcolor="$sidebg">
 $upperleft</td>  $upperleft</td>
 <td bgcolor="$sidebg" align="right">$messages&nbsp;</td>  <td bgcolor="$sidebg" align="right">$messages&nbsp;</td>
Line 3086  Incoming parameters: Line 3094  Incoming parameters:
 3. access status: users must have - either active,   3. access status: users must have - either active, 
 previous, future, or all.  previous, future, or all.
 4. reference to array of permissible roles  4. reference to array of permissible roles
 5. reference to results object (hash of hashes).  5. reference to array of section restrictions (optional)
   6. reference to results object (hash of hashes).
   7. reference to optional userdata hash
 Keys of top level hash are roles.  Keys of top level hash are roles.
 Keys of inner hashes are username:domain, with   Keys of inner hashes are username:domain, with 
 values set to access type.  values set to access type.
                                                                                   Optional userdata hash returns an array with arguments in the 
   same order as loncoursedata::get_classlist() for student data.
   
   Entries for end, start, section and status are blank because
   of the possibility of multiple values for non-student roles.
   
 =cut  =cut
                                                                                                                                                                   
 ###############################################  ###############################################
                                                                                                                                                                   
 sub get_course_users {  sub get_course_users {
     my ($cdom,$cnum,$types,$roles,$users) = @_;      my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_;
       my %idx = ();
   
       $idx{udom} = &Apache::loncoursedata::CL_SDOM();
       $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
       $idx{end} = &Apache::loncoursedata::CL_END();
       $idx{start} = &Apache::loncoursedata::CL_START();
       $idx{id} = &Apache::loncoursedata::CL_ID();
       $idx{section} = &Apache::loncoursedata::CL_SECTION();
       $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
       $idx{status} = &Apache::loncoursedata::CL_STATUS();
   
     if (grep/^st$/,@{$roles}) {      if (grep/^st$/,@{$roles}) {
         my $statusidx = &Apache::loncoursedata::CL_STATUS();  
         my $startidx = &Apache::loncoursedata::CL_START();  
         my $endidx = &Apache::loncoursedata::CL_END();  
         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);          my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
         my $now = time;          my $now = time;
         foreach my $student (keys(%{$classlist})) {          foreach my $student (keys(%{$classlist})) {
               my $match = 0;
               if (defined($sections) && (ref($sections) eq 'ARRAY')) {
                   if (@{$sections} > 0) {
                       unless(grep/^$$classlist{$student}[$idx{section}]$/,@{$sections}) {
                           next;
                       }
                   }
               } 
             if (defined($$types{'active'})) {              if (defined($$types{'active'})) {
                 if ($$classlist{$student}[$statusidx] eq 'Active') {                  if ($$classlist{$student}[$idx{status}] eq 'Active') {
                     push(@{$$users{st}{$student}},'active');                      push(@{$$users{st}{$student}},'active');
                       $match = 1;
                 }                  }
             }              }
             if (defined($$types{'previous'})) {              if (defined($$types{'previous'})) {
                 if ($$classlist{$student}[$endidx] <= $now) {                  if ($$classlist{$student}[$idx{end}] <= $now) {
                     push(@{$$users{st}{$student}},'previous');                      push(@{$$users{st}{$student}},'previous');
                       $match = 1;
                 }                  }
             }              }
             if (defined($$types{'future'})) {              if (defined($$types{'future'})) {
                 if (($$classlist{$student}[$startidx] > $now) && ($$classlist{$student}[$endidx] > $now) || ($$classlist{$student}[$endidx] == 0) || ($$classlist{$student}[$endidx] eq '')) {                  if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) || ($$classlist{$student}[$idx{end}] == 0) || ($$classlist{$student}[$idx{end}] eq '')) {
                     push(@{$$users{st}{$student}},'future');                      push(@{$$users{st}{$student}},'future');
                       $match = 1;
                 }                  }
             }              }
               if ($match && defined($userdata)) {
                   $$userdata{$student} = $$classlist{$student};
               }
         }          }
     }      }
     if ((@{$roles} > 0) && (@{$roles} ne "st")) {      if ((@{$roles} > 0) && (@{$roles} ne "st")) {
         my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);          my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);
         foreach my $person (@coursepersonnel) {          foreach my $person (@coursepersonnel) {
               my $match = 0;
             my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);              my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);
             $user =~ s/:$//;              $user =~ s/:$//;
             if (($role) && (grep(/^$role$/,@{$roles}))) {              if (($role) && (grep(/^$role$/,@{$roles}))) {
                 my ($uname,$udom) = split(/:/,$user);                  my ($uname,$udom,$usec) = split(/:/,$user);
                   unless ($usec eq '') {
                       if (defined($sections) && (ref($sections) eq 'ARRAY')) {
                           if (@{$sections} > 0) {
                               unless(grep/^$usec$/,@{$sections}) {
                                   next;
                               }
                           }
                       }
                   }
                 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);
                     foreach my $type (keys(%{$types})) {                       foreach my $type (keys(%{$types})) { 
                         if ($status eq $type) {                          if ($status eq $type) {
                             $$users{$role}{$user} = $type;                              @{$$users{$role}{$user}} = $type;
                               $match = 1;
                           }
                       }
                       if ($match && defined($userdata)) {
                           unless(exists($$userdata{$uname.':'.$udom})) {
                               &get_user_info($udom,$uname,\%idx,$userdata);
                         }                          }
                     }                      }
                 }                  }
Line 3143  sub get_course_users { Line 3196  sub get_course_users {
                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);                  my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                 if ( defined($csettings{'internal.courseowner'}) ) {                  if ( defined($csettings{'internal.courseowner'}) ) {
                     my $owner = $csettings{'internal.courseowner'};                      my $owner = $csettings{'internal.courseowner'};
                     $$users{'ow'}{$owner.':'.$cdom} = 'any';                      @{$$users{'ow'}{$owner.':'.$cdom}} = 'any';
                       if (defined($userdata)) {
                           unless(exists($$userdata{$owner.':'.$cdom})) {
                               &get_user_info($cdom,$owner,\%idx,$userdata);
                           }
                       }
                 }                  }
             }              }
         }          }
Line 3151  sub get_course_users { Line 3209  sub get_course_users {
     return;      return;
 }  }
   
   sub get_user_info {
       my ($udom,$uname,$idx,$userdata) = @_;
       $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
    &plainname($uname,$udom,'lastname');
       $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname
       $$userdata{$uname.':'.$udom}[$$idx{uname}] = $udom
       return;
   }
   
 ###############################################  ###############################################
   

Removed from v.1.282  
changed lines
  Added in v.1.289


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