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   62646 use warnings; no warnings 'redefine';
  12     12   35  
  12     2   386  
  12     2   76  
  12         22  
  12         344  
  2         15  
  2         4  
  2         56  
  2         11  
  2         2  
  2         51  
5 12     12   61 use rlib '../../../..';
  12     2   25  
  12         70  
  2         10  
  2         4  
  2         8  
6              
7             package Devel::Trepan::CmdProcessor::Command::Macro;
8 12     12   4757 use English qw( -no_match_vars );
  12     2   3155  
  12         62  
  2         704  
  2         5  
  2         11  
9 12     12   4331 use if !@ISA, Devel::Trepan::CmdProcessor::Command ;
  12     2   50  
  12         80  
  2         511  
  2         4  
  2         13  
10             unless (@ISA) {
11 12     12   71 eval <<'EOE';
  12     12   26  
  12     12   659  
  12     12   66  
  12         27  
  12         522  
  12         93  
  12         28  
  12         479  
  12         64  
  12         28  
  12         371  
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   17016 use strict; use vars qw(@ISA); @ISA = @CMD_ISA;
  12     12   25  
  12     2   257  
  12     2   56  
  12         24  
  12         514  
  2         97  
  2         4  
  2         47  
  2         11  
  2         4  
  2         92  
20 12     12   70 use vars @CMD_VARS; # Value inherited from parent
  12     2   22  
  12         4799  
  2         10  
  2         5  
  2         823  
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 1131  
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         3  
95 0         0 $cmd_argstr =~ s/^\s+//;
  1         5  
96 0         0 my $fn = eval($cmd_argstr);
  1         114  
97 0 0 0     0 if ($EVAL_ERROR) {
  1 0 33     10  
    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         5  
101 0         0 $proc->msg("Macro \"${cmd_name}\" defined.");
  1         6  
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;