← 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/Filter/HASH.pm
StatementsExecuted 12 statements in 499µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11119µs21µsData::Printer::Filter::HASH::::BEGIN@2Data::Printer::Filter::HASH::BEGIN@2
1116µs6µsData::Printer::Filter::HASH::::BEGIN@5Data::Printer::Filter::HASH::BEGIN@5
1115µs22µsData::Printer::Filter::HASH::::BEGIN@4Data::Printer::Filter::HASH::BEGIN@4
1114µs16µsData::Printer::Filter::HASH::::BEGIN@3Data::Printer::Filter::HASH::BEGIN@3
1112µs2µsData::Printer::Filter::HASH::::BEGIN@6Data::Printer::Filter::HASH::BEGIN@6
111300ns300nsData::Printer::Filter::HASH::::__ANON__Data::Printer::Filter::HASH::__ANON__ (xsub)
0000s0sData::Printer::Filter::HASH::::_needs_quoteData::Printer::Filter::HASH::_needs_quote
0000s0sData::Printer::Filter::HASH::::parseData::Printer::Filter::HASH::parse
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Data::Printer::Filter::HASH;
2219µs222µs
# spent 21µs (19+1) within Data::Printer::Filter::HASH::BEGIN@2 which was called: # once (19µs+1µs) by Data::Printer::Object::BEGIN@54 at line 2
use strict;
# spent 21µs making 1 call to Data::Printer::Filter::HASH::BEGIN@2 # spent 1µs making 1 call to strict::import
3213µs228µs
# spent 16µs (4+12) within Data::Printer::Filter::HASH::BEGIN@3 which was called: # once (4µs+12µs) by Data::Printer::Object::BEGIN@54 at line 3
use warnings;
# spent 16µs making 1 call to Data::Printer::Filter::HASH::BEGIN@3 # spent 12µs making 1 call to warnings::import
4212µs238µs
# spent 22µs (5+16) within Data::Printer::Filter::HASH::BEGIN@4 which was called: # once (5µs+16µs) by Data::Printer::Object::BEGIN@54 at line 4
use Data::Printer::Filter;
# spent 22µs making 1 call to Data::Printer::Filter::HASH::BEGIN@4 # spent 16µs making 1 call to Data::Printer::Filter::import
5215µs26µs
# spent 6µs (6+300ns) within Data::Printer::Filter::HASH::BEGIN@5 which was called: # once (6µs+300ns) by Data::Printer::Object::BEGIN@54 at line 5
use Data::Printer::Common;
# spent 6µs making 1 call to Data::Printer::Filter::HASH::BEGIN@5 # spent 300ns making 1 call to Data::Printer::Filter::HASH::__ANON__
62436µs12µs
# spent 2µs within Data::Printer::Filter::HASH::BEGIN@6 which was called: # once (2µs+0s) by Data::Printer::Object::BEGIN@54 at line 6
use Scalar::Util ();
# spent 2µs making 1 call to Data::Printer::Filter::HASH::BEGIN@6
7
812µs115µsfilter 'HASH' => \&parse;
9
10
11sub parse {
12 my ($hash_ref, $ddp) = @_;
13 my $tied = '';
14 if ($ddp->show_tied and my $tie = ref tied %$hash_ref) {
15 $tied = " (tied to $tie)";
16 }
17 return $ddp->maybe_colorize('{', 'brackets')
18 . ' ' . $ddp->maybe_colorize('...', 'hash')
19 . ' ' . $ddp->maybe_colorize('}', 'brackets')
20 . $tied
21 if $ddp->max_depth && $ddp->current_depth >= $ddp->max_depth;
22
23 my @src_keys = keys %$hash_ref;
24 return $ddp->maybe_colorize('{}', 'brackets') . $tied unless @src_keys;
25 @src_keys = Data::Printer::Common::_nsort(@src_keys) if $ddp->sort_keys;
26
27 my $len = 0;
28 my $align_keys = $ddp->multiline && $ddp->align_hash;
29
30 my @i = Data::Printer::Common::_fetch_indexes_for(\@src_keys, 'hash', $ddp);
31
32 my %processed_keys;
33 # first pass, preparing keys and getting largest key size:
34 foreach my $idx (@i) {
35 next if ref $idx;
36 my $raw_key = $src_keys[$idx];
37 my $colored_key = Data::Printer::Common::_process_string($ddp, $raw_key, 'hash');
38 my $new_key = Data::Printer::Common::_colorstrip($colored_key);
39
40 if (_needs_quote($ddp, $raw_key, $new_key)) {
41 my $quote_char = $ddp->scalar_quotes;
42 # foo'bar ==> 'foo\'bar'
43 if (index($new_key, $quote_char) >= 0) {
44 $new_key =~ s{$quote_char}{\\$quote_char}g;
45 $colored_key =~ s{$quote_char}{\\$quote_char}g;
46 }
47 $new_key = $quote_char . $new_key . $quote_char;
48 $colored_key = $ddp->maybe_colorize($quote_char, 'quotes')
49 . $colored_key
50 . $ddp->maybe_colorize($quote_char, 'quotes')
51 ;
52 }
53 $processed_keys{$idx} = {
54 raw => $raw_key,
55 colored => $colored_key,
56 nocolor => $new_key,
57 };
58 if ($align_keys) {
59 my $l = length $new_key;
60 $len = $l if $l > $len;
61 }
62 }
63 # second pass, traversing and rendering:
64 $ddp->indent;
65 my $total_keys = scalar @i; # yes, counting messages so ',' appear in between.
66 #keys %processed_keys;
67 my $string = $ddp->maybe_colorize('{', 'brackets');
68 foreach my $idx (@i) {
69 $total_keys--;
70 # $idx is a message to display, not a real index
71 if (ref $idx) {
72 $string .= $ddp->newline . $$idx;
73 next;
74 }
75 my $key = $processed_keys{$idx};
76
77 my $original_varname = $ddp->current_name;
78 # update 'var' to 'var{key}':
79 $ddp->current_name(
80 $original_varname
81 . ($ddp->arrows eq 'all' || ($ddp->arrows eq 'first' && $ddp->current_depth == 1) ? '->' : '')
82 . '{' . $key->{nocolor} . '}'
83 );
84
85 my $padding = $len - length($key->{nocolor});
86 $padding = 0 if $padding < 0;
87 $string .= $ddp->newline
88 . $key->{colored}
89 . (' ' x $padding)
90 . $ddp->maybe_colorize($ddp->hash_separator, 'separator')
91 ;
92
93 # scalar references should be re-referenced to gain
94 # a '\' in front of them.
95 my $ref = ref $hash_ref->{$key->{raw}};
96 if ( $ref && $ref eq 'SCALAR' ) {
97 $string .= $ddp->parse(\$hash_ref->{ $key->{raw} });
98 }
99 elsif ( $ref && $ref ne 'REF' ) {
100 $string .= $ddp->parse( $hash_ref->{ $key->{raw} });
101 } else {
102 $string .= $ddp->parse(\$hash_ref->{ $key->{raw} });
103 }
104
105 $string .= $ddp->maybe_colorize($ddp->separator, 'separator')
106 if $total_keys > 0 || $ddp->end_separator;
107
108 # restore var name back to "var"
109 $ddp->current_name($original_varname);
110 }
111 $ddp->outdent;
112 $string .= $ddp->newline . $ddp->maybe_colorize('}', 'brackets');
113 return $string . $tied;
114};
115
116#######################################
117### Private auxiliary helpers below ###
118#######################################
119
120sub _needs_quote {
121 my ($ddp, $raw_key, $new_key) = @_;
122 my $quote_keys = $ddp->quote_keys;
123 my $scalar_quotes = $ddp->scalar_quotes;
124 return 0 unless defined $quote_keys && defined $scalar_quotes;;
125 if ($quote_keys eq 'auto'
126 && $raw_key eq $new_key
127 && $new_key !~ /\s|\r|\n|\t|\f/) {
128 return 0;
129 }
130 return 1;
131}
132
13312µs1;
 
# spent 300ns within Data::Printer::Filter::HASH::__ANON__ which was called: # once (300ns+0s) by Data::Printer::Filter::HASH::BEGIN@5 at line 5
sub Data::Printer::Filter::HASH::__ANON__; # xsub