在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任何定義的變量功能。