--- loncom/lonnet/perl/lonnet.pm 2005/11/15 22:02:58 1.679 +++ loncom/lonnet/perl/lonnet.pm 2005/11/21 19:08:29 1.682 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.679 2005/11/15 22:02:58 raeburn Exp $ +# $Id: lonnet.pm,v 1.682 2005/11/21 19:08:29 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}; } } } @@ -3745,6 +3743,23 @@ 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; +} + # ------------------------------------------------------------------ Plain Text sub plaintext { @@ -3937,6 +3952,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 '.