home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / vms / ext / Filespec.pm next >
Text File  |  1999-07-20  |  11KB  |  350 lines
  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@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.  
  132. # If you want to use this package on a non-VMS system,
  133. # uncomment the following line.
  134. # use AutoLoader;
  135. require Exporter;
  136.  
  137. @ISA = qw( Exporter );
  138. @EXPORT = qw( &vmsify &unixify &pathify &fileify
  139.               &vmspath &unixpath &candelete &rmsexpand );
  140.  
  141. 1;
  142.  
  143.  
  144. __END__
  145.  
  146.  
  147. # The autosplit routines here are provided for use by non-VMS systems
  148. # They are not guaranteed to function identically to the XSUBs of the
  149. # same name, since they do not have access to the RMS system routine
  150. # sys$parse() (in particular, no real provision is made for handling
  151. # of complex DECnet node specifications).  However, these routines
  152. # should be adequate for most purposes.
  153.  
  154. # A sort-of sys$parse() replacement
  155. sub rmsexpand ($;$) {
  156.   my($fspec,$defaults) = @_;
  157.   if (!$fspec) { return undef }
  158.   my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);
  159.  
  160.   $fspec =~ s/:$//;
  161.   $defaults = [] unless $defaults;
  162.   $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY';
  163.  
  164.   while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} }
  165.  
  166.   if ($fspec =~ /:/) {
  167.     my($dev,$devtrn,$base);
  168.     ($dev,$base) = split(/:/,$fspec);
  169.     $devtrn = $dev;
  170.     while ($devtrn = $ENV{$devtrn}) {
  171.       if ($devtrn =~ /(.)([:>\]])$/) {
  172.         $dev .= ':', last if $1 eq '.';
  173.         $dev = $devtrn, last;
  174.       }
  175.     }
  176.     $fspec = $dev . $base;
  177.   }
  178.  
  179.   ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
  180.      /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
  181.   foreach ((@$defaults,$ENV{'DEFAULT'})) {
  182.     last if $node && $ver && $type && $dev && $dir && $name;
  183.     ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
  184.        /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
  185.     $node = $dnode if $dnode && !$node;
  186.     $dev = $ddev if $ddev && !$dev;
  187.     $dir = $ddir if $ddir && !$dir;
  188.     $name = $dname if $dname && !$name;
  189.     $type = $dtype if $dtype && !$type;
  190.     $ver = $dver if $dver && !$ver;
  191.   }
  192.   # do this the long way to keep -w happy
  193.   $fspec = '';
  194.   $fspec .= $node if $node;
  195.   $fspec .= $dev if $dev;
  196.   $fspec .= $dir if $dir;
  197.   $fspec .= $name if $name;
  198.   $fspec .= $type if $type;
  199.   $fspec .= $ver if $ver;
  200.   $fspec;
  201. }  
  202.  
  203. sub vmsify ($) {
  204.   my($fspec) = @_;
  205.   my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
  206.  
  207.   if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; }
  208.   return $fspec if $fspec !~ m#/#;
  209.   ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#;
  210.   @dirs = split(m#/#,$dir);
  211.   if ($base eq '.') { $base = ''; }
  212.   elsif ($base eq '..') {
  213.     push @dirs,$base;
  214.     $base = '';
  215.   }
  216.   foreach (@dirs) {
  217.     next unless $_;  # protect against // in input
  218.     next if $_ eq '.';
  219.     if ($_ eq '..') {
  220.       if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs }
  221.       else                                           { push @realdirs, '-' }
  222.     }
  223.     else { push @realdirs, $_; }
  224.   }
  225.   if ($hasdev) {
  226.     $dev = shift @realdirs;
  227.     @realdirs = ('000000') unless @realdirs;
  228.     $base = '' unless $base;  # keep -w happy
  229.     $dev . ':[' . join('.',@realdirs) . "]$base";
  230.   }
  231.   else {
  232.     '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base";
  233.   }
  234. }
  235.  
  236. sub unixify ($) {
  237.   my($fspec) = @_;
  238.  
  239.   return $fspec if $fspec !~ m#[:>\]]#;
  240.   return '.' if ($fspec eq '[]' || $fspec eq '<>');
  241.   if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) {
  242.     $fspec = ($1 eq '.' ? '' : "$1.") . $2;
  243.     my($dir,$base) = split(/[\]>]/,$fspec);
  244.     my(@dirs) = grep($_,split(m#\.#,$dir));
  245.     if ($dirs[0] =~ /^-/) {
  246.       my($steps) = shift @dirs;
  247.       for (1..length($steps)) { unshift @dirs, '..'; }
  248.     }
  249.     join('/',@dirs) . "/$base";
  250.   }
  251.   else {
  252.     $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]');
  253.     $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//;
  254.     my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#;
  255.     my(@dirs) = split(m#\.#,$dir);
  256.     if ($dirs[0] && $dirs[0] =~ /^-/) {
  257.       my($steps) = shift @dirs;
  258.       for (1..length($steps)) { unshift @dirs, '..'; }
  259.     }
  260.     "/$dev/" . join('/',@dirs) . "/$base";
  261.   }
  262. }
  263.  
  264.  
  265. sub fileify ($) {
  266.   my($path) = @_;
  267.  
  268.   if (!$path) { return undef }
  269.   if ($path eq '/') { return 'sys$disk:[000000]'; }
  270.   if ($path =~ /(.+)\.([^:>\]]*)$/) {
  271.     $path = $1;
  272.     if ($2 !~ /^dir(?:;1)?$/i) { return undef }
  273.   }
  274.  
  275.   if ($path !~ m#[/>\]]#) {
  276.     $path =~ s/:$//;
  277.     while ($ENV{$path}) {
  278.       ($path = $ENV{$path}) =~ s/:$//;
  279.       last if $path =~ m#[/>\]]#;
  280.     }
  281.   }
  282.   if ($path =~ m#[>\]]#) {
  283.     my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/;
  284.     $sep =~ tr/<[/>]/;
  285.     if ($base) {
  286.       "$dir$sep$base.dir;1";
  287.     }
  288.     else {
  289.       if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; }
  290.       $dir =~ s#\.(\w+)$#$sep$1#;
  291.       $dir =~ s/^.$sep//;
  292.       "$dir.dir;1";
  293.     }
  294.   }
  295.   else {
  296.     $path =~ s#/$##;
  297.     "$path.dir;1";
  298.   }
  299. }
  300.  
  301. sub pathify ($) {
  302.   my($fspec) = @_;
  303.  
  304.   if (!$fspec) { return undef }
  305.   if ($fspec =~ m#[/>\]]$#) { return $fspec; }
  306.   if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') {
  307.     $fspec = $1;
  308.     if ($2 !~ /^dir(?:;1)?$/i) { return undef }
  309.   }
  310.  
  311.   if ($fspec !~ m#[/>\]]#) {
  312.     $fspec =~ s/:$//;
  313.     while ($ENV{$fspec}) {
  314.       if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} }
  315.       else { $fspec = $ENV{$fspec} =~ s/:$// }
  316.     }
  317.   }
  318.   
  319.   if ($fspec !~ m#[>\]]#) { "$fspec/"; }
  320.   else {
  321.     if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; }
  322.     else { $fspec; }
  323.   }
  324. }
  325.  
  326. sub vmspath ($) {
  327.   pathify(vmsify($_[0]));
  328. }
  329.  
  330. sub unixpath ($) {
  331.   pathify(unixify($_[0]));
  332. }
  333.  
  334. sub candelete ($) {
  335.   my($fspec) = @_;
  336.   my($parent);
  337.  
  338.   return '' unless -w $fspec;
  339.   $fspec =~ s#/$##;
  340.   if ($fspec =~ m#/#) {
  341.     ($parent = $fspec) =~ s#/[^/]+$#;
  342.     return (-w $parent);
  343.   }
  344.   elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms
  345.     $parent =~ s/[>\]][^>\]]+//;
  346.     return (-w fileify($parent));
  347.   }
  348.   else { return (-w '[-]'); }
  349. }
  350.