要知道perl脚本是否通过do运行？

我有一个从主脚本加载的小脚本配置文件

#main.pl
package MYPACKAGE;
our $isMaster=1;

package main;
my config=do "./config.pl"

在更复杂的配置文件中，config.pl脚本仅由

do

执行可能并不明显。因此，我想包括一个带有基本使用说明的

die

解决方案：

• 测试主脚本名称的

  $0

• 在主脚本中定义自定义包变量并由配置脚本检查
• 只需在配置中添加一条注释，指导用户如何使用它

---

然而，这些工作是否有某种方法可以知道脚本是否通过内置变量/subs通过do执行？

我将提供一个设计变更：将该配置放在一个普通模块中，然后您可以在其中测试它是否由

main:：

命名空间加载。那么就不需要任何带有控制变量的杂技了

有一种方法可以做到这一点

use warnings;
use strict;
use feature 'say';

use FindBin qw($RealBin);
use lib $RealBin;          # so to be able to 'use' from current directory

use ConfigPackage qw(load_config);

my $config = load_config();
# ...

和

ConfigPackage.pm

（在同一目录中）

（请注意，可以使用此选项。）

这当然只是一个草图；根据需要进行调整、进一步发展和修改。如果这是从除

main:：

以外的包中进行的，因此失败，那么这将发生在编译阶段，因为此时调用。我认为这是件好事。

如果配置代码需要能够运行，正如问题可能指出的那样，那么就有一个单独的可执行文件来加载这个模块并运行需要运行的内容

---

至于前面提到的问题，标题和问题的（明显的）追求略有不同，但都可以使用。不过，它不会是一个干净的小“内置”调用

我们打算使用的东西是

do

“

/stat.pl

”与

eval `cat stat.pl`;

除了

（文档前面介绍了

stat.pl

，只是为了表示在文件上调用了

do

。）

然后，

caller（0）

将提供清晰的提示（参见文档）。它回来了

在要求调用，

do./config.pl'

时，除了

main

（包）和正确的文件名外，

config.pl

中的

调用方（0）

还返回：

• （eval）

  用于

  $subroutine

• $evaltext

• 1

  对于

  $is\u require

总的来说，这给了我们足够的时间来决定是否按要求打电话

---

但是，我不建议使用这种复杂的分析，而不仅仅是使用一个包，这也是非常灵活的。

为什么不使用

require

？或者，为什么要排除

要求

？唯一的区别是，

require

会在代码中出现问题且没有最终的真值时阻止您。感谢您提供的详细信息<代码>调用方我想这就是我的简单脚本所需要的。当在顶层调用时，

caller

返回一个空数组。因此，简单地测试@{[caller]}==0就表明我的config.pl脚本是否直接执行。

package ConfigPackage;

use warnings;
use strict;
use feature 'say';
use Carp;

use Exporter qw();                 # want our own import
our @EXPORT_OK = qw(load_config);

sub import { 
    #say "Loaded by: ", (caller)[0];
    croak "Must only be loaded from 'main::'"
        if not ( (caller)[0] eq 'main' );

    # Now switch to Exporter::import to export symbols as needed
    goto &Exporter::import;
}

sub load_config {
    # ...
    return 'Some config-related data structure';
}

1;

eval `cat stat.pl`;

my ($package, $filename, $line, $subroutine, $hasargs,
    $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash)
= caller($i);