vms/ext/Filespec.pm

   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:  30-Oct-2007
   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;
  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 = vms_case_tolerant;
  24 $unixspec = vms_realpath('file_specification');
  25 $vmsspec = vms_realname('file_specification');
  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
  32 to take advantage of conveniences provided by either syntax (I<e.g.>
  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
  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
  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
  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
  66 The routines provided are:
  67
  68 =head2 rmsexpand
  69
  70 Uses the RMS $PARSE and $SEARCH services to expand the input
  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<$!>
  76 and C<$^E>.
  77
  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
  81 =head2 vmsify
  82
  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.
 118
 119 =head2 unixify
 120
 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.
 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 '/').
 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.
 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
 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.
 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
 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
 222 =head1 REVISION
 223
 224 This document was last revised 15-Nov-2007, for Perl 5.10.0
 225
 226 =cut
 227
 228 package VMS::Filespec;
 229 require 5.002;
 230
 231 our $VERSION = '1.12';
 232
 233 # If you want to use this package on a non-VMS system,
 234 # uncomment the following line.
 235 # use AutoLoader;
 236 require Exporter;
 237
 238 @ISA = qw( Exporter );
 239 @EXPORT = qw( &vmsify &unixify &pathify &fileify
 240               &vmspath &unixpath &candelete &rmsexpand &vms_case_tolerant );
 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
 256 sub rmsexpand ($;$) {
 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'})) {
 283     next unless defined;
 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
 305 sub vmsify ($) {
 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
 338 sub unixify ($) {
 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
 367 sub fileify ($) {
 368   my($path) = @_;
 369
 370   if (!$path) { return undef }
 371   if ($path eq '/') { return 'sys$disk:[000000]'; }
 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
 403 sub pathify ($) {
 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
 428 sub vmspath ($) {
 429   pathify(vmsify($_[0]));
 430 }
 431
 432 sub unixpath ($) {
 433   pathify(unixify($_[0]));
 434 }
 435
 436 sub candelete ($) {
 437   my($fspec) = @_;
 438   my($parent);
 439
 440   return '' unless -w $fspec;
 441   $fspec =~ s#/$##;
 442   if ($fspec =~ m#/#) {
 443     ($parent = $fspec) =~ s#/[^/]+$##;
 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 }
 452
 453 sub vms_case_tolerant ($) {
 454     return 0;
 455 }