Как удалить компоненты относительного пути, но оставить символические ссылки в Perl в покое? - PullRequest
Новая
       32

Как удалить компоненты относительного пути, но оставить символические ссылки в Perl в покое?

0 голосов
/ 27 апреля 2010

Мне нужно, чтобы 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 Ответ

0 голосов
/ 27 апреля 2010

Хорошо, вот что я придумал: 

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

Я знаю, что это, возможно, небезопасно и недопустимо, но любой ввод этой подпрограммы будет исходить от меня из командной строки, и она решает для меня пару хитрых случаев использования.

...