--- loncom/lonnet/perl/lonnet.pm	2006/09/15 07:55:05	1.780
+++ loncom/lonnet/perl/lonnet.pm	2006/10/20 20:39:44	1.782.2.4
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.780 2006/09/15 07:55:05 albertel Exp $
+# $Id: lonnet.pm,v 1.782.2.4 2006/10/20 20:39:44 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -295,9 +295,9 @@ sub error {
 # ------------------------------------------- Transfer profile into environment
 my $env_loaded;
 sub transfer_profile_to_env {
-    if ($env_loaded) { return; } 
+    my ($lonidsdir,$handle,$force_transfer) = @_;
+    if (!$force_transfer && $env_loaded) { return; } 
 
-    my ($lonidsdir,$handle)=@_;
     if (!defined($lonidsdir)) {
 	$lonidsdir = $perlvar{'lonIDsDir'};
     }
@@ -499,41 +499,60 @@ sub overloaderror {
 
 sub spareserver {
     my ($loadpercent,$userloadpercent,$want_server_name) = @_;
-    my $tryserver;
-    my $spareserver='';
+    my $spare_server;
     if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
-    my $lowestserver=$loadpercent > $userloadpercent?
-	             $loadpercent :  $userloadpercent;
-    foreach $tryserver (keys(%spareid)) {
-	my $loadans=&reply('load',$tryserver);
-	my $userloadans=&reply('userload',$tryserver);
-	if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
-	    next; #didn't get a number from the server
-	}
-	my $answer;
-	if ($loadans =~ /\d/) {
-	    if ($userloadans =~ /\d/) {
-		#both are numbers, pick the bigger one
-		$answer=$loadans > $userloadans?
-		    $loadans :  $userloadans;
-	    } else {
-		$answer = $loadans;
-	    }
-	} else {
-	    $answer = $userloadans;
-	}
-	if (($answer =~ /\d/) && ($answer<$lowestserver)) {
-	    if ($want_server_name) {
-		$spareserver=$tryserver;
-	    } else {
-		$spareserver="http://$hostname{$tryserver}";
-	    }
-	    $lowestserver=$answer;
+    my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent 
+                                                     :  $userloadpercent;
+    
+    foreach my $try_server (@{ $spareid{'primary'} }) {
+	($spare_server, $lowest_load) =
+	    &compare_server_load($try_server, $spare_server, $lowest_load);
+    }
+
+    my $found_server = ($spare_server ne '' && $lowest_load < 100);
+
+    if (!$found_server) {
+	foreach my $try_server (@{ $spareid{'default'} }) {
+	    ($spare_server, $lowest_load) =
+		&compare_server_load($try_server, $spare_server, $lowest_load);
 	}
     }
-    return $spareserver;
+
+    if (!$want_server_name) {
+	$spare_server="http://$hostname{$spare_server}";
+    }
+    return $spare_server;
 }
 
+sub compare_server_load {
+    my ($try_server, $spare_server, $lowest_load) = @_;
+
+    my $loadans     = &reply('load',    $try_server);
+    my $userloadans = &reply('userload',$try_server);
+
+    if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
+	next; #didn't get a number from the server
+    }
+
+    my $load;
+    if ($loadans =~ /\d/) {
+	if ($userloadans =~ /\d/) {
+	    #both are numbers, pick the bigger one
+	    $load = ($loadans > $userloadans) ? $loadans 
+		                              : $userloadans;
+	} else {
+	    $load = $loadans;
+	}
+    } else {
+	$load = $userloadans;
+    }
+
+    if (($load =~ /\d/) && ($load < $lowest_load)) {
+	$spare_server = $try_server;
+	$lowest_load  = $load;
+    }
+    return ($spare_server,$lowest_load);
+}
 # --------------------------------------------- Try to change a user's password
 
 sub changepass {
@@ -1191,6 +1210,15 @@ sub ssi_body {
 
 # --------------------------------------------------------- Server Side Include
 
+sub absolute_url {
+    my ($host_name) = @_;
+    my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://');
+    if ($host_name eq '') {
+	$host_name = $ENV{'SERVER_NAME'};
+    }
+    return $protocol.$host_name;
+}
+
 sub ssi {
 
     my ($fn,%form)=@_;
@@ -1202,10 +1230,10 @@ sub ssi {
     $form{'no_update_last_known'}=1;
 
     if (%form) {
-      $request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn);
+      $request=new HTTP::Request('POST',&absolute_url().$fn);
       $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
     } else {
-      $request=new HTTP::Request('GET',"http://".$ENV{'HTTP_HOST'}.$fn);
+      $request=new HTTP::Request('GET',&absolute_url().$fn);
     }
 
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});
@@ -7117,29 +7145,8 @@ BEGIN {
 # ----------------------------------- Read loncapa.conf and loncapa_apache.conf
     unless ($readit) {
 {
-    # FIXME: Use LONCAPA::Configuration::read_conf here and omit next block
-    open(my $config,"</etc/httpd/conf/loncapa.conf");
-
-    while (my $configline=<$config>) {
-        if ($configline=~/\S/ && $configline =~ /^[^\#]*PerlSetVar/) {
-	   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
-           chomp($varvalue);
-           $perlvar{$varname}=$varvalue;
-        }
-    }
-    close($config);
-}
-{
-    open(my $config,"</etc/httpd/conf/loncapa_apache.conf");
-
-    while (my $configline=<$config>) {
-        if ($configline =~ /^[^\#]*PerlSetVar/) {
-	   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
-           chomp($varvalue);
-           $perlvar{$varname}=$varvalue;
-        }
-    }
-    close($config);
+    my $configvars = LONCAPA::Configuration::read_conf('loncapa.conf');
+    %perlvar = (%perlvar,%{$configvars});
 }
 
 # ------------------------------------------------------------ Read domain file
@@ -7221,7 +7228,9 @@ sub get_iphost {
     while (my $configline=<$config>) {
        chomp($configline);
        if ($configline) {
-          $spareid{$configline}=1;
+	   my ($host,$type) = split(':',$configline,2);
+	   if (!defined($type) || $type eq '') { $type = 'default' };
+	   push(@{ $spareid{$type} }, $host);
        }
     }
     close($config);
@@ -7283,7 +7292,9 @@ sub get_iphost {
 
 }
 
-$memcache=new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
+$memcache=new Cache::Memcached({'servers'           => ['127.0.0.1:11211'],
+				'compress_threshold'=> 20_000,
+ 			        });
 
 $processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;