#!/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 }{CODE} };
    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();