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

package File::Spec::Mac;

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

=head1 NAME

File::Spec::Mac - File::Spec for MacOS

=head1 SYNOPSIS

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

=head1 DESCRIPTION

Methods for manipulating file specifications.

=head1 METHODS

=over 2

=item canonpath

On MacOS, there's nothing to be done.  Returns what it's given.

=cut

sub canonpath {
    my ($self,$path) = @_;
    return $path;
}

=item catdir

Concatenate two or more directory names to form a complete path ending with 
a directory.  Put a trailing : on the end of the complete path if there 
isn't one, because that's what's done in MacPerl's environment.

The fundamental requirement of this routine is that

	  File::Spec->catdir(split(":",$path)) eq $path

But because of the nature of Macintosh paths, some additional 
possibilities are allowed to make using this routine give reasonable results 
for some common situations.  Here are the rules that are used.  Each 
argument has its trailing ":" removed.  Each argument, except the first,
has its leading ":" removed.  They are then joined together by a ":".

So

	  File::Spec->catdir("a","b") = "a:b:"
	  File::Spec->catdir("a:",":b") = "a:b:"
	  File::Spec->catdir("a:","b") = "a:b:"
	  File::Spec->catdir("a",":b") = "a:b"
	  File::Spec->catdir("a","","b") = "a::b"

etc.

To get a relative path (one beginning with :), begin the first argument with :
or put a "" as the first argument.

If you don't want to worry about these rules, never allow a ":" on the ends 
of any of the arguments except at the beginning of the first.

Under MacPerl, there is an additional ambiguity.  Does the user intend that

	  File::Spec->catfile("LWP","Protocol","http.pm")

be relative or absolute?  There's no way of telling except by checking for the
existence of LWP: or :LWP, and even there he may mean a dismounted volume or
a relative path in a different directory (like in @INC).   So those checks
aren't done here. This routine will treat this as absolute.

=cut

sub catdir {
    shift;
    my @args = @_;
    my $result = shift @args;
    $result =~ s/:\z//;
    foreach (@args) {
	s/:\z//;
	s/^://s;
	$result .= ":$_";
    }
    return "$result:";
}

=item catfile

Concatenate one or more directory names and a filename to form a
complete path ending with a filename.  Since this uses catdir, the
same caveats apply.  Note that the leading : is removed from the filename,
so that 

	  File::Spec->catfile($ENV{HOME},"file");

and

	  File::Spec->catfile($ENV{HOME},":file");

give the same answer, as one might expect.

=cut

sub catfile {
    my $self = shift;
    my $file = pop @_;
    return $file unless @_;
    my $dir = $self->catdir(@_);
    $file =~ s/^://s;
    return $dir.$file;
}

=item curdir

Returns a string representing the current directory.

=cut

sub curdir {
    return ":";
}

=item devnull

Returns a string representing the null device.

=cut

sub devnull {
    return "Dev:Null";
}

=item rootdir

Returns a string representing the root directory.  Under MacPerl,
returns the name of the startup volume, since that's the closest in
concept, although other volumes aren't rooted there.

=cut

sub rootdir {
#
#  There's no real root directory on MacOS.  The name of the startup
#  volume is returned, since that's the closest in concept.
#
    require Mac::Files;
    my $system =  Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
					 &Mac::Files::kSystemFolderType);
    $system =~ s/:.*\z/:/s;
    return $system;
}

=item tmpdir

Returns a string representation of the first existing directory
from the following list or '' if none exist:

    $ENV{TMPDIR}

=cut

my $tmpdir;
sub tmpdir {
    return $tmpdir if defined $tmpdir;
    $tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
    $tmpdir = '' unless defined $tmpdir;
    return $tmpdir;
}

=item updir

Returns a string representing the parent directory.

=cut

sub updir {
    return "::";
}

=item file_name_is_absolute

Takes as argument a path and returns true, if it is an absolute path.  In 
the case where a name can be either relative or absolute (for example, a 
folder named "HD" in the current working directory on a drive named "HD"), 
relative wins.  Use ":" in the appropriate place in the path if you want to
distinguish unambiguously.

