如何获得给定文件路径的第一个存在的祖先目录？

Question

在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/。

有没有这样做的模块或功能，或者它只是一个拆分/上的路径和测试存在的问题？

Answer 1

我所知道的最接近的是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; 

Answer 2

猴子打补丁

#!/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