--- loncom/lond	2004/03/16 10:52:30	1.178.2.8
+++ loncom/lond	2004/03/22 09:05:11	1.178.2.9
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.178.2.8 2004/03/16 10:52:30 foxr Exp $
+# $Id: lond,v 1.178.2.9 2004/03/22 09:05:11 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -53,7 +53,7 @@ my $DEBUG = 1;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.178.2.8 $'; #' stupid emacs
+my $VERSION='$Revision: 1.178.2.9 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid;
 my $currentdomainid;
@@ -162,7 +162,56 @@ sub isClient {
     return (($ConnectionType eq "client") || ($ConnectionType eq "both"));
 }
 #
-#   Ties a resource file to a hash.  If necessary, an appropriate history
+#  Ties a domain level resource file to a hash.
+#  If requested a history entry is created in the associated hist file.
+#
+#  Parameters:
+#     domain    - Name of the domain in which the resource file lives.
+#     namespace - Name of the hash within that domain.
+#     how       - How to tie the hash (e.g. GDBM_WRCREAT()).
+#     loghead   - Optional parameter, if present a log entry is created
+#                 in the associated history file and this is the first part
+#                  of that entry.
+#     logtail   - Goes along with loghead,  The actual logentry is of the
+#                 form $loghead:<timestamp>:logtail.
+# Returns:
+#    Reference to a hash bound to the db file or alternatively undef
+#    if the tie failed.
+#
+sub TieDomainHash {
+    my $domain    = shift;
+    my $namespace = shift;
+    my $how       = shift;
+
+    # Filter out any whitespace in the domain name:
+
+    $domain =~ s/\W//g;
+
+    # We have enough to go on to tie the hash:
+
+    my $UserTopDir   = $perlvar('lonUsersDir');
+    my $DomainDir    = $UserTopDir."/$domain";
+    my $ResourceFile = $DomainDir."/$namespace.db";
+    my %hash;
+    if(tie(%hash, 'GDBM_File', $ResourceFile, $how, 0640)) {
+	if (scalar @_) {	# Need to log the operation.
+	    my $logFh = IO::File->new(">>$DomainDir/$namespace.hist");
+	    if($logFH) {
+		my $TimeStamp = time;
+		my ($loghead, $logtail) = @_;
+		print $logFH "$loghead:$TimeStamp:$logtail\n";
+	    }
+	}
+	return \%hash;		# Return the tied hash.
+    }
+    else {
+	return undef;		# Tie failed.
+    }
+}
+
+#
+#   Ties a user's resource file to a hash.  
+#   If necessary, an appropriate history
 #   log file entry is made as well.
 #   This sub factors out common code from the subs that manipulate
 #   the various gdbm files that keep keyword value pairs.
