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

Diff for /loncom/interface/loncommon.pm between versions 1.283 and 1.296

version 1.283, 2005/11/08 03:08:15 version 1.296, 2005/11/17 22:59:00
Line 380  sub coursebrowser_javascript { Line 380  sub coursebrowser_javascript {
    return (<<ENDSTDBRW);     return (<<ENDSTDBRW);
 <script type="text/javascript" language="Javascript" >  <script type="text/javascript" language="Javascript" >
     var stdeditbrowser;      var stdeditbrowser;
     function opencrsbrowser(formname,uname,udom,desc,extra_element) {      function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) {
         var url = '/adm/pickcourse?';          var url = '/adm/pickcourse?';
         var filter;          var filter;
         if (filter != null) {          if (filter != null) {
Line 403  sub coursebrowser_javascript { Line 403  sub coursebrowser_javascript {
                 url += '&domainfilter='+extra_element;                  url += '&domainfilter='+extra_element;
             }              }
         }          }
           if (multflag !=null && multflag != '') {
               url += '&multiple='+multflag;
           }
         var title = 'Course_Browser';          var title = 'Course_Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
         options += ',width=700,height=600';          options += ',width=700,height=600';
Line 414  ENDSTDBRW Line 417  ENDSTDBRW
 }  }
   
 sub selectcourse_link {  sub selectcourse_link {
    my ($form,$unameele,$udomele,$desc,$extra_element)=@_;     my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_;
     return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.      return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";          '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'");'."'>".&mt('Select Course')."</a>";
 }  }
   
 sub check_uncheck_jscript {  sub check_uncheck_jscript {
Line 1149  sub domain_select { Line 1152  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 1162  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 1170  Args: Line 1173  Args:
   $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)) {
Line 1185  sub multiple_select_form { Line 1189  sub multiple_select_form {
         }          }
     }      }
     $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 1914  if $first is set to 'lastname' then it r Line 1920  if $first is set to 'lastname' then it r
   
 =cut  =cut
   
   
 ###############################################################  ###############################################################
 sub plainname {  sub plainname {
     my ($uname,$udom,$first)=@_;      my ($uname,$udom,$first)=@_;
     my %names=&Apache::lonnet::get('environment',      my %names=&getnames($uname,$udom);
                     ['firstname','middlename','lastname','generation'],  
  $udom,$uname);  
     my $name=&Apache::lonnet::format_name($names{'firstname'},      my $name=&Apache::lonnet::format_name($names{'firstname'},
   $names{'middlename'},    $names{'middlename'},
   $names{'lastname'},    $names{'lastname'},
Line 1950  if the user does not Line 1955  if the user does not
   
 sub nickname {  sub nickname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     my %names;      my %names=&getnames($uname,$udom);
     if ($uname eq $env{'user.name'} &&  
  $udom eq $env{'user.domain'}) {  
  %names=('nickname'   => $env{'environment.nickname'}  ,  
  'firstname'  => $env{'environment.firstname'} ,  
  'middlename' => $env{'environment.middlename'},  
  'lastname'   => $env{'environment.lastname'}  ,  
  'generation' => $env{'environment.generation'});  
     } else {  
  %names=&Apache::lonnet::get('environment',  
     ['nickname','firstname','middlename',  
      'lastname','generation'],$udom,$uname);  
     }  
     my $name=$names{'nickname'};      my $name=$names{'nickname'};
     if ($name) {      if ($name) {
        $name='&quot;'.$name.'&quot;';          $name='&quot;'.$name.'&quot;'; 
Line 1975  sub nickname { Line 1968  sub nickname {
     return $name;      return $name;
 }  }
   
   sub getnames {
       my ($uname,$udom)=@_;
       my $id=$uname.':'.$udom;
       my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
       if ($cached) {
    return %{$names};
       } else {
    my %loadnames=&Apache::lonnet::get('environment',
                       ['firstname','middlename','lastname','generation','nickname'],
    $udom,$uname);
    &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
    return %loadnames;
       }
   }
   
 # ------------------------------------------------------------------ Screenname  # ------------------------------------------------------------------ Screenname
   
Line 2771  sub bodytag { Line 2778  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 3075  sub get_sections { Line 3086  sub get_sections {
 ###############################################  ###############################################
   
 =pod  =pod
   
   =item get_group_settings
   
   Uses TokeParser to extract group information from the
   XML used to describe course groups.
   
   Input:
   Scalar containing XML (as retrieved from &lonnet::get_coursegroups).
   
   Output:
   Hash containing group information as key=values for (a), and
   hash of hashes for (b)
   
   Keys (in two categories):
   (a) groupname, creator, creation, modified, startdate,enddate.
   Corresponding values are name of the group, creator of the group
   (username:domain), UNIX time for date group was created, and
   settings were last modified, and default start and end access
   times for group members.
   
   (b) functions returned in hash of hashes.
   Outer hash key is functions.
   Inner hash keys are chat,discussion,email,files,homepage,roster.
   Corresponding values are either on or off, depending on
   whther this type of functionality is available for the group.
   
   =cut
                                                                                    
   ###############################################
   
   sub get_group_settings {
       my ($groupinfo)=@_;
       my $parser=HTML::TokeParser->new(\$groupinfo);
       my $token;
       my $tool = '';
       my %content=();
       while ($token=$parser->get_token) {
           if ($token->[0] eq 'S')  {
               my $entry=$token->[1];
               if ($entry eq 'functions') {
                   %{$content{$entry}} = ();
                   $tool = $entry;
               } else {
                   my $value=$parser->get_text('/'.$entry);
                   if ($entry eq 'name') {
                       if ($tool eq 'functions') {
                           my $function = $token->[2]{id};
                           $content{$tool}{$function} = $value;
                       }
                   } elsif ($entry eq 'groupname') {
                       $content{$entry}=&Apache::lonnet::unescape($value);
                   } else {
                       $content{$entry}=$value;
                   }
               }
           } elsif ($token->[0] eq 'E') {
               if ($token->[1] eq 'functions') {
                   $tool = '';
               }
           }
       }
       return %content;
   }
   
   sub check_group_access {
       my ($group) = @_;
       my $access = 1;
       my $now = time;
       my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
       if (($end!=0) && ($end<$now)) { $access = 0; }
       if (($start!=0) && ($start>$now)) { $access=0; }
       return $access;
   }
   
   ###############################################
   
   =pod
                                                                                                                                                                   
 =item get_course_users  =item get_course_users
                                                                                                                                                                   
Line 3087  Incoming parameters: Line 3175  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) = @_;
     if (grep/^st$/,@{$roles}) {      my %idx = ();
         my $statusidx = &Apache::loncoursedata::CL_STATUS();  
         my $startidx = &Apache::loncoursedata::CL_START();      $idx{udom} = &Apache::loncoursedata::CL_SDOM();
         my $endidx = &Apache::loncoursedata::CL_END();      $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})) {
         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 ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
    unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/,
       @{$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(/^\Q$role\E$/,@{$roles}))) {
                 my ($uname,$udom) = split(/:/,$user);                  my ($uname,$udom,$usec) = split(/:/,$user);
                   if ($usec ne '' && (ref($sections) eq 'ARRAY') && 
       @{$sections} > 0) {
       unless(grep(/^\Q$usec\E$/,@{$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) &&
                           !exists($$userdata{$uname.':'.$udom})) {
    &get_user_info($udom,$uname,\%idx,$userdata);
                       }
                 }                  }
             }              }
         }          }
         if (grep/^ow$/,@{$roles}) {          if (grep(/^ow$/,@{$roles})) {
             if ((defined($cdom)) && (defined($cnum))) {              if ((defined($cdom)) && (defined($cnum))) {
                 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) && 
    !exists($$userdata{$owner.':'.$cdom})) {
    &get_user_info($cdom,$owner,\%idx,$userdata);
       }
                 }                  }
             }              }
         }          }
Line 3152  sub get_course_users { Line 3284  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;
   }
   
 ###############################################  ###############################################
   
Line 3292  sub no_cache { Line 3431  sub no_cache {
   
 sub content_type {  sub content_type {
     my ($r,$type,$charset) = @_;      my ($r,$type,$charset) = @_;
       &no_cache($r);
     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }      if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
     unless ($charset) {      unless ($charset) {
  $charset=&Apache::lonlocal::current_encoding;   $charset=&Apache::lonlocal::current_encoding;
Removed from v.1.283  
changed lines
  Added in v.1.296

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