[MacPerl-Porters] A new catdir() for review/discussion

Hi,

I've implemented a new catdir(), which should be much more compatible to the Unix version. Compatibility was the main goal. So I've made one decision, that may (or not :) be a bit odd at the first glance -- but nonetheless makes sense, IMHO. As discussed earlier on p5p, MP-Porters etc., when an empty string is passed as the first argument, the resulting path should be absolute.

In theory, this sounds clear. But when it gets to coding, the decision has to be made what happens with calls like

    catdir('', '::')             or
    catdir('', ':a','b:') 

Obviously, the resulting path can't simply be made absolute, especially in the first example. Hence, I'd suggest, that an empty string when passed as the first argument is treated as File::Spec->rootdir, which on Unix is "/", and on Mac OS is the startup volume. This is the most portable way for solving this absolute path problem I can think of. Comments welcome.

In the following, there are some explanations for the rules used in catdir_new(). It might well be that I've missed something (although I don't think so :). I've also included the code for catdir_new(), which can be copy&paste'd into File::Spec::Mac. Finally, there are some test cases with results, which can be reviewed without actually running catdir_new(). In case this new catdir() fits our needs, I will prepare a proper patch, i.e. add some documentation, update splitdir() if need be, add test cases etc. Your opinion is much appreciated.


# catdir_new()
#
# Here are the rules used in catdir_new():
#	 
# 	1) 	The resulting path is RELATIVE by default, i.e. the resulting path will have a 
#		leading colon.
#
#	2)	A trailing colon is added automatically to the resulting path, to denote a 
#		directory.
#
# 	3)	Generally, each argument has one leading ":" and one trailing ":" removed (if 
#		any). They are then joined together by a ":". Special treatment applies for 
#		arguments denoting updir paths like '::lib:', see (4), or arguments consisting 
#		solely of colons ("colon paths"), see (5).
#
#	4) 	When an updir path like ':::lib::' is passed as argument, the number of  
#		directories to climb up is handled correctly, not removing leading or trailing
#		colons when necessary. E.g.
#
#			catdir(':::a', '::b', 'c') = ':::a::b:c:'
#			catdir(':::a::', '::b', 'c') = ':::a:::b:c:'
#
# 	5) 	Adding a colon ':' or empty string '' to a path at _any_ position doesn't 
#		alter the path, i.e. these arguments are ignored. (When a '' is passed as 
#		the first argument, it has a special meaning, see (6). This way, a colon 
#		':' is handled like a '.' (curdir) on Unix, while an empty string '' is
#		generally ignored (see Unix->canonpath). Likewise, a '::' is handled like a 
#		'..' (updir), and a ':::' is handled like a '../..' etc.  E.g.
#
#			catdir('a', ':', ':', 'b') = ':a:b:'
#			catdir('a', ':', '::', ':b') = ':a::b:'
#
#	6)	If the first argument is an empty string '' or is a volume name, i.e. matches 
#		the pattern /^[^:]+:/, the resulting path is ABSOLUTE. 
#
#	7)	Passing an empty string '' as the first argument to catdir() is like passing 
#		File::Spec->rootdir as the first argument, i.e.
#
#			catdir ('', 'a', 'b')
#
#		is the same as
#
#			catdir (rootdir, 'a', 'b'). 
#
#		This is true on Unix, where catdir ('', 'a', b) yields "/a/b" and rootdir is  
#		'/'. Note that rootdir on Mac OS is the startup volume, which is the closest  
#		in concept to Unix' "/". This is done due to portability reasons.
#
#	8)	For absolute paths, some cleanup is done, to ensure that the volume name isn't
#		immediately followed by updirs. This is invalid, because this would go beyond 
#		"root". Generally, these cases are handled like their Unix counterparts:
#
#		Unix:
#			Unix->catdir('','')  =  "/"		
# 			Unix->catdir('','.')  =  "/"
# 			Unix->catdir('','..') =  "/" 					# can't go beyond root
#			Unix->catdir('','.', '..', '..', a)  =  "/a"
#		Mac:
#			Mac->catdir('','')  =  rootdir (e.g. "MacintoshHD:")
# 			Mac->catdir('',':')  =  rootdir
# 			Mac->catdir('','::') =  rootdir					# can't go beyond root
#			Mac->catdir ('',':', '::', '::', a)  =  rootdir . 'a:' (e.g. "MacintoshHD:a:")
#		
#		However, this approach is limited to the first arguments following "root" (again see
#		Unix->canonpath). If there are more arguments that move up the directory tree, an 
#		invalid path going beyond root can be created. 
#

