Diff for /loncom/interface/loncommon.pm between versions 1.290 and 1.298

version 1.290, 2005/11/15 15:52:51 version 1.298, 2005/11/22 00:01:41
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 1917  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 1953  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 1978  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 2886  ENDROLE Line 2890  ENDROLE
     #      #
     return(<<ENDBODY);      return(<<ENDBODY);
 $bodytag  $bodytag
 <table class="thinborder" width="100%" cellspacing="0" border="0" cellpadding="0">  <table 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 3080  sub get_sections { Line 3084  sub get_sections {
 }  }
   
 ###############################################  ###############################################
                                                                                     
   =pod
                                                                                     
   =item coursegroups
   
   Retrieve information about groups in a course,
   
   Input:
   1. Reference to hash to populate with group information. 
   2. Optional course domain
   3. Optional course number
   4. Optional group name
   
   Course domain and number will be taken from user's
   environment if not supplied. Optional group name will'
   be passed to lonnet::get_coursegroups() as a regexp to
   use in the call to the dump function.
   
   Output
   Returns number of groups in the course (subject to the
   optional group name filter).
   
   Side effects:
   Populates the referenced curr_groups hash, with key,
   value pairs. Keys are group names, corresponding values
   are scalars containing group information in XML. This
   can be sent to &get_group_settings() to be parsed.     
   
   =cut 
   
   ###############################################
   
   sub coursegroups {
       my ($curr_groups,$cdom,$cnum,$group) = @_;
       my $numgroups;
       if (!defined($cdom) || !defined($cnum)) {
           my $cid =  $env{'request.course.id'};
           $cdom = $env{'course.'.$cid.'.domain'};
           $cnum = $env{'course.'.$cid.'.num'};
       }
       %{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
       my ($tmp) = keys(%{$curr_groups});
       if ($tmp=~/^error:/) {
           unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {
               &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.
                                                                      $cdom);
           }
           $numgroups = 0;
       } else {
           $numgroups = keys(%{$curr_groups});
       }
       return $numgroups;
   }
   
   ###############################################
   
   =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 &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  =pod
                                                                                                                                                                   
Line 3128  sub get_course_users { Line 3264  sub get_course_users {
         my $now = time;          my $now = time;
         foreach my $student (keys(%{$classlist})) {          foreach my $student (keys(%{$classlist})) {
             my $match = 0;              my $match = 0;
             if (ref($sections) eq 'ARRAY') && (@{$sections} > 0) {              if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
  unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/,   unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/,
     @{$sections})) {      @{$sections})) {
     next;      next;
Line 3207  sub get_user_info { Line 3343  sub get_user_info {
     my ($udom,$uname,$idx,$userdata) = @_;      my ($udom,$uname,$idx,$userdata) = @_;
     $$userdata{$uname.':'.$udom}[$$idx{fullname}] =       $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
  &plainname($uname,$udom,'lastname');   &plainname($uname,$udom,'lastname');
     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname      $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $udom      $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
     return;      return;
 }  }
   
Line 3350  sub no_cache { Line 3486  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.290  
changed lines
  Added in v.1.298


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