1N/Apackage File::Spec::Unix;
1N/A
1N/Ause strict;
1N/Ause vars qw($VERSION);
1N/A
1N/A$VERSION = '1.5';
1N/A
1N/A=head1 NAME
1N/A
1N/AFile::Spec::Unix - File::Spec for Unix, base for other File::Spec modules
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A require File::Spec::Unix; # Done automatically by File::Spec
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AMethods for manipulating file specifications. Other File::Spec
1N/Amodules, such as File::Spec::Mac, inherit from File::Spec::Unix and
1N/Aoverride specific methods.
1N/A
1N/A=head1 METHODS
1N/A
1N/A=over 2
1N/A
1N/A=item canonpath()
1N/A
1N/ANo physical check on the filesystem, but a logical cleanup of a
1N/Apath. On UNIX eliminates successive slashes and successive "/.".
1N/A
1N/A $cpath = File::Spec->canonpath( $path ) ;
1N/A
1N/A=cut
1N/A
1N/Asub canonpath {
1N/A my ($self,$path) = @_;
1N/A
1N/A # Handle POSIX-style node names beginning with double slash (qnx, nto)
1N/A # Handle network path names beginning with double slash (cygwin)
1N/A # (POSIX says: "a pathname that begins with two successive slashes
1N/A # may be interpreted in an implementation-defined manner, although
1N/A # more than two leading slashes shall be treated as a single slash.")
1N/A my $node = '';
1N/A if ( $^O =~ m/^(?:qnx|nto|cygwin)$/ && $path =~ s:^(//[^/]+)(/|\z):/:s ) {
1N/A $node = $1;
1N/A }
1N/A # This used to be
1N/A # $path =~ s|/+|/|g unless($^O eq 'cygwin');
1N/A # but that made tests 29, 30, 35, 46, and 213 (as of #13272) to fail
1N/A # (Mainly because trailing "" directories didn't get stripped).
1N/A # Why would cygwin avoid collapsing multiple slashes into one? --jhi
1N/A $path =~ s|/+|/|g; # xx////xx -> xx/xx
1N/A $path =~ s@(/\.)+(/|\Z(?!\n))@/@g; # xx/././xx -> xx/xx
1N/A $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx
1N/A $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx
1N/A $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx
1N/A return "$node$path";
1N/A}
1N/A
1N/A=item catdir()
1N/A
1N/AConcatenate two or more directory names to form a complete path ending
1N/Awith a directory. But remove the trailing slash from the resulting
1N/Astring, because it doesn't look good, isn't necessary and confuses
1N/AOS2. Of course, if this is the root directory, don't cut off the
1N/Atrailing slash :-)
1N/A
1N/A=cut
1N/A
1N/Asub catdir {
1N/A my $self = shift;
1N/A
1N/A $self->canonpath(join('/', @_, '')); # '' because need a trailing '/'
1N/A}
1N/A
1N/A=item catfile
1N/A
1N/AConcatenate one or more directory names and a filename to form a
1N/Acomplete path ending with a filename
1N/A
1N/A=cut
1N/A
1N/Asub catfile {
1N/A my $self = shift;
1N/A my $file = $self->canonpath(pop @_);
1N/A return $file unless @_;
1N/A my $dir = $self->catdir(@_);
1N/A $dir .= "/" unless substr($dir,-1) eq "/";
1N/A return $dir.$file;
1N/A}
1N/A
1N/A=item curdir
1N/A
1N/AReturns a string representation of the current directory. "." on UNIX.
1N/A
1N/A=cut
1N/A
1N/Asub curdir () { '.' }
1N/A
1N/A=item devnull
1N/A
1N/AReturns a string representation of the null device. "/dev/null" on UNIX.
1N/A
1N/A=cut
1N/A
1N/Asub devnull () { '/dev/null' }
1N/A
1N/A=item rootdir
1N/A
1N/AReturns a string representation of the root directory. "/" on UNIX.
1N/A
1N/A=cut
1N/A
1N/Asub rootdir () { '/' }
1N/A
1N/A=item tmpdir
1N/A
1N/AReturns a string representation of the first writable directory from
1N/Athe following list or the current directory if none from the list are
1N/Awritable:
1N/A
1N/A $ENV{TMPDIR}
1N/A /tmp
1N/A
1N/ASince perl 5.8.0, if running under taint mode, and if $ENV{TMPDIR}
1N/Ais tainted, it is not used.
1N/A
1N/A=cut
1N/A
1N/Amy $tmpdir;
1N/Asub _tmpdir {
1N/A return $tmpdir if defined $tmpdir;
1N/A my $self = shift;
1N/A my @dirlist = @_;
1N/A {
1N/A no strict 'refs';
1N/A if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
1N/A require Scalar::Util;
1N/A @dirlist = grep { ! Scalar::Util::tainted($_) } @dirlist;
1N/A }
1N/A }
1N/A foreach (@dirlist) {
1N/A next unless defined && -d && -w _;
1N/A $tmpdir = $_;
1N/A last;
1N/A }
1N/A $tmpdir = $self->curdir unless defined $tmpdir;
1N/A $tmpdir = defined $tmpdir && $self->canonpath($tmpdir);
1N/A return $tmpdir;
1N/A}
1N/A
1N/Asub tmpdir {
1N/A return $tmpdir if defined $tmpdir;
1N/A my $self = shift;
1N/A $tmpdir = $self->_tmpdir( $ENV{TMPDIR}, "/tmp" );
1N/A}
1N/A
1N/A=item updir
1N/A
1N/AReturns a string representation of the parent directory. ".." on UNIX.
1N/A
1N/A=cut
1N/A
1N/Asub updir () { '..' }
1N/A
1N/A=item no_upwards
1N/A
1N/AGiven a list of file names, strip out those that refer to a parent
1N/Adirectory. (Does not strip symlinks, only '.', '..', and equivalents.)
1N/A
1N/A=cut
1N/A
1N/Asub no_upwards {
1N/A my $self = shift;
1N/A return grep(!/^\.{1,2}\Z(?!\n)/s, @_);
1N/A}
1N/A
1N/A=item case_tolerant
1N/A
1N/AReturns a true or false value indicating, respectively, that alphabetic
1N/Ais not or is significant when comparing file specifications.
1N/A
1N/A=cut
1N/A
1N/Asub case_tolerant () { 0 }
1N/A
1N/A=item file_name_is_absolute
1N/A
1N/ATakes as argument a path and returns true if it is an absolute path.
1N/A
1N/AThis does not consult the local filesystem on Unix, Win32, OS/2 or Mac
1N/AOS (Classic). It does consult the working environment for VMS (see
1N/AL<File::Spec::VMS/file_name_is_absolute>).
1N/A
1N/A=cut
1N/A
1N/Asub file_name_is_absolute {
1N/A my ($self,$file) = @_;
1N/A return scalar($file =~ m:^/:s);
1N/A}
1N/A
1N/A=item path
1N/A
1N/ATakes no argument, returns the environment variable PATH as an array.
1N/A
1N/A=cut
1N/A
1N/Asub path {
1N/A return () unless exists $ENV{PATH};
1N/A my @path = split(':', $ENV{PATH});
1N/A foreach (@path) { $_ = '.' if $_ eq '' }
1N/A return @path;
1N/A}
1N/A
1N/A=item join
1N/A
1N/Ajoin is the same as catfile.
1N/A
1N/A=cut
1N/A
1N/Asub join {
1N/A my $self = shift;
1N/A return $self->catfile(@_);
1N/A}
1N/A
1N/A=item splitpath
1N/A
1N/A ($volume,$directories,$file) = File::Spec->splitpath( $path );
1N/A ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
1N/A
1N/ASplits a path into volume, directory, and filename portions. On systems
1N/Awith no concept of volume, returns '' for volume.
1N/A
1N/AFor systems with no syntax differentiating filenames from directories,
1N/Aassumes that the last file is a path unless $no_file is true or a
1N/Atrailing separator or /. or /.. is present. On Unix this means that $no_file
1N/Atrue makes this return ( '', $path, '' ).
1N/A
1N/AThe directory portion may or may not be returned with a trailing '/'.
1N/A
1N/AThe results can be passed to L</catpath()> to get back a path equivalent to
1N/A(usually identical to) the original path.
1N/A
1N/A=cut
1N/A
1N/Asub splitpath {
1N/A my ($self,$path, $nofile) = @_;
1N/A
1N/A my ($volume,$directory,$file) = ('','','');
1N/A
1N/A if ( $nofile ) {
1N/A $directory = $path;
1N/A }
1N/A else {
1N/A $path =~ m|^ ( (?: .* / (?: \.\.?\Z(?!\n) )? )? ) ([^/]*) |xs;
1N/A $directory = $1;
1N/A $file = $2;
1N/A }
1N/A
1N/A return ($volume,$directory,$file);
1N/A}
1N/A
1N/A
1N/A=item splitdir
1N/A
1N/AThe opposite of L</catdir()>.
1N/A
1N/A @dirs = File::Spec->splitdir( $directories );
1N/A
1N/A$directories must be only the directory portion of the path on systems
1N/Athat have the concept of a volume or that have path syntax that differentiates
1N/Afiles from directories.
1N/A
1N/AUnlike just splitting the directories on the separator, empty
1N/Adirectory names (C<''>) can be returned, because these are significant
1N/Aon some OSs.
1N/A
1N/AOn Unix,
1N/A
1N/A File::Spec->splitdir( "/a/b//c/" );
1N/A
1N/AYields:
1N/A
1N/A ( '', 'a', 'b', '', 'c', '' )
1N/A
1N/A=cut
1N/A
1N/Asub splitdir {
1N/A return split m|/|, $_[1], -1; # Preserve trailing fields
1N/A}
1N/A
1N/A
1N/A=item catpath()
1N/A
1N/ATakes volume, directory and file portions and returns an entire path. Under
1N/AUnix, $volume is ignored, and directory and file are concatenated. A '/' is
1N/Ainserted if needed (though if the directory portion doesn't start with
1N/A'/' it is not added). On other OSs, $volume is significant.
1N/A
1N/A=cut
1N/A
1N/Asub catpath {
1N/A my ($self,$volume,$directory,$file) = @_;
1N/A
1N/A if ( $directory ne '' &&
1N/A $file ne '' &&
1N/A substr( $directory, -1 ) ne '/' &&
1N/A substr( $file, 0, 1 ) ne '/'
1N/A ) {
1N/A $directory .= "/$file" ;
1N/A }
1N/A else {
1N/A $directory .= $file ;
1N/A }
1N/A
1N/A return $directory ;
1N/A}
1N/A
1N/A=item abs2rel
1N/A
1N/ATakes a destination path and an optional base path returns a relative path
1N/Afrom the base path to the destination path:
1N/A
1N/A $rel_path = File::Spec->abs2rel( $path ) ;
1N/A $rel_path = File::Spec->abs2rel( $path, $base ) ;
1N/A
1N/AIf $base is not present or '', then L<cwd()|Cwd> is used. If $base is
1N/Arelative, then it is converted to absolute form using
1N/AL</rel2abs()>. This means that it is taken to be relative to
1N/AL<cwd()|Cwd>.
1N/A
1N/AOn systems that have a grammar that indicates filenames, this ignores the
1N/A$base filename. Otherwise all path components are assumed to be
1N/Adirectories.
1N/A
1N/AIf $path is relative, it is converted to absolute form using L</rel2abs()>.
1N/AThis means that it is taken to be relative to L<cwd()|Cwd>.
1N/A
1N/ANo checks against the filesystem are made. On VMS, there is
1N/Ainteraction with the working environment, as logicals and
1N/Amacros are expanded.
1N/A
1N/ABased on code written by Shigio Yamaguchi.
1N/A
1N/A=cut
1N/A
1N/Asub abs2rel {
1N/A my($self,$path,$base) = @_;
1N/A
1N/A # Clean up $path
1N/A if ( ! $self->file_name_is_absolute( $path ) ) {
1N/A $path = $self->rel2abs( $path ) ;
1N/A }
1N/A else {
1N/A $path = $self->canonpath( $path ) ;
1N/A }
1N/A
1N/A # Figure out the effective $base and clean it up.
1N/A if ( !defined( $base ) || $base eq '' ) {
1N/A $base = $self->_cwd();
1N/A }
1N/A elsif ( ! $self->file_name_is_absolute( $base ) ) {
1N/A $base = $self->rel2abs( $base ) ;
1N/A }
1N/A else {
1N/A $base = $self->canonpath( $base ) ;
1N/A }
1N/A
1N/A # Now, remove all leading components that are the same
1N/A my @pathchunks = $self->splitdir( $path);
1N/A my @basechunks = $self->splitdir( $base);
1N/A
1N/A while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
1N/A shift @pathchunks ;
1N/A shift @basechunks ;
1N/A }
1N/A
1N/A $path = CORE::join( '/', @pathchunks );
1N/A $base = CORE::join( '/', @basechunks );
1N/A
1N/A # $base now contains the directories the resulting relative path
1N/A # must ascend out of before it can descend to $path_directory. So,
1N/A # replace all names with $parentDir
1N/A $base =~ s|[^/]+|..|g ;
1N/A
1N/A # Glue the two together, using a separator if necessary, and preventing an
1N/A # empty result.
1N/A if ( $path ne '' && $base ne '' ) {
1N/A $path = "$base/$path" ;
1N/A } else {
1N/A $path = "$base$path" ;
1N/A }
1N/A
1N/A return $self->canonpath( $path ) ;
1N/A}
1N/A
1N/A=item rel2abs()
1N/A
1N/AConverts a relative path to an absolute path.
1N/A
1N/A $abs_path = File::Spec->rel2abs( $path ) ;
1N/A $abs_path = File::Spec->rel2abs( $path, $base ) ;
1N/A
1N/AIf $base is not present or '', then L<cwd()|Cwd> is used. If $base is
1N/Arelative, then it is converted to absolute form using
1N/AL</rel2abs()>. This means that it is taken to be relative to
1N/AL<cwd()|Cwd>.
1N/A
1N/AOn systems that have a grammar that indicates filenames, this ignores
1N/Athe $base filename. Otherwise all path components are assumed to be
1N/Adirectories.
1N/A
1N/AIf $path is absolute, it is cleaned up and returned using L</canonpath()>.
1N/A
1N/ANo checks against the filesystem are made. On VMS, there is
1N/Ainteraction with the working environment, as logicals and
1N/Amacros are expanded.
1N/A
1N/ABased on code written by Shigio Yamaguchi.
1N/A
1N/A=cut
1N/A
1N/Asub rel2abs {
1N/A my ($self,$path,$base ) = @_;
1N/A
1N/A # Clean up $path
1N/A if ( ! $self->file_name_is_absolute( $path ) ) {
1N/A # Figure out the effective $base and clean it up.
1N/A if ( !defined( $base ) || $base eq '' ) {
1N/A $base = $self->_cwd();
1N/A }
1N/A elsif ( ! $self->file_name_is_absolute( $base ) ) {
1N/A $base = $self->rel2abs( $base ) ;
1N/A }
1N/A else {
1N/A $base = $self->canonpath( $base ) ;
1N/A }
1N/A
1N/A # Glom them together
1N/A $path = $self->catdir( $base, $path ) ;
1N/A }
1N/A
1N/A return $self->canonpath( $path ) ;
1N/A}
1N/A
1N/A=back
1N/A
1N/A=head1 SEE ALSO
1N/A
1N/AL<File::Spec>
1N/A
1N/A=cut
1N/A
1N/A# Internal routine to File::Spec, no point in making this public since
1N/A# it is the standard Cwd interface. Most of the platform-specific
1N/A# File::Spec subclasses use this.
1N/Asub _cwd {
1N/A require Cwd;
1N/A Cwd::cwd();
1N/A}
1N/A
1N/A1;