#!/bin/sh -- # A comment mentioning perl
eval 'exec perl -S $0 ${1+"$@"}'
        if 0;

$Usage = <<"END";

cleanpath: try to resolve away /../  /./ and //// from paths.

usage: cleanpath [-d] [-a] [<path1>, ...]

reads from stdin if no paths supplied on cmdline.
-a always return absolute paths, apply `pwd` if relative.
-d debug mode prints OLD: ... NEW: lines for each path.
END

if ( $ARGV[0] =~ '^-(h|help)$' ) {
	print $Usage;
	exit 0;
}

if ( $ARGV[0] eq '-d' ) {	# kludge: skip getopts, must have -d first.
	$debug = 1;
	shift;
}
if ( $ARGV[0] eq '-a' ) {
	$absolute = 1;
	shift;
}

if ( @ARGV ) {
	foreach $path (@ARGV) {
		&process($path);
	}
} else {
	# read paths from stdin
	while (<STDIN>) {
		chomp($path = $_);
		&process($path);
	}
}

exit 0;

######################################################################

sub process {
	my($path) = @_;
	if ( $absolute && $path !~ m,^/, ) {
		chomp($PWD = `pwd`) if $PWD eq '';
		$path = "$PWD/$path";
	}
	print STDOUT "OLD: $path\nNEW: " if $debug;
	print STDOUT &remove_dotdots($path), "\n";
	return;
}

sub remove_dotdots {
	##############################################################
	# Resolve /../, /./, /// references from a PATH
	##############################################################
	my ($path) = @_;

	my (@old, @new, $segment);

	my $pre  = '';
	my $post = '';

	# Remove and record leading or trailing slashes.

	if ( $path =~ m,^/+, ) {	# leading /
		$path = $';
		$pre = '/';
	}
	if ( $path =~ m,/+$, ) {	# trailing /
		$path = $`;
		$post = '/';
	}

	foreach $segment (split(/\//, $path)) {	# split on /'s
		next if $segment eq '.';	# skip /./
		next if $segment eq '';		# skip //

		push(@old, $segment);		# push seg onto path list
	}

	# Loop over each segment, backtracking '..' references.
	@new = ();
	foreach $segment (@old) {
		if ( $segment eq '..' ) {
			# if there is something to pop off, pop it:
			pop(@new) if @new != 0;
			next;
		}
		# otherwise, push on the component onto the list:
		push(@new, $segment);
	}

	# Restore leading and trailing slashes (if any).
	$path = $pre . join('/', @new) . $post;

	# fix rare case: pre/post lead to "//", i.e. when @new is empty
	$path =~ s,/+,/,g;  # cleans all multi /'s to a single /
	return $path;
}