[LON-CAPA-cvs] cvs: loncom / lond

albertel lon-capa-cvs@mail.lon-capa.org
Wed, 28 Mar 2007 22:14:33 -0000


This is a MIME encoded message

--albertel1175120073
Content-Type: text/plain

albertel		Wed Mar 28 18:14:33 2007 EDT

  Modified files:              
    /loncom	lond 
  Log:
  - use lonnet, eliminate copies of ruotines taht are in lonnet
  
  
--albertel1175120073
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20070328181433.txt"

Index: loncom/lond
diff -u loncom/lond:1.364 loncom/lond:1.365
--- loncom/lond:1.364	Wed Mar 28 16:28:29 2007
+++ loncom/lond	Wed Mar 28 18:14:33 2007
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.364 2007/03/28 20:28:29 albertel Exp $
+# $Id: lond,v 1.365 2007/03/28 22:14:33 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -33,6 +33,7 @@
 use lib '/home/httpd/lib/perl/';
 use LONCAPA;
 use LONCAPA::Configuration;
+use Apache::lonnet;
 
 use IO::Socket;
 use IO::File;
@@ -49,7 +50,6 @@
 use localstudentphoto;
 use File::Copy;
 use File::Find;
-use LONCAPA::ConfigFileEdit;
 use LONCAPA::lonlocal;
 use LONCAPA::lonssl;
 use Fcntl qw(:flock);
@@ -59,7 +59,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.364 $'; #' stupid emacs
+my $VERSION='$Revision: 1.365 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1032,7 +1032,7 @@
 sub pong_handler {
     my ($cmd, $tail, $replyfd) = @_;
 
-    my $reply=&reply("ping",$clientname);
+    my $reply=&Apache::lonnet::reply("ping",$clientname);
     &Reply( $replyfd, "$currenthostid:$reply\n", "$cmd:$tail"); 
     return 1;
 }
@@ -1142,7 +1142,7 @@
 sub user_load_handler {
     my ($cmd, $tail, $replyfd) = @_;
 
-    my $userloadpercent=&userload();
+    my $userloadpercent=&Apache::lonnet::userload();
     &Reply($replyfd, "$userloadpercent\n", "$cmd:$tail");
     
     return 1;
@@ -1850,13 +1850,13 @@
 	    my $now=time;
 	    my $since=$now-$atime;
 	    if ($since>$perlvar{'lonExpire'}) {
-		my $reply=&reply("unsub:$fname","$clientname");
+		my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname");
 		&devalidate_meta_cache($fname);
 		unlink("$fname");
 		unlink("$fname.meta");
 	    } else {
 		my $transname="$fname.in.transfer";
-		my $remoteurl=&reply("sub:$fname","$clientname");
+		my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname");
 		my $response;
 		alarm(120);
 		{
@@ -1901,22 +1901,12 @@
     my ($url) = @_;
     use Cache::Memcached;
     my $memcache = new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
-    $url = &declutter($url);
+    $url = &Apache::lonnet::declutter($url);
     $url =~ s-\.meta$--;
     my $id = &escape('meta:'.$url);
     $memcache->delete($id);
 }
 
-sub declutter {
-    my $thisfn=shift;
-    $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
-    $thisfn=~s/^\///;
-    $thisfn=~s|^adm/wrapper/||;
-    $thisfn=~s|^adm/coursedocs/showdoc/||;
-    $thisfn=~s/^res\///;
-    $thisfn=~s/\?.+$//;
-    return $thisfn;
-}
 #
 #   Fetch a user file from a remote server to the user's home directory
 #   userfiles subdir.
@@ -4452,10 +4442,10 @@
 						    \%cat_titles,
 						    \%cat_order);
     if ($formatreply eq 'ok') {
-	my $codes_str = &hash2str(%codes);
-	my $codetitles_str = &array2str(@codetitles);
-	my $cat_titles_str = &hash2str(%cat_titles);
-	my $cat_order_str = &hash2str(%cat_order);
+	my $codes_str = &Apache::lonnet::hash2str(%codes);
+	my $codetitles_str = &Apache::lonnet::array2str(@codetitles);
+	my $cat_titles_str = &Apache::lonnet::hash2str(%cat_titles);
+	my $cat_order_str = &Apache::lonnet::hash2str(%cat_order);
 	&Reply($client,
 	       $codes_str.':'.$codetitles_str.':'.$cat_titles_str.':'
 	       .$cat_order_str."\n",
@@ -5287,84 +5277,6 @@
     $0='lond: '.$what.' '.$local;
 }
 
-# ----------------------------------------------------------- Send USR1 to lonc
-
-sub reconlonc {
-    my $peerfile=shift;
-    &logthis("Trying to reconnect for $peerfile");
-    my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
-    if (my $fh=IO::File->new("$loncfile")) {
-	my $loncpid=<$fh>;
-        chomp($loncpid);
-        if (kill 0 => $loncpid) {
-	    &logthis("lonc at pid $loncpid responding, sending USR1");
-            kill USR1 => $loncpid;
-        } else {
-	    &logthis(
-              "<font color='red'>CRITICAL: "
-             ."lonc at pid $loncpid not responding, giving up</font>");
-        }
-    } else {
-      &logthis('<font color="red">CRITICAL: lonc not running, giving up</font>');
-    }
-}
-
-sub create_connection {
-    my ($hostname,$lonid) = @_;
-    my $client=IO::Socket::UNIX->new(Peer    => $perlvar{'lonSockCreate'},
-				     Type    => SOCK_STREAM,
-				     Timeout => 10);
-    return 0 if (!$client);
-    print $client ("$hostname:$lonid\n");
-    my $result = <$client>;
-    chomp($result);
-    return 1 if ($result eq 'done');
-    return 0;
-}
-
-# -------------------------------------------------- Non-critical communication
-my $max_connection_retries = 10;
-sub subreply {
-    my ($cmd,$server)=@_;
-    my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server};
-    my $sclient;
-    for (my $retries = 0; $retries < $max_connection_retries; $retries++) {
-	$sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
-				       Type    => SOCK_STREAM,
-				       Timeout => 10);
-	if($sclient) {
-	    last;		# Connected!
-	} else {
-	    &create_connection($hostname{$server},$server);
-	}
-        sleep(1);		# Try again later if failed connection.
-    }
-    print $sclient "sethost:$server:$cmd\n";
-    my $answer=<$sclient>;
-    chomp($answer);
-    if (!$answer) { $answer="con_lost"; }
-    return $answer;
-}
-
-sub reply {
-  my ($cmd,$server)=@_;
-  my $answer;
-  if ($server ne $currenthostid) { 
-    $answer=subreply($cmd,$server);
-    if ($answer eq 'con_lost') {
-	$answer=subreply("ping",$server);
-        if ($answer ne $server) {
-	    &logthis("sub reply: answer != server answer is $answer, server is $server");
-           &reconlonc("$perlvar{'lonSockDir'}/".$hostname{$server});
-        }
-        $answer=subreply($cmd,$server);
-    }
-  } else {
-    $answer='self_reply';
-  } 
-  return $answer;
-}
-
 # -------------------------------------------------------------- Talk to lonsql
 
 sub sql_reply {
@@ -6351,96 +6263,6 @@
     return "version:$VERSION";
 }
 
