--- loncom/lonnet/perl/lonnet.pm	2003/12/04 20:09:35	1.452
+++ loncom/lonnet/perl/lonnet.pm	2003/12/08 13:50:57	1.457
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.452 2003/12/04 20:09:35 albertel Exp $
+# $Id: lonnet.pm,v 1.457 2003/12/08 13:50:57 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -506,38 +506,16 @@ sub changepass {
 
 sub queryauthenticate {
     my ($uname,$udom)=@_;
-    if (($perlvar{'lonRole'} eq 'library') && 
-        ($udom eq $perlvar{'lonDefDomain'})) {
-	my $answer=reply("encrypt:currentauth:$udom:$uname",
-			 $perlvar{'lonHostID'});
-	unless ($answer eq 'unknown_user' or $answer eq 'refused') {
-	    if (length($answer)) {
-		return $answer;
-	    }
-	    else {
-	&logthis("User $uname at $udom lacks an authentication mechanism");
-		return 'no_host';
-	    }
-	}
-    }
-
-    my $tryserver;
-    foreach $tryserver (keys %libserv) {
-	if ($hostdom{$tryserver} eq $udom) {
-           my $answer=reply("encrypt:currentauth:$udom:$uname",$tryserver);
-	   unless ($answer eq 'unknown_user' or $answer eq 'refused') {
-	       if (length($answer)) {
-		   return $answer;
-	       }
-	       else {
-	   &logthis("User $uname at $udom lacks an authentication mechanism");
-		   return 'no_host';
-	       }
-	   }
-       }
+    my $uhome=&homeserver($uname,$udom);
+    if (!$uhome) {
+	&logthis("User $uname at $udom is unknown when looking for authentication mechanism");
+	return 'no_host';
+    }
+    my $answer=reply("encrypt:currentauth:$udom:$uname",$uhome);
+    if ($answer =~ /^(unknown_user|refused|con_lost)/) {
+	&logthis("User $uname at $udom threw error $answer when checking authentication mechanism");
     }
-    &logthis("User $uname at $udom lacks an authentication mechanism");    
-    return 'no_host';
+    return $answer;
 }
 
 # --------- Try to authenticate user from domain's lib servers (first this one)
@@ -3144,10 +3122,11 @@ sub modifyuser {
 
 sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
-        $end,$start,$forceid,$desiredhome,$email)=@_;
-    my $cid='';
-    unless ($cid=$ENV{'request.course.id'}) {
-	return 'not_in_class';
+        $end,$start,$forceid,$desiredhome,$email,$type,$cid)=@_;
+    if (!$cid) {
+	unless ($cid=$ENV{'request.course.id'}) {
+	    return 'not_in_class';
+	}
     }
 # --------------------------------------------------------------- Make the user
     my $reply=&modifyuser
@@ -3157,24 +3136,34 @@ sub modifystudent {
     # This will cause &modify_student_enrollment to get the uid from the
     # students environment
     $uid = undef if (!$forceid);
-    $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,
-                                        $last,$gene,$usec,$end,$start);
+    $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
+					$gene,$usec,$end,$start,$type,$cid);
     return $reply;
 }
 
 sub modify_student_enrollment {
-    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start) = @_;
-    # Get the course id from the environment
-    my $cid='';
-    unless ($cid=$ENV{'request.course.id'}) {
-	return 'not_in_class';
+    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,
+	$cid) = @_;
+    my ($cdom,$cnum,$chome);
+    if (!$cid) {
+	unless ($cid=$ENV{'request.course.id'}) {
+	    return 'not_in_class';
+	}
+	$cdom=$ENV{'course.'.$cid.'.domain'};
+	$cnum=$ENV{'course.'.$cid.'.num'};
+    } else {
+	($cdom,$cnum)=split(/_/,$cid);
+    }
+    $chome=$ENV{'course.'.$cid.'.home'};
+    if (!$chome) {
+	$chome=&homeserver($cnum,$cdom);
     }
