代码之家 › 专栏 › 技术社区 › We Are All Monica

如何删除相对路径组件,但在Perl中不使用符号链接?

realpath path perl

0

We Are All Monica · 技术社区 · 16 年前

我需要让perl从linux路径中删除相对路径组件。我发现了几个函数,几乎可以满足我的要求,但是:

File::Spec->rel2abs 做得太少了。它无法将“.”正确解析到目录中。

Cwd::realpath 做得太多了。它解析路径中的所有符号链接,这是我不想要的。

也许最好的方式来说明我希望这个函数的行为是发布一个bash日志,其中fixpath是一个假设的命令,它提供所需的输出:

'/tmp/test'$ mkdir -p a/b/c1 a/b/c2
'/tmp/test'$ cd a
'/tmp/test/a'$ ln -s b link
'/tmp/test/a'$ ls
b  link
'/tmp/test/a'$ cd b
'/tmp/test/a/b'$ ls
c1  c2
'/tmp/test/a/b'$ FixPath . # rel2abs works here
===> /tmp/test/a/b
'/tmp/test/a/b'$ FixPath .. # realpath works here
===> /tmp/test/a
'/tmp/test/a/b'$ FixPath c1 # rel2abs works here
===> /tmp/test/a/b/c1
'/tmp/test/a/b'$ FixPath ../b # realpath works here
===> /tmp/test/a/b
'/tmp/test/a/b'$ FixPath ../link/c1 # neither one works here
===> /tmp/test/a/link/c1
'/tmp/test/a/b'$ FixPath missing # should work for nonexistent files
===> /tmp/test/a/b/missing

1 回复 | 直到 16 年前

1

-1

We Are All Monica 16 年前

好吧,这是我想到的:

sub mangle_path {
  # NOT PORTABLE
  # Attempt to remove relative components from a path - can return
  # incorrect results for paths like ../some_symlink/.. etc.

  my $path = shift;
  $path = getcwd . "/$path" if '/' ne substr $path, 0, 1;

  my @dirs = ();
  for(split '/', $path) {
    pop @dirs, next if $_ eq '..';
    push @dirs, $_ unless $_ eq '.' or $_ eq '';
  }
  return '/' . join '/', @dirs;
}

我知道这可能是不安全和无效的,但是这个例程的任何输入都将来自我的命令行,它为我解决了一些棘手的用例。