1 # Perl hooks into the routines in vms.c for interconversion
2 # of VMS and Unix file specification syntax.
5 # Author: Charles Bailey bailey@genetics.upenn.edu
10 VMS::Filespec - convert between VMS and Unix file specification syntax
15 $vmsspec = vmsify('/my/Unix/file/specification');
16 $unixspec = unixify('my:[VMS]file.specification');
17 $path = pathify('my:[VMS.or.Unix.directory]specification.dir');
18 $dirfile = fileify('my:[VMS.or.Unix.directory.specification]');
19 $vmsdir = vmspath('my/VMS/or/Unix/directory/specification.dir');
20 $unixdir = unixpath('my:[VMS.or.Unix.directory]specification.dir');
21 candelete('my:[VMS.or.Unix]file.specification');
25 This package provides routines to simplify conversion between VMS and
26 Unix syntax when processing file specifications. This is useful when
27 porting scripts designed to run under either OS, and also allows you
28 to take advantage of conveniences provided by either syntax (I<e.g.>
29 ability to easily concatenate Unix-style specifications). In
30 addition, it provides an additional file test routine, C<candelete>,
31 which determines whether you have delete access to a file.
33 If you're running under VMS, the routines in this package are special,
34 in that they're automatically made available to any Perl script,
35 whether you're running F<miniperl> or the full F<perl>. The C<use
36 VMS::Filespec> or C<require VMS::Filespec; import VMS::Filespec ...>
37 statement can be used to import the function names into the current
38 package, but they're always available if you use the fully qualified
39 name, whether or not you've mentioned the F<.pm> file in your script.
40 If you're running under another OS and have installed this package, it
41 behaves like a normal Perl extension (in fact, you're using Perl
42 substitutes to emulate the necessary VMS system calls).
44 Each of these routines accepts a file specification in either VMS or
45 Unix syntax, and returns the converted file specification, or C<undef>
46 if an error occurs. The conversions are, for the most part, simply
47 string manipulations; the routines do not check the details of syntax
48 (e.g. that only legal characters are used). There is one exception:
49 when running under VMS, conversions from VMS syntax use the $PARSE
50 service to expand specifications, so illegal syntax, or a relative
51 directory specification which extends above the tope of the current
52 directory path (e.g [---.foo] when in dev:[dir.sub]) will cause
53 errors. In general, any legal file specification will be converted
54 properly, but garbage input tends to produce garbage output.
56 Each of these routines is prototyped as taking a single scalar
57 argument, so you can use them as unary operators in complex
58 expressions (as long as you don't use the C<&> form of
59 subroutine call, which bypasses prototype checking).
62 The routines provided are:
66 Converts a file specification to VMS syntax.
70 Converts a file specification to Unix syntax.
74 Converts a directory specification to a path - that is, a string you
75 can prepend to a file name to form a valid file specification. If the
76 input file specification uses VMS syntax, the returned path does, too;
77 likewise for Unix syntax (Unix paths are guaranteed to end with '/').
78 Note that this routine will insist that the input be a legal directory
79 file specification; the file type and version, if specified, must be
80 F<.DIR;1>. For compatibility with Unix usage, the type and version
85 Converts a directory specification to the file specification of the
86 directory file - that is, a string you can pass to functions like
87 C<stat> or C<rmdir> to manipulate the directory file. If the
88 input directory specification uses VMS syntax, the returned file
89 specification does, too; likewise for Unix syntax. As with
90 C<pathify>, the input file specification must have a type and
91 version of F<.DIR;1>, or the type and version must be omitted.
95 Acts like C<pathify>, but insures the returned path uses VMS syntax.
99 Acts like C<pathify>, but insures the returned path uses Unix syntax.
103 Determines whether you have delete access to a file. If you do, C<candelete>
104 returns true. If you don't, or its argument isn't a legal file specification,
105 C<candelete> returns FALSE. Unlike other file tests, the argument to
106 C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB,
107 it's a list operator, so you need to be careful about parentheses. Both of
108 these restrictions may be removed in the future if the functionality of
109 C<candelete> becomes part of the Perl core.
113 This document was last revised 22-Feb-1996, for Perl 5.002.
117 package VMS::Filespec;
121 # If you want to use this package on a non-VMS system,
122 # uncomment the following line.
126 @ISA = qw( Exporter );
127 @EXPORT = qw( &vmsify &unixify &pathify &fileify
128 &vmspath &unixpath &candelete);
130 @EXPORT_OK = qw( &rmsexpand );
137 # The autosplit routines here are provided for use by non-VMS systems
138 # They are not guaranteed to function identically to the XSUBs of the
139 # same name, since they do not have access to the RMS system routine
140 # sys$parse() (in particular, no real provision is made for handling
141 # of complex DECnet node specifications). However, these routines
142 # should be adequate for most purposes.
144 # A sort-of sys$parse() replacement
146 my($fspec,$defaults) = @_;
147 if (!$fspec) { return undef }
148 my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);
151 $defaults = [] unless $defaults;
152 $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY';
154 while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} }
157 my($dev,$devtrn,$base);
158 ($dev,$base) = split(/:/,$fspec);
160 while ($devtrn = $ENV{$devtrn}) {
161 if ($devtrn =~ /(.)([:>\]])$/) {
162 $dev .= ':', last if $1 eq '.';
163 $dev = $devtrn, last;
166 $fspec = $dev . $base;
169 ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
170 /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
171 foreach ((@$defaults,$ENV{'DEFAULT'})) {
172 last if $node && $ver && $type && $dev && $dir && $name;
173 ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
174 /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
175 $node = $dnode if $dnode && !$node;
176 $dev = $ddev if $ddev && !$dev;
177 $dir = $ddir if $ddir && !$dir;
178 $name = $dname if $dname && !$name;
179 $type = $dtype if $dtype && !$type;
180 $ver = $dver if $dver && !$ver;
182 # do this the long way to keep -w happy
184 $fspec .= $node if $node;
185 $fspec .= $dev if $dev;
186 $fspec .= $dir if $dir;
187 $fspec .= $name if $name;
188 $fspec .= $type if $type;
189 $fspec .= $ver if $ver;
195 my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
197 if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; }
198 return $fspec if $fspec !~ m#/#;
199 ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#;
200 @dirs = split(m#/#,$dir);
201 if ($base eq '.') { $base = ''; }
202 elsif ($base eq '..') {
207 next unless $_; # protect against // in input
210 if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs }
211 else { push @realdirs, '-' }
213 else { push @realdirs, $_; }
216 $dev = shift @realdirs;
217 @realdirs = ('000000') unless @realdirs;
218 $base = '' unless $base; # keep -w happy
219 $dev . ':[' . join('.',@realdirs) . "]$base";
222 '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base";
229 return $fspec if $fspec !~ m#[:>\]]#;
230 return '.' if ($fspec eq '[]' || $fspec eq '<>');
231 if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) {
232 $fspec = ($1 eq '.' ? '' : "$1.") . $2;
233 my($dir,$base) = split(/[\]>]/,$fspec);
234 my(@dirs) = grep($_,split(m#\.#,$dir));
235 if ($dirs[0] =~ /^-/) {
236 my($steps) = shift @dirs;
237 for (1..length($steps)) { unshift @dirs, '..'; }
239 join('/',@dirs) . "/$base";
242 $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]');
243 $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//;
244 my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#;
245 my(@dirs) = split(m#\.#,$dir);
246 if ($dirs[0] && $dirs[0] =~ /^-/) {
247 my($steps) = shift @dirs;
248 for (1..length($steps)) { unshift @dirs, '..'; }
250 "/$dev/" . join('/',@dirs) . "/$base";
258 if (!$path) { return undef }
259 if ($path =~ /(.+)\.([^:>\]]*)$/) {
261 if ($2 !~ /^dir(?:;1)?$/i) { return undef }
264 if ($path !~ m#[/>\]]#) {
266 while ($ENV{$path}) {
267 ($path = $ENV{$path}) =~ s/:$//;
268 last if $path =~ m#[/>\]]#;
271 if ($path =~ m#[>\]]#) {
272 my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/;
275 "$dir$sep$base.dir;1";
278 if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; }
279 $dir =~ s#\.(\w+)$#$sep$1#;
293 if (!$fspec) { return undef }
294 if ($fspec =~ m#[/>\]]$#) { return $fspec; }
295 if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') {
297 if ($2 !~ /^dir(?:;1)?$/i) { return undef }
300 if ($fspec !~ m#[/>\]]#) {
302 while ($ENV{$fspec}) {
303 if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} }
304 else { $fspec = $ENV{$fspec} =~ s/:$// }
308 if ($fspec !~ m#[>\]]#) { "$fspec/"; }
310 if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; }
316 pathify(vmsify($_[0]));
320 pathify(unixify($_[0]));
327 return '' unless -w $fspec;
329 if ($fspec =~ m#/#) {
330 ($parent = $fspec) =~ s#/[^/]+$#;
333 elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms
334 $parent =~ s/[>\]][^>\]]+//;
335 return (-w fileify($parent));
337 else { return (-w '[-]'); }