sub catdir_new {
    my $self = shift;	
	return '' unless @_;	
    my @args = @_;
    my $first_arg;	
	my $relative;	
	
	# take care of the first argument
	
	if ($args[0] eq '')  { # absolute path, rootdir
		shift @args;
		$relative = 0;
		$first_arg = $self->rootdir;
	
	} elsif ($args[0] =~ /^[^:]+:/) { # absolute path, volume name
		$relative = 0;
		$first_arg = shift @args;
		
	} else { # relative path
		$relative = 1;
		if ( $args[0] =~ /^::+\Z(?!\n)/ ) { 
			# updir colon path ('::', ':::' etc.), don't shift
			$first_arg = ':';
		} else {
			if ($args[0] eq ':') {
				$first_arg = shift @args;
			} else {
				# add a trailing ':' if need be
				$first_arg = shift @args;
				$first_arg = "$first_arg:" unless ($first_arg =~ /:\Z(?!\n)/);
			}
		} 
	}	
		
	# For all other arguments,    
	# (a) ignore arguments that equal ':' or '',
	# (b) handle updir paths specially:
	#     '::' 			-> concatenate '::'
	#     '::' . '::' 	-> concatenate ':::' etc.
	# (c) add a trailing ':' if need be
	
	my $result = $first_arg;
	while (@args) {
		my $arg = shift @args;
		unless (($arg eq '') || ($arg eq ':')) {
			if ($arg =~ /^::+\Z(?!\n)/ ) { # updir colon path like ':::'
				my $updir_count = length($arg) - 1;
				while ((@args) && ($args[0] =~ /^::+\Z(?!\n)/) ) { # while updir colon path
					$arg = shift @args; 
					$updir_count += (length($arg) - 1);
				}
				$arg = (':' x $updir_count); 
			} else {
				$arg =~ s/^://s; # remove a leading ':' if any
				$arg = "$arg:" unless ($arg =~ /:\Z(?!\n)/); # ensure trailing ':'
			}
			$result .= $arg;
		}#unless
    }
	
	if ( ($relative) && ($result !~ /^:/) ) {   
		# add a leading colon if need be
		$result = ":$result";
	}
	
	unless ($relative) { 
		# remove updirs immediately following the volume name
		$result =~ s/([^:]+:)(:*)(.*)\Z(?!\n)/$1$3/;
	}
	
    return $result;
} #catdir_new




And here are the test cases; note that File::Spec::Mac->rootdir() is 'MacintoshHD:' here on my Mac:

Mac->catdir_new() = ''
Mac->catdir_new('') = 'MacintoshHD:'
Mac->catdir_new(':') = ':'
Mac->catdir_new('', '') = 'MacintoshHD:'
Mac->catdir_new('', ':') = 'MacintoshHD:'
Mac->catdir_new(':', ':') = ':'
Mac->catdir_new(':', '') = ':'
Mac->catdir_new('', '::') = 'MacintoshHD:'
Mac->catdir_new(':', '::') = '::'
Mac->catdir_new('::', '') = '::'
Mac->catdir_new('::', ':') = '::'
Mac->catdir_new('::', '::') = ':::'
Mac->catdir_new('::', ':::', '::') = ':::::'
Mac->catdir_new('::', ':::', '::', ':') = ':::::'
Mac->catdir_new(':', '::', ':::', '::') = ':::::'
Mac->catdir_new(':', '::', ':::', '::', ':') = ':::::'
Mac->catdir_new('::', 'a', 'b', '::') = '::a:b::'
Mac->catdir_new('::', 'a', '::', ':b:', '::') = '::a::b::'
Mac->catdir_new('::', 'a:', '::', ':b:', '::') = '::a::b::'
Mac->catdir_new('::', ':a', '::', ':b', '::') = '::a::b::'
Mac->catdir_new('::', ':a:', '::', ':b', '::') = '::a::b::'
Mac->catdir_new('a', '::', '::') = ':a:::'
Mac->catdir_new('a', '::', '::', 'b:',) = ':a:::b:'
Mac->catdir_new('a', ':', '::', ':b',) = ':a::b:'
Mac->catdir_new('a', ':', ':', 'b',) = ':a:b:'
Mac->catdir_new('a', ':', ':', ':b:',) = ':a:b:'
Mac->catdir_new('', ':::a', ':', ':', '::b',) = 'MacintoshHD:a::b:'
Mac->catdir_new(':::a', ':', ':', '::b',) = ':::a::b:'
Mac->catdir_new(':::a::', '::b', 'c') = ':::a:::b:c:'
Mac->catdir_new(':a', ':', ':', '::b',) = ':a::b:'
Mac->catdir_new(':', 'a::', ':', ':', 'b',) = ':a::b:'
Mac->catdir_new('', ':a', ':', ':', ':','b:',) = 'MacintoshHD:a:b:'
Mac->catdir_new('', '::a', ':', ':', ':','b:',) = 'MacintoshHD:a:b:'
Mac->catdir_new(':', ':a', ':', ':',':', 'b',) = ':a:b:'
Mac->catdir_new(':d1','d2') = ':d1:d2:'
Mac->catdir_new('','d1','d2','d3') = 'MacintoshHD:d1:d2:d3:'
Mac->catdir_new('','','d2','d3') = 'MacintoshHD:d2:d3:'
Mac->catdir_new('','','','d3') = 'MacintoshHD:d3:'
Mac->catdir_new(':d1') = ':d1:'
Mac->catdir_new(':d1',':d2') = ':d1:d2:'
Mac->catdir_new('', ':d1',':d2') = 'MacintoshHD:d1:d2:'
Mac->catdir_new('','',':d1',':d2') = 'MacintoshHD:d1:d2:'
Mac->catdir_new('hd') = ':hd:'
Mac->catdir_new('hd','d1','d2') = ':hd:d1:d2:'
Mac->catdir_new('hd','d1/','d2') = ':hd:d1/:d2:'
Mac->catdir_new('hd','',':d1') = ':hd:d1:'
Mac->catdir_new('hd','d1') = ':hd:d1:'
Mac->catdir_new('hd','d1', '') = ':hd:d1:'
Mac->catdir_new('hd','d1','','') = ':hd:d1:'
Mac->catdir_new('hd:',':d1') = 'hd:d1:'
Mac->catdir_new('hd:d1:',':d2') = 'hd:d1:d2:'
Mac->catdir_new('hd:','d1') = 'hd:d1:'
Mac->catdir_new('hd',':d1') = ':hd:d1:'
Mac->catdir_new('hd:d1:',':d2') = 'hd:d1:d2:'
Mac->catdir_new('hd:d1:',':d2:') = 'hd:d1:d2:'



Best regards,

--Thomas




_________________________________________________________
Do You Yahoo!?
Get your free @yahoo.com address at http://mail.yahoo.com