Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Capture variable assignments in a Perl eval

Tags:

perl

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.

like image 640
Bruce Avatar asked Nov 23 '11 23:11

Bruce


2 Answers

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.

like image 126
Eric Strom Avatar answered Sep 28 '22 16:09

Eric Strom


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:

  1. The above allows a minimal restrictve set of saf opcodes. See perl opcodes
  2. I've chosen to look for differences before and after executing the command
like image 32
dwarring Avatar answered Sep 28 '22 15:09

dwarring