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

package File::Spec::Epoc;

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

=head1 NAME

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

=head1 SYNOPSIS

 require File::Spec::Epoc; # 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.

This package is still work in progress ;-)
o.flebbe@gmx.de


=over 4

=item devnull

Returns a string representation of the null device.

=cut

sub devnull {
    return "nul:";
}

=item tmpdir

Returns a string representation of a temporay directory:

=cut

my $tmpdir;
sub tmpdir {
    return "C:/System/temp";
}

sub case_tolerant {
    return 1;
}

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

=item path

Takes no argument, returns the environment variable PATH as an array. Since
there is no search path supported, it returns undef, sorry.

=cut

sub path {
    return undef;
}

=item canonpath()

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

=cut

sub canonpath {
    my ($self,$path) = @_;
    $path =~ s/^([a-z]:)/\u$1/s;

    $path =~ s|/+|/|g unless($^O eq 'cygwin');     # xx////xx  -> xx/xx
    $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
    $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
    $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
    $path =~ s|/\z|| unless $path eq "/";          # xx/       -> xx
    return $path;
}

=item splitpath

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

Splits a path in to 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, undef ).

Separators accepted are \ and /.

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)?)? )
                (.*)
             }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| ) {
        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@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@s &&
         $volume =~ m@[^\\/]\z@      &&
         $file   =~ m@[^\\/]@
       ) {
        $volume =~ m@([\\/])@ ;
        my $sep = $1 ? $1 : '\\' ;
        $volume .= $sep ;
    }

    $volume .= $file ;

    return $volume ;
}


=item abs2rel

Takes a destination path and an optional base path returns a relative path
from the base path to the destination path:

    $rel_path = File::Spec->abs2rel( $destination ) ;
    $rel_path = File::Spec->abs2rel( $destination, $base ) ;

If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative, 
then it is converted to absolute form using L</rel2abs()>. This means that it
is taken to be relative to L<cwd()|Cwd>.

On systems with the concept of a volume, this assumes that both paths 
are on the $destination volume, and ignores the $base volume.

On systems that have a grammar that indicates filenames, this ignores the 
$base filename as well. Otherwise all path components are assumed to be
directories.

If $path is relative, it is converted to absolute form using L</rel2abs()>.
This means that it is taken to be relative to L<cwd()|Cwd>.

Based on code written by Shigio Yamaguchi.

No checks against the filesystem are made. 

=cut

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 ( ! $self->file_name_is_absolute( $base ) ) {
        $base = $self->rel2abs( $base ) ;
    }
    elsif ( !defined( $base ) || $base eq '' ) {
        $base = cwd() ;
    }
    else {
        $base = $self->canonpath( $base ) ;
    }

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

    my ( undef, $base_directories, undef ) =
        $self->splitpath( $base, 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" ;
    }

    # It makes no sense to add a relative path to a UNC volume
    $path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;

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

=item rel2abs()

Converts a relative path to an absolute path. 

    $abs_path = File::Spec->rel2abs( $destination ) ;
    $abs_path = File::Spec->rel2abs( $destination, $base ) ;

If $base is not present or '', then L<cwd()|Cwd> is used. If $base is relative, 
then it is converted to absolute form using L</rel2abs()>. This means that it
is taken to be relative to L<cwd()|Cwd>.

Assumes that both paths are on the $base volume, and ignores the 
$destination volume. 

On systems that have a grammar that indicates filenames, this ignores the 
$base filename as well. Otherwise all path components are assumed to be
directories.

If $path is absolute, it is cleaned up and returned using L</canonpath()>.

Based on code written by Shigio Yamaguchi.

No checks against the filesystem are made. 

=cut

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 ( undef, $path_directories, $path_file ) =
            $self->splitpath( $path, 1 ) ;

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

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

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

=back

=head1 SEE ALSO

L<File::Spec>

=cut

