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:  6-DEC-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.  It is
 207 not available on non-VMS systems.
 208
 209 =head2 vms_realname
 210
 211 This uses the C<LIB$FID_TO_NAME> run-time library call to find the name
 212 of the primary link to a file, and returns the filename in VMS format.
 213 This function is not available on non-VMS systems.
 214
 215
 216 =head1 REVISION
 217
 218 This document was last revised 6-DEC-2007, for Perl 5.10.0
 219
 220 =cut
 221
 222 package VMS::Filespec;
 223 require 5.002;
 224
 225 our $VERSION = '1.12';
 226
 227 # If you want to use this package on a non-VMS system,
 228 # uncomment the following line.
 229 # use AutoLoader;
 230 require Exporter;
 231
 232 @ISA = qw( Exporter );
 233 @EXPORT = qw( &vmsify &unixify &pathify &fileify
 234               &vmspath &unixpath &candelete &rmsexpand &vms_case_tolerant );
 235
 236 1;
 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
 250 sub 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
 299 sub 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
 332 sub 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
 361 sub 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
 397 sub 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
 422 sub vmspath ($) {
 423   pathify(vmsify($_[0]));
 424 }
 425
 426 sub unixpath ($) {
 427   pathify(unixify($_[0]));
 428 }
 429
 430 sub 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
 447 sub vms_case_tolerant ($) {
 448     return 0;
 449 }