On Jul 3, 4:38 pm, [EMAIL PROTECTED] (Rob Dixon) wrote:
> > Pardon me for being dense, but I can't figure out a case where
>
> >>       if ($path[-1] eq '..') {
>
> > would ever be true.
>
> My intention was to preserve relative paths starting with '..', but I got it
> wrong. Here's V2.
>
> Rob
>
> sub canonical_path {
>
>   my $path = shift;
>   my @path;
>
>   foreach (File::Spec->splitdir($path)) {
>
>     next if $_ eq '.';
>
>     if ($_ eq '..' and @path and $path[-1] ne '..') {
>       pop @path;
>     }
>     else {
>       push @path, $_;
>     }
>   }
>
>   File::Spec->catdir(@path);
>
> }

At the risk of splitting hairs. (Your code is similar,
but superior, to what I was playing around with ...)

#!/usr/local/bin/perl
use warnings;
use strict;

use File::Spec;
use Test::More 'no_plan';

# as expected?
my @tests = qw(
    /              /
    ..             ..
    ../..          ../..
    ./..           ..
    ./../..        ../..
    a/../..        ..
    a              a
    a/b            a/b
    a/b/./c        a/b/c
    a/b/../c       a/c
    /a             /a
    /a/..          /
    //             /
    //a            /a
    a//            a
    a//b           a/b
    /a/b/./c/../d  /a/b/d
);

# edge case failures?
push @tests, qw(
    .            .
    ./           .
    /..          /
    a/..         .
);

# empty directories[1]?
push @tests, qw(
    //           //
    //a          //a
    a//          a//
    a//b         a//b
);

my $i;
while( my( $before, $after ) = splice @tests, 0, 2 ) {
    is( canonical_path( $before ), $after,
        sprintf "[%d]: %-12s -> %s", ++$i, $before, $after );
}

sub canonical_path {

  my $path = shift;
  my @path;

  foreach (File::Spec->splitdir($path)) {

    next if $_ eq '.';

    if ($_ eq '..' and @path and $path[-1] ne '..') {
      pop @path;
    }
    else {
      push @path, $_;
    }
  }

  File::Spec->catdir(@path);

}


__END__

[1] from perldoc File::Spec

    Unlike just splitting the directories on the separator,
    empty directory names ('') can be returned, because these
    are significant on some OSes.

--
Brad


-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/


Reply via email to