home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / lib / zip / File / Spec / VMS.pm < prev    next >
Encoding:
Perl POD Document  |  1998-07-30  |  3.1 KB  |  149 lines
  1.  
  2. package File::Spec::VMS;
  3.  
  4. use Carp qw( &carp );
  5. use Config;
  6. require Exporter;
  7. use VMS::Filespec;
  8. use File::Basename;
  9.  
  10. use File::Spec;
  11. use vars qw($Revision);
  12. $Revision = '5.3901 (6-Mar-1997)';
  13.  
  14. @ISA = qw(File::Spec::Unix);
  15.  
  16. Exporter::import('File::Spec', '$Verbose');
  17.  
  18. =head1 NAME
  19.  
  20. File::Spec::VMS - methods for VMS file specs
  21.  
  22. =head1 SYNOPSIS
  23.  
  24.  use File::Spec::VMS; # Done internally by File::Spec if needed
  25.  
  26. =head1 DESCRIPTION
  27.  
  28. See File::Spec::Unix for a documentation of the methods provided
  29. there. This package overrides the implementation of these methods, not
  30. the semantics.
  31.  
  32. =head2 Methods always loaded
  33.  
  34. =over
  35.  
  36. =item catdir
  37.  
  38. Concatenates a list of file specifications, and returns the result as a
  39. VMS-syntax directory specification.
  40.  
  41. =cut
  42.  
  43. sub catdir {
  44.     my($self,@dirs) = @_;
  45.     my($dir) = pop @dirs;
  46.     @dirs = grep($_,@dirs);
  47.     my($rslt);
  48.     if (@dirs) {
  49.       my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
  50.       my($spath,$sdir) = ($path,$dir);
  51.       $spath =~ s/.dir$//; $sdir =~ s/.dir$//; 
  52.       $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
  53.       $rslt = $self->fixpath($self->eliminate_macros($spath)."/$sdir",1);
  54.     }
  55.     else { 
  56.       if ($dir =~ /^\$\([^\)]+\)$/) { $rslt = $dir; }
  57.       else                          { $rslt = vmspath($dir); }
  58.     }
  59.     print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
  60.     $rslt;
  61. }
  62.  
  63. =item catfile
  64.  
  65. Concatenates a list of file specifications, and returns the result as a
  66. VMS-syntax directory specification.
  67.  
  68. =cut
  69.  
  70. sub catfile {
  71.     my($self,@files) = @_;
  72.     my($file) = pop @files;
  73.     @files = grep($_,@files);
  74.     my($rslt);
  75.     if (@files) {
  76.       my($path) = (@files == 1 ? $files[0] : $self->catdir(@files));
  77.       my($spath) = $path;
  78.       $spath =~ s/.dir$//;
  79.       if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; }
  80.       else {
  81.           $rslt = $self->eliminate_macros($spath);
  82.           $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
  83.       }
  84.     }
  85.     else { $rslt = vmsify($file); }
  86.     print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
  87.     $rslt;
  88. }
  89.  
  90. =item curdir (override)
  91.  
  92. Returns a string representing of the current directory.
  93.  
  94. =cut
  95.  
  96. sub curdir {
  97.     return '[]';
  98. }
  99.  
  100. =item rootdir (override)
  101.  
  102. Returns a string representing of the root directory.
  103.  
  104. =cut
  105.  
  106. sub rootdir {
  107.     return '';
  108. }
  109.  
  110. =item updir (override)
  111.  
  112. Returns a string representing of the parent directory.
  113.  
  114. =cut
  115.  
  116. sub updir {
  117.     return '[-]';
  118. }
  119.  
  120. =item path (override)
  121.  
  122. Translate logical name DCL$PATH as a searchlist, rather than trying
  123. to C<split> string value of C<$ENV{'PATH'}>.
  124.  
  125. =cut
  126.  
  127. sub path {
  128.     my(@dirs,$dir,$i);
  129.     while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
  130.     @dirs;
  131. }
  132.  
  133. =item file_name_is_absolute (override)
  134.  
  135. Checks for VMS directory spec as well as Unix separators.
  136.  
  137. =cut
  138.  
  139. sub file_name_is_absolute {
  140.     my($self,$file) = @_;
  141.     # If it's a logical name, expand it.
  142.     $file = $ENV{$file} while $file =~ /^[\w\$\-]+$/ and $ENV{$file};
  143.     $file =~ m!^/! or $file =~ m![<\[][^.\-\]>]! or $file =~ /:[^<\[]/;
  144. }
  145.  
  146. 1;
  147. __END__
  148.  
  149.