perl 5.000perl-5.000

[editor's note: this commit combines approximate 4 months of furious
releases of Andy Dougherty and Larry Wall - see pod/perlhist.pod for
details.  Andy notes that;
 
Alas neither my "Irwin AccuTrack" nor my DC 600A quarter-inch cartridge 
backup tapes from that era seem to be readable anymore.  I guess 13 years 
exceeds the shelf life for that backup technology :-(.
]

1 files changed, 53 insertions, 0 deletions

diff --git a/lib/Sys/Hostname.pm b/lib/Sys/Hostname.pm
new file mode 100644
index 0000000000..4dd4fe2bdc
--- /dev/null
+++ b/lib/Sys/Hostname.pm
@@ -0,0 +1,53 @@
+# by David Sundstrom   sunds@asictest.sc.ti.com
+#    Texas Instruments
+
+package Sys::Hostname;
+
+use Carp;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(hostname);
+
+#
+# Try every conceivable way to get hostname.
+# 
+
+sub hostname {
+
+    # method 1 - we already know it
+    return $host if defined $host;
+
+    # method 2 - syscall is preferred since it avoids tainting problems
+    eval {
+	{
+	    package main;
+	    require "syscall.ph";
+	}
+	$host = "\0" x 65; ## preload scalar
+	syscall(&main::SYS_gethostname, $host, 65) == 0;
+    }
+
+    # method 3 - trusty old hostname command
+    || eval {
+	$host = `(hostname) 2>/dev/null`; # bsdish
+    }
+
+    # method 4 - sysV uname command (may truncate)
+    || eval {
+	$host = `uname -n 2>/dev/null`; ## sysVish
+    }
+
+    # method 5 - Apollo pre-SR10
+    || eval {
+	($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
+    }
+
+    # bummer
+    || Carp::croak "Cannot get host name of local machine";  
+
+    # remove garbage 
+    $host =~ tr/\0\r\n//d;
+    $host;
+}
+
+1;