perl - 无论如何要判断 perl 脚本是否通过 do 运行？

Question

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

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

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

#config.pl
my $runViaDoFlag; 

$runViaDoFlag=$0=~/main\.pl/;                  #Test if main.pl is the executing script
$runViaDoFlag=defined $MYPACKAGE::isMaster;    #Test custom package variable
                                               #Is there a 'built-in' way to do this?

die "Need to run from main script! " unless $runViaDoFlag;

{
    options={
        option1=>"some value",
        option2=>"some value",
    },
    mySub=>sub { 
               # do interesting things here
           }
}

在更复杂的配置文件中，config.pl 脚本仅由 do 执行可能不是那么明显。因此，我想包含一个带有基本使用说明的 die。

解决方案:

• 测试 $0 的主脚本名称
• 在主脚本中定义自定义包变量并由配置脚本检查
• 只需在配置中添加注释，指导用户如何使用它。

这些工作，但是有什么方法可以知道脚本是否通过内置变量/subs 执行？

Answer 1

我会提供设计上的更改:将该配置放在一个普通模块中，然后您可以在其中测试它是否被 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(在同一目录下)

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;

(请注意，this 使用 goto 没问题。)

这当然只是一个草图；调整，进一步发展，并根据需要修改。如果这是从 main:: 以外的包中加载出来的，因此它失败了，那么这发生在编译阶段，因为那是 import 的时候。叫做。我认为这是一件好事。

如果该配置代码也需要能够运行(如问题所示)，那么有一个单独的可执行文件来加载此模块并运行需要运行的内容。

---

对于上述问题，标题和问题的(明显)任务略有不同，但都可以使用 caller EXPR 处理。 .不过，它不会是一个干净的小“内置”调用。

关于 do 的事情打算使用的是那个

do './stat.pl' is largely like

eval `cat stat.pl`;

except that ...

(那个 stat.pl 是在前面的文档中介绍的，只是表示在文件上调用了 do。)

然后 caller(0) 将提供明确的提示(请参阅文档)。它返回

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

在请求的调用中，do './config.pl'，除了 main(包)和正确的文件名，caller(0 ) 在 config.pl 中也返回:

• (eval) for $subroutine

• ./config.pl for $evaltext

• 1 for $is_require

总而言之，这为决定是否按要求调用电话提供了充足的依据。

但是，我不推荐这种涉及到的分析，而只是使用一个包，它也无比灵活。