--- loncom/lonnet/perl/lonnet.pm	2005/11/15 21:35:02	1.678
+++ loncom/lonnet/perl/lonnet.pm	2005/11/22 02:24:55	1.684
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.678 2005/11/15 21:35:02 raeburn Exp $
+# $Id: lonnet.pm,v 1.684 2005/11/22 02:24:55 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};
                     }
                 }
             }
@@ -3702,6 +3700,97 @@ sub auto_instcode_format {
     return $response;
 }
 
+# ------------------------------------------------------- Course Group routines
+
+sub get_coursegroups {
+    my ($cdom,$cnum,$group) = @_;
+    return(&dump('coursegroups',$cdom,$cnum,$group));
+}
+
+sub modify_coursegroup {
+    my ($cdom,$cnum,$groupsettings) = @_;
+    return(&put('coursegroups',$groupsettings,$cdom,$cnum));
+}
+
+sub modify_group_roles {
+    my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs) = @_;
+    my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;
+    my $role = 'gr/'.&escape($userprivs);
+    my ($uname,$udom) = split(/:/,$user);
+    my $result = &assignrole($udom,$uname,$url,$role,$end,$start);
+    if ($result eq 'ok') {
+        &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);
+    }
+
+    return $result;
+}
+
+sub modify_coursegroup_membership {
+    my ($cdom,$cnum,$membership) = @_;
+    my $result = &put('groupmembership',$membership,$cdom,$cnum);
+    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 {
@@ -3894,6 +3983,7 @@ sub modifyuser {
     }
     my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }
+    &devalidate_cache_new('namescache',$uname.':'.$udom);
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
 	     $last.', '.$gene.' by '.
@@ -4715,7 +4805,8 @@ sub EXT {
         return $env{'course.'.$courseid.'.'.$spacequalifierrest};
     } elsif ($realm eq 'resource') {
 
-	my $section;
+	my ($section,$group);
+        my @groups = ();
 	if (defined($courseid) && $courseid eq $env{'request.course.id'}) {
 	    if (!$symbparm) { $symbparm=&symbread(); }
 	}
@@ -4735,14 +4826,29 @@ sub EXT {
 	    if (($env{'user.name'} eq $uname) &&
 		($env{'user.domain'} eq $udom)) {
 		$section=$env{'request.course.sec'};
+                @groups=split(/:/,$env{'request.course.groups'});
+                if (@groups > 0) {
+                    @groups = sort(@groups);
+                    $group = $groups[0];
+                }
 	    } else {
 		if (! defined($usection)) {
 		    $section=&getsection($udom,$uname,$courseid);
 		} else {
 		    $section = $usection;
 		}
+                my $grouplist = &get_users_groups($udom,$uname,$courseid);
+                if ($grouplist) {
+                    @groups = split(/:/,$grouplist);
+                    @groups = sort(@groups);
+                    $group = $groups[0];
+                }
 	    }
 
+            my $grplevel=$courseid.'.['.$group.'].'.$spacequalifierrest;
+            my $grplevelr=$courseid.'.['.$group.'].'.$symbparm;
+            my $grplevelm=$courseid.'.['.$group.'].'.$mapparm;
+
 	    my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
 	    my $seclevelr=$courseid.'.['.$section.'].'.$symbparm;
 	    my $seclevelm=$courseid.'.['.$section.'].'.$mapparm;
@@ -4760,8 +4866,17 @@ sub EXT {
 	    if (defined($userreply)) { return $userreply; }
 
 # ------------------------------------------------ second, check some of course
+            my $coursereply;
+            if (defined($group)) {
+                $coursereply = &resdata($env{'course.'.$courseid.'.num'},
+                                     $env{'course.'.$courseid.'.domain'},
+                                     'course',
+                                     ($grplevelr,$grplevelm,$grplevel,
+                                      $courselevelr));
+                if (defined($coursereply)) { return $coursereply; }
+            }
 
-	    my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
+	    $coursereply=&resdata($env{'course.'.$courseid.'.num'},
 				     $env{'course.'.$courseid.'.domain'},
 				     'course',
 				     ($seclevelr,$seclevelm,$seclevel,