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');
26 This package provides routines to simplify conversion between VMS and
27 Unix syntax when processing file specifications. This is useful when
28 porting scripts designed to run under either OS, and also allows you
29 to take advantage of conveniences provided by either syntax (I<e.g.>
30 ability to easily concatenate Unix-style specifications). In
31 addition, it provides an additional file test routine, C<candelete>,
32 which determines whether you have delete access to a file.
34 If you're running under VMS, the routines in this package are special,
35 in that they're automatically made available to any Perl script,
36 whether you're running F<miniperl> or the full F<perl>. The C<use
37 VMS::Filespec> or C<require VMS::Filespec; import VMS::Filespec ...>
38 statement can be used to import the function names into the current
39 package, but they're always available if you use the fully qualified
40 name, whether or not you've mentioned the F<.pm> file in your script.
41 If you're running under another OS and have installed this package, it
42 behaves like a normal Perl extension (in fact, you're using Perl
43 substitutes to emulate the necessary VMS system calls).
45 Each of these routines accepts a file specification in either VMS or
46 Unix syntax, and returns the converted file specification, or C<undef>
47 if an error occurs. The conversions are, for the most part, simply
48 string manipulations; the routines do not check the details of syntax
49 (e.g. that only legal characters are used). There is one exception:
50 when running under VMS, conversions from VMS syntax use the $PARSE
51 service to expand specifications, so illegal syntax, or a relative
52 directory specification which extends above the tope of the current
53 directory path (e.g [---.foo] when in dev:[dir.sub]) will cause
54 errors. In general, any legal file specification will be converted
55 properly, but garbage input tends to produce garbage output.
57 Each of these routines is prototyped as taking a single scalar
58 argument, so you can use them as unary operators in complex
59 expressions (as long as you don't use the C<&> form of
60 subroutine call, which bypasses prototype checking).
63 The routines provided are:
67 Uses the RMS $PARSE and $SEARCH services to expand the input
68 specification to its fully qualified form, except that a null type
69 or version is not added unless it was present in either the original
70 file specification or the default specification passed to C<rmsexpand>.
71 (If the file does not exist, the input specification is expanded as much
72 as possible.) If an error occurs, returns C<undef> and sets C<$!>
77 Converts a file specification to VMS syntax.
81 Converts a file specification to Unix syntax.
85 Converts a directory specification to a path - that is, a string you
86 can prepend to a file name to form a valid file specification. If the
87 input file specification uses VMS syntax, the returned path does, too;
88 likewise for Unix syntax (Unix paths are guaranteed to end with '/').
89 Note that this routine will insist that the input be a legal directory
90 file specification; the file type and version, if specified, must be
91 F<.DIR;1>. For compatibility with Unix usage, the type and version
96 Converts a directory specification to the file specification of the
97 directory file - that is, a string you can pass to functions like
98 C<stat> or C<rmdir> to manipulate the directory file. If the
99 input directory specification uses VMS syntax, the returned file
100 specification does, too; likewise for Unix syntax. As with
101 C<pathify>, the input file specification must have a type and
102 version of F<.DIR;1>, or the type and version must be omitted.
106 Acts like C<pathify>, but insures the returned path uses VMS syntax.
110 Acts like C<pathify>, but insures the returned path uses Unix syntax.
114 Determines whether you have delete access to a file. If you do, C<candelete>
115 returns true. If you don't, or its argument isn't a legal file specification,
116 C<candelete> returns FALSE. Unlike other file tests, the argument to
117 C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB,
118 it's a list operator, so you need to be careful about parentheses. Both of
119 these restrictions may be removed in the future if the functionality of
120 C<candelete> becomes part of the Perl core.
124 This document was last revised 22-Feb-1996, for Perl 5.002.
128 package VMS::Filespec;
131 our $VERSION = '1.11';
133 # If you want to use this package on a non-VMS system,
134 # uncomment the following line.
138 @ISA = qw( Exporter );
139 @EXPORT = qw( &vmsify &unixify &pathify &fileify
140 &vmspath &unixpath &candelete &rmsexpand );
148 # The autosplit routines here are provided for use by non-VMS systems
149 # They are not guaranteed to function identically to the XSUBs of the
150 # same name, since they do not have access to the RMS system routine
151 # sys$parse() (in particular, no real provision is made for handling
152 # of complex DECnet node specifications). However, these routines
153 # should be adequate for most purposes.
155 # A sort-of sys$parse() replacement
156 sub rmsexpand ($;$) {
157 my($fspec,$defaults) = @_;
158 if (!$fspec) { return undef }
159 my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);
162 $defaults = [] unless $defaults;
163 $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY';
165 while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} }
168 my($dev,$devtrn,$base);
169 ($dev,$base) = split(/:/,$fspec);
171 while ($devtrn = $ENV{$devtrn}) {
172 if ($devtrn =~ /(.)([:>\]])$/) {
173 $dev .= ':', last if $1 eq '.';
174 $dev = $devtrn, last;
177 $fspec = $dev . $base;
180 ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
181 /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
182 foreach ((@$defaults,$ENV{'DEFAULT'})) {
184 last if $node && $ver && $type && $dev && $dir && $name;
185 ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
186 /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
187 $node = $dnode if $dnode && !$node;
188 $dev = $ddev if $ddev && !$dev;
189 $dir = $ddir if $ddir && !$dir;
190 $name = $dname if $dname && !$name;
191 $type = $dtype if $dtype && !$type;
192 $ver = $dver if $dver && !$ver;
194 # do this the long way to keep -w happy
196 $fspec .= $node if $node;
197 $fspec .= $dev if $dev;
198 $fspec .= $dir if $dir;
199 $fspec .= $name if $name;
200 $fspec .= $type if $type;
201 $fspec .= $ver if $ver;
207 my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
209 if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; }
210 return $fspec if $fspec !~ m#/#;
211 ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#;
212 @dirs = split(m#/#,$dir);
213 if ($base eq '.') { $base = ''; }
214 elsif ($base eq '..') {
219 next unless $_; # protect against // in input
222 if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs }
223 else { push @realdirs, '-' }
225 else { push @realdirs, $_; }
228 $dev = shift @realdirs;
229 @realdirs = ('000000') unless @realdirs;
230 $base = '' unless $base; # keep -w happy
231 $dev . ':[' . join('.',@realdirs) . "]$base";
234 '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base";
241 return $fspec if $fspec !~ m#[:>\]]#;
242 return '.' if ($fspec eq '[]' || $fspec eq '<>');
243 if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) {
244 $fspec = ($1 eq '.' ? '' : "$1.") . $2;
245 my($dir,$base) = split(/[\]>]/,$fspec);
246 my(@dirs) = grep($_,split(m#\.#,$dir));
247 if ($dirs[0] =~ /^-/) {
248 my($steps) = shift @dirs;
249 for (1..length($steps)) { unshift @dirs, '..'; }
251 join('/',@dirs) . "/$base";
254 $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]');
255 $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//;
256 my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#;
257 my(@dirs) = split(m#\.#,$dir);
258 if ($dirs[0] && $dirs[0] =~ /^-/) {
259 my($steps) = shift @dirs;
260 for (1..length($steps)) { unshift @dirs, '..'; }
262 "/$dev/" . join('/',@dirs) . "/$base";
270 if (!$path) { return undef }
271 if ($path eq '/') { return 'sys$disk:[000000]'; }
272 if ($path =~ /(.+)\.([^:>\]]*)$/) {
274 if ($2 !~ /^dir(?:;1)?$/i) { return undef }
277 if ($path !~ m#[/>\]]#) {
279 while ($ENV{$path}) {
280 ($path = $ENV{$path}) =~ s/:$//;
281 last if $path =~ m#[/>\]]#;
284 if ($path =~ m#[>\]]#) {
285 my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/;
288 "$dir$sep$base.dir;1";
291 if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; }
292 $dir =~ s#\.(\w+)$#$sep$1#;
306 if (!$fspec) { return undef }
307 if ($fspec =~ m#[/>\]]$#) { return $fspec; }
308 if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') {
310 if ($2 !~ /^dir(?:;1)?$/i) { return undef }
313 if ($fspec !~ m#[/>\]]#) {
315 while ($ENV{$fspec}) {
316 if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} }
317 else { $fspec = $ENV{$fspec} =~ s/:$// }
321 if ($fspec !~ m#[>\]]#) { "$fspec/"; }
323 if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; }
329 pathify(vmsify($_[0]));
333 pathify(unixify($_[0]));
340 return '' unless -w $fspec;
342 if ($fspec =~ m#/#) {
343 ($parent = $fspec) =~ s#/[^/]+$##;
346 elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms
347 $parent =~ s/[>\]][^>\]]+//;
348 return (-w fileify($parent));
350 else { return (-w '[-]'); }