The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Copyright (C) 2011-2012 Rocky Bernstein <rocky@cpan.org>
use warnings; no warnings 'redefine';

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

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

unless (@ISA) {
    eval <<'EOE';
use constant CATEGORY   => 'stack';
use constant SHORT_HELP => 'Set frame for use in commands';
use constant MIN_ARGS  => 0;  # Need at least this many
use constant MAX_ARGS  => 2;  # 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<frame> [I<frame-number>]

Change the current frame to frame I<frame-number> if specified, or the
most-recent frame, 0, if no frame number specified.

A negative number indicates the position from the other or
least-recently-entered end.  So C<frame -1> moves to the oldest frame.

=head2 Examples:

   frame     # Set current frame at the current stopping point
   frame 0   # Same as above
   frame .   # Same as above. 'current thread' is explicit.
   frame . 0 # Same as above.
   frame 1   # Move to frame 1. Same as: frame 0; up
   frame -1  # The least-recent frame

=head2 See also:

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

=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 $position_str;

    if (scalar @$args == 1) {
        # Form is: "frame" which means "frame 0"
        $position_str = '0';
    } elsif (scalar @$args == 2) {
        # Form is: "frame position"
        $position_str = $args->[1];
    }

    my ($low, $high) = $proc->frame_low_high(0);
    my $opts= {
        'msg_on_error' =>
            "The '${NAME}' command requires a frame number. Got: ${position_str}",
        min_value => $low,
        max_value => $high
    };
    my $frame_num = $proc->get_an_int($position_str, $opts);
    return unless defined $frame_num;
    $proc->adjust_frame($frame_num, 1);
}

unless (caller) {
    require Devel::Trepan::DB;
    require Devel::Trepan::Core;
    my $db = Devel::Trepan::Core->new;
    my $intf = Devel::Trepan::Interface::User->new;
    my $proc = Devel::Trepan::CmdProcessor->new([$intf], $db);
    $proc->{stack_size} = 0;
    my $cmd = __PACKAGE__->new($proc);
    $cmd->run([$NAME, 0]);
}

1;