File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Backtrace.pm

Criterion	Covered	Total	%
statement	60	86	69.7
branch	0	8	0.0
condition			n/a
subroutine	20	24	83.3
pod	0	4	0.0
total	80	122	65.5

# Copyright (C) 2011-2012, 2014-2015 Rocky Bernstein <[e-mail]>
use warnings; no warnings 'redefine';

use rlib '../../../..';

package Devel::Trepan::CmdProcessor::Command::Backtrace;
use if !@ISA, Devel::Trepan::CmdProcessor::Command ;

unless (@ISA) {
    eval <<"EOE";
use constant ALIASES    => qw(bt where T);
use constant CATEGORY   => 'stack';
use constant SHORT_HELP => 'Print backtrace of stack frames';
use constant MIN_ARGS   => 0;   # Need at least this many
use constant MAX_ARGS   => 1;   # Need at most this many - undef -> unlimited.
use constant NEED_STACK => 1;
EOE
}

use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
use vars @CMD_VARS;  # Value inherited from parent

our $NAME = set_name();
=pod

=head2 Synopsis:

=cut
our $HELP = <<'HELP';
=pod

B<backtrace> [I<count>]

Print a stack trace, with the most recent frame at the top. With a
positive number, print at most many entries.

In the listing produced, an arrow, C<--E<gt>>, indicates the 'current
frame'. The current frame determines the context used for many
debugger commands such as source-line listing
(L<C<list>|Devel::Trepan::CmdProcessor::Command::List>) or the
L<C<edit>|Devel::Trepan::CmdProcessor::Command::Edit> command.

=head2 Examples:

 backtrace    # Print a full stack trace
 backtrace 2  # Print only the top two entries

=head2 See also:

L<C<up>|Devel::Trepan::CmdProcessor::Command::Up>,
L<C<down>|Devel::Trepan::CmdProcessor::Command::Down>, and
L<C<frame>|Devel::Trepan::CmdProcessor::Command::Frame>,

=cut
HELP

sub complete($$)
{
    my ($self, $prefix) = @_;
    $self->{proc}->frame_complete($prefix);
}

# This method runs the command
sub run($$)
{
    my ($self, $args) = @_;
    my $proc = $self->{proc};
    my $opts = {
        basename    => $proc->{settings}{basename},
        current_pos => $proc->{frame_index},
        maxstack    => $proc->{settings}{maxstack},
        maxwidth    => $proc->{settings}{maxwidth},
        displayop    => $proc->{settings}{displayop},
    };
    my $stack_size = $proc->{stack_size};
    my $count = $stack_size;
    if (scalar @$args > 1) {
        $count =
            $proc->get_an_int($args->[1],
                              {cmdname   => $self->name,
                               min_value => 1});
        return unless defined $count;
    }
    $opts->{count} = $count;
    my @frames = $self->{dbgr}->tbacktrace($count-1);
    $self->{proc}->print_stack_trace(\@frames, $opts);
}

unless(caller) {
    # FIXME: DRY this code by putting in common location.
    require Devel::Trepan::DB;
    require Devel::Trepan::Core;
    my $db = Devel::Trepan::Core->new;
    my $intf = Devel::Trepan::Interface::User->new(undef, undef, {readline => 0});
    my $proc = Devel::Trepan::CmdProcessor->new([$intf], $db);

    $proc->{stack_size} = 0;
    my $cmd = __PACKAGE__->new($proc);
    $cmd->run([$NAME]);
}

1;