--- loncom/lonnet/perl/lonnet.pm	2006/10/30 11:10:51	1.801
+++ 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.801 2006/10/30 11:10:51 foxr 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 {
@@ -3219,12 +3266,15 @@ sub eget {
 
 # ------------------------------------------------------------ tmpput interface
 sub tmpput {
-    my ($storehash,$server)=@_;
+    my ($storehash,$server,$context)=@_;
     my $items='';
     foreach my $item (keys(%$storehash)) {
 	$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
     }
     $items=~s/\&$//;
+    if (defined($context)) {
+        $items .= ':'.&escape($context);
+    }
     return &reply("tmpput:$items",$server);
 }
 
@@ -4296,8 +4346,8 @@ sub auto_instcode_defaults {
                     $returnhash->{&unescape($name)}=&unescape($value);
                 }
             }
+            $ok_response = 1;
         }
-        $ok_response = 1;
     }
     if ($ok_response) {
         return 'ok';
@@ -4321,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;
@@ -6604,6 +6682,7 @@ sub rndseed {
     if (!$domain) { $domain=$wdomain; }
     if (!$username) { $username=$wusername }
     my $which=&get_rand_alg();
+
     if (defined(&getCODE())) {
 	if ($which eq '64bit5') {
 	    return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username);
@@ -6661,7 +6740,6 @@ sub rndseed_64bit {
 	#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
 	#&logthis("rndseed :$num:$symb");
 	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
-	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
 	return "$num1,$num2";
     }
 }
@@ -6684,6 +6762,7 @@ sub rndseed_64bit2 {
 	my $num2=$nameseed+$domainseed+$courseseed;
 	#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
 	#&logthis("rndseed :$num:$symb");
+	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
 	return "$num1,$num2";
     }
 }
@@ -8078,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