-#There is a copy of this in lonnet.pm
-sub userload {
-    my $numusers=0;
-    {
-	opendir(LONIDS,$perlvar{'lonIDsDir'});
-	my $filename;
-	my $curtime=time;
-	while ($filename=readdir(LONIDS)) {
-	    if ($filename eq '.' || $filename eq '..') {next;}
-	    my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9];
-	    if ($curtime-$mtime < 1800) { $numusers++; }
-	}
-	closedir(LONIDS);
-    }
-    my $userloadpercent=0;
-    my $maxuserload=$perlvar{'lonUserLoadLim'};
-    if ($maxuserload) {
-	$userloadpercent=100*$numusers/$maxuserload;
-    }
-    $userloadpercent=sprintf("%.2f",$userloadpercent);
-    return $userloadpercent;
-}
-
-# Routines for serializing arrays and hashes (copies from lonnet)
-
-sub array2str {
-  my (@array) = @_;
-  my $result=&arrayref2str(\@array);
-  $result=~s/^__ARRAY_REF__//;
-  $result=~s/__END_ARRAY_REF__$//;
-  return $result;
-}
-                                                                                 
-sub arrayref2str {
-  my ($arrayref) = @_;
-  my $result='__ARRAY_REF__';
-  foreach my $elem (@$arrayref) {
-    if(ref($elem) eq 'ARRAY') {
-      $result.=&arrayref2str($elem).'&';
-    } elsif(ref($elem) eq 'HASH') {
-      $result.=&hashref2str($elem).'&';
-    } elsif(ref($elem)) {
-      #print("Got a ref of ".(ref($elem))." skipping.");
-    } else {
-      $result.=&escape($elem).'&';
-    }
-  }
-  $result=~s/\&$//;
-  $result .= '__END_ARRAY_REF__';
-  return $result;
-}
-                                                                                 
-sub hash2str {
-  my (%hash) = @_;
-  my $result=&hashref2str(\%hash);
-  $result=~s/^__HASH_REF__//;
-  $result=~s/__END_HASH_REF__$//;
-  return $result;
-}
-                                                                                 
-sub hashref2str {
-  my ($hashref)=@_;
-  my $result='__HASH_REF__';
-  foreach (sort(keys(%$hashref))) {
-    if (ref($_) eq 'ARRAY') {
-      $result.=&arrayref2str($_).'=';
-    } elsif (ref($_) eq 'HASH') {
-      $result.=&hashref2str($_).'=';
-    } elsif (ref($_)) {
-      $result.='=';
-      #print("Got a ref of ".(ref($_))." skipping.");
-    } else {
-        if ($_) {$result.=&escape($_).'=';} else { last; }
-    }
-
-    if(ref($hashref->{$_}) eq 'ARRAY') {
-      $result.=&arrayref2str($hashref->{$_}).'&';
-    } elsif(ref($hashref->{$_}) eq 'HASH') {
-      $result.=&hashref2str($hashref->{$_}).'&';
-    } elsif(ref($hashref->{$_})) {
-       $result.='&';
-      #print("Got a ref of ".(ref($hashref->{$_}))." skipping.");
-    } else {
-      $result.=&escape($hashref->{$_}).'&';
-    }
-  }
-  $result=~s/\&$//;
-  $result .= '__END_HASH_REF__';
-  return $result;
-}
 
 # ----------------------------------- POD (plain old documentation, CPAN style)
 

--albertel1175120073--