[p5sagit/p5-mst-13.2.git] / lib / File / Spec / Win32.pm

package File::Spec::Win32;

use strict;
use Cwd;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;

$VERSION = '1.3';

@ISA = qw(File::Spec::Unix);

=head1 NAME

File::Spec::Win32 - methods for Win32 file specs

=head1 SYNOPSIS

 require File::Spec::Win32; # Done internally by File::Spec if needed

=head1 DESCRIPTION

See File::Spec::Unix for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.

=over 4

=item devnull

Returns a string representation of the null device.

=cut

sub devnull {
    return "nul";
}

=item tmpdir

Returns a string representation of the first existing directory
from the following list:

    $ENV{TMPDIR}
    $ENV{TEMP}
    $ENV{TMP}
    SYS:/temp
    C:/temp
    /tmp
    /

The SYS:/temp is preferred in Novell NetWare.

Since Perl 5.8.0, if running under taint mode, and if the environment
variables are tainted, they are not used.

=cut

my $tmpdir;
sub tmpdir {
    return $tmpdir if defined $tmpdir;
    my $self = shift;
    my @dirlist = (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /));
    {
	no strict 'refs';
	if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
	    require Scalar::Util;
	    @dirlist = grep { ! Scalar::Util::tainted $_ } @dirlist;
	}
    }
    foreach (@dirlist) {
	next unless defined && -d;
	$tmpdir = $_;
	last;
    }
    $tmpdir = '' unless defined $tmpdir;
    $tmpdir = $self->canonpath($tmpdir);
    return $tmpdir;
}

sub case_tolerant {
    return 1;
}

sub file_name_is_absolute {
    my ($self,$file) = @_;
    return scalar($file =~ m{^([a-z]:)?[\\/]}is);
}

=item catfile

Concatenate one or more directory names and a filename to form a
complete path ending with a filename

=cut

sub catfile {
    my $self = shift;
    my $file = $self->canonpath(pop @_);
    return $file unless @_;
    my $dir = $self->catdir(@_);
    $dir .= "\\" unless substr($dir,-1) eq "\\";
    return $dir.$file;
}

sub path {
    my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
    my @path = split(';',$path);
    foreach (@path) { $_ = '.' if $_ eq '' }
    return @path;
}

=item canonpath

No physical check on the filesystem, but a logical cleanup of a
path. On UNIX eliminated successive slashes and successive "/.".
On Win32 makes 

	dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
	dir1\dir2\dir3\...\dir4   -> \dir\dir4

=cut

sub canonpath {
    my ($self,$path) = @_;
    my $orig_path = $path;
    $path =~ s/^([a-z]:)/\u$1/s;
    $path =~ s|/|\\|g;
    $path =~ s|([^\\])\\+|$1\\|g;                  # xx\\\\xx  -> xx\xx
    $path =~ s|(\\\.)+\\|\\|g;                     # xx\.\.\xx -> xx\xx
    $path =~ s|^(\.\\)+||s unless $path eq ".\\";  # .\xx      -> xx
    $path =~ s|\\\Z(?!\n)||
             unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s;   # xx\       -> xx
	# xx1/xx2/xx3/../../xx -> xx1/xx
	$path =~ s|\\\.\.\.\\|\\\.\.\\\.\.\\|g; # \...\ is 2 levels up
	$path =~ s|^\.\.\.\\|\.\.\\\.\.\\|g;    # ...\ is 2 levels up
	return $path if $path =~ m|^\.\.|;      # skip relative paths
	return $path unless $path =~ /\.\./;    # too few .'s to cleanup
	return $path if $path =~ /\.\.\.\./;    # too many .'s to cleanup
	return $path if $orig_path =~ m|^\Q/../\E|
			        and $orig_path =~ m|\/$|;  # don't do /../dirs/ 
			        						   # when called from rel2abs()
			        						   # for ../dirs/
	my ($vol,$dirs,$file) = $self->splitpath($path);
	my @dirs = $self->splitdir($dirs);
	my (@base_dirs, @path_dirs);
	my $dest = \@base_dirs;
	for my $dir (@dirs){
		$dest = \@path_dirs if $dir eq $self->updir;
		push @$dest, $dir;
	}
	# for each .. in @path_dirs pop one item from 
	# @base_dirs
	while (my $dir = shift @path_dirs){ 
		unless ($dir eq $self->updir){
			unshift @path_dirs, $dir;
			last;
		}
		pop @base_dirs;
	}
	$path = $self->catpath( 
		$vol, 
		$self->catdir(@base_dirs, @path_dirs), 
		$file
    );
    return $path;
}

