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 (I<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, or C<undef>
  46 if 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 Each of these routines is prototyped as taking a single scalar
  57 argument, so you can use them as unary operators in complex
  58 expressions (as long as you don't use the C<&> form of
  59 subroutine call, which bypasses prototype checking).
  60
  61
  62 The routines provided are:
  63
  64 =head2 vmsify
  65
  66 Converts a file specification to VMS syntax.
  67
  68 =head2 unixify
  69
  70 Converts a file specification to Unix syntax.
  71
  72 =head2 pathify
  73
  74 Converts a directory specification to a path - that is, a string you
  75 can prepend to a file name to form a valid file specification.  If the
  76 input file specification uses VMS syntax, the returned path does, too;
  77 likewise for Unix syntax (Unix paths are guaranteed to end with '/').
  78 Note that this routine will insist that the input be a legal directory
  79 file specification; the file type and version, if specified, must be
  80 F<.DIR;1>.  For compatibility with Unix usage, the type and version
  81 may also be omitted.
  82
  83 =head2 fileify
  84
  85 Converts a directory specification to the file specification of the
  86 directory file - that is, a string you can pass to functions like
  87 C<stat> or C<rmdir> to manipulate the directory file.  If the
  88 input directory specification uses VMS syntax, the returned file
  89 specification does, too; likewise for Unix syntax.  As with
  90 C<pathify>, the input file specification must have a type and
  91 version of F<.DIR;1>, or the type and version must be omitted.
  92
  93 =head2 vmspath
  94
  95 Acts like C<pathify>, but insures the returned path uses VMS syntax.
  96
  97 =head2 unixpath
  98
  99 Acts like C<pathify>, but insures the returned path uses Unix syntax.
 100
 101 =head2 candelete
 102
 103 Determines whether you have delete access to a file.  If you do, C<candelete>
 104 returns true.  If you don't, or its argument isn't a legal file specification,
 105 C<candelete> returns FALSE.  Unlike other file tests, the argument to
 106 C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB,
 107 it's a list operator, so you need to be careful about parentheses.  Both of
 108 these restrictions may be removed in the future if the functionality of
 109 C<candelete> becomes part of the Perl core.
 110
 111 =head1 REVISION
 112
 113 This document was last revised 22-Feb-1996, for Perl 5.002.
 114
 115 =cut
 116
 117 package VMS::Filespec;
 118 require 5.002;
 119
 120
 121 # If you want to use this package on a non-VMS system,
 122 # uncomment the following line.
 123 # use AutoLoader;
 124 require Exporter;
 125
 126 @ISA = qw( Exporter );
 127 @EXPORT = qw( &vmsify &unixify &pathify  &fileify
 128               &vmspath &unixpath &candelete);
 129
 130 @EXPORT_OK = qw( &rmsexpand );
 131 1;
 132
 133
 134 __END__
 135
 136
 137 # The autosplit routines here are provided for use by non-VMS systems
 138 # They are not guaranteed to function identically to the XSUBs of the
 139 # same name, since they do not have access to the RMS system routine
 140 # sys$parse() (in particular, no real provision is made for handling
 141 # of complex DECnet node specifications).  However, these routines
 142 # should be adequate for most purposes.
 143
 144 # A sort-of sys$parse() replacement
 145 sub rmsexpand {
 146   my($fspec,$defaults) = @_;
 147   if (!$fspec) { return undef }
 148   my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);
 149
 150   $fspec =~ s/:$//;
 151   $defaults = [] unless $defaults;
 152   $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY';
 153
 154   while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} }
 155
 156   if ($fspec =~ /:/) {
 157     my($dev,$devtrn,$base);
 158     ($dev,$base) = split(/:/,$fspec);
 159     $devtrn = $dev;
 160     while ($devtrn = $ENV{$devtrn}) {
 161       if ($devtrn =~ /(.)([:>\]])$/) {
 162         $dev .= ':', last if $1 eq '.';
 163         $dev = $devtrn, last;
 164       }
 165     }
 166     $fspec = $dev . $base;
 167   }
 168
 169   ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
 170      /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
 171   foreach ((@$defaults,$ENV{'DEFAULT'})) {
 172     last if $node && $ver && $type && $dev && $dir && $name;
 173     ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
 174        /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
 175     $node = $dnode if $dnode && !$node;
 176     $dev = $ddev if $ddev && !$dev;
 177     $dir = $ddir if $ddir && !$dir;
 178     $name = $dname if $dname && !$name;
 179     $type = $dtype if $dtype && !$type;
 180     $ver = $dver if $dver && !$ver;
 181   }
 182   # do this the long way to keep -w happy
 183   $fspec = '';
 184   $fspec .= $node if $node;
 185   $fspec .= $dev if $dev;
 186   $fspec .= $dir if $dir;
 187   $fspec .= $name if $name;
 188   $fspec .= $type if $type;
 189   $fspec .= $ver if $ver;
 190   $fspec;
 191 }
 192
 193 sub vmsify ($) {
 194   my($fspec) = @_;
 195   my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
 196
 197   if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; }
 198   return $fspec if $fspec !~ m#/#;
 199   ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#;
 200   @dirs = split(m#/#,$dir);
 201   if ($base eq '.') { $base = ''; }
 202   elsif ($base eq '..') {
 203     push @dirs,$base;
 204     $base = '';
 205   }
 206   foreach (@dirs) {
 207     next unless $_;  # protect against // in input
 208     next if $_ eq '.';
 209     if ($_ eq '..') {
 210       if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs }
 211       else                                           { push @realdirs, '-' }
 212     }
 213     else { push @realdirs, $_; }
 214   }
 215   if ($hasdev) {
 216     $dev = shift @realdirs;
 217     @realdirs = ('000000') unless @realdirs;
 218     $base = '' unless $base;  # keep -w happy
 219     $dev . ':[' . join('.',@realdirs) . "]$base";
 220   }
 221   else {
 222     '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base";
 223   }
 224 }
 225
 226 sub unixify ($) {
 227   my($fspec) = @_;
 228
 229   return $fspec if $fspec !~ m#[:>\]]#;
 230   return '.' if ($fspec eq '[]' || $fspec eq '<>');
 231   if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) {
 232     $fspec = ($1 eq '.' ? '' : "$1.") . $2;
 233     my($dir,$base) = split(/[\]>]/,$fspec);
 234     my(@dirs) = grep($_,split(m#\.#,$dir));
 235     if ($dirs[0] =~ /^-/) {
 236       my($steps) = shift @dirs;
 237       for (1..length($steps)) { unshift @dirs, '..'; }
 238     }
 239     join('/',@dirs) . "/$base";
 240   }
 241   else {
 242     $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]');
 243     $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//;
 244     my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#;
 245     my(@dirs) = split(m#\.#,$dir);
 246     if ($dirs[0] && $dirs[0] =~ /^-/) {
 247       my($steps) = shift @dirs;
 248       for (1..length($steps)) { unshift @dirs, '..'; }
 249     }
 250     "/$dev/" . join('/',@dirs) . "/$base";
 251   }
 252 }
 253
 254
 255 sub fileify ($) {
 256   my($path) = @_;
 257
 258   if (!$path) { return undef }
 259   if ($path =~ /(.+)\.([^:>\]]*)$/) {
 260     $path = $1;
 261     if ($2 !~ /^dir(?:;1)?$/i) { return undef }
 262   }
 263
 264   if ($path !~ m#[/>\]]#) {
 265     $path =~ s/:$//;
 266     while ($ENV{$path}) {
 267       ($path = $ENV{$path}) =~ s/:$//;
 268       last if $path =~ m#[/>\]]#;
 269     }
 270   }
 271   if ($path =~ m#[>\]]#) {
 272     my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/;
 273     $sep =~ tr/<[/>]/;
 274     if ($base) {
 275       "$dir$sep$base.dir;1";
 276     }
 277     else {
 278       if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; }
 279       $dir =~ s#\.(\w+)$#$sep$1#;
 280       $dir =~ s/^.$sep//;
 281       "$dir.dir;1";
 282     }
 283   }
 284   else {
 285     $path =~ s#/$##;
 286     "$path.dir;1";
 287   }
 288 }
 289
 290 sub pathify ($) {
 291   my($fspec) = @_;
 292
 293   if (!$fspec) { return undef }
 294   if ($fspec =~ m#[/>\]]$#) { return $fspec; }
 295   if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') {
 296     $fspec = $1;
 297     if ($2 !~ /^dir(?:;1)?$/i) { return undef }
 298   }
 299
 300   if ($fspec !~ m#[/>\]]#) {
 301     $fspec =~ s/:$//;
 302     while ($ENV{$fspec}) {
 303       if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} }
 304       else { $fspec = $ENV{$fspec} =~ s/:$// }
 305     }
 306   }
 307
 308   if ($fspec !~ m#[>\]]#) { "$fspec/"; }
 309   else {
 310     if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; }
 311     else { $fspec; }
 312   }
 313 }
 314
 315 sub vmspath ($) {
 316   pathify(vmsify($_[0]));
 317 }
 318
 319 sub unixpath ($) {
 320   pathify(unixify($_[0]));
 321 }
 322
 323 sub candelete ($) {
 324   my($fspec) = @_;
 325   my($parent);
 326
 327   return '' unless -w $fspec;
 328   $fspec =~ s#/$##;
 329   if ($fspec =~ m#/#) {
 330     ($parent = $fspec) =~ s#/[^/]+$#;
 331     return (-w $parent);
 332   }
 333   elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms
 334     $parent =~ s/[>\]][^>\]]+//;
 335     return (-w fileify($parent));
 336   }
 337   else { return (-w '[-]'); }
 338 }