Filename | /home/hejohns/perl5/lib/perl5/Data/Printer/Filter/SCALAR.pm |
Statements | Executed 13 statements in 550µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 229µs | 292µs | BEGIN@4 | Data::Printer::Filter::SCALAR::
1 | 1 | 1 | 8µs | 9µs | BEGIN@2 | Data::Printer::Filter::SCALAR::
1 | 1 | 1 | 7µs | 20µs | BEGIN@28 | Data::Printer::Filter::SCALAR::
1 | 1 | 1 | 4µs | 8µs | BEGIN@5 | Data::Printer::Filter::SCALAR::
1 | 1 | 1 | 3µs | 16µs | BEGIN@3 | Data::Printer::Filter::SCALAR::
0 | 0 | 0 | 0s | 0s | __ANON__[:15] | Data::Printer::Filter::SCALAR::
0 | 0 | 0 | 0s | 0s | _check_tainted | Data::Printer::Filter::SCALAR::
0 | 0 | 0 | 0s | 0s | _check_unicode | Data::Printer::Filter::SCALAR::
0 | 0 | 0 | 0s | 0s | _is_number | Data::Printer::Filter::SCALAR::
0 | 0 | 0 | 0s | 0s | _quoteme | Data::Printer::Filter::SCALAR::
0 | 0 | 0 | 0s | 0s | parse | Data::Printer::Filter::SCALAR::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Data::Printer::Filter::SCALAR; | ||||
2 | 2 | 16µs | 2 | 11µ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 # spent 9µs making 1 call to Data::Printer::Filter::SCALAR::BEGIN@2
# spent 2µs making 1 call to strict::import |
3 | 2 | 12µs | 2 | 29µ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 # spent 16µs making 1 call to Data::Printer::Filter::SCALAR::BEGIN@3
# spent 13µs making 1 call to warnings::import |
4 | 2 | 75µs | 2 | 307µ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 # spent 292µs making 1 call to Data::Printer::Filter::SCALAR::BEGIN@4
# spent 14µs making 1 call to Data::Printer::Filter::import |
5 | 2 | 80µs | 2 | 14µ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 # spent 8µs making 1 call to Data::Printer::Filter::SCALAR::BEGIN@5
# spent 5µs making 1 call to Exporter::import |
6 | |||||
7 | 1 | 2µs | 1 | 22µs | filter 'SCALAR' => \&parse; # spent 22µs making 1 call to Data::Printer::Filter::__ANON__[Data/Printer/Filter.pm:23] |
8 | filter '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; | ||||
15 | 1 | 2µs | 1 | 8µs | }; # spent 8µs making 1 call to Data::Printer::Filter::__ANON__[Data/Printer/Filter.pm:23] |
16 | |||||
17 | sub 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; | ||||
28 | 2 | 360µs | 2 | 32µ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 # 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 | ####################################### | ||||
76 | sub _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 | |||||
89 | sub _check_tainted { | ||||
90 | my ($self, $var) = @_; | ||||
91 | return ' (TAINTED)' if $self->show_tainted && Scalar::Util::tainted($$var); | ||||
92 | return ''; | ||||
93 | } | ||||
94 | |||||
95 | sub _check_unicode { | ||||
96 | my ($self, $var) = @_; | ||||
97 | return ' (U)' if $self->show_unicode && utf8::is_utf8($$var); | ||||
98 | return ''; | ||||
99 | } | ||||
100 | |||||
101 | sub _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 | |||||
125 | 1 | 3µs | 1; |