--- loncom/lonnet/perl/lonnet.pm 2005/11/15 21:35:02 1.678 +++ 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.678 2005/11/15 21:35:02 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}; } } } @@ -3702,6 +3700,66 @@ sub auto_instcode_format { return $response; } +# ------------------------------------------------------- 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; +} + +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); + 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; +} + # ------------------------------------------------------------------ Plain Text sub plaintext { @@ -3894,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 '.