1;
Commit	Line	Data
fa6a1c44	1	package File::Spec::Epoc;
	2
	3	use strict;
	4	use Cwd;
	5	use vars qw(@ISA);
	6	require File::Spec::Unix;
	7	@ISA = qw(File::Spec::Unix);
	8
	9	=head1 NAME
	10
	11	File::Spec::Epoc - methods for Epoc file specs
	12
	13	=head1 SYNOPSIS
	14
	15	require File::Spec::Epoc; # Done internally by File::Spec if needed
	16
	17	=head1 DESCRIPTION
	18
	19	See File::Spec::Unix for a documentation of the methods provided
	20	there. This package overrides the implementation of these methods, not
	21	the semantics.
	22
	23	This package is still work in progress ;-)
	24	o.flebbe@gmx.de
	25
	26
4ac9195f	27	=over 4
fa6a1c44	28
	29	=item devnull
	30
	31	Returns a string representation of the null device.
	32
	33	=cut
	34
	35	sub devnull {
	36	return "nul:";
	37	}
	38
	39	=item tmpdir
	40
	41	Returns a string representation of a temporay directory:
	42
	43	=cut
	44
	45	my $tmpdir;
	46	sub tmpdir {
	47	return "C:/System/temp";
	48	}
	49
	50	sub case_tolerant {
	51	return 1;
	52	}
	53
	54	sub file_name_is_absolute {
	55	my ($self,$file) = @_;
	56	return scalar($file =~ m{^([a-z?]:)?[\\/]}is);
	57	}
	58
	59	=item path
	60
	61	Takes no argument, returns the environment variable PATH as an array. Since
	62	there is no search path supported, it returns undef, sorry.
	63
	64	=cut
4ac9195f	65
fa6a1c44	66	sub path {
	67	return undef;
	68	}
	69
