[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[raeburn]

raeburn		Fri May 13 02:26:21 2011 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Subroutine to get distro/architecture of a LON-CAPA server. 
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1105 loncom/lonnet/perl/lonnet.pm:1.1106
--- loncom/lonnet/perl/lonnet.pm:1.1105	Sun Mar  6 21:17:18 2011
+++ loncom/lonnet/perl/lonnet.pm	Fri May 13 02:26:21 2011
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1105 2011/03/06 21:17:18 raeburn Exp $
+# $Id: lonnet.pm,v 1.1106 2011/05/13 02:26:21 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -196,6 +196,29 @@
     }
 }
 
+sub get_server_distarch {
+    my ($lonhost,$ignore_cache) = @_;
+    if (defined($lonhost)) {
+        if (!defined(&hostname($lonhost))) {
+            return;
+        }
+        my $cachetime = 12*3600;
+        if (!$ignore_cache) {
+            my ($distarch,$cached)=&is_cached_new('serverdistarch',$lonhost);
+            if (defined($cached)) {
+                return $distarch;
+            }
+        }
+        my $rep = &reply('serverdistarch',$lonhost);
+        unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' ||
+                $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||
+                $rep eq '') {
+            return &do_cache_new('serverdistarch',$lonhost,$rep,$cachetime);
+        }
+    }
+    return;
+}
+
 sub get_server_loncaparev {
     my ($dom,$lonhost,$ignore_cache,$caller) = @_;
     if (defined($lonhost)) {