+    if (!$chome) { return 'unknown_course'; }
     # Make sure the user exists
     my $uhome=&homeserver($uname,$udom);
     if (($uhome eq '') || ($uhome eq 'no_host')) { 
 	return 'error: no such user';
     }
-    #
     # Get student data if we were not given enough information
     if (!defined($first)  || $first  eq '' || 
         !defined($last)   || $last   eq '' || 
@@ -3187,9 +3176,9 @@ sub modify_student_enrollment {
                        ['firstname','middlename','lastname', 'generation','id']
                        ,$udom,$uname);
 
-        foreach (keys(%tmp)) {
-            &logthis("key $_ = ".$tmp{$_});
-        }
+        #foreach (keys(%tmp)) {
+        #    &logthis("key $_ = ".$tmp{$_});
+        #}
         $first  = $tmp{'firstname'}  if (!defined($first)  || $first  eq '');
         $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq '');
         $last   = $tmp{'lastname'}   if (!defined($last)   || $last eq '');
@@ -3198,11 +3187,9 @@ sub modify_student_enrollment {
     }
     my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene,
                                                            $first,$middle);
-    my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
-	              $ENV{'course.'.$cid.'.num'}.':classlist:'.
-                      &escape($uname.':'.$udom).'='.
-                      &escape(join(':',$end,$start,$uid,$usec,$fullname)),
-	              $ENV{'course.'.$cid.'.home'});
+    my $value=&escape($uname.':'.$udom).'='.
+	&escape(join(':',$end,$start,$uid,$usec,$fullname,$type));
+    my $reply=critical('put:'.$cdom.':'.$cnum.':classlist:'.$value,$chome);
     unless (($reply eq 'ok') || ($reply eq 'delayed')) {
 	return 'error: '.$reply;
     }