=cut

sub file_name_is_absolute {
    my ($self,$file) = @_;
    if ($file =~ /:/) {
	return ($file !~ m/^:/s);
    } else {
	return (! -e ":$file");
    }
}

=item path

Returns the null list for the MacPerl application, since the concept is 
usually meaningless under MacOS. But if you're using the MacPerl tool under 
MPW, it gives back $ENV{Commands} suitably split, as is done in 
:lib:ExtUtils:MM_Mac.pm.

=cut

sub path {
#
#  The concept is meaningless under the MacPerl application.
#  Under MPW, it has a meaning.
#
    return unless exists $ENV{Commands};
    return split(/,/, $ENV{Commands});
}

=item splitpath

=cut

sub splitpath {
    my ($self,$path, $nofile) = @_;

    my ($volume,$directory,$file) = ('','','');

    if ( $nofile ) {
        ( $volume, $directory ) = $path =~ m@((?:[^:]+(?::|\z))?)(.*)@s;
    }
    else {
        $path =~ 
            m@^( (?: [^:]+: )? ) 
                ( (?: .*: )? )
                ( .* )
             @xs;
        $volume    = $1;
        $directory = $2;
        $file      = $3;
    }

    # Make sure non-empty volumes and directories end in ':'
    $volume    .= ':' if $volume    =~ m@[^:]\z@ ;
    $directory .= ':' if $directory =~ m@[^:]\z@ ;
    return ($volume,$directory,$file);
}


=item splitdir

=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

=cut

sub catpath {
    my $self = shift ;

    my $result = shift ;
    $result =~ s@^([^/])@/$1@s ;

    my $segment ;
    for $segment ( @_ ) {
        if ( $result =~ m@[^/]\z@ && $segment =~ m@^[^/]@s ) {
            $result .= "/$segment" ;
        }
        elsif ( $result =~ m@/\z@ && $segment =~ m@^/@s ) {
            $result  =~ s@/+\z@/@;
            $segment =~ s@^/+@@s;
            $result  .= "$segment" ;
        }
        else {
            $result  .= $segment ;
        }
    }

    return $result ;
}

=item abs2rel

=cut

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

    # Clean up $path
    if ( ! $self->file_name_is_absolute( $path ) ) {
        $path = $self->rel2abs( $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 ) ;
    }

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

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

    $path = join( ':', @pathchunks );

    # @basechunks now contains the number of directories to climb out of.
    $base = ':' x @basechunks ;

    return "$base:$path" ;
}

=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()> 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()>.

On systems with the concept of a volume, this 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 ) ;
        }

        $path = $self->canonpath("$base$path") ;
    }

    return $path ;
}


=back

=head1 SEE ALSO

L<File::Spec>

=cut

1;
Commit	Line	Data
270d1e39	1	package File::Spec::Mac;
270d1e39	2
270d1e39	3	use strict;
cbc7acb0	4	use vars qw(@ISA);
cbc7acb0	5	require File::Spec::Unix;
270d1e39	6	@ISA = qw(File::Spec::Unix);
270d1e39	7
	8	=head1 NAME
	9
	10	File::Spec::Mac - File::Spec for MacOS
	11
	12	=head1 SYNOPSIS
	13
cbc7acb0	14	require File::Spec::Mac; # Done internally by File::Spec if needed
270d1e39	15
	16	=head1 DESCRIPTION
	17
	18	Methods for manipulating file specifications.
	19
	20	=head1 METHODS
	21
	22	=over 2
	23
	24	=item canonpath
	25
	26	On MacOS, there's nothing to be done. Returns what it's given.
	27
	28	=cut
	29
	30	sub canonpath {
cbc7acb0	31	my ($self,$path) = @_;
cbc7acb0	32	return $path;
270d1e39	33	}
	34
	35	=item catdir
	36
	37	Concatenate two or more directory names to form a complete path ending with
	38	a directory. Put a trailing : on the end of the complete path if there
	39	isn't one, because that's what's done in MacPerl's environment.
	40
	41	The fundamental requirement of this routine is that
	42
	43	File::Spec->catdir(split(":",$path)) eq $path
	44
	45	But because of the nature of Macintosh paths, some additional
