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

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

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

unless (@ISA) {
    eval <<'EOE';
    use constant CATEGORY   => 'data';
    use constant SHORT_HELP => 'debug into a Perl expression or statement';
    use constant MIN_ARGS   => 1;      # Need at least this many
    use constant MAX_ARGS   => undef;  # Need at most this many -
                                       # undef -> unlimited.
    use constant NEED_STACK => 0;
EOE
}

use strict;
use Devel::Trepan::Util;

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

our $NAME = set_name();
our $HELP = <<'HELP';
=pod

B<debug> I<Perl-code>

Recursively debug I<Perl-code>.

The level of recursive debugging is shown in the prompt. For example
C<((trepan.pl))> indicates one nested level of debugging.

=head2 Examples:

 debug finonacci(5)   # Debug fibonacci function
 debug $x=1; $y=2;    # Kind of pointless, but doable.
=cut
HELP

# sub complete($$)
# {
#     my ($self, $prefix) = @_;
# }

sub run($$)
{
    my ($self, $args) = @_;
    my $proc = $self->{proc};
    my $expr = $proc->{cmd_argstr};
    # Trim leading and trailing spaces.
    $expr =~ s/^\s+//; $expr =~ s/\s+$//;
    my $cmd_name = $args->[0];
    no warnings 'once';
    my $opts = {
        return_type => parse_eval_suffix($cmd_name),
        nest => $DB::level,
        # Don't fix up __FILE__ and __LINE__ in this eval.
        # We want to see our debug (eval) with its string.
        fix_file_and_line => 0
    };

    # FIXME: may mess up trace print. And cause skips we didn't want.
    ## Skip over stopping in the eval that is setup below.
    ## $proc->{skip_count} = 1;

    # Have to use $^D rather than $DEBUGGER below since we are in the
    # user's code and they might not have English set.
    my $full_expr =
        "\$DB::event=undef;\n"   .
        "\$DB::single = 1;\n"    .
        "\$^D |= DB::db_stop;\n" .
        "\$DB::in_debugger=0;\n" .
        $expr;

    $proc->eval($full_expr, $opts);

}

unless (caller) {
  # require_relative '../mock'
  # dbgr, cmd = MockDebugger::setup
  # arg_str = '1 + 2'
  # $proc->{cmd_argstr} = $arg_str;
  # print "eval ${arg_str} is: ${cmd.run([cmd.name, arg_str])}\n";
  # $arg_str = 'return "foo"';
  # # sub cmd.proc.current_source_text
  # # {
  # #   'return "foo"';
  # # }
  # # $proc->{cmd_argstr} = $arg_str;
  # # print "eval? ${arg_str} is: ${cmd.run([cmd.name + '?'])}\n";
}