1 files changed, 75 insertions, 52 deletions

diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm
index 208450589e..30440c2218 100644
--- a/lib/File/Spec/VMS.pm
+++ b/lib/File/Spec/VMS.pm
@@ -1,19 +1,12 @@
-
 package File::Spec::VMS;
 
-use Carp qw( &carp );
-use Config;
-require Exporter;
-use VMS::Filespec;
-use File::Basename;
-
-use File::Spec;
-use vars qw($Revision);
-$Revision = '5.3901 (6-Mar-1997)';
-
+use strict;
+use vars qw(@ISA);
+require File::Spec::Unix;
 @ISA = qw(File::Spec::Unix);
 
-Exporter::import('File::Spec', '$Verbose');
+use File::Basename;
+use VMS::Filespec;
 
 =head1 NAME
 
@@ -21,7 +14,7 @@ File::Spec::VMS - methods for VMS file specs
 
 =head1 SYNOPSIS
 
- use File::Spec::VMS; # Done internally by File::Spec if needed
+ require File::Spec::VMS; # Done internally by File::Spec if needed
 
 =head1 DESCRIPTION
 
@@ -41,23 +34,22 @@ VMS-syntax directory specification.
 =cut
 
 sub catdir {
-    my($self,@dirs) = @_;
-    my($dir) = pop @dirs;
+    my ($self,@dirs) = @_;
+    my $dir = pop @dirs;
     @dirs = grep($_,@dirs);
-    my($rslt);
+    my $rslt;
     if (@dirs) {
-      my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
-      my($spath,$sdir) = ($path,$dir);
-      $spath =~ s/.dir$//; $sdir =~ s/.dir$//; 
-      $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
-      $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
+	my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
+	my ($spath,$sdir) = ($path,$dir);
+	$spath =~ s/.dir$//; $sdir =~ s/.dir$//; 
+	$sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
+	$rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
     }
-    else { 
-      if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
-      else                          { $rslt = vmspath($dir); }
+    else {
+	if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
+	else                          { $rslt = vmspath($dir); }
     }
-    print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
-    $rslt;
+    return $rslt;
 }
 
 =item catfile
@@ -68,28 +60,29 @@ VMS-syntax directory specification.
 =cut
 
 sub catfile {
-    my($self,@files) = @_;
-    my($file) = pop @files;
+    my ($self,@files) = @_;
+    my $file = pop @files;
     @files = grep($_,@files);
-    my($rslt);
+    my $rslt;
     if (@files) {
-      my($path) = (@files == 1 ? $files[0] : $self->catdir(@files));
-      my($spath) = $path;
-      $spath =~ s/.dir$//;
-      if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; }
-      else {
-          $rslt = $self->eliminate_macros($spath);
-          $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
-      }
+	my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
+	my $spath = $path;
+	$spath =~ s/.dir$//;
+	if ($spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) {
+	    $rslt = "$spath$file";
+	}
+	else {
+	    $rslt = $self->eliminate_macros($spath);
+	    $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
+	}
     }
     else { $rslt = vmsify($file); }
-    print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
-    $rslt;
+    return $rslt;
 }
 
 =item curdir (override)
 
-Returns a string representing of the current directory.
+Returns a string representation of the current directory: '[]'
 
 =cut
 
@@ -99,27 +92,49 @@ sub curdir {
 
 =item devnull (override)
 
-Returns a string representing the null device.
+Returns a string representation of the null device: '_NLA0:'
 
 =cut
 
 sub devnull {
-    return 'NL:';
+    return "_NLA0:";
 }
 
 =item rootdir (override)
 
-Returns a string representing of the root directory.
+Returns a string representation of the root directory: 'SYS$DISK:[000000]'
 
 =cut
 
 sub rootdir {
-    return '';
+    return 'SYS$DISK:[000000]';
+}
+
+=item tmpdir (override)
+
+Returns a string representation of the first writable directory
+from the following list or '' if none are writable:
+
+    /sys$scratch
+    $ENV{TMPDIR}
+
+=cut
+
+my $tmpdir;
+sub tmpdir {
+    return $tmpdir if defined $tmpdir;
+    foreach ('/sys$scratch', $ENV{TMPDIR}) {
+	next unless defined && -d && -w _;
+	$tmpdir = $_;
+	last;
+    }
+    $tmpdir = '' unless defined $tmpdir;
+    return $tmpdir;
 }
 
 =item updir (override)
 
-Returns a string representing of the parent directory.
+Returns a string representation of the parent directory: '[-]'
 
 =cut
 
@@ -135,9 +150,9 @@ to C<split> string value of C<$ENV{'PATH'}>.
 =cut
 
 sub path {
-    my(@dirs,$dir,$i);
+    my (@dirs,$dir,$i);
     while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
-    @dirs;
+    return @dirs;
 }
 
 =item file_name_is_absolute (override)
@@ -147,12 +162,20 @@ Checks for VMS directory spec as well as Unix separators.
 =cut
 
 sub file_name_is_absolute {
-    my($self,$file) = @_;
+    my ($self,$file) = @_;
     # If it's a logical name, expand it.
-    $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file};
-    $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/;
+    $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ && $ENV{$file};
+    return scalar($file =~ m!^/!              ||
+		  $file =~ m![<\[][^.\-\]>]!  ||
+		  $file =~ /:[^<\[]/);
 }
 
-1;
-__END__
+=back
 
+=head1 SEE ALSO
+
+L<File::Spec>
+
+=cut
+
+1;