2 package File::Spec::VMS;
11 use vars qw($Revision);
12 $Revision = '5.3901 (6-Mar-1997)';
14 @ISA = qw(File::Spec::Unix);
16 Exporter::import('File::Spec', '$Verbose');
20 File::Spec::VMS - methods for VMS file specs
24 use File::Spec::VMS; # Done internally by File::Spec if needed
28 See File::Spec::Unix for a documentation of the methods provided
29 there. This package overrides the implementation of these methods, not
32 =head2 Methods always loaded
38 Concatenates a list of file specifications, and returns the result as a
39 VMS-syntax directory specification.
46 @dirs = grep($_,@dirs);
49 my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
50 my($spath,$sdir) = ($path,$dir);
51 $spath =~ s/.dir$//; $sdir =~ s/.dir$//;
52 $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
53 $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
56 if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
57 else { $rslt = vmspath($dir); }
59 print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
65 Concatenates a list of file specifications, and returns the result as a
66 VMS-syntax directory specification.
71 my($self,@files) = @_;
72 my($file) = pop @files;
73 @files = grep($_,@files);
76 my($path) = (@files == 1 ? $files[0] : $self->catdir(@files));
79 if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; }
81 $rslt = $self->eliminate_macros($spath);
82 $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
85 else { $rslt = vmsify($file); }
86 print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
90 =item curdir (override)
92 Returns a string representing of the current directory.
100 =item devnull (override)
102 Returns a string representing the null device.
110 =item rootdir (override)
112 Returns a string representing of the root directory.
120 =item updir (override)
122 Returns a string representing of the parent directory.
130 =item path (override)
132 Translate logical name DCL$PATH as a searchlist, rather than trying
133 to C<split> string value of C<$ENV{'PATH'}>.
139 while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
143 =item file_name_is_absolute (override)
145 Checks for VMS directory spec as well as Unix separators.
149 sub file_name_is_absolute {
150 my($self,$file) = @_;
151 # If it's a logical name, expand it.
152 $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file};
153 $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/;