Filename | /home/hejohns/perl5/lib/perl5/Data/Printer/Filter/HASH.pm |
Statements | Executed 12 statements in 499µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 19µs | 21µs | BEGIN@2 | Data::Printer::Filter::HASH::
1 | 1 | 1 | 6µs | 6µs | BEGIN@5 | Data::Printer::Filter::HASH::
1 | 1 | 1 | 5µs | 22µs | BEGIN@4 | Data::Printer::Filter::HASH::
1 | 1 | 1 | 4µs | 16µs | BEGIN@3 | Data::Printer::Filter::HASH::
1 | 1 | 1 | 2µs | 2µs | BEGIN@6 | Data::Printer::Filter::HASH::
1 | 1 | 1 | 300ns | 300ns | __ANON__ (xsub) | Data::Printer::Filter::HASH::
0 | 0 | 0 | 0s | 0s | _needs_quote | Data::Printer::Filter::HASH::
0 | 0 | 0 | 0s | 0s | parse | Data::Printer::Filter::HASH::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Data::Printer::Filter::HASH; | ||||
2 | 2 | 19µs | 2 | 22µ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 # spent 21µs making 1 call to Data::Printer::Filter::HASH::BEGIN@2
# spent 1µs making 1 call to strict::import |
3 | 2 | 13µs | 2 | 28µ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 # spent 16µs making 1 call to Data::Printer::Filter::HASH::BEGIN@3
# spent 12µs making 1 call to warnings::import |
4 | 2 | 12µs | 2 | 38µ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 # spent 22µs making 1 call to Data::Printer::Filter::HASH::BEGIN@4
# spent 16µs making 1 call to Data::Printer::Filter::import |
5 | 2 | 15µs | 2 | 6µ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 # spent 6µs making 1 call to Data::Printer::Filter::HASH::BEGIN@5
# spent 300ns making 1 call to Data::Printer::Filter::HASH::__ANON__ |
6 | 2 | 436µs | 1 | 2µ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 # spent 2µs making 1 call to Data::Printer::Filter::HASH::BEGIN@6 |
7 | |||||
8 | 1 | 2µs | 1 | 15µs | filter 'HASH' => \&parse; # spent 15µs making 1 call to Data::Printer::Filter::__ANON__[Data/Printer/Filter.pm:23] |
9 | |||||
10 | |||||
11 | sub 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 | |||||
120 | sub _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 | |||||
133 | 1 | 2µs | 1; | ||
# spent 300ns within Data::Printer::Filter::HASH::__ANON__ which was called:
# once (300ns+0s) by Data::Printer::Filter::HASH::BEGIN@5 at line 5 |