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

Call a subroutine from a file that was required in a different namespace

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

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

是这样导入的：

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

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

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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 是假的。

临时代码

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

1
2
3
4
5
6
7

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

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

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

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

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53

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)),"\
";
print load_from_subroutine(qw(data3.pl data)),"\
";

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;\
$data\
1;";
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}->();
}