--- loncom/lonnet/perl/lonnet.pm 2005/11/21 19:08:29 1.682 +++ loncom/lonnet/perl/lonnet.pm 2005/11/22 00:01:53 1.683 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.682 2005/11/21 19:08:29 raeburn Exp $ +# $Id: lonnet.pm,v 1.683 2005/11/22 00:01:53 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3703,24 +3703,8 @@ sub auto_instcode_format { # ------------------------------------------------------- Course Group routines sub get_coursegroups { - my ($cdom,$cnum,$curr_groups,$group) = @_; - my $numgroups = 0; - %{$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; + my ($cdom,$cnum,$group) = @_; + return(&dump('coursegroups',$cdom,$cnum,$group)); } sub modify_coursegroup { @@ -3760,6 +3744,49 @@ sub get_active_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 sub plaintext {