1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
package Data::Printer::Filter::SCALAR;
use strict;
use warnings;
use Data::Printer::Filter;
use Scalar::Util;
filter 'SCALAR' => \&parse;
filter 'LVALUE' => sub {
my ($scalar_ref, $ddp) = @_;
my $string = parse($scalar_ref, $ddp);
if ($ddp->show_lvalue) {
$string .= $ddp->maybe_colorize(' (LVALUE)', 'lvalue');
}
return $string;
};
sub parse {
my ($scalar_ref, $ddp) = @_;
my $ret;
my $value = ref $scalar_ref ? $$scalar_ref : $scalar_ref;
if (not defined $value) {
$ret = $ddp->maybe_colorize('undef', 'undef');
}
elsif ( $ddp->show_dualvar ne 'off' ) {
my $numified;
$numified = do { no warnings 'numeric'; 0+ $value } if defined $value;
if ( $numified ) {
if ( "$numified" eq $value
|| (
# lax mode allows decimal zeroes
$ddp->show_dualvar eq 'lax'
&& ((index("$numified",'.') != -1 && $value =~ /\A\s*${numified}[0]*\s*\z/)
|| (index("$numified",'.') == -1 && $value =~ /\A\s*$numified(?:\.[0]*)?\s*\z/))
)
) {
$value =~ s/\A\s+//;
$value =~ s/\s+\z//;
$ret = $ddp->maybe_colorize($value, 'number');
}
else {
$ret = Data::Printer::Common::_process_string( $ddp, "$value", 'string' );
$ret = _quoteme($ddp, $ret);
$ret .= ' (dualvar: ' . $ddp->maybe_colorize( $numified, 'number' ) . ')';
}
}
elsif ( !$numified && _is_number($value) ) {
$ret = $ddp->maybe_colorize($value, 'number');
}
else {
$ret = Data::Printer::Common::_process_string($ddp, $value, 'string');
$ret = _quoteme($ddp, $ret);
}
}
elsif (_is_number($value)) {
$ret = $ddp->maybe_colorize($value, 'number');
}
else {
$ret = Data::Printer::Common::_process_string($ddp, $value, 'string');
$ret = _quoteme($ddp, $ret);
}
$ret .= _check_tainted($ddp, $scalar_ref);
$ret .= _check_unicode($ddp, $scalar_ref);
if ($ddp->show_tied and my $tie = ref tied $$scalar_ref) {
$ret .= " (tied to $tie)";
}
return $ret;
};
#######################################
### Private auxiliary helpers below ###
#######################################
sub _quoteme {
my ($ddp, $text) = @_;
my $scalar_quotes = $ddp->scalar_quotes;
if (defined $scalar_quotes) {
# foo'bar ==> 'foo\'bar'
$text =~ s{$scalar_quotes}{\\$scalar_quotes}g if index($text, $scalar_quotes) >= 0;
my $quote = $ddp->maybe_colorize( $scalar_quotes, 'quotes' );
$text = $quote . $text . $quote;
}
return $text;
}
sub _check_tainted {
my ($self, $var) = @_;
return ' (TAINTED)' if $self->show_tainted && Scalar::Util::tainted($$var);
return '';
}
sub _check_unicode {
my ($self, $var) = @_;
return ' (U)' if $self->show_unicode && utf8::is_utf8($$var);
return '';
}
sub _is_number {
my ($maybe_a_number) = @_;
# Scalar values that start with a zero are strings, NOT numbers.
# You can write `my $foo = 0123`, but then `$foo` will be 83,
# (numbers starting with zero are octal integers)
return if $maybe_a_number =~ /^-?0[0-9]/;
my $is_number = $maybe_a_number =~ m/
^
-? # numbers may begin with a '-' sign, but can't with a '+'.
# If they do they are not numbers, but strings.
[0-9]+ # then there should be some numbers
( \. [0-9]+ )? # there can be decimal part, which is optional
( e [+-] [0-9]+ )? # and an also optional exponential notation part
\z
/x;
return $is_number;
}
1;
|
