line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PPI::HTML; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=pod |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
PPI::HTML - Generate syntax-hightlighted HTML for Perl using PPI |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use PPI; |
12
|
|
|
|
|
|
|
use PPI::HTML; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# Load your Perl file |
15
|
|
|
|
|
|
|
my $Document = PPI::Document->load( 'script.pl' ); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# Create a reusable syntax highlighter |
18
|
|
|
|
|
|
|
my $Highlight = PPI::HTML->new( line_numbers => 1 ); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Spit out the HTML |
21
|
|
|
|
|
|
|
print $Highlight->html( $Document ); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 DESCRIPTION |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
PPI::HTML converts Perl documents into syntax highlighted HTML pages. |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=head1 HISTORY |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
PPI::HTML is the successor to the now-redundant PPI::Format::HTML. |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
While early on it was thought that the same formatting code might be able |
32
|
|
|
|
|
|
|
to be used for a variety of different types of things (ANSI and HTML for |
33
|
|
|
|
|
|
|
example) later developments with the here-doc code and the need for |
34
|
|
|
|
|
|
|
independantly written serializers meant that this idea had to be discarded. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
In addition, the old module only made use of the Tokenizer, and had a |
37
|
|
|
|
|
|
|
pretty shit API to boot. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head2 API Overview |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
The new module is much cleaner. Simply create an object with the options |
42
|
|
|
|
|
|
|
you want, pass L<PPI::Document> objects to the C<html> method, |
43
|
|
|
|
|
|
|
and you get strings of HTML that you can do whatever you want with. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head1 METHODS |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=cut |
48
|
|
|
|
|
|
|
|
49
|
2
|
|
|
2
|
|
213645
|
use 5.005; |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
72
|
|
50
|
2
|
|
|
2
|
|
11
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
60
|
|
51
|
2
|
|
|
2
|
|
2254
|
use CSS::Tiny (); |
|
2
|
|
|
|
|
9457
|
|
|
2
|
|
|
|
|
41
|
|
52
|
2
|
|
|
2
|
|
1097
|
use PPI::Document (); |
|
2
|
|
|
|
|
170821
|
|
|
2
|
|
|
|
|
73
|
|
53
|
2
|
|
|
2
|
|
1160
|
use PPI::HTML::Fragment (); |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
41
|
|
54
|
2
|
|
|
2
|
|
11
|
use Params::Util '_HASH', '_INSTANCE'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
123
|
|
55
|
|
|
|
|
|
|
|
56
|
2
|
|
|
2
|
|
9
|
use vars qw{$VERSION}; |
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
76
|
|
57
|
|
|
|
|
|
|
BEGIN { |
58
|
2
|
|
|
2
|
|
4086
|
$VERSION = '1.08'; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=pod |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head2 new %args |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
The C<new> constructor takes a simple set of key/value pairs to define |
73
|
|
|
|
|
|
|
the formatting options for the HTML. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=over |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=item page |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
Is the C<page> option is enabled, the generator will wrap the generated |
80
|
|
|
|
|
|
|
HTML fragment in a basic but complete page. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=item line_numbers |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
At the present time, the only option available. If set to true, line |
85
|
|
|
|
|
|
|
numbers are added to the output. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=item colors | colours |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
For cases where you don't want to use an external stylesheet, you |
90
|
|
|
|
|
|
|
can provide C<colors> as a hash reference where the keys are CSS classes |
91
|
|
|
|
|
|
|
(generally matching the token name) and the values are colours. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
This allows basic colouring without the need for a whole stylesheet. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=item css |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
The C<css> option lets you provide a custom L<CSS::Tiny> object containing |
98
|
|
|
|
|
|
|
any CSS you want to apply to the page (if you are using page mode). |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
If both the C<colors> and C<css> options are used, the colour CSS entries |
101
|
|
|
|
|
|
|
will overwrite anything contained in the L<CSS::Tiny> object. The object |
102
|
|
|
|
|
|
|
will also be cloned if it to be modified, to prevent destroying any CSS |
103
|
|
|
|
|
|
|
objects passed in. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=back |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
Returns a new L<PPI::HTML> object |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=cut |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub new { |
112
|
5
|
50
|
|
5
|
1
|
3890
|
my $class = ref $_[0] ? ref shift : shift; |
113
|
5
|
|
|
|
|
16
|
my %args = @_; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
5
|
|
|
|
|
29
|
my $self = bless { |
117
|
|
|
|
|
|
|
line_numbers => !! $args{line_numbers}, |
118
|
|
|
|
|
|
|
page => !! $args{page}, |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
}, $class; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
5
|
50
|
|
|
|
19
|
$args{colors} = delete $args{colours} if $args{colours}; |
125
|
5
|
100
|
|
|
|
33
|
$self->{colors} = $args{colors} if _HASH($args{colors}); |
126
|
5
|
100
|
|
|
|
37
|
$self->{css} = $args{css} if _INSTANCE($args{css}, 'CSS::Tiny'); |
127
|
|
|
|
|
|
|
|
128
|
5
|
|
|
|
|
18
|
$self; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=pod |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head2 css |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
The C<css> accessor returns the L<CSS::Tiny> object originally provided |
136
|
|
|
|
|
|
|
to the constructor. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=cut |
139
|
|
|
|
|
|
|
|
140
|
1
|
|
|
1
|
1
|
478
|
sub css { $_[0]->{css} } |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=pod |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head2 html $Document | $file | \$source |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
The main method for the class, the C<html> method takes a single |
154
|
|
|
|
|
|
|
L<PPI::Document> object, or anything that can be turned into a |
155
|
|
|
|
|
|
|
L<PPI::Document> via its C<new> method, and returns a string of HTML |
156
|
|
|
|
|
|
|
formatted based on the arguments given to the C<PPI::HTML> constructor. |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Returns a string, or C<undef> on error. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=cut |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub html { |
163
|
4
|
|
|
4
|
1
|
10505
|
my $self = shift; |
164
|
4
|
50
|
|
|
|
17
|
my $Document = $self->_Document(shift) or return undef; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
|
167
|
4
|
50
|
|
|
|
4625
|
$self->_build_fragments($Document) or return undef; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
|
170
|
4
|
50
|
|
|
|
15
|
$self->_build_line_numbers or return undef; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
|
173
|
4
|
50
|
|
|
|
12
|
$self->_optimize_fragments or return undef; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
|
176
|
4
|
50
|
|
|
|
14
|
$self->_build_html or return undef; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
|
179
|
4
|
|
|
|
|
33
|
delete $self->{html}; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub _build_fragments { |
184
|
4
|
|
|
4
|
|
10
|
my ($self, $Document) = @_; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
|
187
|
4
|
|
|
|
|
15
|
$self->{fragments} = []; |
188
|
4
|
|
|
|
|
9
|
$self->{heredoc_buffer} = undef; |
189
|
4
|
|
|
|
|
24
|
foreach my $Token ( $Document->tokens ) { |
190
|
|
|
|
|
|
|
|
191
|
35
|
|
|
|
|
269
|
my @fragments = (); |
192
|
35
|
50
|
|
|
|
257
|
if ( _INSTANCE($Token, 'PPI::Token::HereDoc') ) { |
193
|
0
|
0
|
|
|
|
0
|
@fragments = $self->_heredoc_fragments($Token) or return undef; |
194
|
|
|
|
|
|
|
} else { |
195
|
35
|
50
|
|
|
|
69
|
@fragments = $self->_simple_fragments($Token) or return undef; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
|
199
|
35
|
|
|
|
|
44
|
foreach my $Fragment ( @fragments ) { |
200
|
35
|
50
|
|
|
|
70
|
$self->_add_fragment( $Fragment ) or return undef; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
|
205
|
4
|
50
|
|
|
|
15
|
if ( $self->{heredoc_buffer} ) { |
206
|
|
|
|
|
|
|
|
207
|
0
|
0
|
|
|
|
0
|
unless ( $self->{fragments}->[-1]->ends_line ) { |
208
|
0
|
0
|
|
|
|
0
|
my $Fragment = PPI::HTML::Fragment->new( "\n" ) or return undef; |
209
|
0
|
|
|
|
|
0
|
push @{$self->{fragments}}, $Fragment; |
|
0
|
|
|
|
|
0
|
|
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
0
|
push @{$self->{fragments}}, @{$self->{heredoc_buffer}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
|
217
|
4
|
|
|
|
|
6
|
delete $self->{heredoc_buffer}; |
218
|
|
|
|
|
|
|
|
219
|
4
|
|
|
|
|
14
|
1; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub _simple_fragments { |
223
|
35
|
|
|
35
|
|
49
|
my ($self, $Token) = @_; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
|
226
|
35
|
50
|
|
|
|
84
|
my @strings = grep { defined $_ and length $_ } split /(?<=\n)/, $Token->content; |
|
35
|
|
|
|
|
299
|
|
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
|
229
|
35
|
|
|
|
|
59
|
my @fragments = (); |
230
|
35
|
|
|
|
|
64
|
my $css_class = $self->_css_class( $Token ); |
231
|
35
|
|
|
|
|
57
|
foreach my $string ( @strings ) { |
232
|
35
|
50
|
|
|
|
110
|
my $Fragment = PPI::HTML::Fragment->new( $string, $css_class ) or return (); |
233
|
35
|
|
|
|
|
86
|
push @fragments, $Fragment; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
35
|
|
|
|
|
132
|
@fragments; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub _heredoc_fragments { |
240
|
0
|
|
|
0
|
|
0
|
my ($self, $Token) = @_; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
0
|
foreach my $line ( $Token->heredoc ) { |
245
|
0
|
0
|
|
|
|
0
|
$self->_add_heredoc( $line, |
246
|
|
|
|
|
|
|
'heredoc_content' ) or return (); |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
|
250
|
0
|
0
|
|
|
|
0
|
$self->_add_heredoc( $Token->terminator . "\n", |
251
|
|
|
|
|
|
|
'heredoc_terminator' ) or return (); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
|
254
|
0
|
0
|
|
|
|
0
|
my $Fragment = PPI::HTML::Fragment->new( $Token->content, |
255
|
|
|
|
|
|
|
$self->_css_class( $Token ) ) or return (); |
256
|
|
|
|
|
|
|
|
257
|
0
|
|
|
|
|
0
|
$Fragment; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub _build_line_numbers { |
261
|
4
|
|
|
4
|
|
7
|
my $self = shift; |
262
|
4
|
100
|
|
|
|
25
|
return 1 unless $self->{line_numbers}; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
|
266
|
2
|
|
|
|
|
5
|
my $max = 1 + scalar map { $_->ends_line } @{$self->{fragments}}; |
|
19
|
|
|
|
|
37
|
|
|
2
|
|
|
|
|
4
|
|
267
|
2
|
|
|
|
|
4
|
my $width = length("$max"); |
268
|
2
|
|
|
|
|
5
|
my $pattern = "\%${width}s: "; |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
|
272
|
2
|
|
|
|
|
3
|
my $line = 1; |
273
|
19
|
100
|
|
|
|
43
|
my @fragments = map { |
274
|
2
|
|
|
|
|
4
|
$_->ends_line |
275
|
|
|
|
|
|
|
? ($_, $self->_line_fragment( sprintf($pattern, ++$line) )) |
276
|
|
|
|
|
|
|
: ($_) |
277
|
2
|
|
|
|
|
6
|
} @{$self->{fragments}}; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
|
280
|
2
|
|
|
|
|
8
|
unshift @fragments, $self->_line_fragment( sprintf($pattern, 1) ); |
281
|
|
|
|
|
|
|
|
282
|
2
|
|
|
|
|
4
|
$self->{fragments} = \@fragments; |
283
|
|
|
|
|
|
|
|
284
|
2
|
|
|
|
|
8
|
1; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub _build_html { |
288
|
4
|
|
|
4
|
|
6
|
my $self = shift; |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
|
291
|
4
|
|
|
|
|
5
|
my $html = ''; |
292
|
4
|
|
|
|
|
6
|
foreach my $Fragment ( @{$self->{fragments}} ) { |
|
4
|
|
|
|
|
10
|
|
293
|
36
|
|
|
|
|
97
|
$html .= $Fragment->html; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
|
297
|
4
|
100
|
|
|
|
17
|
if ( $self->{page} ) { |
298
|
1
|
|
|
|
|
3
|
my $css = $self->_css_html; |
299
|
|
|
|
|
|
|
|
300
|
1
|
|
|
|
|
34
|
$html = <<END_HTML; |
301
|
|
|
|
|
|
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"> |
302
|
|
|
|
|
|
|
<html> |
303
|
|
|
|
|
|
|
<head> |
304
|
|
|
|
|
|
|
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> |
305
|
|
|
|
|
|
|
<meta name="robots" content="noarchive"> |
306
|
|
|
|
|
|
|
$css |
307
|
|
|
|
|
|
|
</head> |
308
|
|
|
|
|
|
|
<body bgcolor="#FFFFFF" text="#000000"><pre>$html</pre></body> |
309
|
|
|
|
|
|
|
</html> |
310
|
|
|
|
|
|
|
END_HTML |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
|
314
|
4
|
|
|
|
|
7
|
$self->{html} = $html; |
315
|
4
|
|
|
|
|
32
|
delete $self->{fragments}; |
316
|
|
|
|
|
|
|
|
317
|
4
|
|
|
|
|
12
|
1; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
sub _optimize_fragments { |
321
|
4
|
|
|
4
|
|
9
|
my $self = shift; |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
|
325
|
4
|
|
|
|
|
5
|
my $current = $self->{fragments}; |
326
|
4
|
|
|
|
|
10
|
my @fragments = ( shift @$current ); |
327
|
4
|
|
|
|
|
7
|
foreach my $Fragment ( @$current ) { |
328
|
36
|
100
|
33
|
|
|
90
|
if ( $Fragment->css and $fragments[-1]->css and $Fragment->css eq $fragments[-1]->css ) { |
|
|
|
66
|
|
|
|
|
329
|
4
|
|
|
|
|
8
|
$fragments[-1]->concat( $Fragment->string ); |
330
|
|
|
|
|
|
|
} else { |
331
|
32
|
|
|
|
|
131
|
push @fragments, $Fragment; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
|
336
|
4
|
|
|
|
|
8
|
foreach my $Fragment ( @fragments ) { |
337
|
36
|
50
|
|
|
|
78
|
my $css = $Fragment->css or next; |
338
|
36
|
100
|
|
|
|
102
|
$Fragment->clear if $css eq 'whitespace'; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
|
343
|
4
|
100
|
|
|
|
15
|
if ( $self->{colors} ) { |
344
|
1
|
|
|
|
|
2
|
my $colors = $self->{colors}; |
345
|
1
|
|
|
|
|
3
|
foreach my $Fragment ( @fragments ) { |
346
|
11
|
100
|
|
|
|
20
|
my $css = $Fragment->css or next; |
347
|
7
|
100
|
|
|
|
16
|
next if $colors->{$css}; |
348
|
4
|
|
|
|
|
8
|
$Fragment->clear; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
|
353
|
4
|
|
|
|
|
7
|
$self->{fragments} = \@fragments; |
354
|
|
|
|
|
|
|
|
355
|
4
|
|
|
|
|
38
|
1; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub _css_html { |
360
|
1
|
|
|
1
|
|
2
|
my $self = shift; |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
|
363
|
1
|
50
|
|
|
|
8
|
my $css = $self->{css} |
364
|
|
|
|
|
|
|
? $self->{css}->clone |
365
|
|
|
|
|
|
|
: CSS::Tiny->new; |
366
|
1
|
|
|
|
|
5
|
foreach my $key ( sort keys %{$self->{colors}} ) { |
|
1
|
|
|
|
|
7
|
|
367
|
2
|
|
|
|
|
7
|
$css->{".$key"}->{color} = $self->{colors}->{$key}; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
1
|
50
|
|
|
|
7
|
keys %$css ? $css->html : ''; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub _Document { |
382
|
4
|
|
|
4
|
|
6
|
my $class = shift; |
383
|
4
|
100
|
|
|
|
50
|
_INSTANCE( $_[0], 'PPI::Document' ) |
384
|
|
|
|
|
|
|
? $_[0] |
385
|
|
|
|
|
|
|
: PPI::Document->new( @_ ); |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
sub _Fragment { |
390
|
35
|
|
|
35
|
|
66
|
my $class = shift; |
391
|
35
|
50
|
|
|
|
235
|
_INSTANCE( $_[0], 'PPI::HTML::Fragment' ) |
392
|
|
|
|
|
|
|
? $_[0] |
393
|
|
|
|
|
|
|
: PPI::HTML::Fragment->new( @_ ); |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub _add_fragment { |
397
|
35
|
|
|
35
|
|
47
|
my $self = shift; |
398
|
35
|
50
|
|
|
|
59
|
my $Fragment = $self->_Fragment(@_) or return undef; |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
|
401
|
35
|
|
|
|
|
41
|
push @{$self->{fragments}}, $Fragment; |
|
35
|
|
|
|
|
68
|
|
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
|
405
|
35
|
50
|
33
|
|
|
80
|
if ( $self->{heredoc_buffer} and $Fragment->ends_line ) { |
406
|
0
|
|
|
|
|
0
|
push @{$self->{fragments}}, @{$self->{heredoc_buffer}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
407
|
0
|
|
|
|
|
0
|
$self->{heredoc_buffer} = undef; |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
|
410
|
35
|
|
|
|
|
131
|
1; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub _add_heredoc { |
414
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
415
|
0
|
0
|
|
|
|
0
|
my $Fragment = $self->_Fragment(@_) or return undef; |
416
|
0
|
|
0
|
|
|
0
|
$self->{heredoc_buffer} ||= []; |
417
|
0
|
|
|
|
|
0
|
push @{$self->{heredoc_buffer}}, $Fragment; |
|
0
|
|
|
|
|
0
|
|
418
|
0
|
|
|
|
|
0
|
1; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub _line_fragment { |
422
|
5
|
|
|
5
|
|
10
|
my ($self, $line) = @_; |
423
|
5
|
|
|
|
|
16
|
PPI::HTML::Fragment->new( $line, 'line_number' ); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub _css_class { |
427
|
35
|
|
|
35
|
|
41
|
my ($self, $Token) = @_; |
428
|
35
|
100
|
|
|
|
155
|
if ( $Token->isa('PPI::Token::Word') ) { |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
|
431
|
5
|
|
|
|
|
19
|
my $content = $Token->content; |
432
|
|
|
|
|
|
|
|
433
|
5
|
50
|
33
|
|
|
65
|
unless ( $Token->snext_sibling and $Token->snext_sibling->content eq '=>' ) { |
434
|
5
|
50
|
|
|
|
290
|
if ( $content eq 'sub' ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
435
|
0
|
|
|
|
|
0
|
return 'keyword'; |
436
|
|
|
|
|
|
|
} elsif ( $content eq 'return' ) { |
437
|
0
|
|
|
|
|
0
|
return 'keyword'; |
438
|
|
|
|
|
|
|
} elsif ( $content eq 'undef' ) { |
439
|
0
|
|
|
|
|
0
|
return 'core'; |
440
|
|
|
|
|
|
|
} elsif ( $content eq 'shift' ) { |
441
|
0
|
|
|
|
|
0
|
return 'core'; |
442
|
|
|
|
|
|
|
} elsif ( $content eq 'defined' ) { |
443
|
0
|
|
|
|
|
0
|
return 'core'; |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
|
447
|
5
|
|
|
|
|
22
|
my $parent = $Token->parent; |
448
|
5
|
50
|
|
|
|
101
|
if ( $parent->isa('PPI::Statement::Include') ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
449
|
0
|
0
|
|
|
|
0
|
if ( $content =~ /^(?:use|no)$/ ) { |
450
|
0
|
|
|
|
|
0
|
return 'keyword'; |
451
|
|
|
|
|
|
|
} |
452
|
0
|
0
|
|
|
|
0
|
if ( $content eq $parent->pragma ) { |
453
|
0
|
|
|
|
|
0
|
return 'pragma'; |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
} elsif ( $parent->isa('PPI::Statement::Variable') ) { |
456
|
3
|
50
|
|
|
|
67
|
if ( $content =~ /^(?:my|local|our)$/ ) { |
457
|
3
|
|
|
|
|
12
|
return 'keyword'; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
} elsif ( $parent->isa('PPI::Statement::Compound') ) { |
460
|
0
|
0
|
|
|
|
0
|
if ( $content =~ /^(?:if|else|elsif|unless|for|foreach|while|my)$/ ) { |
461
|
0
|
|
|
|
|
0
|
return 'keyword'; |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
} elsif ( $parent->isa('PPI::Statement::Given') ) { |
464
|
0
|
0
|
|
|
|
0
|
if ( $content eq 'given' ) { |
465
|
0
|
|
|
|
|
0
|
return 'keyword'; |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
} elsif ( $parent->isa('PPI::Statement::When') ) { |
468
|
0
|
0
|
|
|
|
0
|
if ( $content =~ /^(?:when|default)$/ ) { |
469
|
0
|
|
|
|
|
0
|
return 'keyword'; |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
} elsif ( $parent->isa('PPI::Statement::Package') ) { |
472
|
0
|
0
|
|
|
|
0
|
if ( $content eq 'package' ) { |
473
|
0
|
|
|
|
|
0
|
return 'keyword'; |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
} elsif ( $parent->isa('PPI::Statement::Scheduled') ) { |
476
|
0
|
|
|
|
|
0
|
return 'keyword'; |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
|
481
|
32
|
|
|
|
|
68
|
my $css = lc ref $Token; |
482
|
32
|
|
|
|
|
113
|
$css =~ s/^.+:://; |
483
|
32
|
|
|
|
|
71
|
$css; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
1; |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
=pod |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
=head1 SUPPORT |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
Bugs should always be submitted via the CPAN bug tracker |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=PPI-HTML> |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
For other issues, contact the maintainer |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=head1 AUTHOR |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
Adam Kennedy E<lt>adamk@cpan.orgE<gt> |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
Funding provided by The Perl Foundation |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
=head1 SEE ALSO |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
L<http://ali.as/>, L<PPI> |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
=head1 COPYRIGHT |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
Copyright 2005 - 2009 Adam Kennedy. |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
This program is free software; you can redistribute |
513
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
The full text of the license can be found in the |
516
|
|
|
|
|
|
|
LICENSE file included with this module. |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
=cut |
519
|
|
|
|
|
|
|
|