8dcee03e	46	possibilities are allowed to make using this routine give reasonable results
270d1e39	47	for some common situations. Here are the rules that are used. Each
	48	argument has its trailing ":" removed. Each argument, except the first,
	49	has its leading ":" removed. They are then joined together by a ":".
	50
	51	So
	52
	53	File::Spec->catdir("a","b") = "a:b:"
	54	File::Spec->catdir("a:",":b") = "a:b:"
	55	File::Spec->catdir("a:","b") = "a:b:"
	56	File::Spec->catdir("a",":b") = "a:b"
	57	File::Spec->catdir("a","","b") = "a::b"
	58
	59	etc.
	60
	61	To get a relative path (one beginning with :), begin the first argument with :
	62	or put a "" as the first argument.
	63
	64	If you don't want to worry about these rules, never allow a ":" on the ends
	65	of any of the arguments except at the beginning of the first.
	66
	67	Under MacPerl, there is an additional ambiguity. Does the user intend that
	68
	69	File::Spec->catfile("LWP","Protocol","http.pm")
	70
	71	be relative or absolute? There's no way of telling except by checking for the
8dcee03e	72	existence of LWP: or :LWP, and even there he may mean a dismounted volume or
270d1e39	73	a relative path in a different directory (like in @INC). So those checks
	74	aren't done here. This routine will treat this as absolute.
	75
	76	=cut
	77
270d1e39	78	sub catdir {
	79	shift;
	80	my @args = @_;
cbc7acb0	81	my $result = shift @args;
1b1e14d3	82	$result =~ s/:\z//;
cbc7acb0	83	foreach (@args) {
1b1e14d3	84	s/:\z//;
1b1e14d3	85	s/^://s;
cbc7acb0	86	$result .= ":$_";
270d1e39	87	}
cbc7acb0	88	return "$result:";
270d1e39	89	}
	90
	91	=item catfile
	92
	93	Concatenate one or more directory names and a filename to form a
	94	complete path ending with a filename. Since this uses catdir, the
	95	same caveats apply. Note that the leading : is removed from the filename,
	96	so that
	97
	98	File::Spec->catfile($ENV{HOME},"file");
	99
	100	and
	101
	102	File::Spec->catfile($ENV{HOME},":file");
	103
	104	give the same answer, as one might expect.
	105
	106	=cut
	107
	108	sub catfile {
cbc7acb0	109	my $self = shift;
270d1e39	110	my $file = pop @_;
	111	return $file unless @_;
	112	my $dir = $self->catdir(@_);
1b1e14d3	113	$file =~ s/^://s;
270d1e39	114	return $dir.$file;
	115	}
	116
	117	=item curdir
	118
cbc7acb0	119	Returns a string representing the current directory.
270d1e39	120
	121	=cut
	122
	123	sub curdir {
cbc7acb0	124	return ":";
	125	}
	126
	127	=item devnull
	128
	129	Returns a string representing the null device.
	130
	131	=cut
	132
	133	sub devnull {
	134	return "Dev:Null";
270d1e39	135	}
	136
	137	=item rootdir
	138
	139	Returns a string representing the root directory. Under MacPerl,
	140	returns the name of the startup volume, since that's the closest in