=item splitpath

    ($volume,$directories,$file) = File::Spec->splitpath( $path );
    ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );

Splits a path into volume, directory, and filename portions. Assumes that 
the last file is a path unless the path ends in '\\', '\\.', '\\..'
or $no_file is true.  On Win32 this means that $no_file true makes this return 
( $volume, $path, '' ).

Separators accepted are \ and /.

Volumes can be drive letters or UNC sharenames (\\server\share).

The results can be passed to L</catpath> to get back a path equivalent to
(usually identical to) the original path.

=cut

sub splitpath {
    my ($self,$path, $nofile) = @_;
    my ($volume,$directory,$file) = ('','','');
    if ( $nofile ) {
        $path =~ 
            m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) 
                 (.*)
             }xs;
        $volume    = $1;
        $directory = $2;
    }
    else {
        $path =~ 
            m{^ ( (?: [a-zA-Z]: |
                      (?:\\\\|//)[^\\/]+[\\/][^\\/]+
                  )?
                )
                ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
                (.*)
             }xs;
        $volume    = $1;
        $directory = $2;
        $file      = $3;
    }

    return ($volume,$directory,$file);
}


=item splitdir

The opposite of L<catdir()|File::Spec/catdir()>.

    @dirs = File::Spec->splitdir( $directories );

$directories must be only the directory portion of the path on systems 
that have the concept of a volume or that have path syntax that differentiates
files from directories.

Unlike just splitting the directories on the separator, leading empty and 
trailing directory entries can be returned, because these are significant
on some OSs. So,

    File::Spec->splitdir( "/a/b/c" );

Yields:

    ( '', 'a', 'b', '', 'c', '' )

=cut

sub splitdir {
    my ($self,$directories) = @_ ;
    #
    # split() likes to forget about trailing null fields, so here we
    # check to be sure that there will not be any before handling the
    # simple case.
    #
    if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
        return split( m|[\\/]|, $directories );
    }
    else {
        #
        # since there was a trailing separator, add a file name to the end, 
        # then do the split, then replace it with ''.
        #
        my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
        $directories[ $#directories ]= '' ;
        return @directories ;
    }
}


=item catpath

Takes volume, directory and file portions and returns an entire path. Under
Unix, $volume is ignored, and this is just like catfile(). On other OSs,
the $volume become significant.

=cut

sub catpath {
    my ($self,$volume,$directory,$file) = @_;

    # If it's UNC, make sure the glue separator is there, reusing
    # whatever separator is first in the $volume
    $volume .= $1
        if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
             $directory =~ m@^[^\\/]@s
           ) ;

    $volume .= $directory ;

    # If the volume is not just A:, make sure the glue separator is 
    # there, reusing whatever separator is first in the $volume if possible.
    if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
         $volume =~ m@[^\\/]\Z(?!\n)@      &&
         $file   =~ m@[^\\/]@
       ) {
        $volume =~ m@([\\/])@ ;
        my $sep = $1 ? $1 : '\\' ;
        $volume .= $sep ;
    }

    $volume .= $file ;

    return $volume ;
}


sub abs2rel {
    my($self,$path,$base) = @_;

    # Clean up $path
    if ( ! $self->file_name_is_absolute( $path ) ) {
        $path = $self->rel2abs( $path ) ;
    }
    else {
        $path = $self->canonpath( $path ) ;
    }

    # Figure out the effective $base and clean it up.
    if ( !defined( $base ) || $base eq '' ) {
        $base = cwd() ;
    }
    elsif ( ! $self->file_name_is_absolute( $base ) ) {
        $base = $self->rel2abs( $base ) ;
    }
    else {
        $base = $self->canonpath( $base ) ;
    }

    # Split up paths
    my ( undef, $path_directories, $path_file ) =
        $self->splitpath( $path, 1 ) ;

    my $base_directories = ($self->splitpath( $base, 1 ))[1] ;

    # Now, remove all leading components that are the same
    my @pathchunks = $self->splitdir( $path_directories );
    my @basechunks = $self->splitdir( $base_directories );

    while ( @pathchunks && 
            @basechunks && 
            lc( $pathchunks[0] ) eq lc( $basechunks[0] ) 
          ) {
        shift @pathchunks ;
        shift @basechunks ;
    }

    # No need to catdir, we know these are well formed.
    $path_directories = CORE::join( '\\', @pathchunks );
    $base_directories = CORE::join( '\\', @basechunks );

    # $base_directories now contains the directories the resulting relative
    # path must ascend out of before it can descend to $path_directory.  So, 
    # replace all names with $parentDir

    #FA Need to replace between backslashes...
    $base_directories =~ s|[^\\]+|..|g ;

    # Glue the two together, using a separator if necessary, and preventing an
    # empty result.

    #FA Must check that new directories are not empty.
    if ( $path_directories ne '' && $base_directories ne '' ) {
        $path_directories = "$base_directories\\$path_directories" ;
    } else {
        $path_directories = "$base_directories$path_directories" ;
    }

    return $self->canonpath( 
        $self->catpath( "", $path_directories, $path_file ) 
    ) ;
}


