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

我需要让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

---

好的，下面是我的想法：

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;
}

---

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

我很确定您不会找到您真正需要的。为什么你需要这些链接？另外，您将如何处理包含./../../bin/twidle//的符号链接，实际上，twidle是一个执行/arbitral/other/path（或arbitral/path/from/here）的符号链接。另外，您希望它与符号链接路径中的循环或其他类似的循环有什么关系。对于这些情况（例如，在我的示例中，

/../../../bin/twidle/../there

变成了

/tmp/test/bin/there

），我不介意解决方案被破坏。它不需要读取符号链接。如果这样一个函数不存在（我开始明白为什么…），那么我将着手编写它；因此缺乏支持。我不确定这会有多大帮助，但如果你去IIUG网站（）并在存储库中找到“linkpath”，你会发现。。。实现

realpath

效果，但评估路径中每个步骤的安全性的代码。您还将发现一些极为扭曲的符号链接集；我做的酷刑测试（大部分）也在那里。它可能是你所需要的一个基础——它可能不是。我不会假装它是世界上最伟大的代码。然而，我没有发现一种情况下它会不合理地失败——但总有你发明的东西！现在我非常关心这个应用的可移植性。如果我改变主意，我已经在代码中标记了我知道需要更改的地方。