| 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 | Data::Printer::Filter::HASH::BEGIN@2 |
| 1 | 1 | 1 | 6µs | 6µs | Data::Printer::Filter::HASH::BEGIN@5 |
| 1 | 1 | 1 | 5µs | 22µs | Data::Printer::Filter::HASH::BEGIN@4 |
| 1 | 1 | 1 | 4µs | 16µs | Data::Printer::Filter::HASH::BEGIN@3 |
| 1 | 1 | 1 | 2µs | 2µs | Data::Printer::Filter::HASH::BEGIN@6 |
| 1 | 1 | 1 | 300ns | 300ns | Data::Printer::Filter::HASH::__ANON__ (xsub) |
| 0 | 0 | 0 | 0s | 0s | Data::Printer::Filter::HASH::_needs_quote |
| 0 | 0 | 0 | 0s | 0s | Data::Printer::Filter::HASH::parse |
| 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 |