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

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.731 and 1.734

version 1.731, 2006/04/26 14:50:56 version 1.734, 2006/05/01 16:00:44
Line 188  sub reply { Line 188  sub reply {
     my ($cmd,$server)=@_;      my ($cmd,$server)=@_;
     unless (defined($hostname{$server})) { return 'no_such_host'; }      unless (defined($hostname{$server})) { return 'no_such_host'; }
     my $answer=subreply($cmd,$server);      my $answer=subreply($cmd,$server);
     &Apache::lonnet::logthis("$cmd");  
     if (($answer=~/^refused/) || ($answer=~/^rejected/)) {      if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
        &logthis("<font color=\"blue\">WARNING:".         &logthis("<font color=\"blue\">WARNING:".
                 " $cmd to $server returned $answer</font>");                  " $cmd to $server returned $answer</font>");
Line 4017  sub get_group_membership { Line 4016  sub get_group_membership {
   
 sub get_users_groups {  sub get_users_groups {
     my ($udom,$uname,$courseid) = @_;      my ($udom,$uname,$courseid) = @_;
       my @usersgroups;
     my $cachetime=1800;      my $cachetime=1800;
     $courseid=~s/\_/\//g;      $courseid=~s/\_/\//g;
     $courseid=~s/^(\w)/\/$1/;      $courseid=~s/^(\w)/\/$1/;
   
     my $hashid="$udom:$uname:$courseid";      my $hashid="$udom:$uname:$courseid";
     my ($result,$cached)=&is_cached_new('getgroups',$hashid);      my ($grouplist,$cached)=&is_cached_new('getgroups',$hashid);
     if (defined($cached)) { return $result; }      if (defined($cached)) {
           @usersgroups = split(/:/,$grouplist);
     my %roleshash = &dump('roles',$udom,$uname,$courseid);      } else {  
     my ($tmp) = keys(%roleshash);          $grouplist = '';
     if ($tmp=~/^error:/) {          my %roleshash = &dump('roles',$udom,$uname,$courseid);
         &logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom);          my ($tmp) = keys(%roleshash);
         return '';          if ($tmp=~/^error:/) {
     } else {              &logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom);
         my $grouplist;          } else {
         foreach my $key (keys %roleshash) {              my $access_end = $env{'course.'.$courseid.
             if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) {                                    '.default_enrollment_end_date'};
                 unless ($roleshash{$key} =~ /_\d+_\-1$/) {   # deleted membership              my $now = time;
                     $grouplist .= $1.':';              foreach my $key (keys(%roleshash)) {
                   if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) {
                       my $group = $1;
                       if ($roleshash{$key} =~ /_(\d+)_(\d+)$/) {
                           my $start = $2;
                           my $end = $1;
                           if ($start == -1) { next; } # deleted from group
                           if (($start!=0) && ($start>$now)) { next; }
                           if (($end!=0) && ($end<$now)) {
                               if ($access_end && $access_end < $now) {
                                   if ($access_end - $end < 86400) {
                                       push(@usersgroups,$group);
                                   }
                               }
                               next;
                           }
                           push(@usersgroups,$group);
                       }
                 }                  }
             }              }
               @usersgroups = &sort_course_groups($courseid,@usersgroups);
               $grouplist = join(':',@usersgroups);
               &do_cache_new('getgroups',$hashid,$grouplist,$cachetime);
         }          }
         $grouplist =~ s/:$//;  
         return &do_cache_new('getgroups',$hashid,$grouplist,$cachetime);  
     }      }
       return @usersgroups;
 }  }
   
 sub devalidate_getgroups_cache {  sub devalidate_getgroups_cache {
Line 5160  sub EXT { Line 5179  sub EXT {
     if (($env{'user.name'} eq $uname) &&      if (($env{'user.name'} eq $uname) &&
  ($env{'user.domain'} eq $udom)) {   ($env{'user.domain'} eq $udom)) {
  $section=$env{'request.course.sec'};   $section=$env{'request.course.sec'};
                 @groups=&sort_course_groups($env{'request.course.groups'},$courseid);                   @groups = split(/:/,$env{'request.course.groups'});  
                   @groups=&sort_course_groups($courseid,@groups); 
     } else {      } else {
  if (! defined($usection)) {   if (! defined($usection)) {
     $section=&getsection($udom,$uname,$courseid);      $section=&getsection($udom,$uname,$courseid);
  } else {   } else {
     $section = $usection;      $section = $usection;
  }   }
                 my $grouplist = &get_users_groups($udom,$uname,$courseid);                  @groups = &get_users_groups($udom,$uname,$courseid);
                 if ($grouplist) {  
                     @groups=&sort_course_groups($grouplist,$courseid);  
                 }  
     }      }
   
     my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;      my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
Line 5294  sub check_group_parms { Line 5311  sub check_group_parms {
 }  }
   
 sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().  sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
     my ($grouplist,$courseid) = @_;      my ($courseid,@groups) = @_;
     my @groups = sort(split(/:/,$grouplist));      @groups = sort(@groups);
     return @groups;      return @groups;
 }  }
   
Removed from v.1.731  
changed lines
  Added in v.1.734

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