logo标签列表

如何获取正在执行的Perl脚本的完整路径？

perlpathlocation
186

我有一个Perl脚本，需要在执行期间确定脚本的完整路径和文件名。我发现取决于如何调用脚本，$0会有所不同，有时包含fullpath+filename，有时只有filename。由于工作目录也可能会变化，我想不出一种可靠地获取脚本fullpath+filename的方法。

有人有解决方案吗？

我知道这是很久以前的事情了，但我只是在寻找一种在Windows上使用Perl完成此操作的方法，并且对我的解决方案感到非常满意。#!/usr/bin/perl -w my @catalog=dir; $myHome = substr($catalog[3],14); $myHome = &rtrim($myHome); print qq(<$myHome>\n);

右侧修剪函数以删除尾随空格

sub rtrim { my $string = shift; $string =~ s/\s+$//; return $string; } 只是想分享一下。 - user1210923
23个回答
2

perlfaq8回答了一个非常类似的问题，使用$0上的rel2abs()函数。该函数可以在File::Spec中找到。

1
你在寻找这个吗？
my $thisfile = $1 if $0 =~
/\\([^\\]*)$|\/([^\/]*)$/;

print "You are running $thisfile
now.\n";

输出结果将如下所示：

You are running MyFileName.pl now.

它可以在Windows和Unix上运行。

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

4
请不要只回答代码，请解释为什么这是正确的答案。 - Lee Taylor
1

仅使用dirname(__FILE__)存在的问题是它不会遵循符号链接。我必须在我的脚本中使用这个来跟随符号链接到实际的文件位置。

use File::Basename;
my $script_dir = undef;
if(-l __FILE__) {
  $script_dir = dirname(readlink(__FILE__));
}
else {
  $script_dir = dirname(__FILE__);
}
0
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
虽然仅提供源代码的答案可能解决了用户的问题，但它并不能让他们理解为什么它可以这样工作。你已经给了用户一条鱼，但更好的方式是教会他们如何钓鱼。 - the Tin Man
0

没有一个“顶尖”答案对我有效。使用 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));
}
1
该函数具有修改执行脚本的工作目录的副作用。 - amphetamachine
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;

请提供任何建议。
0

所有不需要使用库的解决方案实际上只适用于少数几种路径写法（例如 ../ 或 /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/;
0

不需要任何外部模块，适用于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
当你调用symlink时会发生什么？Cwd在这种情况下表现出色。 - Znik
0
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]
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接