From: Perl 5 Porters <perl5-porters.nicoh.com>
Date: Tue, 2 Jan 1996 03:30:49 +0000 (+0000)
Subject: VMS-specific changes.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=567d72c2df905d84d6219727bd9345d2314e6b6e;p=p5sagit%2Fp5-mst-13.2.git

VMS-specific changes.
---

diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index 438a08e..05c5bd9 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -52,8 +52,7 @@ C<rmtree> takes three arguments:
 the root of the subtree to delete, or a reference to
 a list of roots.  All of the files and directories
 below each root, as well as the roots themselves,
-will be deleted.  For the moment, C<rmtree> expects
-Unix file specification syntax.
+will be deleted.
 
 =item *
 
@@ -83,7 +82,7 @@ Charles Bailey <bailey@genetics.upenn.edu>
 
 =head1 REVISION
 
-This document was last revised 08-Mar-1995, for perl 5.001
+This document was last revised 25-Aug-1995, for perl 5.002
 
 =cut
 
@@ -128,7 +127,7 @@ sub rmtree {
        $root =~ s#/$##;
        if (-d $root) { 
            opendir(D,$root);
-           $root =~ s#\.dir$## if $Is_VMS;
+           ($root = VMS::Filespec::unixify($root)) =~ s#\.dir$## if $Is_VMS;
            @files = map("$root/$_", grep $_!~/^\.{1,2}$/, readdir(D));
            closedir(D);
            $count += rmtree(\@files,$verbose,$safe);
diff --git a/lib/Sys/Hostname.pm b/lib/Sys/Hostname.pm
index 91c62b6..457bf1a 100644
--- a/lib/Sys/Hostname.pm
+++ b/lib/Sys/Hostname.pm
@@ -1,6 +1,7 @@
 package Sys::Hostname;
 
 use Carp;
+use Config;
 require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(hostname);
@@ -33,8 +34,32 @@ Texas Instruments
 
 sub hostname {
 
-    # method 1 - we already know it
-    return $host if defined $host;
+  # method 1 - we already know it
+  return $host if defined $host;
+
+  if ($Config{'osname'} eq 'VMS') {
+
+    # method 2 - no sockets ==> return DECnet node name
+    if (!$Config{'d_has_sockets'}) { return $host = $ENV{'SYS$NODE'}; }
+
+    # method 3 - has someone else done the job already?  It's common for the
+    #    TCP/IP stack to advertise the hostname via a logical name.  (Are
+    #    there any other logicals which TCP/IP stacks use for the host name?)
+    $host = $ENV{'ARPANET_HOST_NAME'}  || $ENV{'INTERNET_HOST_NAME'} ||
+            $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'}      ||
+            $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'};
+    return $host if $host;
+
+    # method 4 - does hostname happen to work?
+    my($rslt) = `hostname`;
+    if ($rslt !~ /IVVERB/) { ($host) = $rslt =~ /^(\S+)/; }
+    return $host if $host;
+
+    # rats!
+    Carp::croak "Cannot get host name of local machine";  
+
+  }
+  else {  # Unix
 
     # method 2 - syscall is preferred since it avoids tainting problems
     eval {
@@ -67,6 +92,7 @@ sub hostname {
     # remove garbage 
     $host =~ tr/\0\r\n//d;
     $host;
+  }
 }
 
 1;
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index b5be230..15a2498 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -225,7 +225,8 @@ command		Execute as a perl statement in current package.
 		    $subname = "main::" . $subname unless $subname =~ /'|::/;
 		    $subname = "main" . $subname if substr($subname,0,1)eq "'";
 		    $subname = "main" . $subname if substr($subname,0,2)eq "::";
-		    ($file,$subrange) = split(/:/,$sub{$subname});
+		    # VMS filespecs may (usually do) contain ':', so don't use split
+		    ($file,$subrange) = $sub{$subname} =~ /(.*):(.*)/;
 		    if ($file ne $filename) {
 			*dbline = "::_<$file";
 			$max = $#dbline;
@@ -305,7 +306,8 @@ command		Execute as a perl statement in current package.
 			unless $subname =~ /'|::/;
 		    $subname = "main" . $subname if substr($subname,0,1) eq "'";
 		    $subname = "main" . $subname if substr($subname,0,2) eq "::";
-		    ($filename,$i) = split(/:/, $sub{$subname});
+		    # VMS filespecs may (usually do) contain ':', so don't use split
+		    ($filename,$i) = $sub{$subname} =~ /(.*):(.*)/;
 		    $i += 0;
 		    if ($i) {
 			*dbline = "::_<$filename";