1#   Perl hooks into the routines in vms.c for interconversion
2#   of VMS and Unix file specification syntax.
3#
4#   Version:  see $VERSION below
5#   Author:   Charles Bailey  bailey@newman.upenn.edu
6#   Revised:  8-DEC-2007
7
8=head1 NAME
9
10VMS::Filespec - convert between VMS and Unix file specification syntax
11
12=head1 SYNOPSIS
13
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');
23  $case_tolerant = case_tolerant_process;
24  $unixspec = unixrealpath('file_specification');
25  $vmsspec = vmsrealpath('file_specification');
26
27=head1 DESCRIPTION
28
29This package provides routines to simplify conversion between VMS and
30Unix syntax when processing file specifications.  This is useful when
31porting scripts designed to run under either OS, and also allows you
32to take advantage of conveniences provided by either syntax (I<e.g.>
33ability to easily concatenate Unix-style specifications).  In
34addition, it provides an additional file test routine, C<candelete>,
35which determines whether you have delete access to a file.
36
37If you're running under VMS, the routines in this package are special,
38in that they're automatically made available to any Perl script,
39whether you're running F<miniperl> or the full F<perl>.  The C<use
40VMS::Filespec> or C<require VMS::Filespec; import VMS::Filespec ...>
41statement can be used to import the function names into the current
42package, but they're always available if you use the fully qualified
43name, whether or not you've mentioned the F<.pm> file in your script.
44If you're running under another OS and have installed this package, it
45behaves like a normal Perl extension (in fact, you're using Perl
46substitutes to emulate the necessary VMS system calls).
47
48Each of these routines accepts a file specification in either VMS or
49Unix syntax, and returns the converted file specification, or C<undef>
50if an error occurs.  The conversions are, for the most part, simply
51string manipulations; the routines do not check the details of syntax
52(e.g. that only legal characters are used).  There is one exception:
53when running under VMS, conversions from VMS syntax use the $PARSE
54service to expand specifications, so illegal syntax, or a relative
55directory specification which extends above the tope of the current
56directory path (e.g [---.foo] when in dev:[dir.sub]) will cause
57errors.  In general, any legal file specification will be converted
58properly, but garbage input tends to produce garbage output.
59
60Each of these routines is prototyped as taking a single scalar
61argument, so you can use them as unary operators in complex
62expressions (as long as you don't use the C<&> form of
63subroutine call, which bypasses prototype checking).
64
65
66The routines provided are:
67
68=head2 rmsexpand
69
70Uses the RMS $PARSE and $SEARCH services to expand the input
71specification to its fully qualified form, except that a null type
72or version is not added unless it was present in either the original
73file specification or the default specification passed to C<rmsexpand>.
74(If the file does not exist, the input specification is expanded as much
75as possible.)  If an error occurs, returns C<undef> and sets C<$!>
76and C<$^E>.
77
78C<rmsexpand> on success will produce a name that fits in a 255 byte buffer,
79which is required for parameters passed to the DCL interpreter.
80
81=head2 vmsify
82
83Converts a file specification to VMS syntax.  If the file specification
84cannot be converted to or is already in VMS syntax, it will be
85passed through unchanged.
86
87The file specifications of C<.> and C<..> will be converted to
88C<[]> and C<[-]>.
89
90If the file specification is already in a valid VMS syntax, it will
91be passed through unchanged, except that the UTF-8 flag will be cleared
92since VMS format file specifications are never in UTF-8.
93
94When Perl is running on an OpenVMS system, if the C<DECC$EFS_CHARSET>
95feature is not enabled, extra dots in the file specification will
96be converted to underscore characters, and the C<?> character will
97be converted to a C<%> character, if a conversion is done.
98
99When Perl is running on an OpenVMS system, if the C<DECC$EFS_CHARSET>
100feature is enabled, this implies that the Unix pathname cannot have
101a version, and that a path consisting of three dots, C<./.../>, will be
102converted to C<[.^.^.^.]>.
103
104Unix style shell macros like C<$(abcd)> are passed through instead
105of being converted to C<$^(abcd^)> independent of the C<DECC$EFS_CHARSET>
106feature setting.  Unix style shell macros should not use characters
107that are not in the ASCII character set, as the resulting specification
108may or may not be still in UTF8 format.
109
110The feature logical name C<PERL_VMS_VTF7_FILENAMES> controls if UNICODE
111characters in Unix filenames are encoded in VTF-7 notation in the resulting
112OpenVMS file specification.  [Currently under development]
113
114C<unixify> on the resulting file specification may not result in the
115original Unix file specification, so programs should not plan to convert
116a file specification from Unix to VMS and then back to Unix again after
117modification of the components.
118
119=head2 unixify
120
121Converts a file specification to Unix syntax.  If the file specification
122cannot be converted to or is already in Unix syntax, it will be passed
123through unchanged.
124
125When Perl is running on an OpenVMS system, the following C<DECC$> feature
126settings 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
134When Perl is being run under a Unix shell on OpenVMS, the defaults at
135a future time may be more appropriate for it.
136
137When Perl is running on an OpenVMS system with C<DECC$EFS_CHARSET>
138enabled, a wild card directory name of C<[...]> cannot be translated to
139a valid Unix file specification.  Also, directory file specifications
140will have their implied ".dir;1" removed, and a trailing C<.> character
141indicating a null extension will be removed.
142
143Note that C<DECC$EFS_CHARSET> requires C<DECC$FILENAME_UNIX_NO_VERSION> because
144the conversion routine cannot differentiate whether the last C<.> of a Unix
145specification is delimiting a version, or is just part of a file specification.
146
147C<vmsify> on the resulting file specification may not result in the
148original VMS file specification, so programs should not plan to convert
149a file specification from VMS to Unix and then back to VMS again after
150modification.
151
152=head2 pathify
153
154Converts a directory specification to a path - that is, a string you
155can prepend to a file name to form a valid file specification.  If the
156input file specification uses VMS syntax, the returned path does, too;
157likewise for Unix syntax (Unix paths are guaranteed to end with '/').
158Note that this routine will insist that the input be a legal directory
159file specification; the file type and version, if specified, must be
160F<.DIR;1>.  For compatibility with Unix usage, the type and version
161may also be omitted.
162
163=head2 fileify
164
165Converts a directory specification to the file specification of the
166directory file - that is, a string you can pass to functions like
167C<stat> or C<rmdir> to manipulate the directory file.  If the
168input directory specification uses VMS syntax, the returned file
169specification does, too; likewise for Unix syntax.  As with
170C<pathify>, the input file specification must have a type and
171version of F<.DIR;1>, or the type and version must be omitted.
172
173=head2 vmspath
174
175Acts like C<pathify>, but insures the returned path uses VMS syntax.
176
177=head2 unixpath
178
179Acts like C<pathify>, but insures the returned path uses Unix syntax.
180
181=head2 candelete
182
183Determines whether you have delete access to a file.  If you do, C<candelete>
184returns true.  If you don't, or its argument isn't a legal file specification,
185C<candelete> returns FALSE.  Unlike other file tests, the argument to
186C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB,
187it's a list operator, so you need to be careful about parentheses.  Both of
188these restrictions may be removed in the future if the functionality of
189C<candelete> becomes part of the Perl core.
190
191=head2 case_tolerant_process
192
193This reports whether the VMS process has been set to a case tolerant
194state, and returns true when the process is in the traditional case
195tolerant mode and false when case sensitivity has been enabled for the
196process.   It is intended for use by the File::Spec::VMS->case_tolerant
197method only, and it is recommended that you only use
198File::Spec->case_tolerant.
199
200=head2 unixrealpath
201
202This exposes the VMS C library C<realpath> function where available.
203It will always return a Unix format specification.
204
205If the C<realpath> function is not available, or is unable to return the
206real path of the file, C<unixrealpath> will use the same internal
207procedure as the C<vmsrealpath> function and convert the output to a
208Unix format specification.  It is not available on non-VMS systems.
209
210=head2 vmsrealpath
211
212This uses the C<LIB$FID_TO_NAME> run-time library call to find the name
213of the primary link to a file, and returns the filename in VMS format.
214This function is not available on non-VMS systems.
215
216
217=head1 REVISION
218
219This document was last revised 8-DEC-2007, for Perl 5.10.0
220
221=cut
222
223package VMS::Filespec;
224require 5.006;
225
226our $VERSION = '1.13';
227
228# If you want to use this package on a non-VMS system,
229# uncomment the following line.
230# use AutoLoader;
231use Exporter 'import';
232
233our @EXPORT = qw( &vmsify &unixify &pathify &fileify
234              &vmspath &unixpath &candelete &rmsexpand );
235our @EXPORT_OK = qw( &unixrealpath &vmsrealpath &case_tolerant_process );
2361;
237
238
239__END__
240
241
242# The autosplit routines here are provided for use by non-VMS systems
243# They are not guaranteed to function identically to the XSUBs of the
244# same name, since they do not have access to the RMS system routine
245# sys$parse() (in particular, no real provision is made for handling
246# of complex DECnet node specifications).  However, these routines
247# should be adequate for most purposes.
248
249# A sort-of sys$parse() replacement
250sub rmsexpand ($;$) {
251  my($fspec,$defaults) = @_;
252  if (!$fspec) { return undef }
253  my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);
254
255  $fspec =~ s/:$//;
256  $defaults = [] unless $defaults;
257  $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY';
258
259  while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} }
260
261  if ($fspec =~ /:/) {
262    my($dev,$devtrn,$base);
263    ($dev,$base) = split(/:/,$fspec);
264    $devtrn = $dev;
265    while ($devtrn = $ENV{$devtrn}) {
266      if ($devtrn =~ /(.)([:>\]])$/) {
267        $dev .= ':', last if $1 eq '.';
268        $dev = $devtrn, last;
269      }
270    }
271    $fspec = $dev . $base;
272  }
273
274  ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
275     /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
276  foreach ((@$defaults,$ENV{'DEFAULT'})) {
277    next unless defined;
278    last if $node && $ver && $type && $dev && $dir && $name;
279    ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
280       /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
281    $node = $dnode if $dnode && !$node;
282    $dev = $ddev if $ddev && !$dev;
283    $dir = $ddir if $ddir && !$dir;
284    $name = $dname if $dname && !$name;
285    $type = $dtype if $dtype && !$type;
286    $ver = $dver if $dver && !$ver;
287  }
288  # do this the long way to keep -w happy
289  $fspec = '';
290  $fspec .= $node if $node;
291  $fspec .= $dev if $dev;
292  $fspec .= $dir if $dir;
293  $fspec .= $name if $name;
294  $fspec .= $type if $type;
295  $fspec .= $ver if $ver;
296  $fspec;
297}
298
299sub vmsify ($) {
300  my($fspec) = @_;
301  my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
302
303  if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; }
304  return $fspec if $fspec !~ m#/#;
305  ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#;
306  @dirs = split(m#/#,$dir);
307  if ($base eq '.') { $base = ''; }
308  elsif ($base eq '..') {
309    push @dirs,$base;
310    $base = '';
311  }
312  foreach (@dirs) {
313    next unless $_;  # protect against // in input
314    next if $_ eq '.';
315    if ($_ eq '..') {
316      if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs }
317      else                                           { push @realdirs, '-' }
318    }
319    else { push @realdirs, $_; }
320  }
321  if ($hasdev) {
322    $dev = shift @realdirs;
323    @realdirs = ('000000') unless @realdirs;
324    $base = '' unless $base;  # keep -w happy
325    $dev . ':[' . join('.',@realdirs) . "]$base";
326  }
327  else {
328    '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base";
329  }
330}
331
332sub unixify ($) {
333  my($fspec) = @_;
334
335  return $fspec if $fspec !~ m#[:>\]]#;
336  return '.' if ($fspec eq '[]' || $fspec eq '<>');
337  if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) {
338    $fspec = ($1 eq '.' ? '' : "$1.") . $2;
339    my($dir,$base) = split(/[\]>]/,$fspec);
340    my(@dirs) = grep($_,split(m#\.#,$dir));
341    if ($dirs[0] =~ /^-/) {
342      my($steps) = shift @dirs;
343      for (1..length($steps)) { unshift @dirs, '..'; }
344    }
345    join('/',@dirs) . "/$base";
346  }
347  else {
348    $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]');
349    $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//;
350    my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#;
351    my(@dirs) = split(m#\.#,$dir);
352    if ($dirs[0] && $dirs[0] =~ /^-/) {
353      my($steps) = shift @dirs;
354      for (1..length($steps)) { unshift @dirs, '..'; }
355    }
356    "/$dev/" . join('/',@dirs) . "/$base";
357  }
358}
359
360
361sub fileify ($) {
362  my($path) = @_;
363
364  if (!$path) { return undef }
365  if ($path eq '/') { return 'sys$disk:[000000]'; }
366  if ($path =~ /(.+)\.([^:>\]]*)$/) {
367    $path = $1;
368    if ($2 !~ /^dir(?:;1)?$/i) { return undef }
369  }
370
371  if ($path !~ m#[/>\]]#) {
372    $path =~ s/:$//;
373    while ($ENV{$path}) {
374      ($path = $ENV{$path}) =~ s/:$//;
375      last if $path =~ m#[/>\]]#;
376    }
377  }
378  if ($path =~ m#[>\]]#) {
379    my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/;
380    $sep =~ tr/<[/>]/;
381    if ($base) {
382      "$dir$sep$base.dir;1";
383    }
384    else {
385      if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; }
386      $dir =~ s#\.(\w+)$#$sep$1#;
387      $dir =~ s/^.$sep//;
388      "$dir.dir;1";
389    }
390  }
391  else {
392    $path =~ s#/$##;
393    "$path.dir;1";
394  }
395}
396
397sub pathify ($) {
398  my($fspec) = @_;
399
400  if (!$fspec) { return undef }
401  if ($fspec =~ m#[/>\]]$#) { return $fspec; }
402  if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') {
403    $fspec = $1;
404    if ($2 !~ /^dir(?:;1)?$/i) { return undef }
405  }
406
407  if ($fspec !~ m#[/>\]]#) {
408    $fspec =~ s/:$//;
409    while ($ENV{$fspec}) {
410      if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} }
411      else { $fspec = $ENV{$fspec} =~ s/:$// }
412    }
413  }
414
415  if ($fspec !~ m#[>\]]#) { "$fspec/"; }
416  else {
417    if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; }
418    else { $fspec; }
419  }
420}
421
422sub vmspath ($) {
423  pathify(vmsify($_[0]));
424}
425
426sub unixpath ($) {
427  pathify(unixify($_[0]));
428}
429
430sub candelete ($) {
431  my($fspec) = @_;
432  my($parent);
433
434  return '' unless -w $fspec;
435  $fspec =~ s#/$##;
436  if ($fspec =~ m#/#) {
437    ($parent = $fspec) =~ s#/[^/]+$##;
438    return (-w $parent);
439  }
440  elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms
441    $parent =~ s/[>\]][^>\]]+//;
442    return (-w fileify($parent));
443  }
444  else { return (-w '[-]'); }
445}
446
447sub case_tolerant_process () {
448    return 0;
449}
450