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:  8-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 = case_tolerant_process;
  24   $unixspec = unixrealpath('file_specification');
  25   $vmsspec = vmsrealpath('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 cannot 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>
 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.
 142
 143 Note that C<DECC$EFS_CHARSET> requires C<DECC$FILENAME_UNIX_NO_VERSION> because
 144 the conversion routine cannot differentiate whether the last C<.> of a Unix
 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
 149 a file specification from VMS to Unix and then back to VMS again after
 150 modification.
 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 '/').
 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.
 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
 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.
 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
 191 =head2 case_tolerant_process
 192
 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.
 199
 200 =head2 unixrealpath
 201
 202 This exposes the VMS C library C<realpath> function where available.
 203 It will always return a Unix format specification.
 204
 205 If the C<realpath> function is not available, or is unable to return the
 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.
 209
 210 =head2 vmsrealpath
 211
 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.
 215
 216
 217 =head1 REVISION
 218
 219 This document was last revised 8-DEC-2007, for Perl 5.10.0
 220
 221 =cut
 222
 223 package VMS::Filespec;
 224 require 5.002;
 225
 226 our $VERSION = '1.12';
 227
 228 # If you want to use this package on a non-VMS system,
 229 # uncomment the following line.
 230 # use AutoLoader;
 231 require Exporter;
 232
 233 @ISA = qw( Exporter );
 234 @EXPORT = qw( &vmsify &unixify &pathify &fileify
 235               &vmspath &unixpath &candelete &rmsexpand );
 236 @EXPORT_OK = qw( &unixrealpath &vmsrealpath &case_tolerant_process );
 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
 251 sub rmsexpand ($;$) {
 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'})) {
 278     next unless defined;
 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
 300 sub vmsify ($) {
 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
 333 sub unixify ($) {
 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
 362 sub fileify ($) {
 363   my($path) = @_;
 364
 365   if (!$path) { return undef }
 366   if ($path eq '/') { return 'sys$disk:[000000]'; }
 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
 398 sub pathify ($) {
 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
 423 sub vmspath ($) {
 424   pathify(vmsify($_[0]));
 425 }
 426
 427 sub unixpath ($) {
 428   pathify(unixify($_[0]));
 429 }
 430
 431 sub candelete ($) {
 432   my($fspec) = @_;
 433   my($parent);
 434
 435   return '' unless -w $fspec;
 436   $fspec =~ s#/$##;
 437   if ($fspec =~ m#/#) {
 438     ($parent = $fspec) =~ s#/[^/]+$##;
 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 }
 447
 448 sub case_tolerant_process () {
 449     return 0;
 450 }