1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
package Data::Printer::Profile::Dumper;
use strict;
use warnings;
sub profile {
return {
show_tainted => 0,
show_unicode => 0,
show_lvalue => 0,
print_escapes => 0,
scalar_quotes => q('),
escape_chars => 'none',
string_max => 0,
unicode_charnames => 0,
array_max => 0,
index => 0,
hash_max => 0,
hash_separator => ' => ',
align_hash => 0,
sort_keys => 0,
quote_keys => 1,
name => '$VAR1',
arrows => 'first',
return_value => 'dump',
output => 'stderr',
indent => 10,
show_readonly => 0,
show_tied => 0,
show_dualvar => 'off',
show_weak => 0,
show_refcount => 0,
show_memsize => 0,
separator => ',',
end_separator => 0,
caller_info => 0,
colored => 0,
class_method => undef,
# Data::Printer doesn't provide a way to directly
# decorate filters, so we do it ourselves:
filters => [
{
'-class' => \&_data_dumper_class_filter,
'SCALAR' => \&_data_dumper_scalar_filter,
'LVALUE' => \&_data_dumper_lvalue_filter,
'HASH' => \&_data_dumper_hash_filter,
'ARRAY' => \&_data_dumper_array_filter,
'CODE' => \&_data_dumper_code_filter,
'FORMAT' => \&_data_dumper_format_filter,
'GLOB' => \&_data_dumper_glob_filter,
'REF' => \&_data_dumper_ref_filter,,
'Regexp' => \&_data_dumper_regexp_filter,
'VSTRING' => \&_data_dumper_vstring_filter,
},
],
};
}
sub _data_dumper_regexp_filter {
my ($re, $ddp) = @_;
my $v = "$re";
my $mod = "";
if ($v =~ /^\(\?\^?([msixpadlun-]*):([\x00-\xFF]*)\)\z/) {
$mod = $1;
$v = $2;
$mod =~ s/-.*//;
}
$v =~ s{/}{\\/}g;
return _output_wrapper($ddp, $ddp->maybe_colorize("qr/$v/$mod", 'regex'));
}
sub _data_dumper_glob_filter {
my ($glob, $ddp) = @_;
my $ret = "$$glob";
$ret =~ s|\A\*main:|\*:|;
$ret =~ s|\A\*|\\*{'|;
$ret .= '\'}';
return _output_wrapper($ddp, $ddp->maybe_colorize($ret, 'glob'));
}
sub _data_dumper_lvalue_filter {
my (undef, $ddp) = @_;
Data::Printer::Common::_warn($ddp, 'cannot handle ref type 10');
return _output_wrapper($ddp, '');
}
sub _data_dumper_scalar_filter {
my ($scalar, $ddp) = @_;
my $ret = Data::Printer::Filter::SCALAR::parse(@_);
return _output_wrapper($ddp, $ret);
}
sub _data_dumper_ref_filter {
my ($scalar, $ddp) = @_;
$ddp->indent;
my $ret = Data::Printer::Filter::REF::parse(@_);
$ret =~ s{\A[\\]+\s+}{\\}; # DDP's REF filter adds a space after refs.
$ddp->outdent;
return _output_wrapper($ddp, $ret);
}
sub _data_dumper_vstring_filter {
my ($scalar, $ddp) = @_;
my $ret = Data::Printer::Filter::VSTRING::parse(@_);
if ($] < 5.009 && substr($ret, 0, 7) eq 'VSTRING') {
$ret = $ddp->maybe_colorize('', 'vstring');
}
return _output_wrapper($ddp, $ret);
}
sub _data_dumper_format_filter {
my (undef, $ddp) = @_;
Data::Printer::Common::_warn($ddp, 'cannot handle ref type 14');
return _output_wrapper($ddp, '');
}
sub _data_dumper_code_filter {
my (undef, $ddp) = @_;
return _output_wrapper($ddp, $ddp->maybe_colorize('sub { "DUMMY" }', 'code'));
}
sub _data_dumper_array_filter {
my ($hashref, $ddp) = @_;
my $ret = Data::Printer::Filter::ARRAY::parse(@_);
return _output_wrapper($ddp, $ret);
}
sub _data_dumper_hash_filter {
my ($hashref, $ddp) = @_;
my $ret = Data::Printer::Filter::HASH::parse(@_);
return _output_wrapper($ddp, $ret);
}
sub _data_dumper_class_filter {
my ($obj, $ddp) = @_;
require Scalar::Util;
my $reftype = Scalar::Util::reftype($obj);
$reftype = 'Regexp' if $reftype eq 'REGEXP';
my ($parse_prefix, $parse_suffix) = ('', '');
if ($reftype eq 'SCALAR' || $reftype eq 'REF' || $reftype eq 'VSTRING') {
$parse_prefix = 'do{\(my $o = ';
$parse_prefix .= '\\' if $reftype eq 'REF';
$parse_suffix = ')}';
}
$ddp->indent;
my $ret = $ddp->maybe_colorize('bless( ' . $parse_prefix, 'method')
. $ddp->parse_as($reftype, $obj)
. $ddp->maybe_colorize($parse_suffix, 'method')
. q|, '| . $ddp->maybe_colorize(ref($obj), 'class') . q|'|
. $ddp->maybe_colorize(' )', 'method')
;
$ddp->outdent;
return _output_wrapper($ddp, $ret);
}
sub _output_wrapper {
my ($ddp, $output) = @_;
if ($ddp->current_depth == 0) {
$output = '$VAR1 = ' . $output . ';';
}
return $output;
}
1;
__END__
=head1 NAME
Data::Printer::Profile::Dumper - use DDP like Data::Dumper
=head1 SYNOPSIS
While loading Data::Printer:
use DDP profile => 'Dumper';
While asking for a print:
p $var, profile => 'Dumper';
or in your C<.dataprinter> file:
profile = Dumper
=head1 DESCRIPTION
This profile tries to simulate Data::Dumper's output as closely as possible,
using Data::Printer, even skipping types unsupported by Data::Dumper like lvalues
and formats.
It's not guaranteed to be 100% accurate, but hopefully it's close enough :)
=head2 Notable Diferences from Data::Dumper
It's important to notice that this profile tries to emulate
Data::Dumper's I<output>, NOT its behaviour. As such, some things are
still happening in a much DDP-ish way.
* no $VAR2, ...
* return value
* prototypes
* still called 'p' (say alias = 'Dumper' if you want)
* arg is always a reference, so on the top level, references to scalars will be rendered as scalars. References to references and inner references will be rendered properly.
=head1 SEE ALSO
L<Data::Printer>
L<Data::Dumper>
|
