File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Info_Subcmd/Macros.pm
Criterion Covered Total %
statement 36 90 40.0
branch 0 24 0.0
condition 0 6 0.0
subroutine 12 14 85.7
pod n/a
total 48 134 35.8


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   148 use warnings;
  12     1   39  
  12         533  
  1         8  
  1         3  
  1         27  
5 12     12   77 use rlib '../../../../..';
  12     1   35  
  12         76  
  1         6  
  1         3  
  1         4  
6              
7             # For highight_string
8 12     12   5206 use Devel::Trepan::DB::LineCache;
  12     1   37  
  12         2919  
  1         440  
  1         2  
  1         213  
9              
10             package Devel::Trepan::CmdProcessor::Command::Info::Macros;
11 12     12   99 use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
  12     1   31  
  12         555  
  1         8  
  1         2  
  1         37  
12              
13             @ISA = qw(Devel::Trepan::CmdProcessor::Command::Subcmd);
14             # Values inherited from parent
15 12     12   76 use vars @Devel::Trepan::CmdProcessor::Command::Subcmd::SUBCMD_VARS;
  12     1   30  
  12         2269  
  1         5  
  1         3  
  1         145  
16              
17             unless (@ISA) {
18             eval <<"EOE";
19             use constant MAX_ARGS => undef; # unlimited.
20             EOE
21             }
22              
23             our $CMD = "info macros";
24             =pod
25              
26             =head2 Synopsis:
27              
28             =cut
29             our $HELP = <<'HELP';
30             =pod
31              
32             info macros
33              
34             B<info macros *>
35             B<info macros> I<macro1> [I<macro2> ..]
36              
37             In the first form a list of the existing macro names are shown
38             in column format.
39              
40             In the second form, all macro names and their definitions are shown.
41              
42             In the last form the only definitions of the given macro names is shown.
43             show macro [I<name1> I<name2> ...]
44              
45             If macros names are given, show their definition. If left blank, show
46             all macro names.
47             =cut
48             HELP
49              
50             our $MIN_ABBREV = length('ma');
51             our $SHORT_HELP = "Show defined macros";
52              
53             # sub complete($$) {
54             # {
55             # my ($self, $prefix) = @_;
56             # my @cmds = sort keys %{$proc->{macros}};
57             # Trepan::Complete.complete_token(@cmds, $prefix);
58             # }
59              
60 12     12   87 no warnings 'redefine';
  12     1   31  
  12         4499  
  1         7  
  1         2  
  1         365  
61             sub run($$) {
62 0     0     my ($self, $args) = @_;
  0     0      
63 0           my $proc = $self->{proc};
  0            
64 0           my @args = @$args;
  0            
65 0 0         if (scalar(@args) > 2) {
  0 0          
66 0           my @macro_names;
  0            
67 0 0 0       if ((scalar(@args)) == 3 && '*' eq $args[2]) {
  0 0 0        
68 0           @macro_names = sort keys %{$proc->{macros}};
  0            
  0            
  0            
69 0 0         if (scalar @macro_names == 0) {
  0 0          
70 0           $proc->msg("No macros defined.");
  0            
71 0           return;
  0            
72             }
73             } else {
74 0           @macro_names = @args[2..$#args];
  0            
75             }
76 0           for my $macro_name (@macro_names) {
  0            
77 0 0         if (exists $proc->{macros}{$macro_name}) {
  0 0          
78 0           my $line = $proc->{macros}{$macro_name}->[1];
  0            
79 0 0         if ($proc->{settings}{highlight}) {
  0 0          
80 0           $line = Devel::Trepan::DB::LineCache::highlight_string($line);
  0            
81             }
82 0           my $msg = sprintf("%s: %s", $macro_name, $line);
  0            
83 0           $proc->msg($msg);
  0            
84             } else {
85 0           $proc->errmsg("$macro_name is not a defined macro");
  0            
86             }
87             }
88             } else {
89 0           my @macros = sort keys %{$proc->{macros}};
  0            
  0            
  0            
90 0 0         if (scalar @macros == 0) {
  0 0          
91 0           $proc->msg("No macros defined.");
  0            
92             } else {
93 0           $proc->section("List of macro names currently defined:");
  0            
94 0           my @cmds = sort @macros;
  0            
95 0           $proc->msg($self->{cmd}->columnize_commands(\@cmds));
  0            
96             }
97             }
98             }
99              
100             unless(caller) {
101             # Demo it.
102             # require_relative '../../mock';
103             # my $cmd = MockDebugger::sub_setup(__PACKAGE__);
104             # my $cmd->run($cmd->{prefix} + %w(u foo));
105             }
106              
107             1;