@@ -3694,10 +3681,8 @@ sub EXT {
 		my $hashid="$udom:$uname";
 		my ($result,$cached)=&is_cached(\%userresdatacache,$hashid,
 						'userres');
-		if (!defined($cached)) { 
-		    my %resourcedata=&get('resourcedata',
-					  [$courselevelr,$courselevelm,
-					   $courselevel],$udom,$uname);
+		if (!defined($cached)) {
+		    my %resourcedata=&dump('resourcedata',$udom,$uname);
 		    $result=\%resourcedata;
 		    &do_cache(\%userresdatacache,$hashid,$result,'userres');
 		}
@@ -3846,7 +3831,9 @@ sub metadata {
 #
 # Is this a recursive call for a library?
 #
-	my %lcmetacache;
+	if (! exists($metacache{$uri})) {
+	    $metacache{$uri}={};
+	}
         if ($liburi) {
 	    $liburi=&declutter($liburi);
             $filename=$liburi;
@@ -3870,10 +3857,10 @@ sub metadata {
 		    if (defined($token->[2]->{'id'})) { 
 			$keyroot.='_'.$token->[2]->{'id'}; 
 		    }
-		    if ($lcmetacache{':packages'}) {
-			$lcmetacache{':packages'}.=','.$package.$keyroot;
+		    if ($metacache{$uri}->{':packages'}) {
+			$metacache{$uri}->{':packages'}.=','.$package.$keyroot;
 		    } else {
-			$lcmetacache{':packages'}=$package.$keyroot;
+			$metacache{$uri}->{':packages'}=$package.$keyroot;
 		    }
 		    foreach (keys %packagetab) {
 			my $part=$keyroot;
@@ -3895,14 +3882,14 @@ sub metadata {
 			    if ($subp eq 'display') {
 				$value.=' [Part: '.$part.']';
 			    }
-			    $lcmetacache{':'.$unikey.'.part'}=$part;
+			    $metacache{$uri}->{':'.$unikey.'.part'}=$part;
 			    $metathesekeys{$unikey}=1;
-			    unless (defined($lcmetacache{':'.$unikey.'.'.$subp})) {
-				$lcmetacache{':'.$unikey.'.'.$subp}=$value;
+			    unless (defined($metacache{$uri}->{':'.$unikey.'.'.$subp})) {
+				$metacache{$uri}->{':'.$unikey.'.'.$subp}=$value;
 			    }
-			    if (defined($lcmetacache{':'.$unikey.'.default'})) {
-				$lcmetacache{':'.$unikey}=
-				    $lcmetacache{':'.$unikey.'.default'};
+			    if (defined($metacache{$uri}->{':'.$unikey.'.default'})) {
+				$metacache{$uri}->{':'.$unikey}=
+				    $metacache{$uri}->{':'.$unikey.'.default'};
 			    }
 			}
 		    }
@@ -3935,6 +3922,7 @@ sub metadata {
 			    foreach (sort(split(/\,/,&metadata($uri,'keys',
 							       $location,$unikey,
 							       $depthcount+1)))) {
+				$metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
 				$metathesekeys{$_}=1;
 			    }
 			}
@@ -3945,18 +3933,18 @@ sub metadata {
 			}
 			$metathesekeys{$unikey}=1;
 			foreach (@{$token->[3]}) {
-			    $lcmetacache{':'.$unikey.'.'.$_}=$token->[2]->{$_};
+			    $metacache{$uri}->{':'.$unikey.'.'.$_}=$token->[2]->{$_};
 			}
 			my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry));
-			my $default=$lcmetacache{':'.$unikey.'.default'};
+			my $default=$metacache{$uri}->{':'.$unikey.'.default'};
 			if ( $internaltext =~ /^\s*$/ && $default !~ /^\s*$/) {
 		 # only ws inside the tag, and not in default, so use default
 		 # as value
-			    $lcmetacache{':'.$unikey}=$default;
+			    $metacache{$uri}->{':'.$unikey}=$default;
 			} else {
 		  # either something interesting inside the tag or default
                   # uninteresting
-			    $lcmetacache{':'.$unikey}=$internaltext;
+			    $metacache{$uri}->{':'.$unikey}=$internaltext;
 			}
 # end of not-a-package not-a-library import
 		    }
@@ -3966,27 +3954,28 @@ sub metadata {
 	    }
 	}
 # are there custom rights to evaluate
-	if ($lcmetacache{':copyright'} eq 'custom') {
+	if ($metacache{$uri}->{':copyright'} eq 'custom') {
 
     #
     # Importing a rights file here
     #
 	    unless ($depthcount) {
-		my $location=$lcmetacache{':customdistributionfile'};
+		my $location=$metacache{$uri}->{':customdistributionfile'};
 		my $dir=$filename;
 		$dir=~s|[^/]*$||;
 		$location=&filelocation($dir,$location);
 		foreach (sort(split(/\,/,&metadata($uri,'keys',
 						   $location,'_rights',
 						   $depthcount+1)))) {
+		    $metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
 		    $metathesekeys{$_}=1;
 		}
 	    }
 	}
-	$lcmetacache{':keys'}=join(',',keys %metathesekeys);
-	&metadata_generate_part0(\%metathesekeys,\%lcmetacache,$uri);
-	$lcmetacache{':allpossiblekeys'}=join(',',keys %metathesekeys);
-	&do_cache(\%metacache,$uri,\%lcmetacache,'meta');
+	$metacache{$uri}->{':keys'}=join(',',keys %metathesekeys);
+	&metadata_generate_part0(\%metathesekeys,$metacache{$uri},$uri);
+	$metacache{$uri}->{':allpossiblekeys'}=join(',',keys %metathesekeys);
+	&do_cache(\%metacache,$uri,$metacache{$uri},'meta');
 # this is the end of "was not already recently cached
     }
     return $metacache{$uri}->{':'.$what};