view release on metacpan or  search on metacpan

lib/Devel/Trepan/CmdProcessor/Eval.pm  view on Meta::CPAN

# -*- coding: utf-8 -*-
# Copyright (C) 2012-2014 Rocky Bernstein <rocky@cpan.org>
use warnings; use utf8;
use rlib '../../..';

package Devel::Trepan::CmdProcessor;
use Devel::Trepan::Util qw(hash_merge uniq_abbrev);
use PadWalker qw(peek_my peek_our);
use strict;

# Note DB::Eval uses and sets its own variables.

use constant HAVE_EVAL_WITH_LEXICALS => eval("use Eval::WithLexicals; 1") ? 1 : 0;

my $given_eval_warning = 0;

sub eval($$$$) {
    my ($self, $code_to_eval, $opts) = @_;
    no warnings 'once';
    my $return_type = $opts->{return_type};
    if (0 == $self->{frame_index} || !HAVE_EVAL_WITH_LEXICALS) {
        unless (0 == $self->{frame_index}) {
            $self->msg("Evaluation occurs in top-most frame not this one");
        }
        $DB::eval_str = $self->{dbgr}->evalcode($code_to_eval);
        $DB::eval_opts = $opts;
        $DB::result_opts = $opts;

        ## This doesn't work because it doesn't pick up "my" variables
        # DB::eval_with_return($code_to_eval, $opts, @DB::saved);
        # $self->process_after_eval();

        # All the way back to DB seems to work here.
        $self->{DB_running} = 2;
        $self->{leave_cmd_loop} = 1;

    } else {
        # Have to use Eval::WithLexicals which, unfortunately,
        # loses on 'local' variables.

        my $stack_size_with_debugger = 0;
        while (my ($pkg, $file, $line, $fn) =
	       caller($stack_size_with_debugger++)) { ; };
        my $diff = $stack_size_with_debugger - $self->{stack_size};

        my $my_hash  = peek_my($diff + $self->{frame_index} - 1);
        my $our_hash = peek_our($diff + $self->{frame_index} - 1);
        my $var_hash = hash_merge($my_hash, $our_hash);

        unless ($given_eval_warning) {
            $self->msg("Evaluation in this frame may not find local values");
            $given_eval_warning = 0 # 1;
        }

        my $context = 'scalar';
        $return_type = '$' unless defined($return_type);
        if ('@' eq $return_type) {
            $context = 'list';
            $code_to_eval = "\@DB::eval_result = $code_to_eval";
        } else {
            ## FIXME do fixup for hash.
            $context = 'scalar';
            $code_to_eval = "\$DB::eval_result = $code_to_eval";
        }
        my $eval = Eval::WithLexicals->new(
            lexicals => $var_hash,
            in_package => $self->{frame}{pkg},
            context => $context,