Commit | Line | Data |
748a9306 |
1 | # Perl hooks into the routines in vms.c for interconversion |
2 | # of VMS and Unix file specification syntax. |
3 | # |
28b605d8 |
4 | # Version: see $VERSION below |
bd3fa61c |
5 | # Author: Charles Bailey bailey@newman.upenn.edu |
b1a8dcd7 |
6 | # Revised: 30-Oct-2007 |
748a9306 |
7 | |
8 | =head1 NAME |
9 | |
10 | VMS::Filespec - convert between VMS and Unix file specification syntax |
11 | |
12 | =head1 SYNOPSIS |
13 | |
14 | use VMS::Filespec; |
17f28c40 |
15 | $fullspec = rmsexpand('[.VMS]file.specification'[, 'default:[file.spec]']); |
748a9306 |
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'); |
b1a8dcd7 |
23 | $case_tolerant = vms_case_tolerant; |
24 | $unixspec = vms_realpath('file_specification'); |
25 | $vmsspec = vms_realname('file_specification'); |
748a9306 |
26 | |
27 | =head1 DESCRIPTION |
28 | |
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 |
a5f75d66 |
32 | to take advantage of conveniences provided by either syntax (I<e.g.> |
748a9306 |
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. |
36 | |
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). |
47 | |
48 | Each of these routines accepts a file specification in either VMS or |
e518068a |
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 |
748a9306 |
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. |
59 | |
a5f75d66 |
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). |
64 | |
65 | |
748a9306 |
66 | The routines provided are: |
67 | |
60618c03 |
68 | =head2 rmsexpand |
69 | |
70 | Uses the RMS $PARSE and $SEARCH services to expand the input |
17f28c40 |
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<$!> |
60618c03 |
76 | and C<$^E>. |
77 | |
b1a8dcd7 |
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. |
80 | |
748a9306 |
81 | =head2 vmsify |
82 | |
b1a8dcd7 |
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. |
86 | |
87 | The file specifications of C<.> and C<..> will be converted to |
88 | C<[]> and C<[-]>. |
89 | |
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. |
93 | |
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. |
98 | |
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<[.^.^.^.]>. |
103 | |
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. |
109 | |
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] |
113 | |
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. |
748a9306 |
118 | |
119 | =head2 unixify |
120 | |
b1a8dcd7 |
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 |
123 | through unchanged. |
124 | |
125 | When Perl is running on an OpenVMS system, the following C<DECC$> feature |
126 | settings will control how the filename is converted: |
127 | |
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> |
133 | |
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. |
136 | |
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. |
140 | |
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. |
144 | |
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. |
148 | |
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 |
152 | modification. |
748a9306 |
153 | |
154 | =head2 pathify |
155 | |
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 '/'). |
e518068a |
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 |
163 | may also be omitted. |
748a9306 |
164 | |
165 | =head2 fileify |
166 | |
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 |
e518068a |
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. |
748a9306 |
174 | |
175 | =head2 vmspath |
176 | |
177 | Acts like C<pathify>, but insures the returned path uses VMS syntax. |
178 | |
179 | =head2 unixpath |
180 | |
181 | Acts like C<pathify>, but insures the returned path uses Unix syntax. |
182 | |
183 | =head2 candelete |
184 | |
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. |
192 | |
b1a8dcd7 |
193 | =head2 vms_case_tolerant |
194 | |
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. |
198 | |
199 | =head2 vms_realpath |
200 | |
201 | This exposes the VMS C library C<realpath> function where available. |
202 | It will always return a UNIX format specification. |
203 | |
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. |
207 | |
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 |
210 | on non-VMS systems. |
211 | |
212 | head2 vms_realname |
213 | |
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. |
216 | |
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 |
219 | on non-VMS systems. |
220 | |
221 | |
748a9306 |
222 | =head1 REVISION |
223 | |
b1a8dcd7 |
224 | This document was last revised 15-Nov-2007, for Perl 5.10.0 |
748a9306 |
225 | |
226 | =cut |
227 | |
228 | package VMS::Filespec; |
a5f75d66 |
229 | require 5.002; |
230 | |
b1a8dcd7 |
231 | our $VERSION = '1.12'; |
748a9306 |
232 | |
e518068a |
233 | # If you want to use this package on a non-VMS system, |
234 | # uncomment the following line. |
235 | # use AutoLoader; |
748a9306 |
236 | require Exporter; |
237 | |
238 | @ISA = qw( Exporter ); |
60618c03 |
239 | @EXPORT = qw( &vmsify &unixify &pathify &fileify |
b1a8dcd7 |
240 | &vmspath &unixpath &candelete &rmsexpand &vms_case_tolerant ); |
748a9306 |
241 | |
242 | 1; |
243 | |
244 | |
245 | __END__ |
246 | |
247 | |
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. |
254 | |
255 | # A sort-of sys$parse() replacement |
60618c03 |
256 | sub rmsexpand ($;$) { |
748a9306 |
257 | my($fspec,$defaults) = @_; |
258 | if (!$fspec) { return undef } |
259 | my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver); |
260 | |
261 | $fspec =~ s/:$//; |
262 | $defaults = [] unless $defaults; |
263 | $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY'; |
264 | |
265 | while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} } |
266 | |
267 | if ($fspec =~ /:/) { |
268 | my($dev,$devtrn,$base); |
269 | ($dev,$base) = split(/:/,$fspec); |
270 | $devtrn = $dev; |
271 | while ($devtrn = $ENV{$devtrn}) { |
272 | if ($devtrn =~ /(.)([:>\]])$/) { |
273 | $dev .= ':', last if $1 eq '.'; |
274 | $dev = $devtrn, last; |
275 | } |
276 | } |
277 | $fspec = $dev . $base; |
278 | } |
279 | |
280 | ($node,$dev,$dir,$name,$type,$ver) = $fspec =~ |
281 | /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/; |
282 | foreach ((@$defaults,$ENV{'DEFAULT'})) { |
ee1280c9 |
283 | next unless defined; |
748a9306 |
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; |
293 | } |
294 | # do this the long way to keep -w happy |
295 | $fspec = ''; |
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; |
302 | $fspec; |
303 | } |
304 | |
a5f75d66 |
305 | sub vmsify ($) { |
748a9306 |
306 | my($fspec) = @_; |
307 | my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs); |
308 | |
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 '..') { |
315 | push @dirs,$base; |
316 | $base = ''; |
317 | } |
318 | foreach (@dirs) { |
319 | next unless $_; # protect against // in input |
320 | next if $_ eq '.'; |
321 | if ($_ eq '..') { |
322 | if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs } |
323 | else { push @realdirs, '-' } |
324 | } |
325 | else { push @realdirs, $_; } |
326 | } |
327 | if ($hasdev) { |
328 | $dev = shift @realdirs; |
329 | @realdirs = ('000000') unless @realdirs; |
330 | $base = '' unless $base; # keep -w happy |
331 | $dev . ':[' . join('.',@realdirs) . "]$base"; |
332 | } |
333 | else { |
334 | '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base"; |
335 | } |
336 | } |
337 | |
a5f75d66 |
338 | sub unixify ($) { |
748a9306 |
339 | my($fspec) = @_; |
340 | |
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, '..'; } |
350 | } |
351 | join('/',@dirs) . "/$base"; |
352 | } |
353 | else { |
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, '..'; } |
361 | } |
362 | "/$dev/" . join('/',@dirs) . "/$base"; |
363 | } |
364 | } |
365 | |
366 | |
a5f75d66 |
367 | sub fileify ($) { |
748a9306 |
368 | my($path) = @_; |
369 | |
370 | if (!$path) { return undef } |
491527d0 |
371 | if ($path eq '/') { return 'sys$disk:[000000]'; } |
748a9306 |
372 | if ($path =~ /(.+)\.([^:>\]]*)$/) { |
373 | $path = $1; |
374 | if ($2 !~ /^dir(?:;1)?$/i) { return undef } |
375 | } |
376 | |
377 | if ($path !~ m#[/>\]]#) { |
378 | $path =~ s/:$//; |
379 | while ($ENV{$path}) { |
380 | ($path = $ENV{$path}) =~ s/:$//; |
381 | last if $path =~ m#[/>\]]#; |
382 | } |
383 | } |
384 | if ($path =~ m#[>\]]#) { |
385 | my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/; |
386 | $sep =~ tr/<[/>]/; |
387 | if ($base) { |
388 | "$dir$sep$base.dir;1"; |
389 | } |
390 | else { |
391 | if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; } |
392 | $dir =~ s#\.(\w+)$#$sep$1#; |
393 | $dir =~ s/^.$sep//; |
394 | "$dir.dir;1"; |
395 | } |
396 | } |
397 | else { |
398 | $path =~ s#/$##; |
399 | "$path.dir;1"; |
400 | } |
401 | } |
402 | |
a5f75d66 |
403 | sub pathify ($) { |
748a9306 |
404 | my($fspec) = @_; |
405 | |
406 | if (!$fspec) { return undef } |
407 | if ($fspec =~ m#[/>\]]$#) { return $fspec; } |
408 | if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') { |
409 | $fspec = $1; |
410 | if ($2 !~ /^dir(?:;1)?$/i) { return undef } |
411 | } |
412 | |
413 | if ($fspec !~ m#[/>\]]#) { |
414 | $fspec =~ s/:$//; |
415 | while ($ENV{$fspec}) { |
416 | if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} } |
417 | else { $fspec = $ENV{$fspec} =~ s/:$// } |
418 | } |
419 | } |
420 | |
421 | if ($fspec !~ m#[>\]]#) { "$fspec/"; } |
422 | else { |
423 | if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; } |
424 | else { $fspec; } |
425 | } |
426 | } |
427 | |
a5f75d66 |
428 | sub vmspath ($) { |
748a9306 |
429 | pathify(vmsify($_[0])); |
430 | } |
431 | |
a5f75d66 |
432 | sub unixpath ($) { |
748a9306 |
433 | pathify(unixify($_[0])); |
434 | } |
435 | |
a5f75d66 |
436 | sub candelete ($) { |
748a9306 |
437 | my($fspec) = @_; |
438 | my($parent); |
439 | |
440 | return '' unless -w $fspec; |
441 | $fspec =~ s#/$##; |
442 | if ($fspec =~ m#/#) { |
a1fc2545 |
443 | ($parent = $fspec) =~ s#/[^/]+$##; |
748a9306 |
444 | return (-w $parent); |
445 | } |
446 | elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms |
447 | $parent =~ s/[>\]][^>\]]+//; |
448 | return (-w fileify($parent)); |
449 | } |
450 | else { return (-w '[-]'); } |
451 | } |
b1a8dcd7 |
452 | |
453 | sub vms_case_tolerant ($) { |
454 | return 0; |
455 | } |