1 package File::Spec::VMS;
5 require File::Spec::Unix;
6 @ISA = qw(File::Spec::Unix);
13 File::Spec::VMS - methods for VMS file specs
17 require File::Spec::VMS; # Done internally by File::Spec if needed
21 See File::Spec::Unix for a documentation of the methods provided
22 there. This package overrides the implementation of these methods, not
27 sub eliminate_macros {
29 return '' unless $path;
30 $self = {} unless ref $self;
31 my($npath) = unixify($path);
33 my($head,$macro,$tail);
35 # perform m##g in scalar context so it acts as an iterator
36 while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#g) {
38 ($head,$macro,$tail) = ($1,$2,$3);
39 if (ref $self->{$macro}) {
40 if (ref $self->{$macro} eq 'ARRAY') {
41 $macro = join ' ', @{$self->{$macro}};
44 print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
45 "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
46 $macro = "\cB$macro\cB";
50 else { ($macro = unixify($self->{$macro})) =~ s#/$##; }
51 $npath = "$head$macro$tail";
54 if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#g; }
59 my($self,$path,$force_path) = @_;
60 return '' unless $path;
61 $self = bless {} unless ref $self;
62 my($fixedpath,$prefix,$name);
64 if ($path =~ m#^\$\([^\)]+\)$# || $path =~ m#[/:>\]]#) {
65 if ($force_path or $path =~ /(?:DIR\)|\])$/) {
66 $fixedpath = vmspath($self->eliminate_macros($path));
69 $fixedpath = vmsify($self->eliminate_macros($path));
72 elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) {
73 my($vmspre) = $self->eliminate_macros("\$($prefix)");
74 # is it a dir or just a name?
75 $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR$/) ? vmspath($vmspre) : '';
76 $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
77 $fixedpath = vmspath($fixedpath) if $force_path;
81 $fixedpath = vmspath($fixedpath) if $force_path;
83 # No hints, so we try to guess
84 if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
85 $fixedpath = vmspath($fixedpath) if -d $fixedpath;
87 # Trim off root dirname if it's had other dirs inserted in front of it.
88 $fixedpath =~ s/\.000000([\]>])/$1/;
93 =head2 Methods always loaded
99 Concatenates a list of file specifications, and returns the result as a
100 VMS-syntax directory specification.
105 my ($self,@dirs) = @_;
107 @dirs = grep($_,@dirs);
110 my $path = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
111 my ($spath,$sdir) = ($path,$dir);
112 $spath =~ s/.dir$//; $sdir =~ s/.dir$//;
113 $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
114 $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
117 if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
118 else { $rslt = vmspath($dir); }
125 Concatenates a list of file specifications, and returns the result as a
126 VMS-syntax directory specification.
131 my ($self,@files) = @_;
132 my $file = pop @files;
133 @files = grep($_,@files);
136 my $path = (@files == 1 ? $files[0] : $self->catdir(@files));
139 if ($spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) {
140 $rslt = "$spath$file";
143 $rslt = $self->eliminate_macros($spath);
144 $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
147 else { $rslt = vmsify($file); }
151 =item curdir (override)
153 Returns a string representation of the current directory: '[]'
161 =item devnull (override)
163 Returns a string representation of the null device: '_NLA0:'
171 =item rootdir (override)
173 Returns a string representation of the root directory: 'SYS$DISK:[000000]'
178 return 'SYS$DISK:[000000]';
181 =item tmpdir (override)
183 Returns a string representation of the first writable directory
184 from the following list or '' if none are writable:
193 return $tmpdir if defined $tmpdir;
194 foreach ('/sys$scratch', $ENV{TMPDIR}) {
195 next unless defined && -d && -w _;
199 $tmpdir = '' unless defined $tmpdir;
203 =item updir (override)
205 Returns a string representation of the parent directory: '[-]'
213 =item path (override)
215 Translate logical name DCL$PATH as a searchlist, rather than trying
216 to C<split> string value of C<$ENV{'PATH'}>.
222 while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
226 =item file_name_is_absolute (override)
228 Checks for VMS directory spec as well as Unix separators.
232 sub file_name_is_absolute {
233 my ($self,$file) = @_;
234 # If it's a logical name, expand it.
235 $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ && $ENV{$file};
236 return scalar($file =~ m!^/! ||
237 $file =~ m![<\[][^.\-\]>]! ||