--- loncom/lonnet/perl/lonnet.pm	2005/11/17 16:58:23	1.680
+++ 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.680 2005/11/17 16:58:23 www Exp $
+# $Id: lonnet.pm,v 1.683 2005/11/22 00:01:53 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2693,21 +2693,19 @@ sub set_userprivs {
     my $author=0;
     my $adv=0;
     my %grouproles = ();
-    my %groups_checked = ();
     if (keys(%{$allgroups}) > 0) {
         foreach my $role (keys %{$allroles}) {
-            my ($trole,$area);
-            if ($role =~ m|^(\w+)\.(/\w+/\w+)|) {
+            my ($trole,$area,$sec,$extendedarea);
+            if ($role =~ m|^(\w+)\.(/\w+/\w+)(/?\w*)|) {
                 $trole = $1;
                 $area = $2;
-                unless ($groups_checked{$area}) {
-                    $groups_checked{$area} = 1;
-                    if (exists($$allgroups{$area})) {
-                        foreach my $group (keys(%{$$allgroups{$area}})) {
-                            my $spec = $trole.'.'.$area;
-                            $grouproles{$spec.'.'.$area.'/'.$group} = 
-                                                    $$allgroups{$area}{$group};
-                        }
+                $sec = $3;
+                $extendedarea = $area.$sec;
+                if (exists($$allgroups{$area})) {
+                    foreach my $group (keys(%{$$allgroups{$area}})) {
+                        my $spec = $trole.'.'.$extendedarea;
+                        $grouproles{$spec.'.'.$area.'/'.$group} = 
+                                                $$allgroups{$area}{$group};
                     }
                 }
             }
@@ -3705,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 {
@@ -3745,6 +3727,66 @@ sub modify_coursegroup_membership {
     return $result;
 }
 
+sub get_active_groups {
+    my ($udom,$uname,$cdom,$cnum) = @_;
+    my $now = time;
+    my %groups = ();
+    foreach my $key (keys(%env)) {
+        if ($key =~ m-user\.role\.gr\./([^/]+)/([^/]+)/(\w+)$-) {
+            my ($start,$end) = split(/\./,$env{$key});
+            if (($end!=0) && ($end<$now)) { next; }
+            if (($start!=0) && ($start>$now)) { next; }
+            if ($1 eq $cdom && $2 eq $cnum) {
+                $groups{$3} = $env{$key} ;
+            }
+        }
+    }
+    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 {