home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _28c69edd5645905709907344b5579f36 < prev    next >
Encoding:
Text File  |  2004-04-13  |  11.1 KB  |  459 lines

  1. package File::Spec::Unix;
  2.  
  3. use strict;
  4. use vars qw($VERSION);
  5.  
  6. $VERSION = '1.2';
  7.  
  8. use Cwd;
  9.  
  10. =head1 NAME
  11.  
  12. File::Spec::Unix - methods used by File::Spec
  13.  
  14. =head1 SYNOPSIS
  15.  
  16.  require File::Spec::Unix; # Done automatically by File::Spec
  17.  
  18. =head1 DESCRIPTION
  19.  
  20. Methods for manipulating file specifications.
  21.  
  22. =head1 METHODS
  23.  
  24. =over 2
  25.  
  26. =item canonpath
  27.  
  28. No physical check on the filesystem, but a logical cleanup of a
  29. path. On UNIX eliminated successive slashes and successive "/.".
  30.  
  31.     $cpath = File::Spec->canonpath( $path ) ;
  32.  
  33. =cut
  34.  
  35. sub canonpath {
  36.     my ($self,$path) = @_;
  37.     $path =~ s|/+|/|g unless($^O eq 'cygwin');     # xx////xx  -> xx/xx
  38.     $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
  39.     $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
  40.     $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
  41.     $path =~ s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
  42.     return $path;
  43. }
  44.  
  45. =item catdir
  46.  
  47. Concatenate two or more directory names to form a complete path ending
  48. with a directory. But remove the trailing slash from the resulting
  49. string, because it doesn't look good, isn't necessary and confuses
  50. OS2. Of course, if this is the root directory, don't cut off the
  51. trailing slash :-)
  52.  
  53. =cut
  54.  
  55. sub catdir {
  56.     my $self = shift;
  57.     my @args = @_;
  58.     foreach (@args) {
  59.     # append a slash to each argument unless it has one there
  60.     $_ .= "/" if $_ eq '' || substr($_,-1) ne "/";
  61.     }
  62.     return $self->canonpath(join('', @args));
  63. }
  64.  
  65. =item catfile
  66.  
  67. Concatenate one or more directory names and a filename to form a
  68. complete path ending with a filename
  69.  
  70. =cut
  71.  
  72. sub catfile {
  73.     my $self = shift;
  74.     my $file = pop @_;
  75.     return $file unless @_;
  76.     my $dir = $self->catdir(@_);
  77.     $dir .= "/" unless substr($dir,-1) eq "/";
  78.     return $dir.$file;
  79. }
  80.  
  81. =item curdir
  82.  
  83. Returns a string representation of the current directory.  "." on UNIX.
  84.  
  85. =cut
  86.  
  87. sub curdir {
  88.     return ".";
  89. }
  90.  
  91. =item devnull
  92.  
  93. Returns a string representation of the null device. "/dev/null" on UNIX.
  94.  
  95. =cut
  96.  
  97. sub devnull {
  98.     return "/dev/null";
  99. }
  100.  
  101. =item rootdir
  102.  
  103. Returns a string representation of the root directory.  "/" on UNIX.
  104.  
  105. =cut
  106.  
  107. sub rootdir {
  108.     return "/";
  109. }
  110.  
  111. =item tmpdir
  112.  
  113. Returns a string representation of the first writable directory
  114. from the following list or "" if none are writable:
  115.  
  116.     $ENV{TMPDIR}
  117.     /tmp
  118.  
  119. =cut
  120.  
  121. my $tmpdir;
  122. sub tmpdir {
  123.     return $tmpdir if defined $tmpdir;
  124.     foreach ($ENV{TMPDIR}, "/tmp") {
  125.     next unless defined && -d && -w _;
  126.     $tmpdir = $_;
  127.     last;
  128.     }
  129.     $tmpdir = '' unless defined $tmpdir;
  130.     return $tmpdir;
  131. }
  132.  
  133. =item updir
  134.  
  135. Returns a string representation of the parent directory.  ".." on UNIX.
  136.  
  137. =cut
  138.  
  139. sub updir {
  140.     return "..";
  141. }
  142.  
  143. =item no_upwards
  144.  
  145. Given a list of file names, strip out those that refer to a parent
  146. directory. (Does not strip symlinks, only '.', '..', and equivalents.)
  147.  
  148. =cut
  149.  
  150. sub no_upwards {
  151.     my $self = shift;
  152.     return grep(!/^\.{1,2}\Z(?!\n)/s, @_);
  153. }
  154.  
  155. =item case_tolerant
  156.  
  157. Returns a true or false value indicating, respectively, that alphabetic
  158. is not or is significant when comparing file specifications.
  159.  
  160. =cut
  161.  
  162. sub case_tolerant {
  163.     return 0;
  164. }
  165.  
  166. =item file_name_is_absolute
  167.  
  168. Takes as argument a path and returns true if it is an absolute path.
  169.  
  170. This does not consult the local filesystem on Unix, Win32, or OS/2.  It
  171. does sometimes on MacOS (see L<File::Spec::MacOS/file_name_is_absolute>).
  172. It does consult the working environment for VMS (see
  173. L<File::Spec::VMS/file_name_is_absolute>).
  174.  
  175. =cut
  176.  
  177. sub file_name_is_absolute {
  178.     my ($self,$file) = @_;
  179.     return scalar($file =~ m:^/:s);
  180. }
  181.  
  182. =item path
  183.  
  184. Takes no argument, returns the environment variable PATH as an array.
  185.  
  186. =cut
  187.  
  188. sub path {
  189.     my @path = split(':', $ENV{PATH});
  190.     foreach (@path) { $_ = '.' if $_ eq '' }
  191.     return @path;
  192. }
  193.  
  194. =item join
  195.  
  196. join is the same as catfile.
  197.  
  198. =cut
  199.  
  200. sub join {
  201.     my $self = shift;
  202.     return $self->catfile(@_);
  203. }
  204.  
  205. =item splitpath
  206.  
  207.     ($volume,$directories,$file) = File::Spec->splitpath( $path );
  208.     ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
  209.  
  210. Splits a path in to volume, directory, and filename portions. On systems
  211. with no concept of volume, returns undef for volume. 
  212.  
  213. For systems with no syntax differentiating filenames from directories, 
  214. assumes that the last file is a path unless $no_file is true or a 
  215. trailing separator or /. or /.. is present. On Unix this means that $no_file
  216. true makes this return ( '', $path, '' ).
  217.  
  218. The directory portion may or may not be returned with a trailing '/'.
  219.  
  220. The results can be passed to L</catpath()> to get back a path equivalent to
  221. (usually identical to) the original path.
  222.  
  223. =cut
  224.  
  225. sub splitpath {
  226.     my ($self,$path, $nofile) = @_;
  227.  
  228.     my ($volume,$directory,$file) = ('','','');
  229.  
  230.     if ( $nofile ) {
  231.         $directory = $path;
  232.     }
  233.     else {
  234.         $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
  235.         $directory = $1;
  236.         $file      = $2;
  237.     }
  238.  
  239.     return ($volume,$directory,$file);
  240. }
  241.  
  242.  
  243. =item splitdir
  244.  
  245. The opposite of L</catdir()>.
  246.  
  247.     @dirs = File::Spec->splitdir( $directories );
  248.  
  249. $directories must be only the directory portion of the path on systems 
  250. that have the concept of a volume or that have path syntax that differentiates
  251. files from directories.
  252.  
  253. Unlike just splitting the directories on the separator, empty
  254. directory names (C<''>) can be returned, because these are significant
  255. on some OSs (e.g. MacOS).
  256.  
  257. On Unix,
  258.  
  259.     File::Spec->splitdir( "/a/b//c/" );
  260.  
  261. Yields:
  262.  
  263.     ( '', 'a', 'b', '', 'c', '' )
  264.  
  265. =cut
  266.  
  267. sub splitdir {
  268.     my ($self,$directories) = @_ ;
  269.     #
  270.     # split() likes to forget about trailing null fields, so here we
  271.     # check to be sure that there will not be any before handling the
  272.     # simple case.
  273.     #
  274.     if ( $directories !~ m|/\Z(?!\n)| ) {
  275.         return split( m|/|, $directories );
  276.     }
  277.     else {
  278.         #
  279.         # since there was a trailing separator, add a file name to the end, 
  280.         # then do the split, then replace it with ''.
  281.         #
  282.         my( @directories )= split( m|/|, "${directories}dummy" ) ;
  283.         $directories[ $#directories ]= '' ;
  284.         return @directories ;
  285.     }
  286. }
  287.  
  288.  
  289. =item catpath
  290.  
  291. Takes volume, directory and file portions and returns an entire path. Under
  292. Unix, $volume is ignored, and directory and file are catenated.  A '/' is
  293. inserted if need be.  On other OSs, $volume is significant.
  294.  
  295. =cut
  296.  
  297. sub catpath {
  298.     my ($self,$volume,$directory,$file) = @_;
  299.  
  300.     if ( $directory ne ''                && 
  301.          $file ne ''                     && 
  302.          substr( $directory, -1 ) ne '/' && 
  303.          substr( $file, 0, 1 ) ne '/' 
  304.     ) {
  305.         $directory .= "/$file" ;
  306.     }
  307.     else {
  308.         $directory .= $file ;
  309.     }
  310.  
  311.     return $directory ;
  312. }
  313.  
  314. =item abs2rel
  315.  
  316. Takes a destination path and an optional base path returns a relative path
  317. from the base path to the destination path:
  318.  
  319.     $rel_path = File::Spec->abs2rel( $path ) ;
  320.     $rel_path = File::Spec->abs2rel( $path, $base ) ;
  321.  
  322. If $base is not present or '', then L<cwd()> is used. If $base is relative, 
  323. then it is converted to absolute form using L</rel2abs()>. This means that it
  324. is taken to be relative to L<cwd()>.
  325.  
  326. On systems with the concept of a volume, this assumes that both paths 
  327. are on the $destination volume, and ignores the $base volume. 
  328.  
  329. On systems that have a grammar that indicates filenames, this ignores the 
  330. $base filename as well. Otherwise all path components are assumed to be
  331. directories.
  332.  
  333. If $path is relative, it is converted to absolute form using L</rel2abs()>.
  334. This means that it is taken to be relative to L<cwd()>.
  335.  
  336. No checks against the filesystem are made on most systems.  On MacOS,
  337. the filesystem may be consulted (see
  338. L<File::Spec::MacOS/file_name_is_absolute>).  On VMS, there is
  339. interaction with the working environment, as logicals and
  340. macros are expanded.
  341.  
  342. Based on code written by Shigio Yamaguchi.
  343.  
  344. =cut
  345.  
  346. sub abs2rel {
  347.     my($self,$path,$base) = @_;
  348.  
  349.     # Clean up $path
  350.     if ( ! $self->file_name_is_absolute( $path ) ) {
  351.         $path = $self->rel2abs( $path ) ;
  352.     }
  353.     else {
  354.         $path = $self->canonpath( $path ) ;
  355.     }
  356.  
  357.     # Figure out the effective $base and clean it up.
  358.     if ( !defined( $base ) || $base eq '' ) {
  359.         $base = cwd() ;
  360.     }
  361.     elsif ( ! $self->file_name_is_absolute( $base ) ) {
  362.         $base = $self->rel2abs( $base ) ;
  363.     }
  364.     else {
  365.         $base = $self->canonpath( $base ) ;
  366.     }
  367.  
  368.     # Now, remove all leading components that are the same
  369.     my @pathchunks = $self->splitdir( $path);
  370.     my @basechunks = $self->splitdir( $base);
  371.  
  372.     while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
  373.         shift @pathchunks ;
  374.         shift @basechunks ;
  375.     }
  376.  
  377.     $path = CORE::join( '/', @pathchunks );
  378.     $base = CORE::join( '/', @basechunks );
  379.  
  380.     # $base now contains the directories the resulting relative path 
  381.     # must ascend out of before it can descend to $path_directory.  So, 
  382.     # replace all names with $parentDir
  383.     $base =~ s|[^/]+|..|g ;
  384.  
  385.     # Glue the two together, using a separator if necessary, and preventing an
  386.     # empty result.
  387.     if ( $path ne '' && $base ne '' ) {
  388.         $path = "$base/$path" ;
  389.     } else {
  390.         $path = "$base$path" ;
  391.     }
  392.  
  393.     return $self->canonpath( $path ) ;
  394. }
  395.  
  396. =item rel2abs
  397.  
  398. Converts a relative path to an absolute path. 
  399.  
  400.     $abs_path = File::Spec->rel2abs( $path ) ;
  401.     $abs_path = File::Spec->rel2abs( $path, $base ) ;
  402.  
  403. If $base is not present or '', then L<cwd()> is used. If $base is relative, 
  404. then it is converted to absolute form using L</rel2abs()>. This means that it
  405. is taken to be relative to L<cwd()>.
  406.  
  407. On systems with the concept of a volume, this assumes that both paths 
  408. are on the $base volume, and ignores the $path volume. 
  409.  
  410. On systems that have a grammar that indicates filenames, this ignores the 
  411. $base filename as well. Otherwise all path components are assumed to be
  412. directories.
  413.  
  414. If $path is absolute, it is cleaned up and returned using L</canonpath()>.
  415.  
  416. No checks against the filesystem are made on most systems.  On MacOS,
  417. the filesystem may be consulted (see
  418. L<File::Spec::MacOS/file_name_is_absolute>).  On VMS, there is
  419. interaction with the working environment, as logicals and
  420. macros are expanded.
  421.  
  422. Based on code written by Shigio Yamaguchi.
  423.  
  424. =cut
  425.  
  426. sub rel2abs {
  427.     my ($self,$path,$base ) = @_;
  428.  
  429.     # Clean up $path
  430.     if ( ! $self->file_name_is_absolute( $path ) ) {
  431.         # Figure out the effective $base and clean it up.
  432.         if ( !defined( $base ) || $base eq '' ) {
  433.             $base = cwd() ;
  434.         }
  435.         elsif ( ! $self->file_name_is_absolute( $base ) ) {
  436.             $base = $self->rel2abs( $base ) ;
  437.         }
  438.         else {
  439.             $base = $self->canonpath( $base ) ;
  440.         }
  441.  
  442.         # Glom them together
  443.         $path = $self->catdir( $base, $path ) ;
  444.     }
  445.  
  446.     return $self->canonpath( $path ) ;
  447. }
  448.  
  449.  
  450. =back
  451.  
  452. =head1 SEE ALSO
  453.  
  454. L<File::Spec>
  455.  
  456. =cut
  457.  
  458. 1;
  459.