Commit | Line | Data |
---|---|---|
748a9306 LW |
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 |
4d8d3a9c | 6 | # Revised: 8-DEC-2007 |
748a9306 LW |
7 | |
8 | =head1 NAME | |
9 | ||
10 | VMS::Filespec - convert between VMS and Unix file specification syntax | |
11 | ||
12 | =head1 SYNOPSIS | |
13 | ||
ac0e7b00 CB |
14 | use VMS::Filespec; |
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'); | |
4d8d3a9c CB |
23 | $case_tolerant = case_tolerant_process; |
24 | $unixspec = unixrealpath('file_specification'); | |
25 | $vmsspec = vmsrealpath('file_specification'); | |
748a9306 LW |
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 LW |
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 LW |
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 AD |
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 LW |
66 | The routines provided are: |
67 | ||
60618c03 | 68 | =head2 rmsexpand |
69 | ||
70 | Uses the RMS $PARSE and $SEARCH services to expand the input | |
17f28c40 CB |
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 JM |
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 LW |
81 | =head2 vmsify |
82 | ||
b1a8dcd7 JM |
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> | |
4d8d3a9c | 100 | feature is enabled, this implies that the Unix pathname cannot have |
b1a8dcd7 JM |
101 | a version, and that a path consisting of three dots, C<./.../>, will be |
102 | converted to C<[.^.^.^.]>. | |
103 | ||
4d8d3a9c | 104 | Unix style shell macros like C<$(abcd)> are passed through instead |
b1a8dcd7 | 105 | of being converted to C<$^(abcd^)> independent of the C<DECC$EFS_CHARSET> |
4d8d3a9c | 106 | feature setting. Unix style shell macros should not use characters |
b1a8dcd7 JM |
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 | |
4d8d3a9c | 111 | characters in Unix filenames are encoded in VTF-7 notation in the resulting |
b1a8dcd7 JM |
112 | OpenVMS file specification. [Currently under development] |
113 | ||
114 | C<unixify> on the resulting file specification may not result in the | |
4d8d3a9c CB |
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 | |
b1a8dcd7 | 117 | modification of the components. |
748a9306 LW |
118 | |
119 | =head2 unixify | |
120 | ||
b1a8dcd7 | 121 | Converts a file specification to Unix syntax. If the file specification |
4d8d3a9c | 122 | cannot be converted to or is already in Unix syntax, it will be passed |
b1a8dcd7 JM |
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 | ||
4d8d3a9c | 134 | When Perl is being run under a Unix shell on OpenVMS, the defaults at |
b1a8dcd7 JM |
135 | a future time may be more appropriate for it. |
136 | ||
4d8d3a9c CB |
137 | When Perl is running on an OpenVMS system with C<DECC$EFS_CHARSET> |
138 | enabled, a wild card directory name of C<[...]> cannot be translated to | |
139 | a valid Unix file specification. Also, directory file specifications | |
140 | will have their implied ".dir;1" removed, and a trailing C<.> character | |
141 | indicating a null extension will be removed. | |
b1a8dcd7 JM |
142 | |
143 | Note that C<DECC$EFS_CHARSET> requires C<DECC$FILENAME_UNIX_NO_VERSION> because | |
4d8d3a9c | 144 | the conversion routine cannot differentiate whether the last C<.> of a Unix |
b1a8dcd7 JM |
145 | specification is delimiting a version, or is just part of a file specification. |
146 | ||
147 | C<vmsify> on the resulting file specification may not result in the | |
148 | original VMS file specification, so programs should not plan to convert | |
4d8d3a9c | 149 | a file specification from VMS to Unix and then back to VMS again after |
b1a8dcd7 | 150 | modification. |
748a9306 LW |
151 | |
152 | =head2 pathify | |
153 | ||
154 | Converts a directory specification to a path - that is, a string you | |
155 | can prepend to a file name to form a valid file specification. If the | |
156 | input file specification uses VMS syntax, the returned path does, too; | |
157 | likewise for Unix syntax (Unix paths are guaranteed to end with '/'). | |
e518068a | 158 | Note that this routine will insist that the input be a legal directory |
159 | file specification; the file type and version, if specified, must be | |
160 | F<.DIR;1>. For compatibility with Unix usage, the type and version | |
161 | may also be omitted. | |
748a9306 LW |
162 | |
163 | =head2 fileify | |
164 | ||
165 | Converts a directory specification to the file specification of the | |
166 | directory file - that is, a string you can pass to functions like | |
167 | C<stat> or C<rmdir> to manipulate the directory file. If the | |
168 | input directory specification uses VMS syntax, the returned file | |
e518068a | 169 | specification does, too; likewise for Unix syntax. As with |
170 | C<pathify>, the input file specification must have a type and | |
171 | version of F<.DIR;1>, or the type and version must be omitted. | |
748a9306 LW |
172 | |
173 | =head2 vmspath | |
174 | ||
175 | Acts like C<pathify>, but insures the returned path uses VMS syntax. | |
176 | ||
177 | =head2 unixpath | |
178 | ||
179 | Acts like C<pathify>, but insures the returned path uses Unix syntax. | |
180 | ||
181 | =head2 candelete | |
182 | ||
183 | Determines whether you have delete access to a file. If you do, C<candelete> | |
184 | returns true. If you don't, or its argument isn't a legal file specification, | |
185 | C<candelete> returns FALSE. Unlike other file tests, the argument to | |
186 | C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB, | |
187 | it's a list operator, so you need to be careful about parentheses. Both of | |
188 | these restrictions may be removed in the future if the functionality of | |
189 | C<candelete> becomes part of the Perl core. | |
190 | ||
4d8d3a9c | 191 | =head2 case_tolerant_process |
b1a8dcd7 | 192 | |
4d8d3a9c CB |
193 | This reports whether the VMS process has been set to a case tolerant |
194 | state, and returns true when the process is in the traditional case | |
195 | tolerant mode and false when case sensitivity has been enabled for the | |
196 | process. It is intended for use by the File::Spec::VMS->case_tolerant | |
197 | method only, and it is recommended that you only use | |
198 | File::Spec->case_tolerant. | |
b1a8dcd7 | 199 | |
4d8d3a9c | 200 | =head2 unixrealpath |
b1a8dcd7 JM |
201 | |
202 | This exposes the VMS C library C<realpath> function where available. | |
4d8d3a9c | 203 | It will always return a Unix format specification. |
b1a8dcd7 JM |
204 | |
205 | If the C<realpath> function is not available, or is unable to return the | |
4d8d3a9c CB |
206 | real path of the file, C<unixrealpath> will use the same internal |
207 | procedure as the C<vmsrealpath> function and convert the output to a | |
208 | Unix format specification. It is not available on non-VMS systems. | |
b1a8dcd7 | 209 | |
4d8d3a9c | 210 | =head2 vmsrealpath |
b1a8dcd7 | 211 | |
ac0e7b00 CB |
212 | This uses the C<LIB$FID_TO_NAME> run-time library call to find the name |
213 | of the primary link to a file, and returns the filename in VMS format. | |
214 | This function is not available on non-VMS systems. | |
b1a8dcd7 JM |
215 | |
216 | ||
748a9306 LW |
217 | =head1 REVISION |
218 | ||
4d8d3a9c | 219 | This document was last revised 8-DEC-2007, for Perl 5.10.0 |
748a9306 LW |
220 | |
221 | =cut | |
222 | ||
223 | package VMS::Filespec; | |
a5f75d66 AD |
224 | require 5.002; |
225 | ||
b1a8dcd7 | 226 | our $VERSION = '1.12'; |
748a9306 | 227 | |
e518068a | 228 | # If you want to use this package on a non-VMS system, |
229 | # uncomment the following line. | |
230 | # use AutoLoader; | |
748a9306 LW |
231 | require Exporter; |
232 | ||
233 | @ISA = qw( Exporter ); | |
60618c03 | 234 | @EXPORT = qw( &vmsify &unixify &pathify &fileify |
4d8d3a9c CB |
235 | &vmspath &unixpath &candelete &rmsexpand ); |
236 | @EXPORT_OK = qw( &unixrealpath &vmsrealpath &case_tolerant_process ); | |
748a9306 LW |
237 | 1; |
238 | ||
239 | ||
240 | __END__ | |
241 | ||
242 | ||
243 | # The autosplit routines here are provided for use by non-VMS systems | |
244 | # They are not guaranteed to function identically to the XSUBs of the | |
245 | # same name, since they do not have access to the RMS system routine | |
246 | # sys$parse() (in particular, no real provision is made for handling | |
247 | # of complex DECnet node specifications). However, these routines | |
248 | # should be adequate for most purposes. | |
249 | ||
250 | # A sort-of sys$parse() replacement | |
60618c03 | 251 | sub rmsexpand ($;$) { |
748a9306 LW |
252 | my($fspec,$defaults) = @_; |
253 | if (!$fspec) { return undef } | |
254 | my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver); | |
255 | ||
256 | $fspec =~ s/:$//; | |
257 | $defaults = [] unless $defaults; | |
258 | $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY'; | |
259 | ||
260 | while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} } | |
261 | ||
262 | if ($fspec =~ /:/) { | |
263 | my($dev,$devtrn,$base); | |
264 | ($dev,$base) = split(/:/,$fspec); | |
265 | $devtrn = $dev; | |
266 | while ($devtrn = $ENV{$devtrn}) { | |
267 | if ($devtrn =~ /(.)([:>\]])$/) { | |
268 | $dev .= ':', last if $1 eq '.'; | |
269 | $dev = $devtrn, last; | |
270 | } | |
271 | } | |
272 | $fspec = $dev . $base; | |
273 | } | |
274 | ||
275 | ($node,$dev,$dir,$name,$type,$ver) = $fspec =~ | |
276 | /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/; | |
277 | foreach ((@$defaults,$ENV{'DEFAULT'})) { | |
ee1280c9 | 278 | next unless defined; |
748a9306 LW |
279 | last if $node && $ver && $type && $dev && $dir && $name; |
280 | ($dnode,$ddev,$ddir,$dname,$dtype,$dver) = | |
281 | /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/; | |
282 | $node = $dnode if $dnode && !$node; | |
283 | $dev = $ddev if $ddev && !$dev; | |
284 | $dir = $ddir if $ddir && !$dir; | |
285 | $name = $dname if $dname && !$name; | |
286 | $type = $dtype if $dtype && !$type; | |
287 | $ver = $dver if $dver && !$ver; | |
288 | } | |
289 | # do this the long way to keep -w happy | |
290 | $fspec = ''; | |
291 | $fspec .= $node if $node; | |
292 | $fspec .= $dev if $dev; | |
293 | $fspec .= $dir if $dir; | |
294 | $fspec .= $name if $name; | |
295 | $fspec .= $type if $type; | |
296 | $fspec .= $ver if $ver; | |
297 | $fspec; | |
298 | } | |
299 | ||
a5f75d66 | 300 | sub vmsify ($) { |
748a9306 LW |
301 | my($fspec) = @_; |
302 | my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs); | |
303 | ||
304 | if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; } | |
305 | return $fspec if $fspec !~ m#/#; | |
306 | ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#; | |
307 | @dirs = split(m#/#,$dir); | |
308 | if ($base eq '.') { $base = ''; } | |
309 | elsif ($base eq '..') { | |
310 | push @dirs,$base; | |
311 | $base = ''; | |
312 | } | |
313 | foreach (@dirs) { | |
314 | next unless $_; # protect against // in input | |
315 | next if $_ eq '.'; | |
316 | if ($_ eq '..') { | |
317 | if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs } | |
318 | else { push @realdirs, '-' } | |
319 | } | |
320 | else { push @realdirs, $_; } | |
321 | } | |
322 | if ($hasdev) { | |
323 | $dev = shift @realdirs; | |
324 | @realdirs = ('000000') unless @realdirs; | |
325 | $base = '' unless $base; # keep -w happy | |
326 | $dev . ':[' . join('.',@realdirs) . "]$base"; | |
327 | } | |
328 | else { | |
329 | '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base"; | |
330 | } | |
331 | } | |
332 | ||
a5f75d66 | 333 | sub unixify ($) { |
748a9306 LW |
334 | my($fspec) = @_; |
335 | ||
336 | return $fspec if $fspec !~ m#[:>\]]#; | |
337 | return '.' if ($fspec eq '[]' || $fspec eq '<>'); | |
338 | if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) { | |
339 | $fspec = ($1 eq '.' ? '' : "$1.") . $2; | |
340 | my($dir,$base) = split(/[\]>]/,$fspec); | |
341 | my(@dirs) = grep($_,split(m#\.#,$dir)); | |
342 | if ($dirs[0] =~ /^-/) { | |
343 | my($steps) = shift @dirs; | |
344 | for (1..length($steps)) { unshift @dirs, '..'; } | |
345 | } | |
346 | join('/',@dirs) . "/$base"; | |
347 | } | |
348 | else { | |
349 | $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]'); | |
350 | $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//; | |
351 | my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#; | |
352 | my(@dirs) = split(m#\.#,$dir); | |
353 | if ($dirs[0] && $dirs[0] =~ /^-/) { | |
354 | my($steps) = shift @dirs; | |
355 | for (1..length($steps)) { unshift @dirs, '..'; } | |
356 | } | |
357 | "/$dev/" . join('/',@dirs) . "/$base"; | |
358 | } | |
359 | } | |
360 | ||
361 | ||
a5f75d66 | 362 | sub fileify ($) { |
748a9306 LW |
363 | my($path) = @_; |
364 | ||
365 | if (!$path) { return undef } | |
491527d0 | 366 | if ($path eq '/') { return 'sys$disk:[000000]'; } |
748a9306 LW |
367 | if ($path =~ /(.+)\.([^:>\]]*)$/) { |
368 | $path = $1; | |
369 | if ($2 !~ /^dir(?:;1)?$/i) { return undef } | |
370 | } | |
371 | ||
372 | if ($path !~ m#[/>\]]#) { | |
373 | $path =~ s/:$//; | |
374 | while ($ENV{$path}) { | |
375 | ($path = $ENV{$path}) =~ s/:$//; | |
376 | last if $path =~ m#[/>\]]#; | |
377 | } | |
378 | } | |
379 | if ($path =~ m#[>\]]#) { | |
380 | my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/; | |
381 | $sep =~ tr/<[/>]/; | |
382 | if ($base) { | |
383 | "$dir$sep$base.dir;1"; | |
384 | } | |
385 | else { | |
386 | if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; } | |
387 | $dir =~ s#\.(\w+)$#$sep$1#; | |
388 | $dir =~ s/^.$sep//; | |
389 | "$dir.dir;1"; | |
390 | } | |
391 | } | |
392 | else { | |
393 | $path =~ s#/$##; | |
394 | "$path.dir;1"; | |
395 | } | |
396 | } | |
397 | ||
a5f75d66 | 398 | sub pathify ($) { |
748a9306 LW |
399 | my($fspec) = @_; |
400 | ||
401 | if (!$fspec) { return undef } | |
402 | if ($fspec =~ m#[/>\]]$#) { return $fspec; } | |
403 | if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') { | |
404 | $fspec = $1; | |
405 | if ($2 !~ /^dir(?:;1)?$/i) { return undef } | |
406 | } | |
407 | ||
408 | if ($fspec !~ m#[/>\]]#) { | |
409 | $fspec =~ s/:$//; | |
410 | while ($ENV{$fspec}) { | |
411 | if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} } | |
412 | else { $fspec = $ENV{$fspec} =~ s/:$// } | |
413 | } | |
414 | } | |
415 | ||
416 | if ($fspec !~ m#[>\]]#) { "$fspec/"; } | |
417 | else { | |
418 | if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; } | |
419 | else { $fspec; } | |
420 | } | |
421 | } | |
422 | ||
a5f75d66 | 423 | sub vmspath ($) { |
748a9306 LW |
424 | pathify(vmsify($_[0])); |
425 | } | |
426 | ||
a5f75d66 | 427 | sub unixpath ($) { |
748a9306 LW |
428 | pathify(unixify($_[0])); |
429 | } | |
430 | ||
a5f75d66 | 431 | sub candelete ($) { |
748a9306 LW |
432 | my($fspec) = @_; |
433 | my($parent); | |
434 | ||
435 | return '' unless -w $fspec; | |
436 | $fspec =~ s#/$##; | |
437 | if ($fspec =~ m#/#) { | |
a1fc2545 | 438 | ($parent = $fspec) =~ s#/[^/]+$##; |
748a9306 LW |
439 | return (-w $parent); |
440 | } | |
441 | elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms | |
442 | $parent =~ s/[>\]][^>\]]+//; | |
443 | return (-w fileify($parent)); | |
444 | } | |
445 | else { return (-w '[-]'); } | |
446 | } | |
b1a8dcd7 | 447 | |
4d8d3a9c | 448 | sub case_tolerant_process () { |
b1a8dcd7 JM |
449 | return 0; |
450 | } |