← 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/SCALAR.pm
StatementsExecuted 13 statements in 550µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111229µs292µsData::Printer::Filter::SCALAR::::BEGIN@4Data::Printer::Filter::SCALAR::BEGIN@4
1118µs9µsData::Printer::Filter::SCALAR::::BEGIN@2Data::Printer::Filter::SCALAR::BEGIN@2
1117µs20µsData::Printer::Filter::SCALAR::::BEGIN@28Data::Printer::Filter::SCALAR::BEGIN@28
1114µs8µsData::Printer::Filter::SCALAR::::BEGIN@5Data::Printer::Filter::SCALAR::BEGIN@5
1113µs16µsData::Printer::Filter::SCALAR::::BEGIN@3Data::Printer::Filter::SCALAR::BEGIN@3
0000s0sData::Printer::Filter::SCALAR::::__ANON__[:15]Data::Printer::Filter::SCALAR::__ANON__[:15]
0000s0sData::Printer::Filter::SCALAR::::_check_taintedData::Printer::Filter::SCALAR::_check_tainted
0000s0sData::Printer::Filter::SCALAR::::_check_unicodeData::Printer::Filter::SCALAR::_check_unicode
0000s0sData::Printer::Filter::SCALAR::::_is_numberData::Printer::Filter::SCALAR::_is_number
0000s0sData::Printer::Filter::SCALAR::::_quotemeData::Printer::Filter::SCALAR::_quoteme
0000s0sData::Printer::Filter::SCALAR::::parseData::Printer::Filter::SCALAR::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::SCALAR;
2216µs211µs
# spent 9µs (8+2) within Data::Printer::Filter::SCALAR::BEGIN@2 which was called: # once (8µs+2µs) by Data::Printer::Object::BEGIN@52 at line 2
use strict;
# spent 9µs making 1 call to Data::Printer::Filter::SCALAR::BEGIN@2 # spent 2µs making 1 call to strict::import
3212µs229µs
# spent 16µs (3+13) within Data::Printer::Filter::SCALAR::BEGIN@3 which was called: # once (3µs+13µs) by Data::Printer::Object::BEGIN@52 at line 3
use warnings;
# spent 16µs making 1 call to Data::Printer::Filter::SCALAR::BEGIN@3 # spent 13µs making 1 call to warnings::import
4275µs2307µs
# spent 292µs (229+64) within Data::Printer::Filter::SCALAR::BEGIN@4 which was called: # once (229µs+64µs) by Data::Printer::Object::BEGIN@52 at line 4
use Data::Printer::Filter;
# spent 292µs making 1 call to Data::Printer::Filter::SCALAR::BEGIN@4 # spent 14µs making 1 call to Data::Printer::Filter::import
5280µs214µs
# spent 8µs (4+5) within Data::Printer::Filter::SCALAR::BEGIN@5 which was called: # once (4µs+5µs) by Data::Printer::Object::BEGIN@52 at line 5
use Scalar::Util;
# spent 8µs making 1 call to Data::Printer::Filter::SCALAR::BEGIN@5 # spent 5µs making 1 call to Exporter::import
6
712µs122µsfilter 'SCALAR' => \&parse;
8filter 'LVALUE' => sub {
9 my ($scalar_ref, $ddp) = @_;
10 my $string = parse($scalar_ref, $ddp);
11 if ($ddp->show_lvalue) {
12 $string .= $ddp->maybe_colorize(' (LVALUE)', 'lvalue');
13 }
14 return $string;
1512µs18µs};
16
17sub parse {
18 my ($scalar_ref, $ddp) = @_;
19
20 my $ret;
21 my $value = ref $scalar_ref ? $$scalar_ref : $scalar_ref;
22
23 if (not defined $value) {
24 $ret = $ddp->maybe_colorize('undef', 'undef');
25 }
26 elsif ( $ddp->show_dualvar ne 'off' ) {
27 my $numified;
282360µs232µs
# spent 20µs (7+13) within Data::Printer::Filter::SCALAR::BEGIN@28 which was called: # once (7µs+13µs) by Data::Printer::Object::BEGIN@52 at line 28
$numified = do { no warnings 'numeric'; 0+ $value } if defined $value;
# spent 20µs making 1 call to Data::Printer::Filter::SCALAR::BEGIN@28 # spent 13µs making 1 call to warnings::unimport
29 if ( $numified ) {
30 if ( "$numified" eq $value
31 || (
32 # lax mode allows decimal zeroes
33 $ddp->show_dualvar eq 'lax'
34 && ((index("$numified",'.') != -1 && $value =~ /\A\s*${numified}[0]*\s*\z/)
35 || (index("$numified",'.') == -1 && $value =~ /\A\s*$numified(?:\.[0]*)?\s*\z/))
36 )
37 ) {
38 $value =~ s/\A\s+//;
39 $value =~ s/\s+\z//;
40 $ret = $ddp->maybe_colorize($value, 'number');
41 }
42 else {
43 $ret = Data::Printer::Common::_process_string( $ddp, "$value", 'string' );
44 $ret = _quoteme($ddp, $ret);
45 $ret .= ' (dualvar: ' . $ddp->maybe_colorize( $numified, 'number' ) . ')';
46 }
47 }
48 elsif ( !$numified && _is_number($value) ) {
49 $ret = $ddp->maybe_colorize($value, 'number');
50 }
51 else {
52 $ret = Data::Printer::Common::_process_string($ddp, $value, 'string');
53 $ret = _quoteme($ddp, $ret);
54 }
55 }
56 elsif (_is_number($value)) {
57 $ret = $ddp->maybe_colorize($value, 'number');
58 }
59 else {
60 $ret = Data::Printer::Common::_process_string($ddp, $value, 'string');
61 $ret = _quoteme($ddp, $ret);
62 }
63 $ret .= _check_tainted($ddp, $scalar_ref);
64 $ret .= _check_unicode($ddp, $scalar_ref);
65
66 if ($ddp->show_tied and my $tie = ref tied $$scalar_ref) {
67 $ret .= " (tied to $tie)";
68 }
69
70 return $ret;
71};
72
73#######################################
74### Private auxiliary helpers below ###
75#######################################
76sub _quoteme {
77 my ($ddp, $text) = @_;
78
79 my $scalar_quotes = $ddp->scalar_quotes;
80 if (defined $scalar_quotes) {
81 # foo'bar ==> 'foo\'bar'
82 $text =~ s{$scalar_quotes}{\\$scalar_quotes}g if index($text, $scalar_quotes) >= 0;
83 my $quote = $ddp->maybe_colorize( $scalar_quotes, 'quotes' );
84 $text = $quote . $text . $quote;
85 }
86 return $text;
87}
88
89sub _check_tainted {
90 my ($self, $var) = @_;
91 return ' (TAINTED)' if $self->show_tainted && Scalar::Util::tainted($$var);
92 return '';
93}
94
95sub _check_unicode {
96 my ($self, $var) = @_;
97 return ' (U)' if $self->show_unicode && utf8::is_utf8($$var);
98 return '';
99}
100
101sub _is_number {
102 my ($maybe_a_number) = @_;
103
104 # Scalar values that start with a zero are strings, NOT numbers.
105 # You can write `my $foo = 0123`, but then `$foo` will be 83,
106 # (numbers starting with zero are octal integers)
107 return if $maybe_a_number =~ /^-?0[0-9]/;
108
109 my $is_number = $maybe_a_number =~ m/
110 ^
111 -? # numbers may begin with a '-' sign, but can't with a '+'.
112 # If they do they are not numbers, but strings.
113
114 [0-9]+ # then there should be some numbers
115
116 ( \. [0-9]+ )? # there can be decimal part, which is optional
117
118 ( e [+-] [0-9]+ )? # and an also optional exponential notation part
119 \z
120 /x;
121
122 return $is_number;
123}
124
12513µs1;