File::Spec->collapse() proof of concept

[Michael G Schwern]

I'm not wedded to the name, but attached is a proof-of-concept of a routine
which collapses updirs.  This is a solution to the problem whether or not
canonpath() should collapse them.  Let the user decide.

0 ~$ perl -w ~/tmp/foo.plx '../../bar'
../../bar
0 ~$ perl -w ~/tmp/foo.plx 'foo/../../bar'
../bar
0 ~$ perl -w ~/tmp/foo.plx '../foo/../../bar'
../../bar
0 ~$ perl -w ~/tmp/foo.plx '/../../../bar'
/bar

There are some problems in Win32 and they look like they're due to 
File::Spec bugs.

0 ~$ perl -w ~/tmp/foo.plx 'C:\foo\..\..\..\bar' Win32
C:bar

This is because:

0 ~$ perl -MFile::Spec::Win32 -wle 'print join "\n", 
File::Spec::Win32->catdir("", "..", "..", "")'

It should be the root dir as it is on Unix.

0 ~$ perl -MFile::Spec::Unix -wle 'print join "\n", 
File::Spec::Unix->catdir("", "..", "..", "")'
/


-- 
Michael G Schwern     [EMAIL PROTECTED]     http://www.pobox.com/~schwern
Reality is that which, when you stop believing in it, doesn't go away.
        -- Phillip K. Dick

#!/usr/bin/perl -lw

use File::Spec;
use File::Spec::Unix;

package File::Spec::Unix;

sub collapse {
    my($fs, $path) = @_;

    my $updir  = $fs->updir;
    my $curdir = $fs->curdir;

    my($vol, $dirs, $file) = $fs->splitpath($path);
    my @dirs = $fs->splitdir($dirs);

    my @collapsed;
    push @collapsed, $curdir unless $fs->file_name_is_absolute($path);

    foreach my $dir (@dirs) {
        if( $dir eq $updir              and   # if we have an updir
            @collapsed                  and   # and something to collapse
            length $collapsed[-1]       and   # and its not the rootdir
            $collapsed[-1] ne $updir    and   # nor another updir
            $collapsed[-1] ne $curdir         # nor the curdir
          ) 
        {                                     # then
            pop @collapsed;                   # collapse
        }
        else {                                # else
            push @collapsed, $dir;            # just hang onto it
        }
    }

    return $fs->catpath($vol,
                        $fs->catdir(@collapsed),
                        $file
                       );
}

package main;

my($path, $os) = @ARGV;
$os ||= '';

my $class = 'File::Spec';
$class .= "::$os" if $os;
eval qq{require $class};

print $class->collapse($path);