sub rel2abs {
    my ($self,$path,$base ) = @_;

    if ( ! $self->file_name_is_absolute( $path ) ) {

        if ( !defined( $base ) || $base eq '' ) {
            $base = cwd() ;
        }
        elsif ( ! $self->file_name_is_absolute( $base ) ) {
            $base = $self->rel2abs( $base ) ;
        }
        else {
            $base = $self->canonpath( $base ) ;
        }

        my ( $path_directories, $path_file ) =
            ($self->splitpath( $path, 1 ))[1,2] ;

        my ( $base_volume, $base_directories ) =
            $self->splitpath( $base, 1 ) ;

        $path = $self->catpath( 
            $base_volume, 
            $self->catdir( $base_directories, $path_directories ), 
            $path_file
        ) ;
    }

    return $self->canonpath( $path ) ;
}

=back

=head2 Note For File::Spec::Win32 Maintainers

Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.

=head1 SEE ALSO

L<File::Spec>

=cut

1;
Commit	Line	Data
270d1e39	1	package File::Spec::Win32;
270d1e39	2
cbc7acb0	3	use strict;
c27914c9	4	use Cwd;
b4296952	5	use vars qw(@ISA $VERSION);
cbc7acb0	6	require File::Spec::Unix;
b4296952	7
88d01e8d	8	$VERSION = '1.3';
b4296952	9
cbc7acb0	10	@ISA = qw(File::Spec::Unix);
cbc7acb0	11
270d1e39	12	=head1 NAME
	13
	14	File::Spec::Win32 - methods for Win32 file specs
	15
	16	=head1 SYNOPSIS
	17
cbc7acb0	18	require File::Spec::Win32; # Done internally by File::Spec if needed
270d1e39	19
	20	=head1 DESCRIPTION
	21
	22	See File::Spec::Unix for a documentation of the methods provided
	23	there. This package overrides the implementation of these methods, not
	24	the semantics.
	25
bbc7dcd2	26	=over 4
270d1e39	27
cbc7acb0	28	=item devnull
270d1e39	29
cbc7acb0	30	Returns a string representation of the null device.
270d1e39	31
cbc7acb0	32	=cut
270d1e39	33
cbc7acb0	34	sub devnull {
	35	return "nul";
	36	}
270d1e39	37
cbc7acb0	38	=item tmpdir
270d1e39	39
cbc7acb0	40	Returns a string representation of the first existing directory
cbc7acb0	41	from the following list:
270d1e39	42
cbc7acb0	43	$ENV{TMPDIR}
	44	$ENV{TEMP}
	45	$ENV{TMP}
dd9bbc5b	46	SYS:/temp
28747828	47	C:/temp
cbc7acb0	48	/tmp
	49	/
	50
dd9bbc5b	51	The SYS:/temp is preferred in Novell NetWare.
	52
	53	Since Perl 5.8.0, if running under taint mode, and if the environment
a384e9e1	54	variables are tainted, they are not used.
a384e9e1	55
cbc7acb0	56	=cut
270d1e39	57
cbc7acb0	58	my $tmpdir;
	59	sub tmpdir {
	60	return $tmpdir if defined $tmpdir;
270d1e39	61	my $self = shift;
a384e9e1	62	my @dirlist = (@ENV{qw(TMPDIR TEMP TMP)}, qw(C:/temp /tmp /));
	63	{
	64	no strict 'refs';
	65	if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0
	66	require Scalar::Util;
	67	@dirlist = grep { ! Scalar::Util::tainted $_ } @dirlist;
	68	}
	69	}
	70	foreach (@dirlist) {
cbc7acb0	71	next unless defined && -d;
	72	$tmpdir = $_;
	73	last;
270d1e39	74	}
cbc7acb0	75	$tmpdir = '' unless defined $tmpdir;
	76	$tmpdir = $self->canonpath($tmpdir);
	77	return $tmpdir;
	78	}
	79