59605c55	70	=item canonpath()
fa6a1c44	71
	72	No physical check on the filesystem, but a logical cleanup of a
	73	path. On UNIX eliminated successive slashes and successive "/.".
	74
	75	=cut
	76
	77	sub canonpath {
	78	my ($self,$path) = @_;
	79	$path =~ s/^([a-z]:)/\u$1/s;
	80
	81	$path =~ s\|/+\|/\|g unless($^O eq 'cygwin'); # xx////xx -> xx/xx
	82	$path =~ s\|(/\.)+/\|/\|g; # xx/././xx -> xx/xx
	83	$path =~ s\|^(\./)+\|\|s unless $path eq "./"; # ./xx -> xx
	84	$path =~ s\|^/(\.\./)+\|/\|s; # /../../xx -> xx
	85	$path =~ s\|/\z\|\| unless $path eq "/"; # xx/ -> xx
	86	return $path;
	87	}
	88
	89	=item splitpath
	90
	91	($volume,$directories,$file) = File::Spec->splitpath( $path );
	92	($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file );
	93
	94	Splits a path in to volume, directory, and filename portions. Assumes that
	95	the last file is a path unless the path ends in '\\', '\\.', '\\..'
	96	or $no_file is true. On Win32 this means that $no_file true makes this return
	97	( $volume, $path, undef ).
	98
	99	Separators accepted are \ and /.
	100
	101	The results can be passed to L</catpath> to get back a path equivalent to
	102	(usually identical to) the original path.
	103
	104	=cut
	105
	106	sub splitpath {
	107	my ($self,$path, $nofile) = @_;
	108	my ($volume,$directory,$file) = ('','','');
	109	if ( $nofile ) {
	110	$path =~
	111	m{^( (?:[a-zA-Z?]:\|(?:\\\\\|//)[^\\/]+[\\/][^\\/]+)? )
	112	(.*)
	113	}xs;
	114	$volume = $1;
	115	$directory = $2;
	116	}
	117	else {
	118	$path =~
	119	m{^ ( (?: [a-zA-Z?]: \|
	120	(?:\\\\\|//)[^\\/]+[\\/][^\\/]+
	121	)?
	122	)
	123	( (?:.*[\\\\/](?:\.\.?\z)?)? )
	124	(.*)
	125	}xs;
	126	$volume = $1;
	127	$directory = $2;
	128	$file = $3;
	129	}
	130
	131	return ($volume,$directory,$file);
	132	}
	133
	134
135	=item splitdir
136
59605c55	137	The opposite of L<catdir()\|File::Spec/catdir()>.
fa6a1c44	138
	139	@dirs = File::Spec->splitdir( $directories );
	140
	141	$directories must be only the directory portion of the path on systems
	142	that have the concept of a volume or that have path syntax that differentiates
	143	files from directories.
	144
	145	Unlike just splitting the directories on the separator, leading empty and
	146	trailing directory entries can be returned, because these are significant
	147	on some OSs. So,
	148
	149	File::Spec->splitdir( "/a/b/c" );
	150
	151	Yields:
	152
	153	( '', 'a', 'b', '', 'c', '' )
	154
	155	=cut
	156
	157	sub splitdir {
	158	my ($self,$directories) = @_ ;
	159	#
	160	# split() likes to forget about trailing null fields, so here we
	161	# check to be sure that there will not be any before handling the
	162	# simple case.
	163	#
	164	if ( $directories !~ m\|[\\/]\z\| ) {
	165	return split( m\|[\\/]\|, $directories );
	166	}
	167	else {
	168	#
	169	# since there was a trailing separator, add a file name to the end,
	170	# then do the split, then replace it with ''.
	171	#
	172	my( @directories )= split( m\|[\\/]\|, "${directories}dummy" ) ;
	173	$directories[ $#directories ]= '' ;
	174	return @directories ;
	175	}
	176	}
	177
	178
	179	=item catpath
	180
	181	Takes volume, directory and file portions and returns an entire path. Under
	182	Unix, $volume is ignored, and this is just like catfile(). On other OSs,
	183	the $volume become significant.
	184
	185	=cut
	186
	187	sub catpath {
	188	my ($self,$volume,$directory,$file) = @_;
	189
	190	# If it's UNC, make sure the glue separator is there, reusing
	191	# whatever separator is first in the $volume
	192	$volume .= $1
	193	if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\z@s &&
	194	$directory =~ m@^[^\\/]@s
	195	) ;
	196
	197	$volume .= $directory ;
	198
	199	# If the volume is not just A:, make sure the glue separator is
	200	# there, reusing whatever separator is first in the $volume if possible.
	201	if ( $volume !~ m@^[a-zA-Z]:\z@s &&
202	$volume =~ m@[^\\/]\z@ &&
203	$file =~ m@[^\\/]@
204	) {
205	$volume =~ m@([\\/])@ ;
206	my $sep = $1 ? $1 : '\\' ;
207	$volume .= $sep ;
208	}
209
210	$volume .= $file ;
211
212	return $volume ;
213	}
214
215
216	=item abs2rel
217
218	Takes a destination path and an optional base path returns a relative path
219	from the base path to the destination path:
220
221	$rel_path = File::Spec->abs2rel( $destination ) ;
222	$rel_path = File::Spec->abs2rel( $destination, $base ) ;
223
59605c55	224	If $base is not present or '', then L<cwd()\|Cwd> is used. If $base is relative,
fa6a1c44	225	then it is converted to absolute form using L</rel2abs()>. This means that it
59605c55	226	is taken to be relative to L<cwd()\|Cwd>.
fa6a1c44	227
	228	On systems with the concept of a volume, this assumes that both paths
	229	are on the $destination volume, and ignores the $base volume.
	230
	231	On systems that have a grammar that indicates filenames, this ignores the
	232	$base filename as well. Otherwise all path components are assumed to be
	233	directories.
	234
	235	If $path is relative, it is converted to absolute form using L</rel2abs()>.
59605c55	236	This means that it is taken to be relative to L<cwd()\|Cwd>.
fa6a1c44	237
	238	Based on code written by Shigio Yamaguchi.
	239
	240	No checks against the filesystem are made.
	241
	242	=cut
	243
	244	sub abs2rel {
	245	my($self,$path,$base) = @_;
	246
	247	# Clean up $path
	248	if ( ! $self->file_name_is_absolute( $path ) ) {
	249	$path = $self->rel2abs( $path ) ;
	250	}
	251	else {
	252	$path = $self->canonpath( $path ) ;
	253	}
	254
	255	# Figure out the effective $base and clean it up.
	256	if ( ! $self->file_name_is_absolute( $base ) ) {
	257	$base = $self->rel2abs( $base ) ;
	258	}
	259	elsif ( !defined( $base ) \|\| $base eq '' ) {
	260	$base = cwd() ;
	261	}
	262	else {
	263	$base = $self->canonpath( $base ) ;
	264	}
	265
	266	# Split up paths
	267	my ( $path_volume, $path_directories, $path_file ) =
	268	$self->splitpath( $path, 1 ) ;
	269
	270	my ( undef, $base_directories, undef ) =
	271	$self->splitpath( $base, 1 ) ;
	272
	273	# Now, remove all leading components that are the same
	274	my @pathchunks = $self->splitdir( $path_directories );
	275	my @basechunks = $self->splitdir( $base_directories );
	276
	277	while ( @pathchunks &&
	278	@basechunks &&
	279	lc( $pathchunks[0] ) eq lc( $basechunks[0] )
	280	) {
	281	shift @pathchunks ;
	282	shift @basechunks ;
	283	}
	284
	285	# No need to catdir, we know these are well formed.
	286	$path_directories = CORE::join( '\\', @pathchunks );
	287	$base_directories = CORE::join( '\\', @basechunks );
	288
	289	# $base_directories now contains the directories the resulting relative
	290	# path must ascend out of before it can descend to $path_directory. So,
	291	# replace all names with $parentDir
	292
	293	#FA Need to replace between backslashes...
	294	$base_directories =~ s\|[^\\]+\|..\|g ;
	295
	296	# Glue the two together, using a separator if necessary, and preventing an
	297	# empty result.
	298
	299	#FA Must check that new directories are not empty.
	300	if ( $path_directories ne '' && $base_directories ne '' ) {
301	$path_directories = "$base_directories\\$path_directories" ;
302	} else {
303	$path_directories = "$base_directories$path_directories" ;
304	}
305
306	# It makes no sense to add a relative path to a UNC volume
307	$path_volume = '' unless $path_volume =~ m{^[A-Z]:}is ;
308
309	return $self->canonpath(
310	$self->catpath($path_volume, $path_directories, $path_file )
311	) ;
312	}
313
59605c55	314	=item rel2abs()
fa6a1c44	315
	316	Converts a relative path to an absolute path.
	317
	318	$abs_path = File::Spec->rel2abs( $destination ) ;
	319	$abs_path = File::Spec->rel2abs( $destination, $base ) ;
	320
59605c55	321	If $base is not present or '', then L<cwd()\|Cwd> is used. If $base is relative,
fa6a1c44	322	then it is converted to absolute form using L</rel2abs()>. This means that it
59605c55	323	is taken to be relative to L<cwd()\|Cwd>.
fa6a1c44	324
	325	Assumes that both paths are on the $base volume, and ignores the
	326	$destination volume.
	327
	328	On systems that have a grammar that indicates filenames, this ignores the
	329	$base filename as well. Otherwise all path components are assumed to be
	330	directories.
	331
	332	If $path is absolute, it is cleaned up and returned using L</canonpath()>.
	333
	334	Based on code written by Shigio Yamaguchi.
	335
	336	No checks against the filesystem are made.
	337
	338	=cut
	339
	340	sub rel2abs($;$;) {
	341	my ($self,$path,$base ) = @_;
	342
	343	if ( ! $self->file_name_is_absolute( $path ) ) {
	344
	345	if ( !defined( $base ) \|\| $base eq '' ) {
	346	$base = cwd() ;
	347	}
	348	elsif ( ! $self->file_name_is_absolute( $base ) ) {
	349	$base = $self->rel2abs( $base ) ;
	350	}
	351	else {
	352	$base = $self->canonpath( $base ) ;
	353	}
	354
	355	my ( undef, $path_directories, $path_file ) =
	356	$self->splitpath( $path, 1 ) ;
	357
	358	my ( $base_volume, $base_directories, undef ) =
	359	$self->splitpath( $base, 1 ) ;
	360
	361	$path = $self->catpath(
	362	$base_volume,
	363	$self->catdir( $base_directories, $path_directories ),
	364	$path_file
	365	) ;
	366	}
	367
	368	return $self->canonpath( $path ) ;
	369	}
	370
	371	=back
	372
	373	=head1 SEE ALSO
	374
	375	L<File::Spec>
	376
	377	=cut
	378
	379	1;