--- loncom/lonnet/perl/lonnet.pm 2006/11/15 14:35:10 1.804 +++ loncom/lonnet/perl/lonnet.pm 2006/11/21 20:58:06 1.806 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.804 2006/11/15 14:35:10 raeburn Exp $ +# $Id: lonnet.pm,v 1.806 2006/11/21 20:58:06 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -694,6 +694,53 @@ sub idput { } } +# ------------------------------------------- get items from domain db files + +sub get_dom { + my ($namespace,$storearr,$udom)=@_; + my $items=''; + foreach my $item (@$storearr) { + $items.=&escape($item).'&'; + } + $items=~s/\&$//; + if (!$udom) { $udom=$env{'user.domain'}; } + if (exists($domain_primary{$udom})) { + my $uhome=$domain_primary{$udom}; + my $rep=&reply("getdom:$udom:$namespace:$items",$uhome); + my @pairs=split(/\&/,$rep); + if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) { + return @pairs; + } + my %returnhash=(); + my $i=0; + foreach my $item (@$storearr) { + $returnhash{$item}=&thaw_unescape($pairs[$i]); + $i++; + } + return %returnhash; + } else { + &logthis("get_dom failed - no primary domain server for $udom"); + } +} + +# -------------------------------------------- put items in domain db files + +sub put_dom { + my ($namespace,$storehash,$udom)=@_; + if (!$udom) { $udom=$env{'user.domain'}; } + if (exists($domain_primary{$udom})) { + my $uhome=$domain_primary{$udom}; + my $items=''; + foreach my $item (keys(%$storehash)) { + $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; + } + $items=~s/\&$//; + return &reply("putdom:$udom:$namespace:$items",$uhome); + } else { + &logthis("put_dom failed - no primary domain server for $udom"); + } +} + # --------------------------------------------------- Assign a key to a student sub assign_access_key { @@ -4324,11 +4371,39 @@ sub get_coursegroups { return(&dump('coursegroups',$cdom,$cnum,$group)); } +sub get_deleted_groups { + my ($cdom,$cnum,$group) = @_; + return(&dump('deleted_groups',$cdom,$cnum,$group)); +} + sub modify_coursegroup { my ($cdom,$cnum,$groupsettings) = @_; return(&put('coursegroups',$groupsettings,$cdom,$cnum)); } +sub delete_coursegroup { + my ($cdom,$cnum,$group) = @_; + my %curr_group = &get_coursegroups($cdom,$cnum,$group); + if (my $tmp = &error(%curr_group)) { + &Apache::lonnet::logthis('Error retrieving group: '.$tmp.' in '.$cnum.':'.$cdom); + return ('read error',$tmp); + } else { + my %savedsettings = %curr_group; + my $result = &put('deleted_groups',\%savedsettings,$cdom,$cnum); + my $deloutcome; + if ($result eq 'ok') { + $deloutcome = &del('coursegroups',[$group],$cdom,$cnum); + } else { + return ('write error',$result); + } + if ($deloutcome eq 'ok') { + return 'ok'; + } else { + return ('delete error',$deloutcome); + } + } +} + sub modify_group_roles { my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs) = @_; my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id; @@ -8082,6 +8157,15 @@ reference filled in from namesp (encrypt log($udom,$name,$home,$message) : write to permanent log for user; use critical subroutine +=item * + +get_dom($namespace,$storearr,$udomain) : returns hash with keys from array +reference filled in from namespace found in domain level on primary domain server ($udomain is optional) + +=item * + +put_dom($namespace,$storehash,$udomain) : stores hash in namespace at domain level on primary domain server ($udomain is optional) + =back =head2 Network Status Functions