File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Display_Subcmd/Eval.pm
Criterion Covered Total %
statement 30 53 56.6
branch 0 8 0.0
condition n/a
subroutine 10 12 83.3
pod n/a
total 40 73 54.7


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2011-2015 Rocky Bernstein <rocky@cpan.org>
3 12     12   86 use warnings; no warnings 'redefine'; no warnings 'once';
  12     12   38  
  12     12   487  
  12         72  
  12         33  
  12         365  
  12         70  
  12         37  
  12         322  
4 12     12   73 use rlib '../../../../../..';
  12         31  
  12         75  
5              
6             # eval "use Data::Dumper::Perltidy";
7              
8             package Devel::Trepan::CmdProcessor::Command::Set::Display::Eval;
9              
10 12     12   5165 use Devel::Trepan::CmdProcessor::Command::Subcmd::Subsubcmd;
  12         37  
  12         286  
11              
12 12     12   66 use strict;
  12         32  
  12         301  
13 12     12   66 use vars qw(@ISA @SUBCMD_VARS);
  12         29  
  12         836  
14             @ISA = qw(Devel::Trepan::CmdProcessor::Command::Subsubcmd);
15             # Values inherited from parent
16              
17 12     12   79 use vars @Devel::Trepan::CmdProcessor::Command::Subsubcmd::SUBCMD_VARS;
  12         35  
  12         2450  
18             our $CMD = 'set display eval';
19             my @DISPLAY_TYPES = @Devel::Trepan::CmdProcessor::DISPLAY_TYPES;
20             my $param = join('|', @DISPLAY_TYPES);
21             =pod
22              
23             =head2 Synopsis:
24              
25             =cut
26              
27             our $HELP = <<"HELP";
28             =pod
29              
30             B<set display eval> {B<concise>|B<ddp>|B<dumper>|B<tidy> [printer options]}
31              
32             Set how you want evaluation results to be shown.
33              
34             Devel::Trepan relegates how Perl the contents of expressions variables
35             are displayed to one of the many Perl modules designed for this
36             purpose. Below is a list of the option name and the corresponding Perl
37             module that gets used for that option. I<Note: the order given is the
38             order tried by default on startup.>
39              
40             =over
41              
42             =item *
43             C<ddp> E<mdash> L<Data::Printer>
44              
45             =item *
46             C<tidy> E<mdash> L<Data::Dumper::Perltidy>
47              
48             =item *
49             C<concise> E<mdash> L<Data::Dumper::Concise>
50              
51             =item *
52             C<dumper> E<mdash> L<Data::Dumper>
53              
54             =back
55              
56             See the respective display manual pages for how to influence display
57             for a given module.
58              
59             =head2 Examples:
60              
61             set display eval dumper
62             set display eval ddp # works only if Data::Printer is around
63             set display eval ddp { colored => 0 }
64             set display eval tidy # works if Data::Dumper::Perltidy is around
65             set display eval tidy -nst -mbl=2 -pt=0 -nola
66              
67             =head2 See also:
68              
69             L<C<show display eval>|Devel::Trepan::CmdProcessor::Command::Show::Display::Eval>,
70             L<C<eval>|Devel::Trepan::CmdProcessor::Command::Eval>,
71             L<C<set auto eval>|Devel::Trepan::CmdProcessor::Command::Set::Auto::Eval>,
72             L<Data::Dumper::Perltidy>, and
73             L<Data::Printer>.
74              
75             =cut
76             HELP
77              
78             our $MIN_ABBREV = length('ev');
79 12     12   100 use constant MIN_ARGS => 1;
  12         38  
  12         778  
80 12     12   82 use constant MAX_ARGS => 1;
  12         29  
  12         6851  
81             our $SHORT_HELP = 'Set how you want the evaluation results shown';
82              
83             sub complete($$)
84             {
85 0     0     my ($self, $prefix) = @_;
86 0           Devel::Trepan::Complete::complete_token(\@DISPLAY_TYPES, $prefix);
87             }
88              
89             sub run($$)
90             {
91 0     0     my ($self, $args) = @_;
92 0           my $proc = $self->{proc};
93 0           my @args = @{$args};
  0            
94 0           my $evaltype = $args[3];
95 0           my @result = grep($_ eq $evaltype, @DISPLAY_TYPES);
96 0 0         if (1 == scalar @result) {
97 0           my $key = $self->{subcmd_setting_key};
98 0           $proc->{settings}{$key} = $evaltype;
99 0           my $argc = scalar @args;
100 0 0         if ($argc > 4) {
101 0           my $dp_args = join(' ', @{$args[4..$argc-1]});
  0            
102 0 0         if ($evaltype eq 'ddp') {
    0          
103 0           eval("use Data::Printer $dp_args");
104             } elsif ($evaltype eq 'tidy') {
105 0           eval "$Data::Dumper::Perltidy::ARGV = '$dp_args'";
106             }
107             }
108             } else {
109 0           my $or_list = join(', or ', map{"'$_'"} @DISPLAY_TYPES);
  0            
110 0           $proc->errmsg("Expecting either $or_list; got ${evaltype}");
111 0           return;
112             }
113 0           $proc->{commands}{show}->run(['show', 'display', 'eval']);
114             }
115              
116             unless (caller) {
117             require Devel::Trepan::CmdProcessor;
118             my $cmdproc = Devel::Trepan::CmdProcessor->new();
119             my $subcmd = Devel::Trepan::CmdProcessor::Command::Set->new($cmdproc, 'set');
120             my $parent_cmd = Devel::Trepan::CmdProcessor::Command::Set::Display->new($subcmd, 'display');
121             my $cmd = __PACKAGE__->new($parent_cmd, 'eval');
122             # Add common routine
123             foreach my $field (qw(min_abbrev name)) {
124             printf "Field %s is: %s\n", $field, $cmd->{$field};
125             }
126             my @args = qw(set display eval dumper);
127             $cmd->run(\@args);
128             @args = qw(set display eval concise);
129             $cmd->run(\@args);
130             }
131              
132             1;