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