File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Macro.pm
Criterion Covered Total %
statement 71 86 82.5
branch 2 8 25.0
condition 1 6 16.6
subroutine 21 22 95.4
pod 0 2 0.0
total 95 124 76.6


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011-2014 Rocky Bernstein <rocky@cpan.org>
3              
4 12     12   30609 use warnings; no warnings 'redefine';
  12     12   32  
  12     2   487  
  12     2   71  
  12         30  
  12         427  
  2         19  
  2         7  
  2         62  
  2         10  
  2         6  
  2         58  
5 12     12   77 use rlib '../../../..';
  12     2   29  
  12         81  
  2         10  
  2         5  
  2         9  
6              
7             package Devel::Trepan::CmdProcessor::Command::Macro;
8 12     12   5150 use English qw( -no_match_vars );
  12     2   4789  
  12         94  
  2         652  
  2         5  
  2         15  
9 12     12   5912 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     2   50  
  12         97  
  2         651  
  2         4  
  2         19  
10             unless (@ISA) {
11 12     12   93 eval <<'EOE';
  12     12   39  
  12     12   786  
  12     12   79  
  12         31  
  12         552  
  12         79  
  12         31  
  12         529  
  12         76  
  12         42  
  12         431  
12             use constant CATEGORY => 'support';
13             use constant SHORT_HELP => 'Define a macro';
14             use constant MIN_ARGS => 3; # Need at least this many
15             use constant MAX_ARGS => undef; # Need at most this many - undef -> unlimited.
16             EOE
17             }
18              
19 12     12   2241 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   33  
  12     2   330  
  12     2   68  
  12         37  
  12         636  
  2         112  
  2         5  
  2         50  
  2         12  
  2         6  
  2         97  
20 12     12   86 use vars @CMD_VARS; # Value inherited from parent
  12     2   29  
  12         5830  
  2         11  
  2         4  
  2         833  
21              
22             our $NAME = set_name();
23             =pod
24              
25             =head2 Synopsis:
26              
27             =cut
28             our $HELP = <<'HELP';
29             =pod
30              
31             macro I<macro-name> sub { ... }
32              
33             Define I<macro-name> as a debugger macro. Debugger macros get a list of
34             arguments which you supply without parenthesis or commas. See below
35             for an example.
36              
37             The macro (really a Perl anonymous subroutine) should return either a
38             string or an list reference to a list of strings. Each string is a
39             debugger command.
40              
41             If a single string is returned, that gets tokenized by a simple C<split(/ /,
42             $string)>. Note that macro processing is done right after splitting
43             on C<;;> so if the macro returns a string containing C<;;> this will
44             not be handled on the string returned.
45              
46             If a reference to a list of strings is returned instead, then the
47             first string is shifted from the array and executed. The remaining
48             strings are pushed onto the command queue. In contrast to the first
49             string, subsequent strings can contain other macros. Any C<;;> in those
50             strings will be split into separate commands.
51              
52             =head2 Examples:
53              
54             The below creates a macro called I<fin+> which issues two commands
55             C<finish> followed by C<step>:
56              
57             macro fin+ sub{ ['finish', 'step']}
58              
59             If you wanted to parameterize the argument of the C<finish> command
60             you could do it this way:
61              
62             macro fin+ sub{ \
63             ['finish', 'step ' . (shift)] \
64             }
65              
66             Invoking with:
67              
68             fin+ 3
69              
70             would expand to C<["finish", "step 3"]>
71              
72             If you were to add another parameter, note that the invocation is like
73             you use for other debugger commands, no commas or parenthesis. That is:
74              
75             fin+ 3 2
76              
77             rather than C<fin+(3,2)> or C<fin+ 3, 2>.
78              
79             =head2 See also:
80              
81             L<C<alias>|Devel::Trepan::CmdProcessor::Command::Alias>, and
82             L<C<info macro>|Devel::Trepan::CmdProcessor::Command::Info::Macro>.
83              
84             =cut
85             HELP
86              
87             # This method runs the command
88             sub run($$) {
89 0     0 0 0 my ($self, $args) = @_;
  1     1 0 26  
90 0         0 my $cmd_name = $args->[1];
  1         4  
91 0         0 my $proc = $self->{proc};
  1         7  
92 0         0 my $cmd_argstr = $proc->{cmd_argstr};
  1         3  
93 0         0 $cmd_argstr =~ s/^\s+//;
  1         4  
94 0         0 $cmd_argstr = substr($cmd_argstr, length($cmd_name));
  1         4  
95 0         0 $cmd_argstr =~ s/^\s+//;
  1         44  
96 0         0 my $fn = eval($cmd_argstr);
  1         69  
97 0 0 0     0 if ($EVAL_ERROR) {
  1 0 33     13  
    50          
    50          
98 0         0 $proc->errmsg($EVAL_ERROR)
  0         0  
99             } elsif ($fn && ref($fn) eq 'CODE') {
100 0         0 $proc->{macros}{$cmd_name} = [$fn, $cmd_argstr];
  1         6  
101 0         0 $proc->msg("Macro \"${cmd_name}\" defined.");
  1         7  
102             } else {
103 0         0 $proc->errmsg("Expecting an anonymous subroutine");
  0            
104             }
105             }
106              
107             unless (caller) {
108             require Devel::Trepan::CmdProcessor;
109             my $proc = Devel::Trepan::CmdProcessor->new(undef, 'bogus');
110             my $cmd = __PACKAGE__->new($proc);
111             $proc->{cmd_argstr} = "fin+ sub{ ['finish', 'step']}";
112             my @args = ($NAME, split(/\s+/, $proc->{cmd_argstr}));
113             $cmd->run(\@args);
114             print join(' ', @{$proc->{macros}{'fin+'}}), "\n";
115             }
116              
117             1;