--- loncom/lonnet/perl/lonnet.pm 2005/11/15 21:35:02 1.678 +++ loncom/lonnet/perl/lonnet.pm 2005/11/21 15:41:29 1.681 @@ -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.681 2005/11/21 15:41: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,49 @@ 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; +} + # ------------------------------------------------------------------ Plain Text sub plaintext { @@ -3894,6 +3935,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 '.