home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / lib / zip / File / Spec / Unix.pm < prev    next >
Encoding:
Perl POD Document  |  1998-07-30  |  3.4 KB  |  198 lines
  1. package File::Spec::Unix;
  2.  
  3. use Exporter ();
  4. use Config;
  5. use File::Basename qw(basename dirname fileparse);
  6. use DirHandle;
  7. use strict;
  8. use vars qw(@ISA $Is_Mac $Is_OS2 $Is_VMS $Is_Win32);
  9. use File::Spec;
  10.  
  11. Exporter::import('File::Spec', '$Verbose');
  12.  
  13. $Is_OS2 = $^O eq 'os2';
  14. $Is_Mac = $^O eq 'MacOS';
  15. $Is_Win32 = $^O eq 'MSWin32';
  16.  
  17. if ($Is_VMS = $^O eq 'VMS') {
  18.     require VMS::Filespec;
  19.     import VMS::Filespec qw( &vmsify );
  20. }
  21.  
  22. =head1 NAME
  23.  
  24. File::Spec::Unix - methods used by File::Spec
  25.  
  26. =head1 SYNOPSIS
  27.  
  28. C<require File::Spec::Unix;>
  29.  
  30. =head1 DESCRIPTION
  31.  
  32. Methods for manipulating file specifications.
  33.  
  34. =head1 METHODS
  35.  
  36. =over 2
  37.  
  38. =item canonpath
  39.  
  40. No physical check on the filesystem, but a logical cleanup of a
  41. path. On UNIX eliminated successive slashes and successive "/.".
  42.  
  43. =cut
  44.  
  45. sub canonpath {
  46.     my($self,$path) = @_;
  47.     $path =~ s|/+|/|g ;                            # xx////xx  -> xx/xx
  48.     $path =~ s|(/\.)+/|/|g ;                       # xx/././xx -> xx/xx
  49.     $path =~ s|^(\./)+|| unless $path eq "./";     # ./xx      -> xx
  50.     $path =~ s|/$|| unless $path eq "/";           # xx/       -> xx
  51.     $path;
  52. }
  53.  
  54. =item catdir
  55.  
  56. Concatenate two or more directory names to form a complete path ending
  57. with a directory. But remove the trailing slash from the resulting
  58. string, because it doesn't look good, isn't necessary and confuses
  59. OS2. Of course, if this is the root directory, don't cut off the
  60. trailing slash :-)
  61.  
  62. =cut
  63.  
  64. # ';
  65.  
  66. sub catdir {
  67.     shift;
  68.     my @args = @_;
  69.     for (@args) {
  70.     # append a slash to each argument unless it has one there
  71.     $_ .= "/" if $_ eq '' or substr($_,-1) ne "/";
  72.     }
  73.     my $result = join('', @args);
  74.     # remove a trailing slash unless we are root
  75.     substr($result,-1) = ""
  76.     if length($result) > 1 && substr($result,-1) eq "/";
  77.     $result;
  78. }
  79.  
  80. =item catfile
  81.  
  82. Concatenate one or more directory names and a filename to form a
  83. complete path ending with a filename
  84.  
  85. =cut
  86.  
  87. sub catfile {
  88.     my $self = shift @_;
  89.     my $file = pop @_;
  90.     return $file unless @_;
  91.     my $dir = $self->catdir(@_);
  92.     for ($dir) {
  93.     $_ .= "/" unless substr($_,length($_)-1,1) eq "/";
  94.     }
  95.     return $dir.$file;
  96. }
  97.  
  98. =item curdir
  99.  
  100. Returns a string representing of the current directory.  "." on UNIX.
  101.  
  102. =cut
  103.  
  104. sub curdir {
  105.     return "." ;
  106. }
  107.  
  108. =item rootdir
  109.  
  110. Returns a string representing of the root directory.  "/" on UNIX.
  111.  
  112. =cut
  113.  
  114. sub rootdir {
  115.     return "/";
  116. }
  117.  
  118. =item updir
  119.  
  120. Returns a string representing of the parent directory.  ".." on UNIX.
  121.  
  122. =cut
  123.  
  124. sub updir {
  125.     return "..";
  126. }
  127.  
  128. =item no_upwards
  129.  
  130. Given a list of file names, strip out those that refer to a parent
  131. directory. (Does not strip symlinks, only '.', '..', and equivalents.)
  132.  
  133. =cut
  134.  
  135. sub no_upwards {
  136.     my($self) = shift;
  137.     return grep(!/^\.{1,2}$/, @_);
  138. }
  139.  
  140. =item file_name_is_absolute
  141.  
  142. Takes as argument a path and returns true, if it is an absolute path.
  143.  
  144. =cut
  145.  
  146. sub file_name_is_absolute {
  147.     my($self,$file) = @_;
  148.     $file =~ m:^/: ;
  149. }
  150.  
  151. =item path
  152.  
  153. Takes no argument, returns the environment variable PATH as an array.
  154.  
  155. =cut
  156.  
  157. sub path {
  158.     my($self) = @_;
  159.     my $path_sep = ":";
  160.     my $path = $ENV{PATH};
  161.     my @path = split $path_sep, $path;
  162.     foreach(@path) { $_ = '.' if $_ eq '' }
  163.     @path;
  164. }
  165.  
  166. =item join
  167.  
  168. join is the same as catfile.
  169.  
  170. =cut
  171.  
  172. sub join {
  173.     my($self) = shift @_;
  174.     $self->catfile(@_);
  175. }
  176.  
  177. =item nativename
  178.  
  179. TBW.
  180.  
  181. =cut
  182.  
  183. sub nativename {
  184.     my($self,$name) = shift @_;
  185.     $name;
  186. }
  187.  
  188. =back
  189.  
  190. =head1 SEE ALSO
  191.  
  192. L<File::Spec>
  193.  
  194. =cut
  195.  
  196. 1;
  197. __END__
  198.