46726cbe	80	sub case_tolerant {
	81	return 1;
	82	}
	83
cbc7acb0	84	sub file_name_is_absolute {
cbc7acb0	85	my ($self,$file) = @_;
1b1e14d3	86	return scalar($file =~ m{^([a-z]:)?[\\/]}is);
270d1e39	87	}
	88
	89	=item catfile
	90
	91	Concatenate one or more directory names and a filename to form a
	92	complete path ending with a filename
	93
	94	=cut
	95
	96	sub catfile {
cbc7acb0	97	my $self = shift;
02961b52	98	my $file = $self->canonpath(pop @_);
270d1e39	99	return $file unless @_;
270d1e39	100	my $dir = $self->catdir(@_);
cbc7acb0	101	$dir .= "\\" unless substr($dir,-1) eq "\\";
270d1e39	102	return $dir.$file;
	103	}
	104
	105	sub path {
270d1e39	106	my $path = $ENV{'PATH'} \|\| $ENV{'Path'} \|\| $ENV{'path'};
270d1e39	107	my @path = split(';',$path);
cbc7acb0	108	foreach (@path) { $_ = '.' if $_ eq '' }
cbc7acb0	109	return @path;
270d1e39	110	}
	111
	112	=item canonpath
	113
	114	No physical check on the filesystem, but a logical cleanup of a
	115	path. On UNIX eliminated successive slashes and successive "/.".
cc23144f	116	On Win32 makes
	117
	118	dir1\dir2\dir3\..\..\dir4 -> \dir\dir4 and even
	119	dir1\dir2\dir3\...\dir4 -> \dir\dir4
