从不同命名空间中所需的文件调用子例程

Question

我正在重构一些旧的、糟糕的 Perl 代码。在许多地方，存储在外部.pl 文件中的数据如下：

sub data{{ huge => 'datastructure', etc => '...' }};
1;

是这样导入的：

require 'file_with_data.pl';
my $data = data();

我无法更改这些数据的存储方式，但我将所有这些 require 逻辑移动到一个包中，这样任何人都可以访问这些数据。

我的问题是，我必须循序渐进地做到这一点，即在一段时间内，一些模块会使用旧的、丑陋的方式，而另一些模块会使用新的、稍微不那么丑陋的方式。

这是我的新包中的一种方法：

sub load_from_subroutine {
    no strict 'refs';
    my ($self, $file, $subroutine) = @_;
    my $data;
    try {
        if (exists $INC{$file}) {
            die "What should I do now?";  # <-- this is what I want to change
        }
        else {
            untaint $file;
            require $file;
            if (defined &$subroutine) {
                $data = &$subroutine;
            }
            else {
                die "Subroutine $subroutine is not defined";
            }
        }
    }
    catch {
        croak "Unable to load resource from file $file: $_";
    };
    return $data;
}

如果exists $INC{$file} 测试为真，我可以使用什么技巧来获得&$subroutine？暗示，在这个命名空间中，defined &$subroutine 是假的。

临时代码

与此同时，这是我正在使用的：

warn "Doing dirty trick in order to be able to load $file!\n";
my $tmp = '/tmp/data' . time . rand(100) . '.pl';
copy $file, $tmp;
require $tmp;
# do the loading stuff as shown...
unlink $tmp;

这真的很糟糕，我渴望更好的解决方案。

Answer 1

听起来 ikegami 帮助解决了您最初的问题。

请注意，由于您将所有这些文件导入到一个包中，因此可能会出现一些名称重叠，尤其是如果之前的编码器重用了名称 sub data。因此，我建议您为这些文件中的每一个提供自己的包并缓存结果。

下面演示了如何做到这一点：

package MyNamespace::DataLoader;

use strict;
use warnings;
use autodie;

use Carp;

# Both of the below subs output a string, like:  sub data { "foo" }
print load_from_subroutine(qw(data2.pl data)), "\n";
print load_from_subroutine(qw(data3.pl data)), "\n";

our %files;
our $inc = 0;

sub load_from_subroutine {
    my ($file, $subroutine) = @_;

    # Load the file
    if (!$files{$file}) {
        my $data = do {
            local $/;
            open my $fh, '<', $file;
            <$fh>;
        };

        carp "File already has a package declaration: $file" if $data =~ /^package/;

        my $pkg = __PACKAGE__ . '::Package' . ++$inc;
        $files{$file}{pkg} = $pkg;

        eval "package $pkg;\n$data\n1;";
        croak "Unable to load '$file': $@" if $@;
    }

    # Reference the subroutine
    if (!$files{$file}{sub}{$subroutine}) {
        my $subname = $files{$file}{pkg} . '::' . $subroutine;

        no strict 'refs';
        if (! defined &{"$subname"}) {
            croak "Subroutine doesn't exist: $file->$subroutine";
        }

        $files{$file}{sub}{$subroutine} = \&{"$subname"};
    }

    return $files{$file}{sub}{$subroutine}->();
}

Answer 2

它没有加载到不同的命名空间中（注意缺少package）。缺少package 也意味着您应该使用do 而不是require。 do 忽略 %INC。