cbc7acb0	141	concept, although other volumes aren't rooted there.
270d1e39	142
	143	=cut
	144
	145	sub rootdir {
	146	#
cbc7acb0	147	# There's no real root directory on MacOS. The name of the startup
cbc7acb0	148	# volume is returned, since that's the closest in concept.
270d1e39	149	#
cbc7acb0	150	require Mac::Files;
	151	my $system = Mac::Files::FindFolder(&Mac::Files::kOnSystemDisk,
	152	&Mac::Files::kSystemFolderType);
14a089c5	153	$system =~ s/:.*\z/:/s;
cbc7acb0	154	return $system;
	155	}
	156
	157	=item tmpdir
	158
	159	Returns a string representation of the first existing directory
	160	from the following list or '' if none exist:
	161
	162	$ENV{TMPDIR}
	163
	164	=cut
	165
	166	my $tmpdir;
	167	sub tmpdir {
	168	return $tmpdir if defined $tmpdir;
	169	$tmpdir = $ENV{TMPDIR} if -d $ENV{TMPDIR};
	170	$tmpdir = '' unless defined $tmpdir;
	171	return $tmpdir;
270d1e39	172	}
	173
	174	=item updir
	175
	176	Returns a string representing the parent directory.
	177
	178	=cut
	179
	180	sub updir {
	181	return "::";
	182	}
	183
	184	=item file_name_is_absolute
	185
	186	Takes as argument a path and returns true, if it is an absolute path. In
	187	the case where a name can be either relative or absolute (for example, a
	188	folder named "HD" in the current working directory on a drive named "HD"),
	189	relative wins. Use ":" in the appropriate place in the path if you want to
	190	distinguish unambiguously.
	191
	192	=cut
	193
	194	sub file_name_is_absolute {
cbc7acb0	195	my ($self,$file) = @_;
cbc7acb0	196	if ($file =~ /:/) {
1b1e14d3	197	return ($file !~ m/^:/s);
cbc7acb0	198	} else {
cbc7acb0	199	return (! -e ":$file");
270d1e39	200	}
	201	}
	202
	203	=item path
	204
	205	Returns the null list for the MacPerl application, since the concept is
	206	usually meaningless under MacOS. But if you're using the MacPerl tool under
	207	MPW, it gives back $ENV{Commands} suitably split, as is done in
	208	:lib:ExtUtils:MM_Mac.pm.
	209
	210	=cut
	211
	212	sub path {
	213	#
	214	# The concept is meaningless under the MacPerl application.
	215	# Under MPW, it has a meaning.
	216	#
cbc7acb0	217	return unless exists $ENV{Commands};
cbc7acb0	218	return split(/,/, $ENV{Commands});
270d1e39	219	}
270d1e39	220
0994714a	221	=item splitpath
	222
	223	=cut
	224
	225	sub splitpath {
	226	my ($self,$path, $nofile) = @_;
	227
	228	my ($volume,$directory,$file) = ('','','');
	229
	230	if ( $nofile ) {
14a089c5	231	( $volume, $directory ) = $path =~ m@((?:[^:]+(?::\|\z))?)(.*)@s;
0994714a	232	}
	233	else {
	234	$path =~
	235	m@^( (?: [^:]+: )? )
	236	( (?: .*: )? )
	237	( .* )
1b1e14d3	238	@xs;
0994714a	239	$volume = $1;
	240	$directory = $2;
	241	$file = $3;
	242	}
	243
	244	# Make sure non-empty volumes and directories end in ':'
1b1e14d3	245	$volume .= ':' if $volume =~ m@[^:]\z@ ;
1b1e14d3	246	$directory .= ':' if $directory =~ m@[^:]\z@ ;
0994714a	247	return ($volume,$directory,$file);
	248	}
	249
	250
	251	=item splitdir
	252
	253	=cut
	254
	255	sub splitdir {
	256	my ($self,$directories) = @_ ;
	257	#
	258	# split() likes to forget about trailing null fields, so here we
	259	# check to be sure that there will not be any before handling the
	260	# simple case.
	261	#
1b1e14d3	262	if ( $directories !~ m@:\z@ ) {
0994714a	263	return split( m@:@, $directories );
	264	}
	265	else {
	266	#
	267	# since there was a trailing separator, add a file name to the end,
	268	# then do the split, then replace it with ''.
	269	#
	270	my( @directories )= split( m@:@, "${directories}dummy" ) ;
	271	$directories[ $#directories ]= '' ;
	272	return @directories ;
	273	}
	274	}
	275
	276
	277	=item catpath
	278
	279	=cut
	280
	281	sub catpath {
	282	my $self = shift ;
	283
	284	my $result = shift ;
1b1e14d3	285	$result =~ s@^([^/])@/$1@s ;
0994714a	286
	287	my $segment ;
	288	for $segment ( @_ ) {
1b1e14d3	289	if ( $result =~ m@[^/]\z@ && $segment =~ m@^[^/]@s ) {
0994714a	290	$result .= "/$segment" ;
0994714a	291	}
1b1e14d3	292	elsif ( $result =~ m@/\z@ && $segment =~ m@^/@s ) {
	293	$result =~ s@/+\z@/@;
	294	$segment =~ s@^/+@@s;
0994714a	295	$result .= "$segment" ;
	296	}
	297	else {
	298	$result .= $segment ;
	299	}
	300	}
	301
	302	return $result ;
	303	}
	304
	305	=item abs2rel
	306
	307	=cut
	308
	309	sub abs2rel {
	310	my($self,$path,$base) = @_;
	311
	312	# Clean up $path
	313	if ( ! $self->file_name_is_absolute( $path ) ) {
	314	$path = $self->rel2abs( $path ) ;
	315	}
	316
	317	# Figure out the effective $base and clean it up.
	318	if ( !defined( $base ) \|\| $base eq '' ) {
	319	$base = cwd() ;
	320	}
	321	elsif ( ! $self->file_name_is_absolute( $base ) ) {
	322	$base = $self->rel2abs( $base ) ;
	323	}
	324
	325	# Now, remove all leading components that are the same
	326	my @pathchunks = $self->splitdir( $path );
	327	my @basechunks = $self->splitdir( $base );
	328
	329	while (@pathchunks && @basechunks && $pathchunks[0] eq $basechunks[0]) {
	330	shift @pathchunks ;
	331	shift @basechunks ;
	332	}
	333
	334	$path = join( ':', @pathchunks );
	335
	336	# @basechunks now contains the number of directories to climb out of.
	337	$base = ':' x @basechunks ;
	338
	339	return "$base:$path" ;
	340	}
	341
	342	=item rel2abs
	343
	344	Converts a relative path to an absolute path.
	345
	346	$abs_path = $File::Spec->rel2abs( $destination ) ;
	347	$abs_path = $File::Spec->rel2abs( $destination, $base ) ;
	348
	349	If $base is not present or '', then L<cwd()> is used. If $base is relative,
	350	then it is converted to absolute form using L</rel2abs()>. This means that it
	351	is taken to be relative to L<cwd()>.
	352
	353	On systems with the concept of a volume, this assumes that both paths
	354	are on the $base volume, and ignores the $destination volume.
	355
	356	On systems that have a grammar that indicates filenames, this ignores the
	357	$base filename as well. Otherwise all path components are assumed to be
	358	directories.
359
360	If $path is absolute, it is cleaned up and returned using L</canonpath()>.
361
362	Based on code written by Shigio Yamaguchi.
363
364	No checks against the filesystem are made.
365
366	=cut
367
368	sub rel2abs($;$;) {
369	my ($self,$path,$base ) = @_;
370
371	if ( ! $self->file_name_is_absolute( $path ) ) {
372	if ( !defined( $base ) \|\| $base eq '' ) {
373	$base = cwd() ;
374	}
375	elsif ( ! $self->file_name_is_absolute( $base ) ) {
376	$base = $self->rel2abs( $base ) ;
377	}
378	else {
379	$base = $self->canonpath( $base ) ;
380	}
381
382	$path = $self->canonpath("$base$path") ;
383	}
384
385	return $path ;
386	}
387
388
270d1e39	389	=back
	390
	391	=head1 SEE ALSO
	392
	393	L<File::Spec>
	394
	395	=cut
	396
	397	1;