| 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 | Data::Printer::Filter::SCALAR::BEGIN@4 |
| 1 | 1 | 1 | 8µs | 9µs | Data::Printer::Filter::SCALAR::BEGIN@2 |
| 1 | 1 | 1 | 7µs | 20µs | Data::Printer::Filter::SCALAR::BEGIN@28 |
| 1 | 1 | 1 | 4µs | 8µs | Data::Printer::Filter::SCALAR::BEGIN@5 |
| 1 | 1 | 1 | 3µs | 16µs | Data::Printer::Filter::SCALAR::BEGIN@3 |
| 0 | 0 | 0 | 0s | 0s | Data::Printer::Filter::SCALAR::__ANON__[:15] |
| 0 | 0 | 0 | 0s | 0s | Data::Printer::Filter::SCALAR::_check_tainted |
| 0 | 0 | 0 | 0s | 0s | Data::Printer::Filter::SCALAR::_check_unicode |
| 0 | 0 | 0 | 0s | 0s | Data::Printer::Filter::SCALAR::_is_number |
| 0 | 0 | 0 | 0s | 0s | Data::Printer::Filter::SCALAR::_quoteme |
| 0 | 0 | 0 | 0s | 0s | Data::Printer::Filter::SCALAR::parse |
| 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; |