我有一个Perl脚本,需要在执行期间确定脚本的完整路径和文件名。我发现取决于如何调用脚本,$0
会有所不同,有时包含fullpath+filename
,有时只有filename
。由于工作目录也可能会变化,我想不出一种可靠地获取脚本fullpath+filename
的方法。
有人有解决方案吗?
my $thisfile = $1 if $0 =~
/\\([^\\]*)$|\/([^\/]*)$/;
print "You are running $thisfile
now.\n";
输出结果将如下所示:
You are running MyFileName.pl now.
它可以在Windows和Unix上运行。
#!/usr/bin/perl -w
use strict;
my $path = $0;
$path =~ s/\.\///g;
if ($path =~ /\//){
if ($path =~ /^\//){
$path =~ /^((\/[^\/]+){1,}\/)[^\/]+$/;
$path = $1;
}
else {
$path =~ /^(([^\/]+\/){1,})[^\/]+$/;
my $path_b = $1;
my $path_a = `pwd`;
chop($path_a);
$path = $path_a."/".$path_b;
}
}
else{
$path = `pwd`;
chop($path);
$path.="/";
}
$path =~ s/\/\//\//g;
print "\n$path\n";
:DD
仅使用dirname(__FILE__)
存在的问题是它不会遵循符号链接。我必须在我的脚本中使用这个来跟随符号链接到实际的文件位置。
use File::Basename;
my $script_dir = undef;
if(-l __FILE__) {
$script_dir = dirname(readlink(__FILE__));
}
else {
$script_dir = dirname(__FILE__);
}
use strict ; use warnings ; use Cwd 'abs_path';
sub ResolveMyProductBaseDir {
# Start - Resolve the ProductBaseDir
#resolve the run dir where this scripts is placed
my $ScriptAbsolutPath = abs_path($0) ;
#debug print "\$ScriptAbsolutPath is $ScriptAbsolutPath \n" ;
$ScriptAbsolutPath =~ m/^(.*)(\\|\/)(.*)\.([a-z]*)/;
$RunDir = $1 ;
#debug print "\$1 is $1 \n" ;
#change the \'s to /'s if we are on Windows
$RunDir =~s/\\/\//gi ;
my @DirParts = split ('/' , $RunDir) ;
for (my $count=0; $count < 4; $count++) { pop @DirParts ; }
my $ProductBaseDir = join ( '/' , @DirParts ) ;
# Stop - Resolve the ProductBaseDir
#debug print "ResolveMyProductBaseDir $ProductBaseDir is $ProductBaseDir \n" ;
return $ProductBaseDir ;
} #eof sub
没有一个“顶尖”答案对我有效。使用 FindBin '$Bin' 或 Cwd 的问题是它们返回解析所有符号链接的绝对路径。在我的情况下,我需要具有符号链接的确切路径 - 与 Unix 命令“pwd”返回的相同,而不是“pwd -P”。以下函数提供了解决方案:
sub get_script_full_path {
use File::Basename;
use File::Spec;
use Cwd qw(chdir cwd);
my $curr_dir = cwd();
chdir(dirname($0));
my $dir = $ENV{PWD};
chdir( $curr_dir);
return File::Spec->catfile($dir, basename($0));
}
__FILE__
的问题在于它会打印核心模块 ".pm" 的路径,而不一定是正在运行的 ".cgi" 或 ".pl" 脚本路径。我猜这取决于你的目标是什么。
我觉得 Cwd
只需要针对 mod_perl 进行更新即可。以下是我的建议:
my $path;
use File::Basename;
my $file = basename($ENV{SCRIPT_NAME});
if (exists $ENV{MOD_PERL} && ($ENV{MOD_PERL_API_VERSION} < 2)) {
if ($^O =~/Win/) {
$path = `echo %cd%`;
chop $path;
$path =~ s!\\!/!g;
$path .= $ENV{SCRIPT_NAME};
}
else {
$path = `pwd`;
$path .= "/$file";
}
# add support for other operating systems
}
else {
require Cwd;
$path = Cwd::getcwd()."/$file";
}
print $path;
所有不需要使用库的解决方案实际上只适用于少数几种路径写法(例如 ../ 或 /bla/x/../bin/./x/../ 等)。我的解决方案如下所示。我有一个怪癖:我不知道为什么必须运行两次替换。如果不这样做,就会出现虚假的 "./" 或 "../"。除此之外,它在我看来似乎相当稳健。
my $callpath = $0;
my $pwd = `pwd`; chomp($pwd);
# if called relative -> add pwd in front
if ($callpath !~ /^\//) { $callpath = $pwd."/".$callpath; }
# do the cleanup
$callpath =~ s!^\./!!; # starts with ./ -> drop
$callpath =~ s!/\./!/!g; # /./ -> /
$callpath =~ s!/\./!/!g; # /./ -> / (twice)
$callpath =~ s!/[^/]+/\.\./!/!g; # /xxx/../ -> /
$callpath =~ s!/[^/]+/\.\./!/!g; # /xxx/../ -> / (twice)
my $calldir = $callpath;
$calldir =~ s/(.*)\/([^\/]+)/$1/;
不需要任何外部模块,适用于shell,即使使用'../'也能正常工作:
my $self = `pwd`;
chomp $self;
$self .='/'.$1 if $0 =~/([^\/]*)$/; #keep the filename only
print "self=$self\n";
测试:
$ /my/temp/Host$ perl ./host-mod.pl
self=/my/temp/Host/host-mod.pl
$ /my/temp/Host$ ./host-mod.pl
self=/my/temp/Host/host-mod.pl
$ /my/temp/Host$ ../Host/./host-mod.pl
self=/my/temp/Host/host-mod.pl
use File::Basename;
use Cwd 'abs_path';
print dirname(abs_path(__FILE__)) ;
德鲁的回答 给了我:
'.'
$ cat >testdirname
use File::Basename;
print dirname(__FILE__);
$ perl testdirname
.$ perl -v
This is perl 5, version 28, subversion 1 (v5.28.1) built for x86_64-linux-gnu-thread-multi][1]
dir
; $myHome = substr($catalog[3],14); $myHome = &rtrim($myHome); print qq(<$myHome>\n);右侧修剪函数以删除尾随空格
sub rtrim { my $string = shift; $string =~ s/\s+$//; return $string; } 只是想分享一下。 - user1210923