1 # Perl hooks into the routines in vms.c for interconversion
2 # of VMS and Unix file specification syntax.
4 # Version: see $VERSION below
5 # Author: Charles Bailey bailey@newman.upenn.edu
10 VMS::Filespec - convert between VMS and Unix file specification syntax
15 $fullspec = rmsexpand('[.VMS]file.specification'[, 'default:[file.spec]']);
16 $vmsspec = vmsify('/my/Unix/file/specification');
17 $unixspec = unixify('my:[VMS]file.specification');
18 $path = pathify('my:[VMS.or.Unix.directory]specification.dir');
19 $dirfile = fileify('my:[VMS.or.Unix.directory.specification]');
20 $vmsdir = vmspath('my/VMS/or/Unix/directory/specification.dir');
21 $unixdir = unixpath('my:[VMS.or.Unix.directory]specification.dir');
22 candelete('my:[VMS.or.Unix]file.specification');
23 $case_tolerant = vms_case_tolerant;
24 $unixspec = vms_realpath('file_specification');
25 $vmsspec = vms_realname('file_specification');
29 This package provides routines to simplify conversion between VMS and
30 Unix syntax when processing file specifications. This is useful when
31 porting scripts designed to run under either OS, and also allows you
32 to take advantage of conveniences provided by either syntax (I<e.g.>
33 ability to easily concatenate Unix-style specifications). In
34 addition, it provides an additional file test routine, C<candelete>,
35 which determines whether you have delete access to a file.
37 If you're running under VMS, the routines in this package are special,
38 in that they're automatically made available to any Perl script,
39 whether you're running F<miniperl> or the full F<perl>. The C<use
40 VMS::Filespec> or C<require VMS::Filespec; import VMS::Filespec ...>
41 statement can be used to import the function names into the current
42 package, but they're always available if you use the fully qualified
43 name, whether or not you've mentioned the F<.pm> file in your script.
44 If you're running under another OS and have installed this package, it
45 behaves like a normal Perl extension (in fact, you're using Perl
46 substitutes to emulate the necessary VMS system calls).
48 Each of these routines accepts a file specification in either VMS or
49 Unix syntax, and returns the converted file specification, or C<undef>
50 if an error occurs. The conversions are, for the most part, simply
51 string manipulations; the routines do not check the details of syntax
52 (e.g. that only legal characters are used). There is one exception:
53 when running under VMS, conversions from VMS syntax use the $PARSE
54 service to expand specifications, so illegal syntax, or a relative
55 directory specification which extends above the tope of the current
56 directory path (e.g [---.foo] when in dev:[dir.sub]) will cause
57 errors. In general, any legal file specification will be converted
58 properly, but garbage input tends to produce garbage output.
60 Each of these routines is prototyped as taking a single scalar
61 argument, so you can use them as unary operators in complex
62 expressions (as long as you don't use the C<&> form of
63 subroutine call, which bypasses prototype checking).
66 The routines provided are:
70 Uses the RMS $PARSE and $SEARCH services to expand the input
71 specification to its fully qualified form, except that a null type
72 or version is not added unless it was present in either the original
73 file specification or the default specification passed to C<rmsexpand>.
74 (If the file does not exist, the input specification is expanded as much
75 as possible.) If an error occurs, returns C<undef> and sets C<$!>
78 C<rmsexpand> on success will produce a name that fits in a 255 byte buffer,
79 which is required for parameters passed to the DCL interpreter.
83 Converts a file specification to VMS syntax. If the file specification
84 cannot be converted to or is already in VMS syntax, it will be
85 passed through unchanged.
87 The file specifications of C<.> and C<..> will be converted to
90 If the file specification is already in a valid VMS syntax, it will
91 be passed through unchanged, except that the UTF-8 flag will be cleared
92 since VMS format file specifications are never in UTF-8.
94 When Perl is running on an OpenVMS system, if the C<DECC$EFS_CHARSET>
95 feature is not enabled, extra dots in the file specification will
96 be converted to underscore characters, and the C<?> character will
97 be converted to a C<%> character, if a conversion is done.
99 When Perl is running on an OpenVMS system, if the C<DECC$EFS_CHARSET>
100 feature is enabled, this implies that the UNIX pathname can not have
101 a version, and that a path consisting of three dots, C<./.../>, will be
102 converted to C<[.^.^.^.]>.
104 UNIX style shell macros like C<$(abcd)> are passed through instead
105 of being converted to C<$^(abcd^)> independent of the C<DECC$EFS_CHARSET>
106 feature setting. UNIX style shell macros should not use characters
107 that are not in the ASCII character set, as the resulting specification
108 may or may not be still in UTF8 format.
110 The feature logical name C<PERL_VMS_VTF7_FILENAMES> controls if UNICODE
111 characters in UNIX filenames are encoded in VTF-7 notation in the resulting
112 OpenVMS file specification. [Currently under development]
114 C<unixify> on the resulting file specification may not result in the
115 original UNIX file specification, so programs should not plan to convert
116 a file specification from UNIX to VMS and then back to UNIX again after
117 modification of the components.
121 Converts a file specification to Unix syntax. If the file specification
122 cannot be converted to or is already in UNIX syntax, it will be passed
125 When Perl is running on an OpenVMS system, the following C<DECC$> feature
126 settings will control how the filename is converted:
128 C<decc$disable_to_vms_logname_translation:> default = C<ENABLE>
129 C<decc$disable_posix_root:> default = C<ENABLE>
130 C<decc$efs_charset:> default = C<DISABLE>
131 C<decc$filename_unix_no_version:> default = C<DISABLE>
132 C<decc$readdir_dropdotnotype:> default = C<ENABLE>
134 When Perl is being run under a UNIX shell on OpenVMS, the defaults at
135 a future time may be more appropriate for it.
137 When Perl is running on an OpenVMS system with C<DECC$EFS_CHARSET> enabled,
138 a wild card directory name of C<[...]> can not be translated to a valid
139 UNIX file specification when a conversion is done.
141 When Perl is running on an OpenVMS system with C<DECC$EFS_CHARSET> enabled,
142 directory file specifications will have their implied ".dir;1" removed,
143 and a trailing C<.> character indicating a null extension will be removed.
145 Note that C<DECC$EFS_CHARSET> requires C<DECC$FILENAME_UNIX_NO_VERSION> because
146 the conversion routine can not differentiate whether the last C<.> of a UNIX
147 specification is delimiting a version, or is just part of a file specification.
149 C<vmsify> on the resulting file specification may not result in the
150 original VMS file specification, so programs should not plan to convert
151 a file specification from VMS to UNIX and then back to VMS again after
156 Converts a directory specification to a path - that is, a string you
157 can prepend to a file name to form a valid file specification. If the
158 input file specification uses VMS syntax, the returned path does, too;
159 likewise for Unix syntax (Unix paths are guaranteed to end with '/').
160 Note that this routine will insist that the input be a legal directory
161 file specification; the file type and version, if specified, must be
162 F<.DIR;1>. For compatibility with Unix usage, the type and version
167 Converts a directory specification to the file specification of the
168 directory file - that is, a string you can pass to functions like
169 C<stat> or C<rmdir> to manipulate the directory file. If the
170 input directory specification uses VMS syntax, the returned file
171 specification does, too; likewise for Unix syntax. As with
172 C<pathify>, the input file specification must have a type and
173 version of F<.DIR;1>, or the type and version must be omitted.
177 Acts like C<pathify>, but insures the returned path uses VMS syntax.
181 Acts like C<pathify>, but insures the returned path uses Unix syntax.
185 Determines whether you have delete access to a file. If you do, C<candelete>
186 returns true. If you don't, or its argument isn't a legal file specification,
187 C<candelete> returns FALSE. Unlike other file tests, the argument to
188 C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB,
189 it's a list operator, so you need to be careful about parentheses. Both of
190 these restrictions may be removed in the future if the functionality of
191 C<candelete> becomes part of the Perl core.
193 =head2 vms_case_tolerant
195 This reports whether the VMS process has been set to a case tolerant state.
196 It is intended for use by the File::Spec::VMS->case_tolerant method only, and
197 it is recommended that you only use File::Spec->case_tolerant.
201 This exposes the VMS C library C<realpath> function where available.
202 It will always return a UNIX format specification.
204 If the C<realpath> function is not available, or is unable to return the
205 real path of the file, C<vms_realpath> will use the C<vms_realfile>
206 function and convert the output to a UNIX format specification.
208 This function is intended for use by Cwd.pm for the implementation of
209 the abs_path function with support for symbolic links. It is not available
214 This uses the VMS LIB$FID_TO_NAME function to find the name of the primary
215 link to a file, and returns the filename in VMS format.
217 This function is intended for use by Cwd.pm for the implementation of
218 the abs_path function with support for symbolic links. It is not available
224 This document was last revised 15-Nov-2007, for Perl 5.10.0
228 package VMS::Filespec;
231 our $VERSION = '1.12';
233 # If you want to use this package on a non-VMS system,
234 # uncomment the following line.
238 @ISA = qw( Exporter );
239 @EXPORT = qw( &vmsify &unixify &pathify &fileify
240 &vmspath &unixpath &candelete &rmsexpand &vms_case_tolerant );
248 # The autosplit routines here are provided for use by non-VMS systems
249 # They are not guaranteed to function identically to the XSUBs of the
250 # same name, since they do not have access to the RMS system routine
251 # sys$parse() (in particular, no real provision is made for handling
252 # of complex DECnet node specifications). However, these routines
253 # should be adequate for most purposes.
255 # A sort-of sys$parse() replacement
256 sub rmsexpand ($;$) {
257 my($fspec,$defaults) = @_;
258 if (!$fspec) { return undef }
259 my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);
262 $defaults = [] unless $defaults;
263 $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY';
265 while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} }
268 my($dev,$devtrn,$base);
269 ($dev,$base) = split(/:/,$fspec);
271 while ($devtrn = $ENV{$devtrn}) {
272 if ($devtrn =~ /(.)([:>\]])$/) {
273 $dev .= ':', last if $1 eq '.';
274 $dev = $devtrn, last;
277 $fspec = $dev . $base;
280 ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
281 /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
282 foreach ((@$defaults,$ENV{'DEFAULT'})) {
284 last if $node && $ver && $type && $dev && $dir && $name;
285 ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
286 /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
287 $node = $dnode if $dnode && !$node;
288 $dev = $ddev if $ddev && !$dev;
289 $dir = $ddir if $ddir && !$dir;
290 $name = $dname if $dname && !$name;
291 $type = $dtype if $dtype && !$type;
292 $ver = $dver if $dver && !$ver;
294 # do this the long way to keep -w happy
296 $fspec .= $node if $node;
297 $fspec .= $dev if $dev;
298 $fspec .= $dir if $dir;
299 $fspec .= $name if $name;
300 $fspec .= $type if $type;
301 $fspec .= $ver if $ver;
307 my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
309 if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; }
310 return $fspec if $fspec !~ m#/#;
311 ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#;
312 @dirs = split(m#/#,$dir);
313 if ($base eq '.') { $base = ''; }
314 elsif ($base eq '..') {
319 next unless $_; # protect against // in input
322 if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs }
323 else { push @realdirs, '-' }
325 else { push @realdirs, $_; }
328 $dev = shift @realdirs;
329 @realdirs = ('000000') unless @realdirs;
330 $base = '' unless $base; # keep -w happy
331 $dev . ':[' . join('.',@realdirs) . "]$base";
334 '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base";
341 return $fspec if $fspec !~ m#[:>\]]#;
342 return '.' if ($fspec eq '[]' || $fspec eq '<>');
343 if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) {
344 $fspec = ($1 eq '.' ? '' : "$1.") . $2;
345 my($dir,$base) = split(/[\]>]/,$fspec);
346 my(@dirs) = grep($_,split(m#\.#,$dir));
347 if ($dirs[0] =~ /^-/) {
348 my($steps) = shift @dirs;
349 for (1..length($steps)) { unshift @dirs, '..'; }
351 join('/',@dirs) . "/$base";
354 $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]');
355 $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//;
356 my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#;
357 my(@dirs) = split(m#\.#,$dir);
358 if ($dirs[0] && $dirs[0] =~ /^-/) {
359 my($steps) = shift @dirs;
360 for (1..length($steps)) { unshift @dirs, '..'; }
362 "/$dev/" . join('/',@dirs) . "/$base";
370 if (!$path) { return undef }
371 if ($path eq '/') { return 'sys$disk:[000000]'; }
372 if ($path =~ /(.+)\.([^:>\]]*)$/) {
374 if ($2 !~ /^dir(?:;1)?$/i) { return undef }
377 if ($path !~ m#[/>\]]#) {
379 while ($ENV{$path}) {
380 ($path = $ENV{$path}) =~ s/:$//;
381 last if $path =~ m#[/>\]]#;
384 if ($path =~ m#[>\]]#) {
385 my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/;
388 "$dir$sep$base.dir;1";
391 if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; }
392 $dir =~ s#\.(\w+)$#$sep$1#;
406 if (!$fspec) { return undef }
407 if ($fspec =~ m#[/>\]]$#) { return $fspec; }
408 if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') {
410 if ($2 !~ /^dir(?:;1)?$/i) { return undef }
413 if ($fspec !~ m#[/>\]]#) {
415 while ($ENV{$fspec}) {
416 if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} }
417 else { $fspec = $ENV{$fspec} =~ s/:$// }
421 if ($fspec !~ m#[>\]]#) { "$fspec/"; }
423 if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; }
429 pathify(vmsify($_[0]));
433 pathify(unixify($_[0]));
440 return '' unless -w $fspec;
442 if ($fspec =~ m#/#) {
443 ($parent = $fspec) =~ s#/[^/]+$##;
446 elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms
447 $parent =~ s/[>\]][^>\]]+//;
448 return (-w fileify($parent));
450 else { return (-w '[-]'); }
453 sub vms_case_tolerant ($) {