File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Load_Subcmd/Subcmd.pm
Criterion Covered Total %
statement 63 109 57.8
branch 0 20 0.0
condition n/a
subroutine 21 25 84.0
pod n/a
total 84 154 54.5


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2014 Rocky Bernstein <rocky@cpan.org>
3 12     12   627 use warnings; use utf8;
  12     12   30  
  12     2   526  
  12     2   69  
  12         34  
  12         91  
  2         19  
  2         7  
  2         72  
  2         15  
  2         7  
  2         23  
4 12     12   318 use rlib '../../../../..';
  12     2   32  
  12         157  
  2         85  
  2         8  
  2         18  
5              
6             package Devel::Trepan::CmdProcessor::Command::Load::Subcmd;
7 12     12   5120 use Cwd 'abs_path';
  12     2   31  
  12         594  
  2         1290  
  2         7  
  2         130  
8              
9 12     12   381 use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
  12     2   38  
  12         313  
  2         16  
  2         7  
  2         65  
10 12     12   78 use Devel::Trepan::DB::LineCache;
  12     2   38  
  12         2161  
  2         16  
  2         7  
  2         395  
11              
12 12     12   1636 use strict;
  12     2   32  
  12         727  
  2         18  
  2         7  
  2         140  
13             our (@ISA, @SUBCMD_VARS);
14             # Values inherited from parent
15 12     12   75 use vars @Devel::Trepan::CmdProcessor::Command::Subcmd::SUBCMD_VARS;
  12     2   32  
  12         2344  
  2         16  
  2         13  
  2         450  
16              
17             unless (@ISA) {
18 12     12   102 eval <<"EOE";
  12     12   35  
  12     12   1091  
  12         81  
  12         28  
  12         524  
  12         72  
  12         29  
  12         433  
19             use constant MIN_ARGS => 1;
20             use constant MAX_ARGS => 2;
21             use constant NEED_STACK => 0;
22             EOE
23             }
24              
25             @ISA = qw(Devel::Trepan::CmdProcessor::Command::Subcmd);
26              
27             our $HELP = <<'HELP';
28             =pod
29              
30             B<load subcmd> I<command> [I<Trepan-subcmd-module>]
31              
32             Load debugger subcommands of command
33             I<command>. [I<Trepan-subcmd-module>] is the file name a Devel::Trepan
34             subcommand module. If not given, we'll reload all subcommands under
35             command. This may or not be in the directory you were expecting;
36             beware when reloading everything.
37              
38             This command is useful if you want to add, change, or fix a debugger
39             command while inside the debugger.
40             =cut
41             HELP
42              
43             our $SHORT_HELP = 'Load debugger sub-command(s)';
44             our $MIN_ABBREV = length('sub');
45              
46 12     12   85 no warnings 'redefine';
  12     2   32  
  12         4546  
  2         17  
  2         7  
  2         899  
47              
48             sub complete($$)
49             {
50 0     0     my ($self, $prefix) = @_;
  0     0      
51 0           $self->{proc}->filename_complete($prefix);
  0            
52             }
53              
54             sub run($$)
55             {
56 0     0     my ($self, $args) = @_;
  0     0      
57 0           my $proc = $self->{proc};
  0            
58 0           my @args = @$args; shift @args; shift @args;
  0            
  0            
  0            
  0            
  0            
59 0           my $cmd_name = shift @args;
  0            
60 0           my $mgr = $proc->{commands}{$cmd_name};
  0            
61 0 0         if ($mgr) {
  0 0          
62 0 0         if ($mgr->can('load_debugger_subcommand')) {
  0 0          
63 0 0         if (scalar @args == 0) {
  0 0          
64 0           $mgr->load_debugger_subcommands();
  0            
65 0           $proc->msg("Subcommands of command '$cmd_name' reloaded");
  0            
66             } else {
67 0           my $trepan_subcmd_module = shift @args;
  0            
68 0 0         if (-r $trepan_subcmd_module) {
  0 0          
69 0           my $cmd="";
  0            
70 0 0         if ($mgr->load_debugger_subcommand(ucfirst
  0 0          
71             $cmd_name,
72             $trepan_subcmd_module)) {
73 0           my $msg = sprintf("File '%s' of command '%s' loaded",
  0            
74             $trepan_subcmd_module, $cmd_name);
75 0           $proc->msg($msg);
  0            
76             }
77             } else {
78 0           $proc->errmsg("File '$trepan_subcmd_module' is not readable")
  0            
79             }
80             }
81             } else {
82 0           $proc->errmsg("Command '$cmd_name' is does not have sub commands")
  0            
83             }
84             } else {
85 0           $proc->errmsg("Can't find debugger command: '$cmd_name'")
  0            
86             }
87             }
88              
89             unless (caller) {
90             require Devel::Trepan;
91             # Demo it.
92             # require_relative '../../mock'
93             # my($dbgr, $parent_cmd) = MockDebugger::setup('show');
94             # $cmd = __PACKAGE__->new(parent_cmd);
95             # $cmd->run(@$cmd->prefix);
96             }
97              
98             # Suppress a "used-once" warning;
99             $HELP || scalar @SUBCMD_VARS;