VMS-specific changes.
Perl 5 Porters [Tue, 2 Jan 1996 03:30:49 +0000 (03:30 +0000)]
lib/File/Path.pm
lib/Sys/Hostname.pm
lib/perl5db.pl

index 438a08e..05c5bd9 100644 (file)
@@ -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);
index 91c62b6..457bf1a 100644 (file)
@@ -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;
index b5be230..15a2498 100644 (file)
@@ -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";