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

use Devel::Trepan::DB;

package Devel::Trepan::CmdProcessor::Command::Set::Display::OP;
use Devel::Trepan::CmdProcessor::Command::Subcmd::Subsubcmd;

use strict;
use vars qw(@ISA @SUBCMD_VARS);
@ISA = qw(Devel::Trepan::CmdProcessor::Command::SetBoolSubsubcmd);
# Values inherited from parent

use vars @Devel::Trepan::CmdProcessor::Command::Subsubcmd::SUBCMD_VARS;

our $IN_LIST      = 1;
=pod

=head2 Synopsis:

=cut

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

Set to show the OP address in location status.

The OP address is the address of the Perl Tree Opcode that is about
to be run. It gives the most precise indication of where you are.
This can be useful in disambiguating where among Perl several
statements in a line you are at.

In the future we may also allow a breakpoint at a COP address.

=head2 See also:

L<C<show display op>|Devel::Trepan::CmdProcessor::Command::Show::Display::OP>,
L<C<show line>|Devel::Trepan::CmdProcessor::Command::Show::Line>,
L<C<show program>|Devel::Trepan::CmdProcessor::Command::Show::Program>, and
L<C<disassemble>|Devel::Trepan::CmdProcessor::Command::Disassemble>
(via plugin L<Devel::Trepan::Disassemble>).
=cut

HELP

our $MIN_ABBREV   = length('co');
use constant MAX_ARGS => 1;
our $SHORT_HELP   = "Set to show OP address in locations";

sub run($$)
{
    my ($self, $args) = @_;
    if ($DB::HAVE_MODULE{'Devel::Callsite'}) {
        $self->SUPER::run($args);
    } else {
        $self->{proc}->errmsg("You need Devel::Callsite installed to run this");
    }
}

unless (caller) {
    # Demo it.
    # DRY this.
    require Devel::Trepan::CmdProcessor;
    my $cmdproc = Devel::Trepan::CmdProcessor->new();
    my $subcmd  =  Devel::Trepan::CmdProcessor::Command::Set->new($cmdproc, 'set');
    my $dispcmd =  Devel::Trepan::CmdProcessor::Command::Set::Display->new($subcmd, 'display');
    my $opcmd   =  Devel::Trepan::CmdProcessor::Command::Set::Display::OP->new($dispcmd, 'op');
    # Add common routine
    foreach my $field (qw(min_abbrev name)) {
	printf "Field %s is: %s\n", $field, $opcmd->{$field};
    }
    my @args = qw(set display op on);
    $opcmd->run(\@args);
    @args = qw(set display op off);
    $opcmd->run(\@args);
}

1;