File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Debug.pm
Criterion Covered Total %
statement 69 87 79.3
branch n/a
condition n/a
subroutine 23 25 92.0
pod 0 2 0.0
total 92 114 80.7


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011, 2012, 2014 Rocky Bernstein <rockb@cpan.org>
3 12     12   92 use warnings; no warnings 'redefine';
  12     12   29  
  12     1   412  
  12     1   64  
  12         22  
  12         361  
  1         6  
  1         2  
  1         37  
  1         6  
  1         2  
  1         29  
4              
5 12     12   57 use rlib '../../../..';
  12     1   27  
  12         58  
  1         5  
  1         2  
  1         3  
6              
7             package Devel::Trepan::CmdProcessor::Command::Debug;
8 12     12   4447 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   25  
  12         76  
  1         336  
  1         2  
  1         5  
9              
10             unless (@ISA) {
11 12     12   69 eval <<'EOE';
  12     12   27  
  12     12   632  
  12     12   69  
  12     12   36  
  12         614  
  12         74  
  12         26  
  12         583  
  12         69  
  12         35  
  12         551  
  12         72  
  12         32  
  12         481  
12             use constant CATEGORY => 'data';
13             use constant SHORT_HELP => 'debug into a Perl expression or statement';
14             use constant MIN_ARGS => 1; # Need at least this many
15             use constant MAX_ARGS => undef; # Need at most this many -
16             # undef -> unlimited.
17             use constant NEED_STACK => 0;
18             EOE
19             }
20              
21 12     12   1896 use strict;
  12     1   26  
  12         382  
  1         64  
  1         3  
  1         20  
22 12     12   67 use Devel::Trepan::Util;
  12     1   46  
  12         2748  
  1         4  
  1         2  
  1         122  
23              
24 12     12   77 use vars qw(@ISA); @ISA = @CMD_ISA;
  12     1   23  
  12         808  
  1         6  
  1         1  
  1         49  
25 12     12   80 use vars @CMD_VARS; # Value inherited from parent
  12     1   25  
  12         2228  
  1         6  
  1         2  
  1         171  
26              
27             our $NAME = set_name();
28             our $HELP = <<'HELP';
29             =pod
30              
31             B<debug> I<Perl-code>
32              
33             Recursively debug I<Perl-code>.
34              
35             The level of recursive debugging is shown in the prompt. For example
36             C<((trepan.pl))> indicates one nested level of debugging.
37              
38             =head2 Examples:
39              
40             debug finonacci(5) # Debug fibonacci function
41             debug $x=1; $y=2; # Kind of pointless, but doable.
42             =cut
43             HELP
44              
45             # sub complete($$)
46             # {
47             # my ($self, $prefix) = @_;
48             # }
49              
50             sub run($$)
51             {
52 0     0 0   my ($self, $args) = @_;
  0     0 0    
53 0           my $proc = $self->{proc};
  0            
54 0           my $expr = $proc->{cmd_argstr};
  0            
55             # Trim leading and trailing spaces.
56 0           $expr =~ s/^\s+//; $expr =~ s/\s+$//;
  0            
  0            
  0            
57 0           my $cmd_name = $args->[0];
  0            
58 12     12   94 no warnings 'once';
  12     1   25  
  12         2158  
  1         6  
  1         2  
  1         145  
59 0           my $opts = {
  0            
60             return_type => parse_eval_suffix($cmd_name),
61             nest => $DB::level,
62             # Don't fix up __FILE__ and __LINE__ in this eval.
63             # We want to see our debug (eval) with its string.
64             fix_file_and_line => 0
65             };
66              
67             # FIXME: may mess up trace print. And cause skips we didn't want.
68             ## Skip over stopping in the eval that is setup below.
69             ## $proc->{skip_count} = 1;
70              
71             # Have to use $^D rather than $DEBUGGER below since we are in the
72             # user's code and they might not have English set.
73 0           my $full_expr =
  0            
74             "\$DB::event=undef;\n" .
75             "\$DB::single = 1;\n" .
76             "\$^D |= DB::db_stop;\n" .
77             "\$DB::in_debugger=0;\n" .
78             $expr;
79              
80 0           $proc->eval($full_expr, $opts);
  0            
81              
82             }
83              
84             unless (caller) {
85             # require_relative '../mock'
86             # dbgr, cmd = MockDebugger::setup
87             # arg_str = '1 + 2'
88             # $proc->{cmd_argstr} = $arg_str;
89             # print "eval ${arg_str} is: ${cmd.run([cmd.name, arg_str])}\n";
90             # $arg_str = 'return "foo"';
91             # # sub cmd.proc.current_source_text
92             # # {
93             # # 'return "foo"';
94             # # }
95             # # $proc->{cmd_argstr} = $arg_str;
96             # # print "eval? ${arg_str} is: ${cmd.run([cmd.name + '?'])}\n";
97             }