Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Any way to access the contents of a block eval?

by adrianh (Chancellor)
on Oct 10, 2007 at 15:15 UTC ( [id://643982]=perlquestion: print w/replies, xml ) Need Help??

adrianh has asked for the wisdom of the Perl Monks concerning the following question:

I'm fairly sure the answer is no - but just in case...

Is there any way to get at the contents of a block eval so you can do the moral equivalent of:

eval { 1/0 }; if ($@) { print _MAGIC_CONTENT_OF_LAST_EVAL # outputs # { 1/0 }

(without mucking around with source filters that is)

Replies are listed 'Best First'.
Re: Any way to access the contents of a block eval?
by chromatic (Archbishop) on Oct 11, 2007 at 00:10 UTC

    Easy!

    #!/usr/bin/perl use strict; use warnings; use B::Deparse; sub get_eval_text { my $start = shift; # turn the invoking subroutine into a B::Op-derived object my ($package, $sub, $end) = (caller(1))[0, 3, 2]; my $subref = do { no strict 'refs'; *{ $package . '::' . $sub }{C +ODE} }; my $cv = B::svref_2object( $subref ); # create a B::Deparse object and give it a sub to deparse (in part +) my $deparse = B::Deparse->new(); $deparse->{curcv} = $cv; # search the optree for the first op on the eval {} line my $op = deparse_from($cv->START, $start); # and deparse from that op return $deparse->deparse($op, 0) if $op; } sub deparse_from { my ($start, $line) = @_; for (my $op = $start; $$op; $op = $op->next()) { # look for nextstate ops next unless $op->isa( 'B::COP' ); # ... specifically the one representing the start of the eval +{} next unless $op->line == $line; # then grab the sibling op in the tree: leavetry return $op->sibling; } return; } sub main { my $x = 10; my $y = 20; eval { my $x = 1; my $y = $x; die 'aaaarrrr' }; print( $@, get_eval_text( __LINE__ - 1 ) ) if $@; } main();

    I haven't found a way to get rid of __LINE__ - 1 reliably, but if you're willing to add that, here you go.

      Easy!

      Impressive! You are a sick, sick man :-)

Re: Any way to access the contents of a block eval?
by shmem (Chancellor) on Oct 10, 2007 at 17:41 UTC
    For simple uses, as long as you have a __DATA__ or __END__ token and the eval is in the same file, you can use this trick:
    #!/usr/bin/perl my $foo = 1; my $bar = $foo - 1; $SIG{__DIE__} = \&report; eval { print + ( $foo / $bar ),"\n"; }; sub report { (my $num) = shift() =~ /at \S+ line (\d+)/; warn "Failure in eval() at line $num:\n"; seek DATA, 0,0; my $c; EVAL: while (<DATA>) { if ($. == $num) { $c += () = /\{/; warn $_; $c -= () = /\}/; last unless $c; while (<DATA>) { $c += () = /\{/; warn $_; $c -= () = /\}/; last EVAL unless $c; } } }; }; __END__ Failure in eval() at line 8: print + ( $foo / $bar ),"\n";

    which is far from perfect (and doesn't claim to be (specially the bracket foo is b0rken)). I'm not sure whether this qualifies as "mucking around with source filters" to your eyes, but I'm inclined to believe it does.

    --shmem

    _($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                                  /\_¯/(q    /
    ----------------------------  \__(m.====·.(_("always off the crowd"))."·
    ");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}
Re: Any way to access the contents of a block eval?
by ikegami (Patriarch) on Oct 10, 2007 at 15:48 UTC

    There's surely some way of recreating the code from optree quite accurately. (See B::Deparse for a module that does something similar.)

    However, I don't see the use of this. The contents of an eval BLOCK doesn't change. What's the point of printing out something you already know? What does change is the contents of variables, so there would be value in printing those.

    But that's a hard problem. Consider

    eval { func_that_uses_globals() }; eval { $big_complex_object->method() };

    How would one programatically determine which variables would be relevant to print? What if the variable doesn't even exist in the eval block because the exception occured in code called by the eval block? I'm sure there are more issues.

    Seems to me you'll just have to use the line number in the error message and either manually add code to print out the variables you deem relevant or use a debugger.

    By the way, 1/0 (unlike 1/$x) throws an exception eval BLOCK can't catch, because the exception occurs at compile time during constant folding, long before eval is executed.

      However, I don't see the use of this. The contents of an eval BLOCK doesn't change. What's the point of printing out something you already know?

      I was thinking of nicer default diagnostic messages for Test::Exception - so instead of writing:

      lives_ok { $o->something } 'something worked';

      you could just write

      lives_ok { $o->something };

      And still get a vaguely nice diagnostic

      ok - $o->something lived

        In that case, chromatic's code simplifies to

        use B::Deparse qw( ); my $deparse = B::Deparse->new(); sub lives_ok(&;$) { my ($code, $desc) = @_; $desc = $deparse->coderef2text($code) if !defined($desc); return Text::Exception::lives_ok($code, $desc); }

        Be careful to avoid accidently overriding your own functions with those from the module you are extending.

        Ah, so you already have the sub reference. Even easier.

Re: Any way to access the contents of a block eval?
by cdarke (Prior) on Oct 10, 2007 at 15:39 UTC
    Not directly so far as I know, but you can just about do this with a simple command, like this:
    my $cmd = '1/0'; eval $cmd; if ($@) { print "$cmd gives: $@\n" } 1/0 gives: Illegal division by zero at (eval 1) line 2.
    and that is not the block eval command that you asked for.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://643982]
Approved by Mutant
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2024-03-28 08:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found