File Coverage

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


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011, 2014 Rocky Bernstein <rocky@cpan.org>
3 12     12   110 use warnings; no warnings 'redefine'; no warnings 'once';
  12     12   41  
  12     12   470  
  12     2   79  
  12     2   29  
  12     2   332  
  12         63  
  12         34  
  12         298  
  2         17  
  2         7  
  2         71  
  2         13  
  2         12  
  2         105  
  2         15  
  2         6  
  2         82  
4 12     12   70 use rlib '../../../../..';
  12     2   30  
  12         74  
  2         14  
  2         7  
  2         17  
5              
6             package Devel::Trepan::CmdProcessor::Command::Show::Highlight;
7              
8 12     12   4935 use Devel::Trepan::CmdProcessor::Command::Subcmd::Core;
  12     2   33  
  12         532  
  2         1128  
  2         5  
  2         98  
9              
10             @ISA = qw(Devel::Trepan::CmdProcessor::Command::ShowBoolSubcmd);
11             # Values inherited from parent
12 12     12   71 use vars @Devel::Trepan::CmdProcessor::Command::Subcmd::SUBCMD_VARS;
  12     2   30  
  12         4155  
  2         13  
  2         7  
  2         875  
13              
14             # =pod
15             #
16             # =head2 Synopsis:
17             #
18             # =cut
19             our $HELP = <<"EOH";
20             =pod
21              
22             B<show highlight>
23              
24             Show whether we use terminal highlighting
25              
26             =head2 See also:
27              
28             L<C<set highlight>|Devel::Trepan::CmdProcessor::Command::Set::Highlight>
29             =cut
30             EOH
31             our $SHORT_HELP = "Show whether we use terminal highlighting";
32             our $MIN_ABBREV = length('high');
33              
34             sub run($$)
35             {
36 0     0     my ($self, $args) = @_;
  0     0      
37 0           my $proc = $self->{proc};
  0            
38 0   0       my $val = $proc->{settings}{highlight} || 'plain';
  0   0        
39 0           my $mess;
  0            
40 0 0         if ('plain' eq $val) {
  0 0          
    0          
    0          
    0          
    0          
41 0           $mess = 'output set to not use terminal escape sequences';
  0            
42             } elsif ('light' eq $val) {
43 0           $mess = 'output set for terminal with escape sequences ' .
  0            
44             'for a light background';
45             } elsif ('dark' eq $val) {
46 0           $mess = ('output set for terminal with escape sequences ' .
  0            
47             'for a dark background')
48             } else {
49 0           $proc->errmsg(sprintf('Internal error: incorrect highlight setting %s', $val));
  0            
50             }
51 0           $proc->msg($mess);
  0            
52             }
53              
54             unless (caller) {
55             # Demo it.
56             require Devel::Trepan::CmdProcessor;
57             my $proc = Devel::Trepan::CmdProcessor->new;
58             my $parent = Devel::Trepan::CmdProcessor::Command::Set->new($proc, 'show');
59             my $cmd = __PACKAGE__->new($parent, 'highlight');
60             print $cmd->{help}, "\n";
61             print "min args: ", $cmd->MIN_ARGS, "\n";
62             print $cmd->run();
63             }
64              
65             1;