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   107 use warnings; no warnings 'redefine';
  12     12   33  
  12     1   407  
  12     1   64  
  12         30  
  12         409  
  1         8  
  1         2  
  1         24  
  1         5  
  1         2  
  1         32  
4              
5 12     12   65 use rlib '../../../..';
  12     1   33  
  12         78  
  1         5  
  1         2  
  1         6  
6              
7             package Devel::Trepan::CmdProcessor::Command::Debug;
8 12     12   4192 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     1   31  
  12         71  
  1         334  
  1         2  
  1         5  
9              
10             unless (@ISA) {
11 12     12   81 eval <<'EOE';
  12     12   32  
  12     12   666  
  12     12   79  
  12     12   28  
  12         580  
  12         77  
  12         27  
  12         497  
  12         70  
  12         31  
  12         475  
  12         73  
  12         32  
  12         516  
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   1892 use strict;
  12     1   33  
  12         278  
  1         51  
  1         2  
  1         21  
22 12     12   68 use Devel::Trepan::Util;
  12     1   31  
  12         1819  
  1         5  
  1         2  
  1         134  
23              
24 12     12   85 use vars qw(@ISA); @ISA = @CMD_ISA;
  12     1   31  
  12         610  
  1         5  
  1         2  
  1         44  
25 12     12   74 use vars @CMD_VARS; # Value inherited from parent
  12     1   33  
  12         2314  
  1         4  
  1         5  
  1         163  
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   85 no warnings 'once';
  12     1   30  
  12         1722  
  1         5  
  1         3  
  1         130  
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             }