在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/
。是否存在执行此操作的模块或函数,或者只是在/
上拆分路径并测试是否存在?
答案 0 :(得分: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;
答案 1 :(得分: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