2011-09-17 1 views
1

В Perl, если задан путь к файлу, как вы находите первого существующего предка?Как вы получаете первый существующий каталог предков, заданный путь к файлу?

Например:

  • Если данный путь /opt/var/DOES/NOT/EXIST/wtv/blarg.txt и каталог /opt/var/DOES/ нет, но каталог /opt/var/ это, результат должен быть /opt/var/.
  • Если задан путь /home/leguri/images/nsfw/lena-full.jpg и каталог /home/leguri/images/nsfw/ не существует, но каталог /home/leguri/images/, результат должен быть /home/leguri/images/.

Есть ли модуль или функция, которая делает это, или это просто вопрос разделения пути на / и тестирование на существование?

ответ

5

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

use Path::Class 'dir'; 

sub get_existing_dir { 
    my ($path) = @_; 

    my $dir = dir($path); 
    while (!-d $dir) { 
     $dir = $dir->parent; 
    } 
    return $dir->stringify; 
} 

my $file = '/opt/var/DOES/NOT/EXIST/wtv/blarg.txt'; 
my $dir = get_existing_dir($file); 
print $dir; 
+0

путь начинается с '/': '/ Opt/вар/ДЕЛАЕТ/NOT/EXIST/WTV/blarg.txt' – Toto

+1

Если вы поставляете полностью фиктивными по отношению path ('bogus/relative/path'), метод возвращает текущий рабочий каталог (' .'), который может или не может быть тем, что хочет OP. Кроме того, по крайней мере, в Windows, если '$ path' использует несуществующий том, цикл' while' не завершается. – FMc

0

обезьяны патч это

#!/usr/bin/perl -- 
use strict; 
use warnings; 
use Path::Class ; 

my @paths = map dir($_) , 
    map join('/', $_, 1..6), 
    grep defined, 
    @ENV{qw/ WINDIR PROGRAMFILES TEMP HOME /}, 
    'Q:/bogus/drive/and/path', 
    'QQ:/bogus/drive/bogusly/treated/as/file', 
    ; 
push @paths, dir('bogus/relative/path/becomes/dot'); 
push @paths, dir('bogus/relative/path/becomes/relative/to/cwd')->absolute; 

for my $path (@paths) { 
    print $path, "\n\t=> ", $path->real_parent, "\n\n"; 
} 

sub Path::Class::Entity::real_parent { 
    package Path::Class::Entity; 
    my($dir) = @_; 
    while(!-d $dir){ 
     my $parent = $dir->parent; 
     last if $parent eq $dir ; # no infinite loop on bogus drive 
     $dir = $parent; 
    } 
    return $dir if -d $dir; 
    return; 
} 
__END__ 
C:\WINDOWS\1\2\3\4\5\6 
    => C:\WINDOWS 

C:\PROGRA~1\1\2\3\4\5\6 
    => C:\PROGRA~1 

C:\DOCUME~1\bogey\LOCALS~1\Temp\1\2\3\4\5\6 
    => C:\DOCUME~1\bogey\LOCALS~1\Temp 

C:\DOCUME~1\bogey\1\2\3\4\5\6 
    => C:\DOCUME~1\bogey 

Q:\bogus\drive\and\path\1\2\3\4\5\6 
    => 

QQ:\bogus\drive\bogusly\treated\as\file\1\2\3\4\5\6 
    => . 

bogus\relative\path\becomes\dot 
    => . 

C:\temp\bogus\relative\path\becomes\relative\to\cwd 
    => C:\temp 
+0

Вы можете добавить эту проверку в ответ stevenl без каких-либо проблем. Так почему же нужно рисковать обезглавливанием? –