leocharre has asked for the wisdom of the Perl Monks concerning the following question:

I want to resolve a path like '/this/that/../instead/here/' to '/this/instead/here'.

Cwd::abs_path() will do it. It will also resolve symlinks. Which I foresee a possible problem with in the future, for what I am working on.

What I think I need is some way to resolve a path without resolving symlinks.. I looked at File::Spec::Functions 'canonpath', it cleans things up a bit- but that's all.

I was playing with the following script, but I don't trust my imperfect mind's ability to do this right..

use Test::Simple 'no_plan';
use strict;
#use File::Spec::Functions;
use constant DEBUG => 1;
my $p = {
# mess is      =>     should be
'/self/xplanatori' => '/self/xplanatori',
'/usr/lib/perl5/../../' => '/usr',
'/home/fake4/../fake/' => '/home/fake',
'/resolve/me/../right/' => '/resolve/right',
'/./resolve////me/../right/.' => '/resolve/right',
'/../.././usr/././.' => '/usr',
'/../.././////././.' => '/',
'/.....' => '/.....',
'.///../' =>'/'
};

#map { ok( canonpath($_) eq $p->{$_}, "$_" )   } keys %$p;

map { ok( abs_path2($_) eq $p->{$_}, "[$_]" )   } keys %$p;



sub abs_path2 {
    my $path = shift;
    print STDERR " [$path]\n" if DEBUG;

    $path=~s/(?<=\/)\.(?=\/|\z)/\//sg; # /./ or /. to /    
    print STDERR " [$path]\n" if DEBUG;

    1 while $path=~s/[^\/]+\/+\.\.[\/|\Z]*//g; # anything/../ to /
    print STDERR " [$path]\n" if DEBUG;

    
    $path=~s/\/{2,}/\//g; # /// to /
    $path=~s/(?<=.)\/+$//g; # a/ to a

    print STDERR " [$path]\n" if DEBUG;
    return $path;
}

[download]

Any suggestions?

Replies are listed 'Best First'.
Re: cleaning up absolute path without resolving symlinks
by johngg (Canon) on Mar 06, 2007 at 22:47 UTC
    I've used this routine in the past. It seems to work with your data.

    use strict;
use warnings;

my @paths = qw{
   /self/xplanatori
   /usr/lib/perl5/../../
   /home/fake4/../fake/
   /resolve/me/../right/
   /./resolve////me/../right/.
   /../.././usr/././.
   /../.././////././.
   /.....
   .///../};

print qq{@{[cleanPath($_)]}\n} for @paths;

#   ---------
sub cleanPath
#   ---------
{
    my $absPath = shift;
    return $absPath if $absPath =~ m{^/$};
    my @elems = split m{/}, $absPath;
    my $ptr = 1;
    while($ptr <= $#elems)
    {
        if($elems[$ptr] eq q{})
        {
            splice @elems, $ptr, 1;
        }
        elsif($elems[$ptr] eq q{.})
        {
            splice @elems, $ptr, 1;
        }
        elsif($elems[$ptr] eq q{..})
        {
            if($ptr < 2)
            {
                splice @elems, $ptr, 1;
            }
            else
            {
                $ptr--;
                splice @elems, $ptr, 2;
            }
        }
        else
        {
            $ptr++;
        }
    }
    return $#elems ? join q{/}, @elems : q{/};
}

    [download]

    Here's the output.

    /self/xplanatori
/usr
/home/fake
/resolve/right
/resolve/right
/usr
/
/.....
/

    [download]

    I hope this is of interest.

    Cheers,

    JohnGG

[reply]
[d/l]
[select]
Re: cleaning up absolute path without resolving symlinks
by merlyn (Sage) on Mar 06, 2007 at 16:19 UTC
    What does it mean to "clean up a path without resolving symlinks?" To me that says "I want to clean up a path, but incorrectly". What's your application for cleaning up things incorrectly? In other words, what are you working on that has you say "Which I foresee a possible problem with in the future, for what I am working on".

    -- Randal L. Schwartz, Perl hacker

[reply]

      My application serves files to users via a web interface.

      When a user is authenticated, the application instance has to be confined to the user's assigned parts of the filesystem hierarchy.

      First there is the hierarchy of what the application can access, say, '/serve/files'.

      Then there is the hierarchy (filesystem tree slice(?)) That user x is given access to; '/serve/files/a' and '/serve/files/b'.

      When the application asks to do something to /serve/files/g, it should recognize that this is not one of the places that the current instance of this application (the user) can access.

      The ammount of data is large and I foresee it getting much larger. So, mounting will happen.

      I need to know that file /serve/files/a/this is first and foremost within '/serve/files'. But /serve/files/a might someday be mounted, as may serve/files/b and serve/files/c, and from different drives.

      (I have fantasized about just making each 'user' a real user on the system (linux) and taking it from there. Which seems sensible to me- but freaks out my co-workers. It's been pretty much decided that it would be too.. iffy? complex? Or leave too many security holes open; to do that. So I have to mimic a filesystem, somewhat.)

[reply]
        I'm not seeing where the symlinks fit in. Mounting separate volumes should be transparent to file system users like your application, shouldn't they? i.e. if you mount /serve/files/b from a remote disk, shouldn't it still just look like /serve/files/b, no symlink involved? Or are you implying a symlink somewhere else?
[reply]
Re: cleaning up absolute path without resolving symlinks
by Moron (Curate) on Mar 06, 2007 at 16:37 UTC
    (untested) 
    sub Resolve {
    my @stack = $_[0] =~ /^\./ ? split /\/, $ENV{ PWD } : ();
    join '/',
        map { ( $_ eq '..' ) ? pop @stack : ( $_ ne '.' )
          && ( push @stack, $_);  } split /\/, $_[0];
}

    [download]

    -M

    Free your mind

[reply]
[d/l]

      Depending on how cross-platform you need to be, you might use updir() and related functions from File::Spec instead of ...

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom