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