← 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/ARRAY.pm
StatementsExecuted 12 statements in 360µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1118µs9µsData::Printer::Filter::ARRAY::::BEGIN@2Data::Printer::Filter::ARRAY::BEGIN@2
1116µs6µsData::Printer::Filter::ARRAY::::BEGIN@5Data::Printer::Filter::ARRAY::BEGIN@5
1113µs15µsData::Printer::Filter::ARRAY::::BEGIN@3Data::Printer::Filter::ARRAY::BEGIN@3
1113µs14µsData::Printer::Filter::ARRAY::::BEGIN@4Data::Printer::Filter::ARRAY::BEGIN@4
1111µs1µsData::Printer::Filter::ARRAY::::BEGIN@6Data::Printer::Filter::ARRAY::BEGIN@6
111200ns200nsData::Printer::Filter::ARRAY::::__ANON__Data::Printer::Filter::ARRAY::__ANON__ (xsub)
0000s0sData::Printer::Filter::ARRAY::::parseData::Printer::Filter::ARRAY::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::ARRAY;
2216µs210µs
# spent 9µs (8+1) within Data::Printer::Filter::ARRAY::BEGIN@2 which was called: # once (8µs+1µs) by Data::Printer::Object::BEGIN@53 at line 2
use strict;
# spent 9µs making 1 call to Data::Printer::Filter::ARRAY::BEGIN@2 # spent 1µs making 1 call to strict::import
3212µs227µs
# spent 15µs (3+12) within Data::Printer::Filter::ARRAY::BEGIN@3 which was called: # once (3µs+12µs) by Data::Printer::Object::BEGIN@53 at line 3
use warnings;
# spent 15µs making 1 call to Data::Printer::Filter::ARRAY::BEGIN@3 # spent 12µs making 1 call to warnings::import
4211µs224µs
# spent 14µs (3+11) within Data::Printer::Filter::ARRAY::BEGIN@4 which was called: # once (3µs+11µs) by Data::Printer::Object::BEGIN@53 at line 4
use Data::Printer::Filter;
# spent 14µs making 1 call to Data::Printer::Filter::ARRAY::BEGIN@4 # spent 11µs making 1 call to Data::Printer::Filter::import
5214µs26µs
# spent 6µs (6+200ns) within Data::Printer::Filter::ARRAY::BEGIN@5 which was called: # once (6µs+200ns) by Data::Printer::Object::BEGIN@53 at line 5
use Data::Printer::Common;
# spent 6µs making 1 call to Data::Printer::Filter::ARRAY::BEGIN@5 # spent 200ns making 1 call to Data::Printer::Filter::ARRAY::__ANON__
62301µs11µs
# spent 1µs within Data::Printer::Filter::ARRAY::BEGIN@6 which was called: # once (1µs+0s) by Data::Printer::Object::BEGIN@53 at line 6
use Scalar::Util ();
# spent 1µs making 1 call to Data::Printer::Filter::ARRAY::BEGIN@6
7
812µs114µsfilter 'ARRAY' => \&parse;
# spent 14µs making 1 call to Data::Printer::Filter::__ANON__[Data/Printer/Filter.pm:23]
9
10
11sub parse {
12 my ($array_ref, $ddp) = @_;
13
14 my $tied = '';
15 if ($ddp->show_tied and my $tie = ref tied @$array_ref) {
16 $tied = " (tied to $tie)";
17 }
18
19 return $ddp->maybe_colorize('[]', 'brackets') . $tied
20 unless @$array_ref;
21 return $ddp->maybe_colorize('[', 'brackets')
22 . $ddp->maybe_colorize('...', 'array')
23 . $ddp->maybe_colorize(']', 'brackets')
24 . $tied
25 if $ddp->max_depth && $ddp->current_depth >= $ddp->max_depth;
26
27 #Scalar::Util::weaken($array_ref);
28 my $string = $ddp->maybe_colorize('[', 'brackets');
29
30 my @i = Data::Printer::Common::_fetch_indexes_for($array_ref, 'array', $ddp);
31
32 # when showing array index, we must add the padding for newlines:
33 my $has_index = $ddp->index;
34 my $local_padding = 0;
35 if ($has_index) {
36 my $last_index;
37 # Get the last index shown to add the proper padding.
38 # If the array has 5000 elements but we're showing 4,
39 # the padding must be 3 + length(1), not 3 + length(5000):
40 for (my $idx = $#i; $idx >= 0; $idx--) {
41 next if ref $i[$idx];
42 $last_index = $i[$idx];
43 last;
44 }
45 if (defined $last_index) {
46 $local_padding = 3 + length($last_index);
47 $ddp->{_array_padding} += $local_padding;
48 }
49 }
50
51 $ddp->indent;
52 foreach my $idx (@i) {
53 $string .= $ddp->newline;
54
55 # $idx is a message to display, not a real index
56 if (ref $idx) {
57 $string .= $$idx;
58 next;
59 }
60
61 my $original_varname = $ddp->current_name;
62 # if name was "var" it must become "var[0]", "var[1]", etc
63 $ddp->current_name(
64 $original_varname
65 . ($ddp->arrows eq 'all' || ($ddp->arrows eq 'first' && $ddp->current_depth == 1) ? '->' : '')
66 . "[$idx]"
67 );
68
69 if ($has_index) {
70 substr($string, -$local_padding) = ''; # get rid of local padding
71 $string .= $ddp->maybe_colorize(
72 sprintf("%-*s", $local_padding, "[$idx]"),
73 'array'
74 );
75 }
76
77 # scalar references should be re-referenced to gain
78 # a '\' in front of them.
79 my $ref = ref $array_ref->[$idx];
80 if ($ref) {
81 if ($ref eq 'SCALAR') {
82 $string .= $ddp->parse(\$array_ref->[$idx]);
83 }
84 elsif ($ref eq 'REF') {
85 $string .= $ddp->parse(\$array_ref->[$idx]);
86 }
87 else {
88 $string .= $ddp->parse($array_ref->[$idx]);
89 }
90 }
91 else {
92 # not a reference, so we don't need to worry about refcounts.
93 # it helps to prevent cases where Perl reuses addresses:
94 $string .= $ddp->parse(\$array_ref->[$idx], seen_override => 1);
95 }
96
97 $string .= $ddp->maybe_colorize($ddp->separator, 'separator')
98 if $idx < $#{$array_ref} || $ddp->end_separator;
99
100 # we're finished with "var[x]", turn it back to "var":
101 $ddp->current_name( $original_varname );
102 }
103 $ddp->outdent;
104 $ddp->{_array_padding} -= $local_padding if $has_index;
105 $string .= $ddp->newline;
106 $string .= $ddp->maybe_colorize(']', 'brackets');
107
108 return $string . $tied;
109};
110
111#######################################
112### Private auxiliary helpers below ###
113#######################################
114
11512µs1;
 
# spent 200ns within Data::Printer::Filter::ARRAY::__ANON__ which was called: # once (200ns+0s) by Data::Printer::Filter::ARRAY::BEGIN@5 at line 5
sub Data::Printer::Filter::ARRAY::__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.