Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.682 and 1.683

version 1.682, 2005/11/21 19:08:29 version 1.683, 2005/11/22 00:01:53
Line 3703  sub auto_instcode_format { Line 3703  sub auto_instcode_format {
 # ------------------------------------------------------- Course Group routines  # ------------------------------------------------------- Course Group routines
   
 sub get_coursegroups {  sub get_coursegroups {
     my ($cdom,$cnum,$curr_groups,$group) = @_;      my ($cdom,$cnum,$group) = @_;
     my $numgroups = 0;      return(&dump('coursegroups',$cdom,$cnum,$group));
     %{$curr_groups} = &dump('coursegroups',$cdom,$cnum,$group);  
     my ($tmp)=keys(%{$curr_groups});  
     if ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {  
         my %emptyhash = ();  
         if (&put('coursegroups',\%emptyhash,$cdom,$cnum) eq 'ok') {  
             %{$curr_groups} = &dump('coursegroups',$cdom,$cnum,$group);  
             $tmp=keys(%{$curr_groups});  
         }  
     }  
     if ($tmp=~/^error:/) {  
         &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom);  
     } else {  
         my @groups = keys(%{$curr_groups});  
         $numgroups = @groups;  
     }  
     return $numgroups;  
 }  }
   
 sub modify_coursegroup {  sub modify_coursegroup {
Line 3760  sub get_active_groups { Line 3744  sub get_active_groups {
     return %groups;      return %groups;
 }  }
   
   sub get_group_membership {
       my ($cdom,$cnum,$group) = @_;
       return(&dump('groupmembership',$cdom,$cnum,$group));
   }
   
   sub get_users_groups {
       my ($udom,$uname,$courseid) = @_;
       my $cachetime=1800;
       $courseid=~s/\_/\//g;
       $courseid=~s/^(\w)/\/$1/;
   
       my $hashid="$udom:$uname:$courseid";
       my ($result,$cached)=&is_cached_new('getgroups',$hashid);
       if (defined($cached)) { return $result; }
   
       my %roleshash = &dump('roles',$udom,$uname,$courseid);
       my ($tmp) = keys(%roleshash);
       if ($tmp=~/^error:/) {
           &logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom);
           return '';
       } else {
           my $grouplist;
           foreach my $key (keys %roleshash) {
               if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) {
                   unless ($roleshash{$key} =~ /_1_1$/) {   # deleted membership
                       $grouplist .= $1.':';
                   }
               }
           }
           $grouplist =~ s/:$//;
           return &do_cache_new('getgroups',$hashid,$grouplist,$cachetime);
       }
   }
   
   sub devalidate_getgroups_cache {
       my ($udom,$uname,$cdom,$cnum)=@_;
       my $courseid = $cdom.'_'.$cnum;
       $courseid=~s/\_/\//g;
       $courseid=~s/^(\w)/\/$1/;
       my $hashid="$udom:$uname:$courseid";
       &devalidate_cache_new('getgroups',$hashid);
   }
   
 # ------------------------------------------------------------------ Plain Text  # ------------------------------------------------------------------ Plain Text
   
 sub plaintext {  sub plaintext {

Removed from v.1.682  
changed lines
  Added in v.1.683


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