File Coverage

blib/lib/Devel/StackTrace/WithLexicals.pm

Criterion	Covered	Total	%
statement	60	60	100.0
branch	13	20	65.0
condition	5	14	35.7
subroutine	10	10	100.0
pod			n/a
total	88	104	84.6

package Devel::StackTrace::WithLexicals;
use strict;
use warnings;
use 5.008001;
use base 'Devel::StackTrace';

use Devel::StackTrace::WithLexicals::Frame;

use PadWalker 'peek_my';

our $VERSION = '2.00';

# mostly copied from Devel::StackTrace 2.00
sub _record_caller_data {
    my $self = shift;

    my $filter = $self->{filter_frames_early} && $self->_make_frame_filter();

    # We exclude this method by starting at least one frame back.
    my $x = 1 + ( $self->{skip_frames} || 0 );

    # PadWalker ignores eval block and eval string, so we have to keep
    # a different frame count for it
    my $walker = 0;
    for my $caller_count (0..$x) {
        my $sub = (caller($caller_count))[3];
        ++$walker unless $sub eq '(eval)';
    }

    while (
        my @c
        = $self->{no_args}
        ? caller( $x++ )
        : do {
            package    # the newline keeps dzil from adding a version here
                DB;
            @DB::args = ();
            caller( $x++ );
        }
        ) {

        my @args;

        @args = $self->{no_args} ? () : @DB::args;

        my $raw = {
            caller => \@c,
            args   => \@args,
        };

        my $sub = $c[3];
        if ($sub ne '(eval)') {
            $raw->{lexicals} = peek_my($walker++);
        }

        next if $filter && !$filter->($raw);

        unless ( $self->{unsafe_ref_capture} ) {
            $raw->{args} = [ map { ref $_ ? $self->_ref_to_string($_) : $_ }
                    @{ $raw->{args} } ];
            for (values %{ $raw->{lexicals} }) {
                $_ = $$_ if ref($_) eq 'REF';
                $_ = $self->_ref_to_string($_);
            }
        }

        push @{ $self->{raw} }, $raw;
    }
}

sub _frame_class { "Devel::StackTrace::WithLexicals::Frame" }

sub _make_frames {
    my $self = shift;

    my $filter = !$self->{filter_frames_early} && $self->_make_frame_filter();

    my $raw = delete $self->{raw};
    for my $r ( @{$raw} ) {
        next if $filter && !$filter->($r);

        $self->_add_frame( $r->{caller}, $r->{args}, $r->{lexicals} );
    }
}

sub _add_frame {
    my $self = shift;
    my $c    = shift;
    my $p    = shift;
    my $lexicals = shift;

    # eval and is_require are only returned when applicable under 5.00503.
    push @$c, ( undef, undef ) if scalar @$c == 6;

    push @{ $self->{frames} },
        $self->_frame_class->new(
        $c,
        $p,
        $self->{respect_overload},
        $self->{max_arg_length},
        $self->{message},
        $self->{indent},
        $lexicals,
        );
}


1;

__END__