# Sample code
use Data::Dumper;
my $k = 42;
my $j = sub { $k };
sub r {
    my $r = shift;
    $r--;
    if ( $r and $k and $j->() ) {
        r( $r );
    } else {
        print Dumper( [ map $_->hash, PadViewer->new( \&r )->pads ] );
    }
}

r( 10 );
[download]

package PadViewer;
use strict;
use 5.006;
use warnings FATAL => 'all';
use B;

sub new {
    my $class = shift;
    my $rv    = shift;
    
    bless \ B::svref_2object( $rv ), $class;
}

sub pads {
    my $self = shift;

    return unless
        $$self and
        $$self->can('PADLIST') and
        $$self->PADLIST and
        $$self->PADLIST->can('ARRAY');

    my ($names, @values) = $$self->PADLIST->ARRAY;
    map PadViewer::Pad->new( $names, $_),
    @values;
}

package PadViewer::Pad;
use strict;
use warnings FATAL => 'all';
use Devel::Pointer::PP;

sub new {
    my $class  = shift;
    my $names  = shift;
    my $values = shift;

    bless { names  => $names,
            values => $values }, $class;
}

sub names {
    my $self = shift;

    return unless
        $self->{'names'}->can('ARRAY') and
        $self->{'values'}->can('ARRAY');

    my @n = $self->{'names'}->ARRAY;
    my @v = $self->{'values'}->ARRAY;

    map +((ref $n[$_] && $n[$_]->can('PV')) ? $n[$_]->PV : undef),
    grep _is_lexical($v[$_]),
    0 .. $#v;
}

sub values {
    my $self = shift;

    return unless $self->{'values'}->can('ARRAY');

    my @v = $self->{'values'}->ARRAY;

    map deref($$_),
    grep _is_lexical($_), @v;
}

sub hash {
    my $self = shift;

    my %h;
    @h{ $self->names } = $self->values;

    \ %h;
}

sub _is_lexical {
    my $padv = shift;

    $padv->can('FLAGS') and $padv->FLAGS & 0x400;
}

1;
[download]