#!/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.
|