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