--- loncom/lonnet/perl/lonnet.pm	2007/04/20 21:48:09	1.871
+++ loncom/lonnet/perl/lonnet.pm	2007/05/17 09:25:31	1.878
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.871 2007/04/20 21:48:09 albertel Exp $
+# $Id: lonnet.pm,v 1.878 2007/05/17 09:25:31 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -744,7 +744,7 @@ sub get_dom {
         if (defined(&domain($udom,'primary'))) {
             $uhome=&domain($udom,'primary');
         } else {
-            $uhome eq '';
+            undef($uhome);
         }
     } else {
         if (!$uhome) {
@@ -756,14 +756,13 @@ sub get_dom {
     if ($udom && $uhome && ($uhome ne 'no_host')) {
         my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
         my %returnhash;
-        if ($rep =~ /^error: 2 /) {
+        if ($rep eq '' || $rep =~ /^error: 2 /) {
             return %returnhash;
         }
         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]);
@@ -784,7 +783,7 @@ sub put_dom {
         if (defined(&domain($udom,'primary'))) {
             $uhome=&domain($udom,'primary');
         } else {
-            $uhome eq '';
+            undef($uhome);
         }
     } else {
         if (!$uhome) {
@@ -1065,7 +1064,10 @@ my $kicks=0;
 my $hits=0;
 sub make_key {
     my ($name,$id) = @_;
-    if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); }
+    if (length($id) > 65 
+	&& length(&escape($id)) > 200) {
+	$id=length($id).':'.&Digest::MD5::md5_hex($id);
+    }
     return &escape($name.':'.$id);
 }
 
@@ -1112,7 +1114,9 @@ sub do_cache_new {
 	$time=600;
     }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
-    $memcache->set($id,$setvalue,$time);
+    if (!($memcache->set($id,$setvalue,$time))) {
+	&logthis("caching of id -> $id  failed");
+    }
     # need to make a copy of $value
     #&make_room($id,$value,$debug);
     return $value;
@@ -4450,8 +4454,18 @@ sub userlog_query {
 
 sub auto_run {
     my ($cnum,$cdom) = @_;
-    my $homeserver = &homeserver($cnum,$cdom);
-    my $response = &reply('autorun:'.$cdom,$homeserver);
+    my $response = 0;
+    my $settings;
+    my %domconfig = &get_dom('configuration',['autoenroll'],$cdom);
+    if (ref($domconfig{'autoenroll'}) eq 'HASH') {
+        $settings = $domconfig{'autoenroll'};
+        if ($settings->{'run'} eq '1') {
+            $response = 1;
+        }
+    } else {
+        my $homeserver = &homeserver($cnum,$cdom);
+        $response = &reply('autorun:'.$cdom,$homeserver);
+    }
     return $response;
 }
 
@@ -4481,15 +4495,27 @@ sub auto_validate_courseID {
 }
 
 sub auto_create_password {
-    my ($cnum,$cdom,$authparam) = @_;
-    my $homeserver = &homeserver($cnum,$cdom); 
+    my ($cnum,$cdom,$authparam,$udom) = @_;
+    my ($homeserver,$response);
     my $create_passwd = 0;
     my $authchk = '';
-    my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
-    if ($response eq 'refused') {
-        $authchk = 'refused';
+    if ($udom =~ /^$match_domain$/) {
+        $homeserver = &domain($udom,'primary');
+    }
+    if ($homeserver eq '') {
+        if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
+            $homeserver = &homeserver($cnum,$cdom);
+        }
+    }
+    if ($homeserver eq '') {
+        $authchk = 'nodomain';
     } else {
-        ($authparam,$create_passwd,$authchk) = split/:/,$response;
+        $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver));
+        if ($response eq 'refused') {
+            $authchk = 'refused';
+        } else {
+            ($authparam,$create_passwd,$authchk) = split/:/,$response;
+        }
     }
     return ($authparam,$create_passwd,$authchk);
 }
@@ -5886,6 +5912,13 @@ sub devalidatecourseresdata {
 
 
 # --------------------------------------------------- Course Resourcedata Query
+#
+#  Parameters:
+#      $coursenum    - Number of the course.
+#      $coursedomain - Domain at which the course was created.
+#  Returns:
+#     A hash of the course parameters along (I think) with timestamps
+#     and version info.
 
 sub get_courseresdata {
     my ($coursenum,$coursedomain)=@_;
@@ -8504,6 +8537,14 @@ setting for a specific $type, where $typ
 @what should be a list of parameters to ask about. This routine caches
 answers for 5 minutes.
 
+=item *
+
+get_courseresdata($courseid, $domain) : dump the entire course resource
+data base, returning a hash that is keyed by the resource name and has
+values that are the resource value.  I believe that the timestamps and
+versions are also returned.
+
+
 =back
 
 =head2 Course Modification
@@ -9186,3 +9227,4 @@ symblist($mapname,%newhash) : update sym
 =back
 
 =cut
+