@@ -179,7 +228,7 @@ sub isClient {
 #   hash to which the database is tied.  It's up to the caller to untie.
 #   undef if the has could not be tied.
 #
-sub TieResourceHash {
+sub TieUserHash {
   my $domain      = shift;
   my $user        = shift;
   my $namespace   = shift;
@@ -1364,7 +1413,7 @@ sub PutUserProfileEntry {
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
     if ($namespace ne 'roles') {
        chomp($what);
-       my $hashref = TieResourceHash($udom, $uname, $namespace,
+       my $hashref = TieUserHash($udom, $uname, $namespace,
 				     &GDBM_WRCREAT(),"P",$what);
        if($hashref) {
 	 my @pairs=split(/\&/,$what);
@@ -1415,7 +1464,7 @@ sub IncrementUserValueHandler {
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
     if ($namespace ne 'roles') {
         chomp($what);
-	my $hashref = TieResourceHash($udom, $uname,
+	my $hashref = TieUserHash($udom, $uname,
 				      $namespace, &GDBM_WRCREAT(),
 				      "P",$what);
 	if ($hashref) {
@@ -1476,7 +1525,7 @@ sub RolesPutHandler {
 	   "what = ".$what);
     my $namespace='roles';
     chomp($what);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				  &GDBM_WRCREAT(), "P",
 				  "$exedom:$exeuser:$what");
     #
@@ -1533,7 +1582,7 @@ sub RolesDeleteHandler {
 	   "what = ".$what);
     my $namespace='roles';
     chomp($what);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				  &GDBM_WRCREAT(), "D",
 				  "$exedom:$exeuser:$what");
 
@@ -1585,7 +1634,7 @@ sub GetProfileEntry {
    
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				 &GDBM_READER());
     if ($hashref) {
         my @queries=split(/\&/,$what);
@@ -1640,7 +1689,7 @@ sub GetProfileEntryEncrypted {
    
     my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
     chomp($what);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				  &GDBM_READER());
     if ($hashref) {
         my @queries=split(/\&/,$what);
@@ -1703,7 +1752,7 @@ sub DeleteProfileEntry {
 
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				  &GDBM_WRCREAT(),
 				  "D",$what);
     if ($hashref) {
@@ -1747,7 +1796,7 @@ sub GetProfileKeys {
 
     my ($udom,$uname,$namespace)=split(/:/,$tail);
     my $qresult='';
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				  &GDBM_READER());
     if ($hashref) {
 	foreach my $key (keys %$hashref) {
@@ -1794,7 +1843,7 @@ sub DumpProfileDatabase {
     my $userinput = "$cmd:$tail";
    
     my ($udom,$uname,$namespace) = split(/:/,$tail);
-    my $hashref = TieResourceHash($udom, $uname, $namespace,
+    my $hashref = TieUserHash($udom, $uname, $namespace,
 				  &GDBM_READER());
     if ($hashref) {
 	# Structure of %data:
@@ -1875,7 +1924,7 @@ sub DumpWithRegexp {
     } else {
 	$regexp='.';
     }
-    my $hashref =TieResourceHash($udom, $uname, $namespace,
+    my $hashref =TieUserHash($udom, $uname, $namespace,
 				 &GDBM_READER());
     if ($hashref) {
         my $qresult='';
@@ -1935,7 +1984,7 @@ sub StoreHandler {
 
 	chomp($what);
 	my @pairs=split(/\&/,$what);
-	my $hashref  = TieResourceHash($udom, $uname, $namespace,
+	my $hashref  = TieUserHash($udom, $uname, $namespace,
 				       &GDBM_WRCREAT(), "P",
 				       "$rid:$what");
 	if ($hashref) {
@@ -2214,20 +2263,17 @@ sub PutCourseIdHandler {
 
     my $userinput = "$cmd:$tail";
 
-    my ($udom,$what)=split(/:/,$tail);
     chomp($what);
-    $udom=~s/\W//g;
-    my $proname=
-	"$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
     my $now=time;
     my @pairs=split(/\&/,$what);
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
+
+    my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
+    if ($hashref) {
 	foreach my $pair (@pairs) {
 	    my ($key,$value)=split(/=/,$pair);
-	    $hash{$key}=$value.':'.$now;
+	    $hashref->{$key}=$value.':'.$now;
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    Reply($client, "ok\n", $userinput);
 	} else {
 	    Failure( $client, "error: ".($!+0)
@@ -2282,10 +2328,10 @@ sub DumpCourseIdHandler {
     }
     unless (defined($since)) { $since=0; }
     my $qresult='';
-    my $proname = "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
-	while (my ($key,$value) = each(%hash)) {
+
+    my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
+    if ($hashref) {
+	while (my ($key,$value) = each(%$hashref)) {
 	    my ($descr,$lasttime)=split(/\:/,$value);
 	    if ($lasttime<$since) { 
 		next; 
@@ -2299,7 +2345,7 @@ sub DumpCourseIdHandler {
 		}
 	    }
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    chop($qresult);
 	    Reply($client, "$qresult\n", $userinput);
 	} else {
@@ -2340,23 +2386,15 @@ sub PutIdHandler {
 
     my ($udom,$what)=split(/:/,$tail);
     chomp($what);
-    $udom=~s/\W//g;
-    my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
-    my $now=time;
-    {
-	my $hfh;
-	if ($hfh=IO::File->new(">>$proname.hist")) { 
-	    print $hfh "P:$now:$what\n"; 
-	}
-    }
     my @pairs=split(/\&/,$what);
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
+    my $hashref = TieDomainHash($udom, "ids", &GDBM_WRCREAT(),
+				"P", $what);
+    if ($hashref) {
 	foreach my $pair (@pairs) {
 	    my ($key,$value)=split(/=/,$pair);
-	    $hash{$key}=$value;
+	    $hashref->{$key}=$value;
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    Reply($client, "ok\n", $userinput);
 	} else {
 	    Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
@@ -2399,16 +2437,14 @@ sub GetIdHandler {
 
     my ($udom,$what)=split(/:/,$tail);
     chomp($what);
-    $udom=~s/\W//g;
-    my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
     my @queries=split(/\&/,$what);
     my $qresult='';
-    my %hash;
-    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
+    my $hashref = TieDomainHash($udom, "ids", &GDBM_READER());
+    if ($hashref) {
 	for (my $i=0;$i<=$#queries;$i++) {
-	    $qresult.="$hash{$queries[$i]}&";
+	    $qresult.="$hashref->{$queries[$i]}&";
 	}
-	if (untie(%hash)) {
+	if (untie(%$hashref)) {
 	    $qresult=~s/\&$//;
 	    Reply($client, "$qresult\n", $userinput);
 	} else {