← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:10 2023

Filename/home/hejohns/perl5/lib/perl5/Data/Printer/Object.pm
StatementsExecuted 82 statements in 4.22ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.73ms1.81msData::Printer::::BEGIN@3.28 Data::Printer::BEGIN@3.28
1111.42ms1.50msData::Printer::Object::::BEGIN@61 Data::Printer::Object::BEGIN@61
111885µs930µsData::Printer::Object::::BEGIN@51 Data::Printer::Object::BEGIN@51
111538µs619µsData::Printer::Object::::BEGIN@54 Data::Printer::Object::BEGIN@54
111538µs913µsData::Printer::Object::::BEGIN@52 Data::Printer::Object::BEGIN@52
111400µs459µsData::Printer::Object::::BEGIN@53 Data::Printer::Object::BEGIN@53
111358µs588µsData::Printer::Object::::BEGIN@57 Data::Printer::Object::BEGIN@57
111337µs525µsData::Printer::Object::::BEGIN@60 Data::Printer::Object::BEGIN@60
111227µs296µsData::Printer::Object::::BEGIN@56 Data::Printer::Object::BEGIN@56
111224µs279µsData::Printer::Object::::BEGIN@59 Data::Printer::Object::BEGIN@59
111197µs251µsData::Printer::Object::::BEGIN@55 Data::Printer::Object::BEGIN@55
111125µs180µsData::Printer::Object::::BEGIN@58 Data::Printer::Object::BEGIN@58
1119µs14µsData::Printer::Object::::BEGIN@76 Data::Printer::Object::BEGIN@76
1116µs7µsData::Printer::::BEGIN@1 Data::Printer::BEGIN@1
111114µs4µsData::Printer::Object::::__ANON__ Data::Printer::Object::__ANON__ (xsub)
1113µs12µsData::Printer::::BEGIN@2.27 Data::Printer::BEGIN@2.27
1112µs2µsData::Printer::Object::::BEGIN@50 Data::Printer::Object::BEGIN@50
4422µs2µsData::Printer::::__ANON__ Data::Printer::__ANON__ (xsub)
0000s0sData::Printer::Object::ClassOptions::::expandData::Printer::Object::ClassOptions::expand
0000s0sData::Printer::Object::ClassOptions::::format_inheritanceData::Printer::Object::ClassOptions::format_inheritance
0000s0sData::Printer::Object::ClassOptions::::inheritedData::Printer::Object::ClassOptions::inherited
0000s0sData::Printer::Object::ClassOptions::::internalsData::Printer::Object::ClassOptions::internals
0000s0sData::Printer::Object::ClassOptions::::linear_isaData::Printer::Object::ClassOptions::linear_isa
0000s0sData::Printer::Object::ClassOptions::::newData::Printer::Object::ClassOptions::new
0000s0sData::Printer::Object::ClassOptions::::parent_filtersData::Printer::Object::ClassOptions::parent_filters
0000s0sData::Printer::Object::ClassOptions::::parentsData::Printer::Object::ClassOptions::parents
0000s0sData::Printer::Object::ClassOptions::::show_methodsData::Printer::Object::ClassOptions::show_methods
0000s0sData::Printer::Object::ClassOptions::::show_overloadsData::Printer::Object::ClassOptions::show_overloads
0000s0sData::Printer::Object::ClassOptions::::show_reftypeData::Printer::Object::ClassOptions::show_reftype
0000s0sData::Printer::Object::ClassOptions::::show_wrappedData::Printer::Object::ClassOptions::show_wrapped
0000s0sData::Printer::Object::ClassOptions::::sort_methodsData::Printer::Object::ClassOptions::sort_methods
0000s0sData::Printer::Object::ClassOptions::::stringifyData::Printer::Object::ClassOptions::stringify
0000s0sData::Printer::Object::ClassOptions::::universalData::Printer::Object::ClassOptions::universal
0000s0sData::Printer::Object::::__ANON__[:728] Data::Printer::Object::__ANON__[:728]
0000s0sData::Printer::Object::::__ANON__[:80] Data::Printer::Object::__ANON__[:80]
0000s0sData::Printer::Object::::_check_memsize Data::Printer::Object::_check_memsize
0000s0sData::Printer::Object::::_check_readonly Data::Printer::Object::_check_readonly
0000s0sData::Printer::Object::::_check_weak Data::Printer::Object::_check_weak
0000s0sData::Printer::Object::::_detect_color_level Data::Printer::Object::_detect_color_level
0000s0sData::Printer::Object::::_filters_for_class Data::Printer::Object::_filters_for_class
0000s0sData::Printer::Object::::_filters_for_data Data::Printer::Object::_filters_for_data
0000s0sData::Printer::Object::::_filters_for_type Data::Printer::Object::_filters_for_type
0000s0sData::Printer::Object::::_init Data::Printer::Object::_init
0000s0sData::Printer::Object::::_load_colors Data::Printer::Object::_load_colors
0000s0sData::Printer::Object::::_load_external_filter Data::Printer::Object::_load_external_filter
0000s0sData::Printer::Object::::_load_filters Data::Printer::Object::_load_filters
0000s0sData::Printer::Object::::_load_output_handle Data::Printer::Object::_load_output_handle
0000s0sData::Printer::Object::::_refcount Data::Printer::Object::_refcount
0000s0sData::Printer::Object::::_see Data::Printer::Object::_see
0000s0sData::Printer::Object::::_write_label Data::Printer::Object::_write_label
0000s0sData::Printer::Object::::current_depth Data::Printer::Object::current_depth
0000s0sData::Printer::Object::::current_name Data::Printer::Object::current_name
0000s0sData::Printer::Object::::extra_config Data::Printer::Object::extra_config
0000s0sData::Printer::Object::::fulldump Data::Printer::Object::fulldump
0000s0sData::Printer::Object::::indent Data::Printer::Object::indent
0000s0sData::Printer::Object::::maybe_colorize Data::Printer::Object::maybe_colorize
0000s0sData::Printer::Object::::multiline Data::Printer::Object::multiline
0000s0sData::Printer::Object::::new Data::Printer::Object::new
0000s0sData::Printer::Object::::newline Data::Printer::Object::newline
0000s0sData::Printer::Object::::outdent Data::Printer::Object::outdent
0000s0sData::Printer::Object::::output Data::Printer::Object::output
0000s0sData::Printer::Object::::parse Data::Printer::Object::parse
0000s0sData::Printer::Object::::parse_as Data::Printer::Object::parse_as
0000s0sData::Printer::Object::::seen Data::Printer::Object::seen
0000s0sData::Printer::Object::::unsee Data::Printer::Object::unsee
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1214µs28µs
# spent 7µs (6+1000ns) within Data::Printer::BEGIN@1 which was called: # once (6µs+1000ns) by Data::Printer::BEGIN@4 at line 1
use strict;
# spent 7µs making 1 call to Data::Printer::BEGIN@1 # spent 1µs making 1 call to strict::import
2216µs221µs
# spent 12µs (3+9) within Data::Printer::BEGIN@2.27 which was called: # once (3µs+9µs) by Data::Printer::BEGIN@4 at line 2
use warnings;
# spent 12µs making 1 call to Data::Printer::BEGIN@2.27 # spent 9µs making 1 call to warnings::import
32295µs21.81ms
# spent 1.81ms (1.73+75µs) within Data::Printer::BEGIN@3.28 which was called: # once (1.73ms+75µs) by Data::Printer::BEGIN@4 at line 3
use Data::Printer::Common;
# spent 1.81ms making 1 call to Data::Printer::BEGIN@3.28 # spent 500ns making 1 call to Data::Printer::__ANON__
4
5package # hide from pause
6 Data::Printer::Object::ClassOptions;
7 sub parents { $_[0]->{'parents'} }
8 sub linear_isa { $_[0]->{'linear_isa'} }
9 sub universal { $_[0]->{'universal'} }
10 sub expand { $_[0]->{'expand'} }
11 sub stringify { $_[0]->{'stringify'} }
12 sub show_reftype { $_[0]->{'show_reftype'} }
13 sub show_overloads { $_[0]->{'show_overloads'} }
14 sub show_methods { $_[0]->{'show_methods'} }
15 sub sort_methods { $_[0]->{'sort_methods'} }
16 sub show_wrapped { $_[0]->{'show_wrapped'} }
17 sub inherited { $_[0]->{'inherited'} }
18 sub format_inheritance { $_[0]->{'format_inheritance'} }
19 sub parent_filters { $_[0]->{'parent_filters'} }
20 sub internals { $_[0]->{'internals'} }
21 sub new {
22 my ($class, $params) = @_;
23 my $self = {
24 'linear_isa' => Data::Printer::Common::_fetch_scalar_or_default($params, 'linear_isa', 'auto'),
25 'show_reftype' => Data::Printer::Common::_fetch_scalar_or_default($params, 'show_reftype', 0),
26 'show_overloads' => Data::Printer::Common::_fetch_scalar_or_default($params, 'show_overloads', 1),
27 'stringify' => Data::Printer::Common::_fetch_scalar_or_default($params, 'stringify', 1),
28 'expand' => Data::Printer::Common::_fetch_scalar_or_default($params, 'expand', 1),
29 'show_methods' => Data::Printer::Common::_fetch_anyof(
30 $params, 'show_methods', 'all', [qw(none all private public)]
31 ),
32 'inherited' => Data::Printer::Common::_fetch_anyof(
33 $params, 'inherited', 'public', [qw(none all private public)]
34 ),
35 'format_inheritance' => Data::Printer::Common::_fetch_anyof(
36 $params, 'format_inheritance', 'lines', [qw(string lines)]
37 ),
38 'parent_filters' => Data::Printer::Common::_fetch_scalar_or_default($params, 'parent_filters', 1),
39 'universal' => Data::Printer::Common::_fetch_scalar_or_default($params, 'universal', 0),
40 'sort_methods' => Data::Printer::Common::_fetch_scalar_or_default($params, 'sort_methods', 1),
41 'show_wrapped' => Data::Printer::Common::_fetch_scalar_or_default($params, 'show_wrapped', 1),
42 'internals' => Data::Printer::Common::_fetch_scalar_or_default($params, 'internals', 1),
43 'parents' => Data::Printer::Common::_fetch_scalar_or_default($params, 'parents', 1),
44 };
45 return bless $self, $class;
46 }
471;
48
49package Data::Printer::Object;
50215µs12µs
# spent 2µs within Data::Printer::Object::BEGIN@50 which was called: # once (2µs+0s) by Data::Printer::BEGIN@4 at line 50
use Scalar::Util ();
# spent 2µs making 1 call to Data::Printer::Object::BEGIN@50
51288µs2931µs
# spent 930µs (885+45) within Data::Printer::Object::BEGIN@51 which was called: # once (885µs+45µs) by Data::Printer::BEGIN@4 at line 51
use Data::Printer::Theme;
# spent 930µs making 1 call to Data::Printer::Object::BEGIN@51 # spent 700ns making 1 call to Data::Printer::Object::__ANON__
52283µs2913µs
# spent 913µs (538+376) within Data::Printer::Object::BEGIN@52 which was called: # once (538µs+376µs) by Data::Printer::BEGIN@4 at line 52
use Data::Printer::Filter::SCALAR; # also implements LVALUE
# spent 913µs making 1 call to Data::Printer::Object::BEGIN@52 # spent 300ns making 1 call to Data::Printer::Object::__ANON__
53275µs2459µs
# spent 459µs (400+59) within Data::Printer::Object::BEGIN@53 which was called: # once (400µs+59µs) by Data::Printer::BEGIN@4 at line 53
use Data::Printer::Filter::ARRAY;
# spent 459µs making 1 call to Data::Printer::Object::BEGIN@53 # spent 300ns making 1 call to Data::Printer::Object::__ANON__
54288µs2619µs
# spent 619µs (538+81) within Data::Printer::Object::BEGIN@54 which was called: # once (538µs+81µs) by Data::Printer::BEGIN@4 at line 54
use Data::Printer::Filter::HASH;
# spent 619µs making 1 call to Data::Printer::Object::BEGIN@54 # spent 300ns making 1 call to Data::Printer::Object::__ANON__
55297µs2252µs
# spent 251µs (197+54) within Data::Printer::Object::BEGIN@55 which was called: # once (197µs+54µs) by Data::Printer::BEGIN@4 at line 55
use Data::Printer::Filter::REF;
# spent 251µs making 1 call to Data::Printer::Object::BEGIN@55 # spent 300ns making 1 call to Data::Printer::Object::__ANON__
56287µs2297µs
# spent 296µs (227+69) within Data::Printer::Object::BEGIN@56 which was called: # once (227µs+69µs) by Data::Printer::BEGIN@4 at line 56
use Data::Printer::Filter::VSTRING;
# spent 296µs making 1 call to Data::Printer::Object::BEGIN@56 # spent 700ns making 1 call to Data::Printer::Object::__ANON__
57285µs2588µs
# spent 588µs (358+230) within Data::Printer::Object::BEGIN@57 which was called: # once (358µs+230µs) by Data::Printer::BEGIN@4 at line 57
use Data::Printer::Filter::GLOB;
# spent 588µs making 1 call to Data::Printer::Object::BEGIN@57 # spent 300ns making 1 call to Data::Printer::Object::__ANON__
58274µs2180µs
# spent 180µs (125+55) within Data::Printer::Object::BEGIN@58 which was called: # once (125µs+55µs) by Data::Printer::BEGIN@4 at line 58
use Data::Printer::Filter::FORMAT;
# spent 180µs making 1 call to Data::Printer::Object::BEGIN@58 # spent 300ns making 1 call to Data::Printer::Object::__ANON__
59269µs2279µs
# spent 279µs (224+55) within Data::Printer::Object::BEGIN@59 which was called: # once (224µs+55µs) by Data::Printer::BEGIN@4 at line 59
use Data::Printer::Filter::Regexp;
# spent 279µs making 1 call to Data::Printer::Object::BEGIN@59 # spent 300ns making 1 call to Data::Printer::Object::__ANON__
60274µs2526µs
# spent 525µs (337+189) within Data::Printer::Object::BEGIN@60 which was called: # once (337µs+189µs) by Data::Printer::BEGIN@4 at line 60
use Data::Printer::Filter::CODE;
# spent 525µs making 1 call to Data::Printer::Object::BEGIN@60 # spent 300ns making 1 call to Data::Printer::Object::__ANON__
612124µs21.50ms
# spent 1.50ms (1.42+72µs) within Data::Printer::Object::BEGIN@61 which was called: # once (1.42ms+72µs) by Data::Printer::BEGIN@4 at line 61
use Data::Printer::Filter::GenericClass;
# spent 1.50ms making 1 call to Data::Printer::Object::BEGIN@61 # spent 400ns making 1 call to Data::Printer::Object::__ANON__
62
63# create our basic accessors:
6414µsmy @method_names =qw(
65 name show_tainted show_unicode show_readonly show_lvalue show_refcount
66 show_memsize memsize_unit print_escapes scalar_quotes escape_chars
67 caller_info caller_message caller_message_newline caller_message_position
68 string_max string_overflow string_preserve resolve_scalar_refs
69 array_max array_overflow array_preserve hash_max hash_overflow
70 hash_preserve unicode_charnames colored theme show_weak
71 max_depth index separator end_separator class_method class hash_separator
72 align_hash sort_keys quote_keys deparse return_value show_dualvar show_tied
73 warnings arrows coderef_stub coderef_undefined
74);
751300nsforeach my $method_name (@method_names) {
7622.86ms219µs
# spent 14µs (9+5) within Data::Printer::Object::BEGIN@76 which was called: # once (9µs+5µs) by Data::Printer::BEGIN@4 at line 76
no strict 'refs';
# spent 14µs making 1 call to Data::Printer::Object::BEGIN@76 # spent 5µs making 1 call to strict::unimport
77 *{__PACKAGE__ . "::$method_name"} = sub {
78 $_[0]->{$method_name} = $_[1] if @_ > 1;
79 return $_[0]->{$method_name};
80 }
814769µs}
82sub extra_config { $_[0]->{extra_config} }
83
84sub current_depth { $_[0]->{_depth} }
85sub indent { $_[0]->{_depth}++ }
86sub outdent { $_[0]->{_depth}-- }
87
88sub newline {
89 my ($self) = @_;
90 return $self->{_linebreak}
91 . (' ' x ($self->{_depth} * $self->{_current_indent}))
92 . (' ' x $self->{_array_padding})
93 ;
94}
95
96sub current_name {
97 my ($self, $new_value) = @_;
98 if (defined $new_value) {
99 $self->{_current_name} = $new_value;
100 }
101 else {
102 $self->{_current_name} = $self->name unless defined $self->{_current_name};
103 }
104 return $self->{_current_name};
105}
106
107sub _init {
108 my $self = shift;
109 my $props = { @_ == 1 ? %{$_[0]} : @_ };
110
111 $self->{'_linebreak'} = "\n";
112 $self->{'_depth'} = 0;
113 $self->{'_position'} = 0; # depth is for indentation only!
114 $self->{'_array_padding'} = 0;
115 $self->{'_seen'} = {};
116 $self->{_refcount_base} = 3;
117 $self->{'warnings'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'warning', 1);
118 $self->{'indent'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'indent', 4);
119 $self->{'index'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'index', 1);
120 $self->{'name'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'name', 'var');
121 $self->{'arrows'} = Data::Printer::Common::_fetch_anyof(
122 $props,
123 'arrows',
124 'none',
125 [qw(none first all)]
126 );
127
128 $self->{'show_tainted'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_tainted', 1);
129 $self->{'show_tied'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_tied', 1);
130 $self->{'show_weak'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_weak', 1);
131 $self->{'show_unicode'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_unicode', 0);
132 $self->{'show_readonly'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_readonly', 1);
133 $self->{'show_lvalue'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_lvalue', 1);
134 $self->{'show_refcount'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_refcount', 0);
135 $self->{'show_memsize'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'show_memsize', 0);
136 $self->{'memsize_unit'} = Data::Printer::Common::_fetch_anyof(
137 $props,
138 'memsize_unit',
139 'auto',
140 [qw(auto b k m)]
141 );
142 $self->{'print_escapes'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'print_escapes', 0);
143 $self->{'scalar_quotes'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'scalar_quotes', q("));
144 $self->{'escape_chars'} = Data::Printer::Common::_fetch_anyof(
145 $props,
146 'escape_chars',
147 'none',
148 [qw(none nonascii nonlatin1 all)]
149 );
150 $self->{'caller_info'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'caller_info', 0);
151 $self->{'caller_message'} = Data::Printer::Common::_fetch_scalar_or_default(
152 $props,
153 'caller_message',
154 'Printing in line __LINE__ of __FILENAME__:'
155 );
156 $self->{'caller_message_newline'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'caller_message_newline', 1);
157 $self->{'caller_message_position'} = Data::Printer::Common::_fetch_anyof($props, 'caller_message_position', 'before', [qw(before after)]);
158 $self->{'resolve_scalar_refs'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'resolve_scalar_refs', 0);
159 $self->{'string_max'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'string_max', 4096);
160 $self->{'string_preserve'} = Data::Printer::Common::_fetch_anyof(
161 $props,
162 'string_preserve',
163 'begin',
164 [qw(begin end middle extremes none)]
165 );
166 $self->{'string_overflow'} = Data::Printer::Common::_fetch_scalar_or_default(
167 $props,
168 'string_overflow',
169 '(...skipping __SKIPPED__ chars...)'
170 );
171 $self->{'array_max'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'array_max', 100);
172 $self->{'array_preserve'} = Data::Printer::Common::_fetch_anyof(
173 $props,
174 'array_preserve',
175 'begin',
176 [qw(begin end middle extremes none)]
177 );
178 $self->{'array_overflow'} = Data::Printer::Common::_fetch_scalar_or_default(
179 $props,
180 'array_overflow',
181 '(...skipping __SKIPPED__ items...)'
182 );
183 $self->{'hash_max'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'hash_max', 100);
184 $self->{'hash_preserve'} = Data::Printer::Common::_fetch_anyof(
185 $props,
186 'hash_preserve',
187 'begin',
188 [qw(begin end middle extremes none)]
189 );
190 $self->{'hash_overflow'} = Data::Printer::Common::_fetch_scalar_or_default(
191 $props,
192 'hash_overflow',
193 '(...skipping __SKIPPED__ keys...)'
194 );
195 $self->{'unicode_charnames'} = Data::Printer::Common::_fetch_scalar_or_default(
196 $props,
197 'unicode_charnames',
198 0
199 );
200 $self->{'colored'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'colored', 'auto');
201 $self->{'max_depth'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'max_depth', 0);
202 $self->{'separator'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'separator', ',');
203 $self->{'end_separator'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'end_separator', 0);
204 $self->{'class_method'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'class_method', '_data_printer');
205 $self->{'class'} = Data::Printer::Object::ClassOptions->new($props->{'class'});
206 $self->{'hash_separator'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'hash_separator', ' ');
207 $self->{'align_hash'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'align_hash', 1);
208 $self->{'sort_keys'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'sort_keys', 1);
209 $self->{'quote_keys'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'quote_keys', 'auto');
210 $self->{'deparse'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'deparse', 0);
211 $self->{'coderef_stub'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'coderef_stub', 'sub { ... }');
212 $self->{'coderef_undefined'} = Data::Printer::Common::_fetch_scalar_or_default($props, 'coderef_undefined', '<undefined coderef>');
213 $self->{'return_value'} = Data::Printer::Common::_fetch_anyof(
214 $props,
215 'return_value',
216 'pass',
217 [qw(pass dump void)]
218 );
219 $self->{'show_dualvar'} = Data::Printer::Common::_fetch_anyof(
220 $props,
221 'show_dualvar',
222 'lax',
223 [qw(lax strict off)]
224 );
225
226 if (exists $props->{as}) {
227 my $msg = Data::Printer::Common::_fetch_scalar_or_default($props, 'as', '');
228 $self->{caller_info} = 1;
229 $self->{caller_message} = $msg;
230 }
231
232 $self->multiline(
233 Data::Printer::Common::_fetch_scalar_or_default($props, 'multiline', 1)
234 );
235
236 $self->fulldump(
237 Data::Printer::Common::_fetch_scalar_or_default($props, 'fulldump', 0)
238 );
239
240 $self->output(defined $props->{output} ? $props->{output} : 'stderr');
241 $self->_load_colors($props);
242 $self->_load_filters($props);
243
244 my %extra_config;
245 my %core_options = map { $_ => 1 }
246 (@method_names, qw(as multiline output colors filters));
247 foreach my $key (keys %$props) {
248 $extra_config{$key} = $props->{$key} unless exists $core_options{$key};
249 }
250 $self->{extra_config} = \%extra_config;
251
252 return $self;
253}
254
255sub output {
256 my ($self, $new_output) = @_;
257 if (@_ > 1) {
258 $self->_load_output_handle($new_output);
259 }
260 return $self->{output};
261}
262
263sub _load_output_handle {
264 my ($self, $output) = @_;
265 my %targets = ( stdout => *STDOUT, stderr => *STDERR );
266 my $error;
267 my $ref = ref $output;
268 if (!$ref and exists $targets{ lc $output }) {
269 $self->{output} = lc $output;
270 $self->{output_handle} = $targets{ $self->{output} };
271 }
272 elsif ( ( $ref and $ref eq 'GLOB')
273 or (!$ref and \$output =~ /GLOB\([^()]+\)$/)
274 ) {
275 $self->{output} = 'handle';
276 $self->{output_handle} = $output;
277 }
278 elsif (!$ref or $ref eq 'SCALAR') {
279 if (open my $fh, '>>', $output) {
280 $self->{output} = 'file';
281 $self->{output_handle} = $fh;
282 }
283 else {
284 $error = "file '$output': $!";
285 }
286 }
287 else {
288 $error = 'unknown output data';
289 }
290 if ($error) {
291 Data::Printer::Common::_warn($self, "error opening custom output handle: $error");
292 $self->{output_handle} = $targets{'stderr'}
293 }
294 return;
295}
296
297sub new {
298 my $class = shift;
299 my $self = bless {}, $class;
300 return $self->_init(@_);
301}
302
303sub multiline {
304 my ($self, $value) = @_;
305 if (defined $value) {
306 $self->{multiline} = !!$value;
307 if ($value) {
308 $self->{_linebreak} = "\n";
309 $self->{_current_indent} = $self->{indent};
310 $self->index( $self->{_original_index} )
311 if exists $self->{_original_index};
312 $self->hash_separator( $self->{_original_separator} )
313 if exists $self->{_original_separator};
314 $self->array_overflow( $self->{_original_array_overflow} )
315 if exists $self->{_original_array_overflow};
316 $self->hash_overflow( $self->{_original_hash_overflow} )
317 if exists $self->{_original_hash_overflow};
318 $self->string_overflow( $self->{_original_string_overflow} )
319 if exists $self->{_original_string_overflow};
320 }
321 else {
322 $self->{_original_index} = $self->index;
323 $self->index(0);
324 $self->{_original_separator} = $self->hash_separator;
325 $self->hash_separator(':');
326 $self->{_original_array_overflow} = $self->array_overflow;
327 $self->array_overflow('(...)');
328 $self->{_original_hash_overflow} = $self->hash_overflow;
329 $self->hash_overflow('(...)');
330 $self->{_original_string_overflow} = $self->string_overflow;
331 $self->string_overflow('(...)');
332 $self->{_linebreak} = ' ';
333 $self->{_current_indent} = 0;
334 }
335 }
336 return $self->{multiline};
337}
338
339sub fulldump {
340 my ($self, $value) = @_;
341 if (defined $value) {
342 $self->{fulldump} = !!$value;
343 if ($value) {
344 $self->{_original_string_max} = $self->string_max;
345 $self->string_max(0);
346 $self->{_original_array_max} = $self->array_max;
347 $self->array_max(0);
348 $self->{_original_hash_max} = $self->hash_max;
349 $self->hash_max(0);
350 }
351 else {
352 $self->string_max($self->{_original_string_max})
353 if exists $self->{_original_string_max};
354 $self->array_max($self->{_original_array_max})
355 if exists $self->{_original_array_max};
356 $self->hash_max($self->{_original_hash_max})
357 if exists $self->{_original_hash_max};
358 }
359 }
360}
361
362sub _load_filters {
363 my ($self, $props) = @_;
364
365 # load our core filters (LVALUE is under the 'SCALAR' filter module)
366 my @core_filters = qw(SCALAR ARRAY HASH REF VSTRING GLOB FORMAT Regexp CODE GenericClass);
367 foreach my $class (@core_filters) {
368 $self->_load_external_filter($class);
369 }
370 my @filters;
371 # load any custom filters provided by the user
372 if (exists $props->{filters}) {
373 if (ref $props->{filters} eq 'HASH') {
374 Data::Printer::Common::_warn(
375 $self,
376 'please update your code: filters => { ... } is now filters => [{ ... }]'
377 );
378 push @filters, $props->{filters};
379 }
380 elsif (ref $props->{filters} eq 'ARRAY') {
381 @filters = @{ $props->{filters} };
382 }
383 else {
384 Data::Printer::Common::_warn($self, 'filters must be an ARRAY reference');
385 }
386 }
387 foreach my $filter (@filters) {
388 my $filter_reftype = Scalar::Util::reftype($filter);
389 if (!defined $filter_reftype) {
390 $self->_load_external_filter($filter);
391 }
392 elsif ($filter_reftype eq 'HASH') {
393 foreach my $k (keys %$filter) {
394 if ($k eq '-external') {
395 Data::Printer::Common::_warn(
396 $self,
397 'please update your code: '
398 . 'filters => { -external => [qw(Foo Bar)}'
399 . ' is now filters => [qw(Foo Bar)]'
400 );
401 next;
402 }
403 if (Scalar::Util::reftype($filter->{$k}) eq 'CODE') {
404 my $type = Data::Printer::Common::_filter_category_for($k);
405 unshift @{ $self->{$type}{$k} }, $filter->{$k};
406 }
407 else {
408 Data::Printer::Common::_warn(
409 $self,
410 'hash filters must point to a CODE reference'
411 );
412 }
413 }
414 }
415 else {
416 Data::Printer::Common::_warn($self, 'filters must be a name or { type => sub {...} }');
417 }
418 }
419 return;
420}
421
422sub _load_external_filter {
423 my ($self, $class) = @_;
424 my $module = "Data::Printer::Filter::$class";
425 my $error = Data::Printer::Common::_tryme("use $module; 1;");
426 if ($error) {
427 Data::Printer::Common::_warn($self, "error loading filter '$class': $error");
428 return;
429 }
430 my $from_module = $module->_filter_list;
431 foreach my $kind (keys %$from_module) {
432 foreach my $name (keys %{$from_module->{$kind}}) {
433 unshift @{ $self->{$kind}{$name} }, @{ $from_module->{$kind}{$name} };
434 }
435 }
436 return;
437}
438
439sub _detect_color_level {
440 my ($self) = @_;
441 my $colored = $self->colored;
442 my $color_level;
443
444 # first we honour ANSI_COLORS_DISABLED, colored and writing to files
445 if ( !$colored
446 || ($colored eq 'auto'
447 && (exists $ENV{ANSI_COLORS_DISABLED}
448 || $self->output eq 'handle'
449 || $self->output eq 'file'
450 )
451 )
452 ) {
453 $color_level = 0;
454 }
455 else {
456 # NOTE: we could try `tput colors` but it may not give
457 # the proper result, so instead we do what most terminals
458 # currently do and rely on environment variables.
459 if ($ENV{COLORTERM} && $ENV{COLORTERM} eq 'truecolor') {
460 $color_level = 3;
461 }
462 elsif ($ENV{TERM_PROGRAM} && $ENV{TERM_PROGRAM} eq 'iTerm.app') {
463 my $major_version = substr($ENV{TERM_PROGRAM_VERSION} || '0', 0, 1);
464 $color_level = $major_version >= 3 ? 3 : 2;
465 }
466 elsif ($ENV{TERM_PROGRAM} && $ENV{TERM_PROGRAM} eq 'Apple_Terminal') {
467 $color_level= 2;
468 }
469 elsif ($ENV{TERM} && $ENV{TERM} =~ /\-256(?:color)?\z/i) {
470 $color_level = 2;
471 }
472 elsif ($ENV{TERM}
473 && ($ENV{TERM} =~ /\A(?:screen|xterm|vt100|rxvt)/i
474 || $ENV{TERM} =~ /color|ansi|cygwin|linux/i)
475 ) {
476 $color_level = 1;
477 }
478 elsif ($ENV{COLORTERM}) {
479 $color_level = 1;
480 }
481 else {
482 $color_level = $colored eq 'auto' ? 0 : 1;
483 }
484 }
485 return $color_level;
486}
487
488sub _load_colors {
489 my ($self, $props) = @_;
490
491 $self->{_output_color_level} = $self->_detect_color_level;
492
493 my $theme_object;
494 my $default_theme = 'Material';
495 my $theme_name = Data::Printer::Common::_fetch_scalar_or_default($props, 'theme', $default_theme);
496 $theme_object = Data::Printer::Theme->new(
497 name => $theme_name,
498 color_overrides => $props->{colors},
499 color_level => $self->{_output_color_level},
500 ddp => $self,
501 );
502 if (!$theme_object) {
503 if ($theme_name ne $default_theme) {
504 $theme_object = Data::Printer::Theme->new(
505 name => $default_theme,
506 color_overrides => $props->{colors},
507 color_level => $self->{_output_color_level},
508 ddp => $self,
509 );
510 }
511 Data::Printer::Common::_die("Unable to load default theme. This should never happen - please contact the author") unless $theme_object;
512 }
513 $self->{theme} = $theme_object;
514}
515
516sub _filters_for_type {
517 my ($self, $type) = @_;
518 return exists $self->{type_filters}{$type} ? @{ $self->{type_filters}{$type} } : ();
519}
520
521sub _filters_for_class {
522 my ($self, $type) = @_;
523 return exists $self->{class_filters}{$type} ? @{ $self->{class_filters}{$type} } : ();
524}
525
526sub _filters_for_data {
527 my ($self, $data) = @_;
528
529 # we favour reftype() over ref() because you could have
530 # a HASH.pm (or ARRAY.pm or whatever) blessing any variable.
531 my $ref_kind = Scalar::Util::reftype($data);
532 $ref_kind = 'SCALAR' unless $ref_kind;
533
534 # ref() returns 'Regexp' but reftype() returns 'REGEXP', so we picked one:
535 $ref_kind = 'Regexp' if $ref_kind eq 'REGEXP';
536
537 my @potential_filters;
538
539 # first, try class name + full inheritance for a specific name.
540 my $class = Scalar::Util::blessed($data);
541
542 # a regular regexp is blessed, but in that case we want a
543 # regexp filter, not a class filter.
544 if (defined $class && $class eq 'Regexp') {
545 if ($ref_kind eq 'Regexp' || ($] < 5.011 && $ref_kind eq 'SCALAR')) {
546 $ref_kind = 'Regexp';
547 undef $class;
548 }
549 }
550 if (defined $class) {
551 if ($self->class->parent_filters) {
552 my $linear_ISA = Data::Printer::Common::_linear_ISA_for($class, $self);
553 foreach my $candidate_class (@$linear_ISA) {
554 push @potential_filters, $self->_filters_for_class($candidate_class);
555 }
556 }
557 else {
558 push @potential_filters, $self->_filters_for_class($class);
559 }
560 # next, let any '-class' filters have a go:
561 push @potential_filters, $self->_filters_for_class('-class');
562 }
563
564 # then, try regular data filters
565 push @potential_filters, $self->_filters_for_type($ref_kind);
566
567 # finally, if it's neither a class nor a known core type,
568 # we must be in a future perl with some type we're unaware of:
569 push @potential_filters, $self->_filters_for_class('-unknown');
570
571 return @potential_filters;
572}
573
574# _see($data): marks data as seen if it was never seen it before.
575# if we are showing refcounts, we return those. Initially we had
576# this funcionallity separated, but refcounts increase as we find
577# them again and because of that we were seeing weird refcounting.
578# So now instead we store the refcount of the variable when we
579# first see it.
580# Finally, if we have already seen the data, we return its stringified
581# position, like "var", "var{foo}[7]", etc. UNLESS $options{seen_override}
582# is set. Why seen_override? Sometimes we want to print the same data
583# twice, like the GenericClass filter, which prints the object's metadata
584# via parse() and then the internal structure via parse_as(). But if we
585# simply do that, we'd get the "seen" version (because we have already
586# visited it!) The refcount is still calculated only once though :)
587sub _see {
588 my ($self, $data, %options) = @_;
589 return {} unless ref $data;
590 my $id = pack 'J', Scalar::Util::refaddr($data);
591 if (!exists $self->{_seen}{$id}) {
592 $self->{_seen}{$id} = {
593 name => $self->current_name,
594 refcount => ($self->show_refcount ? $self->_refcount($data) : 0),
595 };
596 return { refcount => $self->{_seen}{$id}->{refcount} };
597 }
598 return { refcount => $self->{_seen}{$id}->{refcount} } if $options{seen_override};
599 return $self->{_seen}{$id};
600}
601
602sub seen {
603 my ($self, $data) = @_;
604 my $id = pack 'J', Scalar::Util::refaddr($data);
605 return exists $self->{_seen}{$id};
606}
607
608sub unsee {
609 my ($self, $data) = @_;
610 return unless ref $data && keys %{$self->{_seen}};
611
612 my $id = pack 'J', Scalar::Util::refaddr($data);
613 delete $self->{_seen}{$id};
614 return;
615}
616
617sub _refcount {
618 my ($self, $data) = @_;
619
620 require B;
621 my $count;
622 my $rv = B::svref_2object(\$data)->RV;
623 if (ref($data) eq 'REF' && ref($$data)) {
624 $rv = B::svref_2object($data)->RV;
625 }
626
627 # some SV's are special (represented by B::SPECIAL)
628 # and don't have a ->REFCNT (e.g. \undef)
629 return 0 unless $rv->can( 'REFCNT' );
630
631 # 3 is our magical number: so we return the actual reference count
632 # minus the references we added as we were traversing:
633 return $rv->REFCNT - $self->{_refcount_base};
634}
635
636sub parse_as {
637 my ($self, $type, $data) = @_;
638 return $self->parse($data, force_type => $type, seen_override => 1);
639}
640
641# parse() must always receive a reference, never a regular copy, because
642# that's the only way we are able to figure whether the source data
643# is a weak ref or not.
644sub parse {
645 my $self = shift;
646 my $str_weak = $self->_check_weak( $_[0] );
647
648 my ($data, %options) = @_;
649 my $parsed_string = '';
650
651 # if we've seen this structure before, we return its location
652 # instead of going through it again. This avoids infinite loops
653 # when parsing circular references:
654 my $seen = $self->_see($data, %options);
655 if (my $name = $seen->{name}) {
656 $parsed_string .= $self->maybe_colorize(
657 ((ref $data eq 'SCALAR' && $self->resolve_scalar_refs)
658 ? $$data
659 : $name
660 ),
661 'repeated'
662 );
663 # on repeated references, the only extra data we put
664 # is whether this reference is weak or not.
665 $parsed_string .= $str_weak;
666 return $parsed_string;
667 }
668 $self->{_position}++;
669
670 # Each filter type provides an array of potential parsers.
671 # Once we find the right kind, we go through all of them,
672 # from most precise match to most generic.
673 # The first filter that returns a defined value "wins"
674 # (even if it's an empty string)
675 foreach my $filter (
676 exists $options{force_type}
677 ? $self->_filters_for_type($options{force_type})
678 : $self->_filters_for_data($data)
679 ) {
680 if (defined (my $result = $filter->($data, $self))) {
681 $parsed_string .= $result;
682 last;
683 }
684 }
685
686 # FIXME: because of prototypes, p(@data) becomes a ref (that we don't care about)
687 # to the data (that we do care about). So we should not show refcounts, memsize
688 # or readonly status for something guaranteed to be ephemeral.
689 $parsed_string .= $self->_check_readonly($data);
690 $parsed_string .= $str_weak if ref($data) ne 'REF';
691 $parsed_string .= $self->_check_memsize($data);
692
693 if ($self->show_refcount && ref($data) ne 'SCALAR' && $seen->{refcount} > 1 ) {
694 $parsed_string .= ' (refcount: ' . $seen->{refcount} .')';
695 }
696
697 if (--$self->{'_position'} == 0) {
698 $self->{'_seen'} = {};
699 $self->{'_refcount_base'} = 3;
700 $self->{'_position'} = 0;
701 }
702
703 return $parsed_string;
704}
705
706sub _check_memsize {
707 my ($self, $data) = @_;
708 return '' unless $self->show_memsize
709 && ( $self->show_memsize eq 'all'
710 || $self->show_memsize >= $self->{_position});
711 my $size;
712 my $unit;
713 my $error = Data::Printer::Common::_tryme(sub {
714 require Devel::Size;
715 $size = Devel::Size::total_size($data);
716 $unit = uc $self->memsize_unit;
717 if ($unit eq 'M' || ($unit eq 'AUTO' && $size > 1024*1024)) {
718 $size = $size / (1024*1024);
719 $unit = 'M';
720 }
721 elsif ($unit eq 'K' || ($unit eq 'AUTO' && $size > 1024)) {
722 $size = $size / 1024;
723 $unit = 'K';
724 }
725 else {
726 $unit = 'B';
727 }
728 });
729 if ($error) {
730 if ($error =~ m{locate Devel/Size.pm}) {
731 Data::Printer::Common::_warn($self, "Devel::Size not found, show_memsize will be ignored")
732 if $self->{_position} == 1;
733 }
734 else {
735 Data::Printer::Common::_warn($self, "error fetching memory usage: $error");
736 }
737 return '';
738 }
739 return '' unless $size;
740 my $string = ' (' . ($size < 0 ? sprintf("%.2f", $size) : int($size)) . $unit . ')';
741 return $self->maybe_colorize($string, 'memsize');
742}
743
744sub _check_weak {
745 my ($self) = shift;
746 return '' unless $self->show_weak;
747
748 my $realtype = Scalar::Util::reftype($_[0]);
749 my $isweak;
750 if ($realtype && ($realtype eq 'REF' || $realtype eq 'SCALAR')) {
751 $isweak = Scalar::Util::isweak($_[0]);
752 }
753 else {
754 $isweak = Scalar::Util::isweak($_[0]);
755 }
756 return '' unless $isweak;
757 return ' ' . $self->maybe_colorize('(weak)', 'weak');
758}
759
760sub _write_label {
761 my ($self) = @_;
762 return '' unless $self->caller_info;
763 my @caller = caller 1;
764
765 my $message = $self->caller_message;
766
767 $message =~ s/\b__PACKAGE__\b/$caller[0]/g;
768 $message =~ s/\b__FILENAME__\b/$caller[1]/g;
769 $message =~ s/\b__LINE__\b/$caller[2]/g;
770
771 my $separator = $self->caller_message_newline ? "\n" : ' ';
772 $message = $self->maybe_colorize($message, 'caller_info');
773 $message = $self->caller_message_position eq 'before'
774 ? $message . $separator
775 : $separator . $message
776 ;
777 return $message;
778}
779
780sub maybe_colorize {
781 my ($self, $output, $color_type, $default_color, $end_color) = @_;
782
783 if ($self->{_output_color_level} && defined $color_type) {
784 my $theme = $self->theme;
785 my $sgr_color = $theme->sgr_color_for($color_type);
786 if (!defined $sgr_color && defined $default_color) {
787 $sgr_color = $theme->_parse_color($default_color);
788 }
789 if ($sgr_color) {
790 $output = $sgr_color
791 . $output
792 . (defined $end_color
793 ? $theme->sgr_color_for($end_color)
794 : $theme->color_reset
795 );
796 }
797 }
798 return $output;
799}
800
801sub _check_readonly {
802 my ($self) = @_;
803 return ' (read-only)' if $self->show_readonly && &Internals::SvREADONLY($_[1]);
804 return '';
805}
806
80716µs42;
808__END__
 
# spent 4µs within Data::Printer::Object::__ANON__ which was called 11 times, avg 382ns/call: # once (700ns+0s) by Data::Printer::Object::BEGIN@51 at line 51 # once (700ns+0s) by Data::Printer::Object::BEGIN@56 at line 56 # once (400ns+0s) by Data::Printer::Object::BEGIN@61 at line 61 # once (300ns+0s) by Data::Printer::Object::BEGIN@60 at line 60 # once (300ns+0s) by Data::Printer::Object::BEGIN@54 at line 54 # once (300ns+0s) by Data::Printer::Object::BEGIN@58 at line 58 # once (300ns+0s) by Data::Printer::Object::BEGIN@57 at line 57 # once (300ns+0s) by Data::Printer::Object::BEGIN@55 at line 55 # once (300ns+0s) by Data::Printer::Object::BEGIN@52 at line 52 # once (300ns+0s) by Data::Printer::Object::BEGIN@59 at line 59 # once (300ns+0s) by Data::Printer::Object::BEGIN@53 at line 53
sub Data::Printer::Object::__ANON__; # xsub
# spent 2µs within Data::Printer::__ANON__ which was called 4 times, avg 625ns/call: # once (1µs+0s) by Data::Printer::BEGIN@4 at line 4 of Data/Printer.pm # once (700ns+0s) by Data::Printer::BEGIN@6 at line 6 of Data/Printer.pm # once (500ns+0s) by Data::Printer::BEGIN@3.28 at line 3 # once (200ns+0s) by Data::Printer::BEGIN@5 at line 5 of Data/Printer.pm
sub Data::Printer::__ANON__; # xsub
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.