File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Show_Subcmd/Interactive.pm
Criterion Covered Total %
statement 36 56 64.2
branch 0 4 0.0
condition 0 6 0.0
subroutine 12 14 85.7
pod n/a
total 48 80 60.0


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011-2012, 2014 Rocky Bernstein <rocky@cpan.org>
3 12     12   116 use warnings; no warnings 'redefine'; no warnings 'once';
  12     12   36  
  12     12   461  
  12     2   68  
  12     2   35  
  12     2   336  
  12         66  
  12         37  
  12         360  
  2         18  
  2         7  
  2         112  
  2         17  
  2         8  
  2         87  
  2         16  
  2         6  
  2         71  
4 12     12   79 use rlib '../../../../..';
  12     2   31  
  12         75  
  2         13  
  2         9  
  2         12  
5              
6             package Devel::Trepan::CmdProcessor::Command::Show::Interactive;
7              
8 12     12   4857 use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
  12     2   33  
  12         488  
  2         1165  
  2         8  
  2         136  
9              
10             @ISA = qw(Devel::Trepan::CmdProcessor::Command::ShowBoolSubcmd);
11             # Values inherited from parent
12 12     12   65 use vars @Devel::Trepan::CmdProcessor::Command::Subcmd::SUBCMD_VARS;
  12     2   33  
  12         3300  
  2         20  
  2         8  
  2         867  
13              
14             =pod
15              
16             =head2 Synopsis:
17              
18             =cut
19              
20             our $HELP = <<"EOH";
21             =pod
22              
23             B<show interactive>
24              
25             Show whether debugger input is a terminal.
26             =cut
27             EOH
28             our $SHORT_HELP = "Show whether debugger input is a terminal";
29             our $MIN_ABBREV = length('inter');
30              
31             sub run($$)
32             {
33 0     0     my ($self, $args) = @_;
  0     0      
34 0           my $proc = $self->{proc};
  0            
35 0           my $intf = $proc->{interfaces}->[-1];
  0            
36 0           my $bool = $intf->is_interactive();
  0            
37 0           my $msg = sprintf("Debugger's interactive mode is %s.",
  0            
38             $self->show_onoff($bool));
39 0           $proc->msg($msg);
  0            
40 0 0         if ($bool) {
  0 0          
41             $bool = $intf->{input}->can("have_term_readline") &&
42 0   0       $intf->{input}->have_term_readline();
  0   0        
43 0           $msg = sprintf("Terminal Readline capability is %s.",
  0            
44             $self->show_onoff(!!$bool));
45 0           $proc->msg($msg);
  0            
46             }
47             }
48              
49             unless (caller) {
50             # Demo it.
51             # require_relative '../../mock'
52              
53             # # FIXME: DRY the below code
54             # my ($dbgr, $cmd) = MockDebugger::setup('show');
55             # $subcommand = __PACKAGE__->new(cmd);
56             # $testcmdMgr = Trepan::Subcmd->new(subcommand);
57              
58             # $subcommand->run_show_bool();
59             # $subcommand->summary_help($NAME);
60             }
61              
62             1;