在Perl eval中捕获变量赋值

Question

我希望能够从Perl eval中捕获变量赋值。也就是说，要确定在代码中分配了哪些变量名称并提取它们的值。

例如，如果我运行：

eval '$foo=42; $bar=3.14;' 

的EVAL的结果是3.14（最后一个值计算的），但我也希望能够确定名称“$ foo”和“$酒吧“和他们的价值（事先不知道名字）。

我已经阅读了几种通过安全和评估::上下文将变量插入到eval块中的方法，但尚未以任何方式提取它们。我更熟悉Python的eval/exec，它们已经构建了对此的支持。

Answer 1

这是我的尝试，充实了基于Safe的解决方案，正如Eric Strom所建议的那样。

package main; 
use warnings; use strict; 
use Safe; 

my $cpt = new Safe; 

$cpt->permit_only(qw(sassign lineseq padany const rv2sv leaveeval)); 
my $name_space = $cpt->root; 

my $no_strict = 0; 
# 
# populate the clean symbol table 
# 
$cpt->reval('0'); 
die "safe compartment initialisation error: $@" if $@; 
my %symtab_clean = do {no strict 'refs'; %{$name_space.'::'} }; 

my $result = $cpt->reval('$foo=42; $bar=3.14;', $no_strict); 

if ($@) { 
    warn "eval error: $@"; 
} 
else { 
    # 
    # symbol table additions 
    # 
    my %symtab_dirty = do {no strict 'refs'; %{$name_space.'::'} }; 

    my @updated_variables = grep { ! exists $symtab_clean{$_} } (sort keys %symtab_dirty); 

    foreach my $variable (@updated_variables) { 
     my $value = do{ no strict 'refs'; ${$name_space.'::'.$variable} }; 
     print "variable $variable was set to: $value\n" 
    } 
} 

注：

1. 上述允许的最小restrictve组SAF操作码。见perl opcodes
2. 我选择去寻找之前的差异和执行命令

Answer 2

那么，eval运行后$ foo的值将是42。 $ foo不可见的范围没有变化。

但是，这当然假定$ foo的存在预知。

无论如何，这只会在没有use strict集的情况下工作，这几乎肯定是一个坏主意。使用use strict，脚本将不会编译。我假设你的例子更复杂，并且你正在寻找由你的eval执行的现有散列的更改。但目前还不清楚你的eval怎么知道它在改变什么，除非有某种动态代码注入正在进行。

Answer 3

eval中声明的任何词汇变量在eval结束后都会丢失。要捕获和隔离在eval中设置的全局变量，可以使用Safe模块来创建新的全局名称空间。像下面这样：

use Safe; 

my $vars = Safe->new->reval(qq{ 
    $code_to_eval; 
    $code_to_search_the_symbol_table_for_declared_variables 
}); 

，其中搜索码被定义为东西，走在嵌套%main::符号表中寻找感兴趣的任何变量。你可以让它返回一个包含这些信息的数据结构，然后你可以用它来做你喜欢的事情。

如果你只担心在根级别定义的变量，你可以写这样的：

use strict; 
use warnings; 

my $eval_code = '$foo=42; $bar=3.14;'; 

use Safe; 
my $vars = Safe->new->reval(
    $eval_code . q{; 
    my %vars; 
    for my $name (keys %main::) { 
     next if $name =~ /::$/ # exclude packages 
     or not $name =~ /[a-z]/; # and names without lc letters 

     my $glob = $main::{$name}; 
     for (qw($SCALAR @ARRAY %HASH)) { 
      my ($sigil, $type) = /(.)(.+)/; 
      if (my $ref = *$glob{$type}) { 
       $vars{$sigil.$name} = /\$/ ? $$ref : $ref 
      } 
     } 
    } 
    \%vars 
}); 

print "$_: $$vars{$_}\n" for keys %$vars; 
# $foo: 42 
# $bar: 3.14 

搜索代码还可以采用Padwalker搜索当前词法范围使用peek_my任何定义的变量功能。