line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
1
|
|
|
1
|
|
66303
|
use strict; |
|
1
|
|
|
|
|
12
|
|
|
1
|
|
|
|
|
29
|
|
2
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
72
|
|
3
|
|
|
|
|
|
|
package YAML::PP::Highlight; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.036'; # VERSION |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our @EXPORT_OK = qw/ Dump /; |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
9
|
use base 'Exporter'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
162
|
|
10
|
1
|
|
|
1
|
|
483
|
use YAML::PP; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
49
|
|
11
|
1
|
|
|
1
|
|
6
|
use YAML::PP::Parser; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
22
|
|
12
|
1
|
|
|
1
|
|
538
|
use Encode; |
|
1
|
|
|
|
|
9451
|
|
|
1
|
|
|
|
|
1227
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub Dump { |
15
|
1
|
|
|
1
|
1
|
10584
|
my (@docs) = @_; |
16
|
|
|
|
|
|
|
# Dumping objects is safe, so we enable the Perl schema here |
17
|
1
|
|
|
|
|
635
|
require YAML::PP::Schema::Perl; |
18
|
1
|
|
|
|
|
13
|
my $yp = YAML::PP->new( schema => [qw/ + Perl /] ); |
19
|
1
|
|
|
|
|
5
|
my $yaml = $yp->dump_string(@docs); |
20
|
|
|
|
|
|
|
|
21
|
1
|
|
|
|
|
13
|
my ($error, $tokens) = YAML::PP::Parser->yaml_to_tokens(string => $yaml); |
22
|
1
|
|
|
|
|
20
|
my $highlighted = YAML::PP::Highlight->ansicolored($tokens); |
23
|
1
|
|
|
|
|
6
|
encode_utf8 $highlighted; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my %ansicolors = ( |
28
|
|
|
|
|
|
|
ANCHOR => [qw/ green /], |
29
|
|
|
|
|
|
|
ALIAS => [qw/ bold green /], |
30
|
|
|
|
|
|
|
TAG => [qw/ bold blue /], |
31
|
|
|
|
|
|
|
INDENT => [qw/ white on_grey3 /], |
32
|
|
|
|
|
|
|
COMMENT => [qw/ grey12 /], |
33
|
|
|
|
|
|
|
COLON => [qw/ bold magenta /], |
34
|
|
|
|
|
|
|
DASH => [qw/ bold magenta /], |
35
|
|
|
|
|
|
|
QUESTION => [qw/ bold magenta /], |
36
|
|
|
|
|
|
|
YAML_DIRECTIVE => [qw/ cyan /], |
37
|
|
|
|
|
|
|
TAG_DIRECTIVE => [qw/ bold cyan /], |
38
|
|
|
|
|
|
|
SINGLEQUOTE => [qw/ bold green /], |
39
|
|
|
|
|
|
|
SINGLEQUOTED => [qw/ green /], |
40
|
|
|
|
|
|
|
SINGLEQUOTED_LINE => [qw/ green /], |
41
|
|
|
|
|
|
|
DOUBLEQUOTE => [qw/ bold green /], |
42
|
|
|
|
|
|
|
DOUBLEQUOTED => [qw/ green /], |
43
|
|
|
|
|
|
|
DOUBLEQUOTED_LINE => [qw/ green /], |
44
|
|
|
|
|
|
|
LITERAL => [qw/ bold yellow /], |
45
|
|
|
|
|
|
|
FOLDED => [qw/ bold yellow /], |
46
|
|
|
|
|
|
|
DOC_START => [qw/ bold /], |
47
|
|
|
|
|
|
|
DOC_END => [qw/ bold /], |
48
|
|
|
|
|
|
|
BLOCK_SCALAR_CONTENT => [qw/ yellow /], |
49
|
|
|
|
|
|
|
TAB => [qw/ on_blue /], |
50
|
|
|
|
|
|
|
ERROR => [qw/ bold red /], |
51
|
|
|
|
|
|
|
EOL => [qw/ grey12 /], |
52
|
|
|
|
|
|
|
TRAILING_SPACE => [qw/ on_grey6 /], |
53
|
|
|
|
|
|
|
FLOWSEQ_START => [qw/ bold magenta /], |
54
|
|
|
|
|
|
|
FLOWSEQ_END => [qw/ bold magenta /], |
55
|
|
|
|
|
|
|
FLOWMAP_START => [qw/ bold magenta /], |
56
|
|
|
|
|
|
|
FLOWMAP_END => [qw/ bold magenta /], |
57
|
|
|
|
|
|
|
FLOW_COMMA => [qw/ bold magenta /], |
58
|
|
|
|
|
|
|
PLAINKEY => [qw/ bright_blue /], |
59
|
|
|
|
|
|
|
); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub ansicolored { |
62
|
3
|
|
|
3
|
0
|
16
|
my ($class, $tokens, %args) = @_; |
63
|
3
|
|
|
|
|
6
|
my $expand_tabs = $args{expand_tabs}; |
64
|
3
|
100
|
|
|
|
8
|
$expand_tabs = 1 unless defined $expand_tabs; |
65
|
3
|
|
|
|
|
16
|
require Term::ANSIColor; |
66
|
|
|
|
|
|
|
|
67
|
3
|
|
|
|
|
12
|
local $Term::ANSIColor::EACHLINE = "\n"; |
68
|
3
|
|
|
|
|
6
|
my $ansi = ''; |
69
|
3
|
|
|
|
|
4
|
my $highlighted = ''; |
70
|
|
|
|
|
|
|
|
71
|
3
|
|
|
|
|
9
|
my @list = $class->transform($tokens); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
3
|
|
|
|
|
6
|
for my $token (@list) { |
75
|
21
|
|
|
|
|
31
|
my $name = $token->{name}; |
76
|
21
|
|
|
|
|
28
|
my $str = $token->{value}; |
77
|
|
|
|
|
|
|
|
78
|
21
|
|
|
|
|
43
|
my $color = $ansicolors{ $name }; |
79
|
21
|
100
|
|
|
|
35
|
if ($color) { |
80
|
15
|
|
|
|
|
32
|
$str = Term::ANSIColor::colored($color, $str); |
81
|
|
|
|
|
|
|
} |
82
|
21
|
|
|
|
|
645
|
$highlighted .= $str; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
3
|
100
|
|
|
|
8
|
if ($expand_tabs) { |
86
|
|
|
|
|
|
|
# Tabs can't be displayed with ansicolors |
87
|
2
|
|
|
|
|
12
|
$highlighted =~ s/\t/' ' x 8/eg; |
|
1
|
|
|
|
|
4
|
|
88
|
|
|
|
|
|
|
} |
89
|
3
|
|
|
|
|
8
|
$ansi .= $highlighted; |
90
|
3
|
|
|
|
|
15
|
return $ansi; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
my %htmlcolors = ( |
94
|
|
|
|
|
|
|
ANCHOR => 'anchor', |
95
|
|
|
|
|
|
|
ALIAS => 'alias', |
96
|
|
|
|
|
|
|
SINGLEQUOTE => 'singlequote', |
97
|
|
|
|
|
|
|
DOUBLEQUOTE => 'doublequote', |
98
|
|
|
|
|
|
|
SINGLEQUOTED => 'singlequoted', |
99
|
|
|
|
|
|
|
DOUBLEQUOTED => 'doublequoted', |
100
|
|
|
|
|
|
|
SINGLEQUOTED_LINE => 'singlequoted', |
101
|
|
|
|
|
|
|
DOUBLEQUOTED_LINE => 'doublequoted', |
102
|
|
|
|
|
|
|
INDENT => 'indent', |
103
|
|
|
|
|
|
|
DASH => 'dash', |
104
|
|
|
|
|
|
|
COLON => 'colon', |
105
|
|
|
|
|
|
|
QUESTION => 'question', |
106
|
|
|
|
|
|
|
YAML_DIRECTIVE => 'yaml_directive', |
107
|
|
|
|
|
|
|
TAG_DIRECTIVE => 'tag_directive', |
108
|
|
|
|
|
|
|
TAG => 'tag', |
109
|
|
|
|
|
|
|
COMMENT => 'comment', |
110
|
|
|
|
|
|
|
LITERAL => 'literal', |
111
|
|
|
|
|
|
|
FOLDED => 'folded', |
112
|
|
|
|
|
|
|
DOC_START => 'doc_start', |
113
|
|
|
|
|
|
|
DOC_END => 'doc_end', |
114
|
|
|
|
|
|
|
BLOCK_SCALAR_CONTENT => 'block_scalar_content', |
115
|
|
|
|
|
|
|
TAB => 'tab', |
116
|
|
|
|
|
|
|
ERROR => 'error', |
117
|
|
|
|
|
|
|
EOL => 'eol', |
118
|
|
|
|
|
|
|
TRAILING_SPACE => 'trailing_space', |
119
|
|
|
|
|
|
|
FLOWSEQ_START => 'flowseq_start', |
120
|
|
|
|
|
|
|
FLOWSEQ_END => 'flowseq_end', |
121
|
|
|
|
|
|
|
FLOWMAP_START => 'flowmap_start', |
122
|
|
|
|
|
|
|
FLOWMAP_END => 'flowmap_end', |
123
|
|
|
|
|
|
|
FLOW_COMMA => 'flow_comma', |
124
|
|
|
|
|
|
|
PLAINKEY => 'plainkey', |
125
|
|
|
|
|
|
|
NOEOL => 'noeol', |
126
|
|
|
|
|
|
|
); |
127
|
|
|
|
|
|
|
sub htmlcolored { |
128
|
0
|
|
|
0
|
0
|
0
|
require HTML::Entities; |
129
|
0
|
|
|
|
|
0
|
my ($class, $tokens) = @_; |
130
|
0
|
|
|
|
|
0
|
my $html = ''; |
131
|
0
|
|
|
|
|
0
|
my @list = $class->transform($tokens); |
132
|
0
|
|
|
|
|
0
|
for my $token (@list) { |
133
|
0
|
|
|
|
|
0
|
my $name = $token->{name}; |
134
|
0
|
|
|
|
|
0
|
my $str = $token->{value}; |
135
|
0
|
|
0
|
|
|
0
|
my $colorclass = $htmlcolors{ $name } || 'default'; |
136
|
0
|
|
|
|
|
0
|
$str = HTML::Entities::encode_entities($str); |
137
|
0
|
|
|
|
|
0
|
$html .= qq{$str}; |
138
|
|
|
|
|
|
|
} |
139
|
0
|
|
|
|
|
0
|
return $html; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub transform { |
143
|
4
|
|
|
4
|
0
|
17
|
my ($class, $tokens) = @_; |
144
|
4
|
|
|
|
|
9
|
my @list; |
145
|
4
|
|
|
|
|
9
|
for my $token (@$tokens) { |
146
|
27
|
|
|
|
|
42
|
my @values; |
147
|
27
|
|
|
|
|
39
|
my $value = $token->{value}; |
148
|
27
|
|
|
|
|
35
|
my $subtokens = $token->{subtokens}; |
149
|
27
|
100
|
|
|
|
45
|
if ($subtokens) { |
150
|
2
|
|
|
|
|
4
|
@values = @$subtokens; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
else { |
153
|
25
|
|
|
|
|
35
|
@values = $token; |
154
|
|
|
|
|
|
|
} |
155
|
27
|
|
|
|
|
38
|
for my $token (@values) { |
156
|
32
|
100
|
|
|
|
60
|
my $value = defined $token->{orig} ? $token->{orig} : $token->{value}; |
157
|
32
|
50
|
66
|
|
|
76
|
if ($token->{name} eq 'EOL' and not length $value) { |
158
|
0
|
|
|
|
|
0
|
push @list, { name => 'NOEOL', value => '' }; |
159
|
0
|
|
|
|
|
0
|
next; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
push @list, map { |
162
|
32
|
|
|
|
|
72
|
$_ =~ tr/\t/\t/ |
163
|
|
|
|
|
|
|
? { name => 'TAB', value => $_ } |
164
|
36
|
100
|
|
|
|
146
|
: { name => $token->{name}, value => $_ } |
165
|
|
|
|
|
|
|
} split m/(\t+)/, $value; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
4
|
|
|
|
|
16
|
for my $i (0 .. $#list) { |
169
|
36
|
|
|
|
|
49
|
my $token = $list[ $i ]; |
170
|
36
|
|
|
|
|
50
|
my $name = $token->{name}; |
171
|
36
|
|
|
|
|
57
|
my $str = $token->{value}; |
172
|
36
|
|
|
|
|
40
|
my $trailing_space = 0; |
173
|
36
|
100
|
|
|
|
79
|
if ($token->{name} eq 'EOL') { |
|
|
50
|
|
|
|
|
|
174
|
9
|
50
|
|
|
|
26
|
if ($str =~ m/ +([\r\n]|\z)/) { |
175
|
0
|
|
|
|
|
0
|
$token->{name} = "TRAILING_SPACE"; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
elsif ($i < $#list) { |
179
|
27
|
100
|
|
|
|
52
|
if ($name eq 'PLAIN') { |
180
|
8
|
|
|
|
|
21
|
for my $n ($i+1 .. $#list) { |
181
|
25
|
|
|
|
|
33
|
my $next = $list[ $n ]; |
182
|
25
|
100
|
|
|
|
47
|
last if $next->{name} eq 'EOL'; |
183
|
17
|
100
|
|
|
|
49
|
next if $next->{name} =~ m/^(WS|SPACE)$/; |
184
|
12
|
100
|
|
|
|
27
|
if ($next->{name} eq 'COLON') { |
185
|
5
|
|
|
|
|
9
|
$token->{name} = 'PLAINKEY'; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
} |
189
|
27
|
|
|
|
|
41
|
my $next = $list[ $i + 1]; |
190
|
27
|
100
|
|
|
|
56
|
if ($next->{name} eq 'EOL') { |
191
|
9
|
100
|
66
|
|
|
45
|
if ($str =~ m/ \z/ and $name =~ m/^(BLOCK_SCALAR_CONTENT|WS|INDENT)$/) { |
192
|
1
|
|
|
|
|
3
|
$token->{name} = "TRAILING_SPACE"; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
} |
197
|
4
|
|
|
|
|
14
|
return @list; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
1; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
__END__ |