270d1e39	120
	121	=cut
	122
	123	sub canonpath {
0994714a	124	my ($self,$path) = @_;
cc23144f	125	my $orig_path = $path;
1b1e14d3	126	$path =~ s/^([a-z]:)/\u$1/s;
270d1e39	127	$path =~ s\|/\|\\\|g;
ecf68df6	128	$path =~ s\|([^\\])\\+\|$1\\\|g; # xx\\\\xx -> xx\xx
	129	$path =~ s\|(\\\.)+\\\|\\\|g; # xx\.\.\xx -> xx\xx
	130	$path =~ s\|^(\.\\)+\|\|s unless $path eq ".\\"; # .\xx -> xx
9c045eb2	131	$path =~ s\|\\\Z(?!\n)\|\|
ecf68df6	132	unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s; # xx\ -> xx
cc23144f	133	# xx1/xx2/xx3/../../xx -> xx1/xx
	134	$path =~ s\|\\\.\.\.\\\|\\\.\.\\\.\.\\\|g; # \...\ is 2 levels up
	135	$path =~ s\|^\.\.\.\\\|\.\.\\\.\.\\\|g; # ...\ is 2 levels up
	136	return $path if $path =~ m\|^\.\.\|; # skip relative paths
	137	return $path unless $path =~ /\.\./; # too few .'s to cleanup
	138	return $path if $path =~ /\.\.\.\./; # too many .'s to cleanup
	139	return $path if $orig_path =~ m\|^\Q/../\E\|
	140	and $orig_path =~ m\|\/$\|; # don't do /../dirs/
	141	# when called from rel2abs()
	142	# for ../dirs/
	143	my ($vol,$dirs,$file) = $self->splitpath($path);
	144	my @dirs = $self->splitdir($dirs);
	145	my (@base_dirs, @path_dirs);
	146	my $dest = \@base_dirs;
	147	for my $dir (@dirs){
	148	$dest = \@path_dirs if $dir eq $self->updir;
	149	push @$dest, $dir;
	150	}
	151	# for each .. in @path_dirs pop one item from
	152	# @base_dirs
	153	while (my $dir = shift @path_dirs){
	154	unless ($dir eq $self->updir){
	155	unshift @path_dirs, $dir;
	156	last;
	157	}
	158	pop @base_dirs;
	159	}
	160	$path = $self->catpath(
	161	$vol,
	162	$self->catdir(@base_dirs, @path_dirs),
	163	$file
	164	);
cbc7acb0	165	return $path;
270d1e39	166	}
270d1e39	167
c27914c9	168	=item splitpath
	169
	170	($volume,$directories,$file) = File::Spec->splitpath( $path );
	171	($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
	172
40d020d9	173	Splits a path into volume, directory, and filename portions. Assumes that
c27914c9	174	the last file is a path unless the path ends in '\\', '\\.', '\\..'
c27914c9	175	or $no_file is true. On Win32 this means that $no_file true makes this return
40d020d9	176	( $volume, $path, '' ).
c27914c9	177
	178	Separators accepted are \ and /.
	179
	180	Volumes can be drive letters or UNC sharenames (\\server\share).
	181
0994714a	182	The results can be passed to L</catpath> to get back a path equivalent to
c27914c9	183	(usually identical to) the original path.
	184
	185	=cut
	186
	187	sub splitpath {
	188	my ($self,$path, $nofile) = @_;
	189	my ($volume,$directory,$file) = ('','','');
	190	if ( $nofile ) {
	191	$path =~
0994714a	192	m{^( (?:[a-zA-Z]:\|(?:\\\\\|//)[^\\/]+[\\/][^\\/]+)? )
c27914c9	193	(.*)
1b1e14d3	194	}xs;
c27914c9	195	$volume = $1;
	196	$directory = $2;
	197	}
	198	else {
	199	$path =~
0994714a	200	m{^ ( (?: [a-zA-Z]: \|
0994714a	201	(?:\\\\\|//)[^\\/]+[\\/][^\\/]+
c27914c9	202	)?
c27914c9	203	)
9c045eb2	204	( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? )
c27914c9	205	(.*)
1b1e14d3	206	}xs;
c27914c9	207	$volume = $1;
	208	$directory = $2;
	209	$file = $3;
	210	}
	211
	212	return ($volume,$directory,$file);
	213	}
	214
	215
	216	=item splitdir
	217
59605c55	218	The opposite of L<catdir()\|File::Spec/catdir()>.
c27914c9	219
	220	@dirs = File::Spec->splitdir( $directories );
	221
	222	$directories must be only the directory portion of the path on systems
	223	that have the concept of a volume or that have path syntax that differentiates
	224	files from directories.
	225
	226	Unlike just splitting the directories on the separator, leading empty and
	227	trailing directory entries can be returned, because these are significant
	228	on some OSs. So,
	229
	230	File::Spec->splitdir( "/a/b/c" );
	231
	232	Yields:
	233
	234	( '', 'a', 'b', '', 'c', '' )
	235
	236	=cut
	237
	238	sub splitdir {
	239	my ($self,$directories) = @_ ;
	240	#
	241	# split() likes to forget about trailing null fields, so here we
	242	# check to be sure that there will not be any before handling the
	243	# simple case.
	244	#
9c045eb2	245	if ( $directories !~ m\|[\\/]\Z(?!\n)\| ) {
c27914c9	246	return split( m\|[\\/]\|, $directories );
	247	}
	248	else {
	249	#
	250	# since there was a trailing separator, add a file name to the end,
	251	# then do the split, then replace it with ''.
	252	#
	253	my( @directories )= split( m\|[\\/]\|, "${directories}dummy" ) ;
	254	$directories[ $#directories ]= '' ;
	255	return @directories ;
	256	}
	257	}
	258
	259
	260	=item catpath
	261
	262	Takes volume, directory and file portions and returns an entire path. Under
	263	Unix, $volume is ignored, and this is just like catfile(). On other OSs,
	264	the $volume become significant.
	265
	266	=cut
	267
	268	sub catpath {
	269	my ($self,$volume,$directory,$file) = @_;
	270
	271	# If it's UNC, make sure the glue separator is there, reusing
	272	# whatever separator is first in the $volume
	273	$volume .= $1
9c045eb2	274	if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s &&
1b1e14d3	275	$directory =~ m@^[^\\/]@s
c27914c9	276	) ;
	277
	278	$volume .= $directory ;
	279
	280	# If the volume is not just A:, make sure the glue separator is
	281	# there, reusing whatever separator is first in the $volume if possible.
9c045eb2	282	if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
9c045eb2	283	$volume =~ m@[^\\/]\Z(?!\n)@ &&
0994714a	284	$file =~ m@[^\\/]@
c27914c9	285	) {
	286	$volume =~ m@([\\/])@ ;
	287	my $sep = $1 ? $1 : '\\' ;
	288	$volume .= $sep ;
	289	}
	290
	291	$volume .= $file ;
	292
	293	return $volume ;
	294	}
	295
	296
c27914c9	297	sub abs2rel {
	298	my($self,$path,$base) = @_;
	299
	300	# Clean up $path
	301	if ( ! $self->file_name_is_absolute( $path ) ) {
	302	$path = $self->rel2abs( $path ) ;
	303	}
	304	else {
	305	$path = $self->canonpath( $path ) ;
	306	}
	307
	308	# Figure out the effective $base and clean it up.
9c1370fb	309	if ( !defined( $base ) \|\| $base eq '' ) {
c27914c9	310	$base = cwd() ;
c27914c9	311	}
9c1370fb	312	elsif ( ! $self->file_name_is_absolute( $base ) ) {
	313	$base = $self->rel2abs( $base ) ;
	314	}
c27914c9	315	else {
	316	$base = $self->canonpath( $base ) ;
	317	}
	318
	319	# Split up paths
9b1c7707	320	my ( undef, $path_directories, $path_file ) =
c27914c9	321	$self->splitpath( $path, 1 ) ;
c27914c9	322
9c045eb2	323	my $base_directories = ($self->splitpath( $base, 1 ))[1] ;
c27914c9	324
	325	# Now, remove all leading components that are the same
	326	my @pathchunks = $self->splitdir( $path_directories );
	327	my @basechunks = $self->splitdir( $base_directories );
	328
	329	while ( @pathchunks &&
	330	@basechunks &&
	331	lc( $pathchunks[0] ) eq lc( $basechunks[0] )
	332	) {
	333	shift @pathchunks ;
	334	shift @basechunks ;
	335	}
	336
	337	# No need to catdir, we know these are well formed.
	338	$path_directories = CORE::join( '\\', @pathchunks );
	339	$base_directories = CORE::join( '\\', @basechunks );
	340
5cefc38b	341	# $base_directories now contains the directories the resulting relative
5cefc38b	342	# path must ascend out of before it can descend to $path_directory. So,
c27914c9	343	# replace all names with $parentDir
5cefc38b	344
	345	#FA Need to replace between backslashes...
	346	$base_directories =~ s\|[^\\]+\|..\|g ;
c27914c9	347
	348	# Glue the two together, using a separator if necessary, and preventing an
	349	# empty result.
5cefc38b	350
	351	#FA Must check that new directories are not empty.
	352	if ( $path_directories ne '' && $base_directories ne '' ) {
c27914c9	353	$path_directories = "$base_directories\\$path_directories" ;
	354	} else {
	355	$path_directories = "$base_directories$path_directories" ;
	356	}
	357
	358	return $self->canonpath(
9b1c7707	359	$self->catpath( "", $path_directories, $path_file )
c27914c9	360	) ;
	361	}
	362
c27914c9	363
786b702f	364	sub rel2abs {
c27914c9	365	my ($self,$path,$base ) = @_;
c27914c9	366
c27914c9	367	if ( ! $self->file_name_is_absolute( $path ) ) {
c27914c9	368
1d7cb664	369	if ( !defined( $base ) \|\| $base eq '' ) {
c27914c9	370	$base = cwd() ;
c27914c9	371	}
1d7cb664	372	elsif ( ! $self->file_name_is_absolute( $base ) ) {
	373	$base = $self->rel2abs( $base ) ;
	374	}
c27914c9	375	else {
	376	$base = $self->canonpath( $base ) ;
	377	}
	378
9c045eb2	379	my ( $path_directories, $path_file ) =
9c045eb2	380	($self->splitpath( $path, 1 ))[1,2] ;
c27914c9	381
9c045eb2	382	my ( $base_volume, $base_directories ) =
c27914c9	383	$self->splitpath( $base, 1 ) ;
	384
	385	$path = $self->catpath(
	386	$base_volume,
	387	$self->catdir( $base_directories, $path_directories ),
	388	$path_file
	389	) ;
	390	}
	391
	392	return $self->canonpath( $path ) ;
	393	}
	394
270d1e39	395	=back
270d1e39	396
dd9bbc5b	397	=head2 Note For File::Spec::Win32 Maintainers
	398
	399	Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32.
	400
cbc7acb0	401	=head1 SEE ALSO
	402
	403	L<File::Spec>
270d1e39	404
cbc7acb0	405	=cut
	406
	407	1;