I would like to be able to capture variable assignments from a Perl eval. That is, to determine what variable names have been assigned to within the code and extract their value.
For example if I run:
eval '$foo=42; $bar=3.14;'
The result of the eval is 3.14 (the last value evaluated), but I would also like to be able to determine the names "$foo" and "$bar" and their values (without knowing the names in advance).
I have read up on a couple of ways of inserting variables into the eval block, through Safe and Eval::Context, but not yet any way of extracting them. I am more familiar with Python's eval/exec which have built in support for this.
Any lexical variables declared within an eval will be lost after the eval ends. To capture and isolate global variables that are set within an eval, you could look into using the Safe module to create a new global namespace. Something like the following:
use Safe;
my $vars = Safe->new->reval(qq{
$code_to_eval;
$code_to_search_the_symbol_table_for_declared_variables
});
Where the search code is defined as something that walks the nested %main::
symbol table searching for any variables of interest. You can have it return a data structure containing the information, and then you can do with it what you like.
If you are only worried about variables defined at the root level, you could write something like:
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
The search code could also employ Padwalker to search the current lexical scope for any defined variables using the peek_my
function.
Here's my attempt at fleshing out a solution based on Safe, as suggested by 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"
}
}
Notes:
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With