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:  08-Mar-1995
   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
  24 =head1 DESCRIPTION
  25
  26 This package provides routines to simplify conversion between VMS and
  27 Unix syntax when processing file specifications.  This is useful when
  28 porting scripts designed to run under either OS, and also allows you
  29 to take advantage of conveniences provided by either syntax (I<e.g.>
  30 ability to easily concatenate Unix-style specifications).  In
  31 addition, it provides an additional file test routine, C<candelete>,
  32 which determines whether you have delete access to a file.
  33
  34 If you're running under VMS, the routines in this package are special,
  35 in that they're automatically made available to any Perl script,
  36 whether you're running F<miniperl> or the full F<perl>.  The C<use
  37 VMS::Filespec> or C<require VMS::Filespec; import VMS::Filespec ...>
  38 statement can be used to import the function names into the current
  39 package, but they're always available if you use the fully qualified
  40 name, whether or not you've mentioned the F<.pm> file in your script.
  41 If you're running under another OS and have installed this package, it
  42 behaves like a normal Perl extension (in fact, you're using Perl
  43 substitutes to emulate the necessary VMS system calls).
  44
  45 Each of these routines accepts a file specification in either VMS or
  46 Unix syntax, and returns the converted file specification, or C<undef>
  47 if an error occurs.  The conversions are, for the most part, simply
  48 string manipulations; the routines do not check the details of syntax
  49 (e.g. that only legal characters are used).  There is one exception:
  50 when running under VMS, conversions from VMS syntax use the $PARSE
  51 service to expand specifications, so illegal syntax, or a relative
  52 directory specification which extends above the tope of the current
  53 directory path (e.g [---.foo] when in dev:[dir.sub]) will cause
  54 errors.  In general, any legal file specification will be converted
  55 properly, but garbage input tends to produce garbage output.
  56
  57 Each of these routines is prototyped as taking a single scalar
  58 argument, so you can use them as unary operators in complex
  59 expressions (as long as you don't use the C<&> form of
  60 subroutine call, which bypasses prototype checking).
  61
  62
  63 The routines provided are:
  64
  65 =head2 rmsexpand
  66
  67 Uses the RMS $PARSE and $SEARCH services to expand the input
  68 specification to its fully qualified form, except that a null type
  69 or version is not added unless it was present in either the original
  70 file specification or the default specification passed to C<rmsexpand>.
  71 (If the file does not exist, the input specification is expanded as much
  72 as possible.)  If an error occurs, returns C<undef> and sets C<$!>
  73 and C<$^E>.
  74
  75 =head2 vmsify
  76
  77 Converts a file specification to VMS syntax.
  78
  79 =head2 unixify
  80
  81 Converts a file specification to Unix syntax.
  82
  83 =head2 pathify
  84
  85 Converts a directory specification to a path - that is, a string you
  86 can prepend to a file name to form a valid file specification.  If the
  87 input file specification uses VMS syntax, the returned path does, too;
  88 likewise for Unix syntax (Unix paths are guaranteed to end with '/').
  89 Note that this routine will insist that the input be a legal directory
  90 file specification; the file type and version, if specified, must be
  91 F<.DIR;1>.  For compatibility with Unix usage, the type and version
  92 may also be omitted.
  93
  94 =head2 fileify
  95
  96 Converts a directory specification to the file specification of the
  97 directory file - that is, a string you can pass to functions like
  98 C<stat> or C<rmdir> to manipulate the directory file.  If the
  99 input directory specification uses VMS syntax, the returned file
 100 specification does, too; likewise for Unix syntax.  As with
 101 C<pathify>, the input file specification must have a type and
 102 version of F<.DIR;1>, or the type and version must be omitted.
 103
 104 =head2 vmspath
 105
 106 Acts like C<pathify>, but insures the returned path uses VMS syntax.
 107
 108 =head2 unixpath
 109
 110 Acts like C<pathify>, but insures the returned path uses Unix syntax.
 111
 112 =head2 candelete
 113
 114 Determines whether you have delete access to a file.  If you do, C<candelete>
 115 returns true.  If you don't, or its argument isn't a legal file specification,
 116 C<candelete> returns FALSE.  Unlike other file tests, the argument to
 117 C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB,
 118 it's a list operator, so you need to be careful about parentheses.  Both of
 119 these restrictions may be removed in the future if the functionality of
 120 C<candelete> becomes part of the Perl core.
 121
 122 =head1 REVISION
 123
 124 This document was last revised 22-Feb-1996, for Perl 5.002.
 125
 126 =cut
 127
 128 package VMS::Filespec;
 129 require 5.002;
 130
 131 our $VERSION = '1.11';
 132
 133 # If you want to use this package on a non-VMS system,
 134 # uncomment the following line.
 135 # use AutoLoader;
 136 require Exporter;
 137
 138 @ISA = qw( Exporter );
 139 @EXPORT = qw( &vmsify &unixify &pathify &fileify
 140               &vmspath &unixpath &candelete &rmsexpand );
 141
 142 1;
 143
 144
 145 __END__
 146
 147
 148 # The autosplit routines here are provided for use by non-VMS systems
 149 # They are not guaranteed to function identically to the XSUBs of the
 150 # same name, since they do not have access to the RMS system routine
 151 # sys$parse() (in particular, no real provision is made for handling
 152 # of complex DECnet node specifications).  However, these routines
 153 # should be adequate for most purposes.
 154
 155 # A sort-of sys$parse() replacement
 156 sub rmsexpand ($;$) {
 157   my($fspec,$defaults) = @_;
 158   if (!$fspec) { return undef }
 159   my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);
 160
 161   $fspec =~ s/:$//;
 162   $defaults = [] unless $defaults;
 163   $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY';
 164
 165   while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} }
 166
 167   if ($fspec =~ /:/) {
 168     my($dev,$devtrn,$base);
 169     ($dev,$base) = split(/:/,$fspec);
 170     $devtrn = $dev;
 171     while ($devtrn = $ENV{$devtrn}) {
 172       if ($devtrn =~ /(.)([:>\]])$/) {
 173         $dev .= ':', last if $1 eq '.';
 174         $dev = $devtrn, last;
 175       }
 176     }
 177     $fspec = $dev . $base;
 178   }
 179
 180   ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
 181      /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
 182   foreach ((@$defaults,$ENV{'DEFAULT'})) {
 183     next unless defined;
 184     last if $node && $ver && $type && $dev && $dir && $name;
 185     ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
 186        /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
 187     $node = $dnode if $dnode && !$node;
 188     $dev = $ddev if $ddev && !$dev;
 189     $dir = $ddir if $ddir && !$dir;
 190     $name = $dname if $dname && !$name;
 191     $type = $dtype if $dtype && !$type;
 192     $ver = $dver if $dver && !$ver;
 193   }
 194   # do this the long way to keep -w happy
 195   $fspec = '';
 196   $fspec .= $node if $node;
 197   $fspec .= $dev if $dev;
 198   $fspec .= $dir if $dir;
 199   $fspec .= $name if $name;
 200   $fspec .= $type if $type;
 201   $fspec .= $ver if $ver;
 202   $fspec;
 203 }
 204
 205 sub vmsify ($) {
 206   my($fspec) = @_;
 207   my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
 208
 209   if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; }
 210   return $fspec if $fspec !~ m#/#;
 211   ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#;
 212   @dirs = split(m#/#,$dir);
 213   if ($base eq '.') { $base = ''; }
 214   elsif ($base eq '..') {
 215     push @dirs,$base;
 216     $base = '';
 217   }
 218   foreach (@dirs) {
 219     next unless $_;  # protect against // in input
 220     next if $_ eq '.';
 221     if ($_ eq '..') {
 222       if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs }
 223       else                                           { push @realdirs, '-' }
 224     }
 225     else { push @realdirs, $_; }
 226   }
 227   if ($hasdev) {
 228     $dev = shift @realdirs;
 229     @realdirs = ('000000') unless @realdirs;
 230     $base = '' unless $base;  # keep -w happy
 231     $dev . ':[' . join('.',@realdirs) . "]$base";
 232   }
 233   else {
 234     '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base";
 235   }
 236 }
 237
 238 sub unixify ($) {
 239   my($fspec) = @_;
 240
 241   return $fspec if $fspec !~ m#[:>\]]#;
 242   return '.' if ($fspec eq '[]' || $fspec eq '<>');
 243   if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) {
 244     $fspec = ($1 eq '.' ? '' : "$1.") . $2;
 245     my($dir,$base) = split(/[\]>]/,$fspec);
 246     my(@dirs) = grep($_,split(m#\.#,$dir));
 247     if ($dirs[0] =~ /^-/) {
 248       my($steps) = shift @dirs;
 249       for (1..length($steps)) { unshift @dirs, '..'; }
 250     }
 251     join('/',@dirs) . "/$base";
 252   }
 253   else {
 254     $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]');
 255     $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//;
 256     my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#;
 257     my(@dirs) = split(m#\.#,$dir);
 258     if ($dirs[0] && $dirs[0] =~ /^-/) {
 259       my($steps) = shift @dirs;
 260       for (1..length($steps)) { unshift @dirs, '..'; }
 261     }
 262     "/$dev/" . join('/',@dirs) . "/$base";
 263   }
 264 }
 265
 266
 267 sub fileify ($) {
 268   my($path) = @_;
 269
 270   if (!$path) { return undef }
 271   if ($path eq '/') { return 'sys$disk:[000000]'; }
 272   if ($path =~ /(.+)\.([^:>\]]*)$/) {
 273     $path = $1;
 274     if ($2 !~ /^dir(?:;1)?$/i) { return undef }
 275   }
 276
 277   if ($path !~ m#[/>\]]#) {
 278     $path =~ s/:$//;
 279     while ($ENV{$path}) {
 280       ($path = $ENV{$path}) =~ s/:$//;
 281       last if $path =~ m#[/>\]]#;
 282     }
 283   }
 284   if ($path =~ m#[>\]]#) {
 285     my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/;
 286     $sep =~ tr/<[/>]/;
 287     if ($base) {
 288       "$dir$sep$base.dir;1";
 289     }
 290     else {
 291       if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; }
 292       $dir =~ s#\.(\w+)$#$sep$1#;
 293       $dir =~ s/^.$sep//;
 294       "$dir.dir;1";
 295     }
 296   }
 297   else {
 298     $path =~ s#/$##;
 299     "$path.dir;1";
 300   }
 301 }
 302
 303 sub pathify ($) {
 304   my($fspec) = @_;
 305
 306   if (!$fspec) { return undef }
 307   if ($fspec =~ m#[/>\]]$#) { return $fspec; }
 308   if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') {
 309     $fspec = $1;
 310     if ($2 !~ /^dir(?:;1)?$/i) { return undef }
 311   }
 312
 313   if ($fspec !~ m#[/>\]]#) {
 314     $fspec =~ s/:$//;
 315     while ($ENV{$fspec}) {
 316       if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} }
 317       else { $fspec = $ENV{$fspec} =~ s/:$// }
 318     }
 319   }
 320
 321   if ($fspec !~ m#[>\]]#) { "$fspec/"; }
 322   else {
 323     if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; }
 324     else { $fspec; }
 325   }
 326 }
 327
 328 sub vmspath ($) {
 329   pathify(vmsify($_[0]));
 330 }
 331
 332 sub unixpath ($) {
 333   pathify(unixify($_[0]));
 334 }
 335
 336 sub candelete ($) {
 337   my($fspec) = @_;
 338   my($parent);
 339
 340   return '' unless -w $fspec;
 341   $fspec =~ s#/$##;
 342   if ($fspec =~ m#/#) {
 343     ($parent = $fspec) =~ s#/[^/]+$##;
 344     return (-w $parent);
 345   }
 346   elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms
 347     $parent =~ s/[>\]][^>\]]+//;
 348     return (-w fileify($parent));
 349   }
 350   else { return (-w '[-]'); }
 351 }