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; |