File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Show_Subcmd/Aliases.pm
Criterion Covered Total %
statement 36 84 42.8
branch 0 12 0.0
condition n/a
subroutine 12 16 75.0
pod n/a
total 48 112 42.8


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011-2012, 2013 Rocky Bernstein <rockbcpan.org>
3              
4 12     12   100 use warnings; no warnings 'redefine'; no warnings 'once';
  12     12   33  
  12     12   465  
  12     2   69  
  12     2   32  
  12     2   366  
  12         67  
  12         34  
  12         306  
  2         22  
  2         8  
  2         86  
  2         16  
  2         6  
  2         80  
  2         22  
  2         8  
  2         69  
5 12     12   68 use rlib '../../../../..';
  12     2   29  
  12         70  
  2         15  
  2         6  
  2         12  
6              
7             package Devel::Trepan::CmdProcessor::Command::Show::Aliases;
8 12     12   5396 use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
  12     2   33  
  12         537  
  2         1039  
  2         7  
  2         91  
9              
10             @ISA = qw(Devel::Trepan::CmdProcessor::Command::Subcmd);
11             # Values inherited from parent
12 12     12   72 use vars @Devel::Trepan::CmdProcessor::Command::Subcmd::SUBCMD_VARS;
  12     2   32  
  12         5087  
  2         14  
  2         6  
  2         1048  
13              
14             =pod
15              
16             =head2 Synopsis:
17              
18             =cut
19             our $HELP = <<"EOH";
20             =pod
21              
22             B<show aliases> [I<alias> [I<alias> ...]]
23              
24             If aliases names are given, show their definition. If left blank, show
25             all alias names.
26              
27             =head2 See also:
28              
29             L<C<alias>|Devel::Trepan::CmdProcessor::Command::Alias>, and
30             L<C<unalias>|Devel::Trepan::CmdProcessor::Command::Unalias>.
31              
32             =cut
33             EOH
34              
35             our $MIN_ABBREV = length('al');
36             our $SHORT_HELP = "Show defined aliases";
37              
38             sub complete($$)
39             {
40 0     0     my ($self, $prefix) = @_;
  0     0      
41 0           my $proc = $self->{proc};
  0            
42 0           my @candidates = keys %{$proc->{aliases}};
  0            
  0            
  0            
43 0           my @matches =
  0            
44             Devel::Trepan::Complete::complete_token(\@candidates, $prefix);
45 0           sort @matches;
  0            
46             }
47              
48             sub run($$) {
49 0     0     my ($self, $args) = @_;
  0     0      
50 0           my $proc = $self->{proc};
  0            
51 0           my @args = @$args;
  0            
52 0 0         if (scalar(@args) > 2) {
  0 0          
53 0           shift @args; shift @args;
  0            
  0            
  0            
54 0           for my $alias_name (@args) {
  0            
55 0 0         if (exists $proc->{aliases}{$alias_name}) {
  0 0          
56 0           my $msg = sprintf "%s: %s", $alias_name, $proc->{aliases}{$alias_name};
  0            
57 0           $proc->msg($msg);
  0            
58             } else {
59 0           $proc->msg("$alias_name is not a defined alias");
  0            
60             }
61             }
62             } else {
63 0           my @aliases = keys %{$proc->{aliases}};
  0            
  0            
  0            
64 0 0         if (scalar @aliases == 0) {
  0 0          
65 0           $proc->msg("No aliases defined.");
  0            
66             } else {
67 0           $proc->section("List of alias names currently defined:");
  0            
68 0           my @cmds = sort @aliases;
  0            
69 0           $proc->msg($self->{cmd}->columnize_commands(\@cmds));
  0            
70             }
71             }
72             }
73              
74             unless(caller) {
75             # Demo it.
76             # require_relative '../../mock';
77             # my $cmd = MockDebugger::sub_setup(__PACKAGE__);
78             # my $cmd->run($cmd->{prefix} + %w(u foo));
79             }
80              
81             1;