blib/lib/HTML/SyntaxHighlighter.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 156 | 221 | 70.5 |
branch | 47 | 102 | 46.0 |
condition | 58 | 192 | 30.2 |
subroutine | 30 | 35 | 85.7 |
pod | 15 | 27 | 55.5 |
total | 306 | 577 | 53.0 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package HTML::SyntaxHighlighter; | ||||||
2 | |||||||
3 | 1 | 1 | 96564 | use strict; | |||
1 | 2 | ||||||
1 | 212 | ||||||
4 | 1 | 1 | 6 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); | |||
1 | 3 | ||||||
1 | 83 | ||||||
5 | |||||||
6 | 1 | 1 | 5 | use Carp (); | |||
1 | 14 | ||||||
1 | 17 | ||||||
7 | 1 | 1 | 1224 | use HTML::Entities; | |||
1 | 34357 | ||||||
1 | 105 | ||||||
8 | 1 | 1 | 13 | use HTML::Parser; | |||
1 | 2 | ||||||
1 | 14292 | ||||||
9 | |||||||
10 | require Exporter; | ||||||
11 | |||||||
12 | @ISA = qw(HTML::Parser Exporter); | ||||||
13 | # Items to export into callers namespace by default. Note: do not export | ||||||
14 | # names by default without a very good reason. Use EXPORT_OK instead. | ||||||
15 | # Do not simply export all your public functions/methods/constants. | ||||||
16 | @EXPORT_OK = qw( | ||||||
17 | ); | ||||||
18 | |||||||
19 | $VERSION = '0.03'; | ||||||
20 | |||||||
21 | my %default_args = ( | ||||||
22 | out_func => \*STDOUT, | ||||||
23 | header => 1, | ||||||
24 | default_type => 'html', | ||||||
25 | force_type => 0, | ||||||
26 | debug => 0, | ||||||
27 | br => ' ', |
||||||
28 | collapse_inline => 0, | ||||||
29 | indent_level => 2 | ||||||
30 | ); | ||||||
31 | |||||||
32 | # Preloaded methods go here. | ||||||
33 | |||||||
34 | sub new { | ||||||
35 | 1 | 1 | 1 | 565 | my $class = shift; | ||
36 | 1 | 4 | my %args = @_; | ||||
37 | 1 | 3 | my $self = bless {}, $class; | ||||
38 | |||||||
39 | 1 | 8 | $self->init(%args); | ||||
40 | 1 | 5 | return $self; | ||||
41 | } | ||||||
42 | |||||||
43 | sub init { | ||||||
44 | 1 | 1 | 0 | 2 | my $self = shift; | ||
45 | 1 | 3 | my %args = @_; | ||||
46 | |||||||
47 | 1 | 6 | foreach ( keys %default_args ) { | ||||
48 | 8 | 50 | 38 | $self->$_( exists( $args{$_} ) ? delete $args{$_} : $default_args{$_} ); | |||
49 | } | ||||||
50 | |||||||
51 | 1 | 12 | $self->SUPER::init(%args); | ||||
52 | 1 | 90 | $self->unbroken_text( 1 ); | ||||
53 | |||||||
54 | 1 | 4 | $self->handler(comment => 'comment', 'self, text'); | ||||
55 | 1 | 11 | $self->handler(declaration => 'declaration', 'self, tokens'); | ||||
56 | 1 | 7 | $self->handler(start_document => 'start_document', 'self'); | ||||
57 | 1 | 5 | $self->handler(end_document => 'end_document', 'self'); | ||||
58 | } | ||||||
59 | |||||||
60 | # SETTINGS | ||||||
61 | |||||||
62 | sub debug { | ||||||
63 | 2 | 2 | 1 | 5 | my ($self, $debug ) = @_; | ||
64 | 2 | 10 | $self->{debug} = $debug; | ||||
65 | } | ||||||
66 | |||||||
67 | sub out_func { | ||||||
68 | 3 | 3 | 1 | 7 | my ($self, $output) = @_; | ||
69 | 3 | 7 | my $ref = ref( $output ); | ||||
70 | 3 | 50 | 20 | if( $ref eq 'CODE' ) { | |||
100 | |||||||
50 | |||||||
71 | 0 | 0 | 0 | $self->{out_func} = sub { $output->( "@_\n" ) }; | |||
0 | 0 | ||||||
72 | } elsif ( $ref eq 'GLOB' ) { | ||||||
73 | 2 | 53 | 33 | $self->{out_func} = sub { print $output "@_\n" }; | |||
53 | 12786 | ||||||
74 | } elsif ( $ref eq 'SCALAR' ) { | ||||||
75 | 1 | 27 | 12 | $self->{out_func} = sub { $$output .= "@_\n" }; | |||
27 | 547 | ||||||
76 | } else { | ||||||
77 | 0 | 0 | Carp::croak( "Output argument ot type '$ref' not supported" ); | ||||
78 | } | ||||||
79 | } | ||||||
80 | |||||||
81 | sub header { | ||||||
82 | 2 | 2 | 1 | 8 | my ($self, $header ) = @_; | ||
83 | 2 | 8 | $self->{header} = $header; | ||||
84 | } | ||||||
85 | |||||||
86 | sub default_type { | ||||||
87 | 1 | 1 | 1 | 2 | my ($self, $type ) = @_; | ||
88 | 1 | 50 | 33 | 5 | unless ( ($type eq 'html') || | ||
89 | ($type eq 'xhtml') ) { | ||||||
90 | 0 | 0 | Carp::croak( "Type '$type' not supported" ); | ||||
91 | } | ||||||
92 | 1 | 5 | $self->{default_type} = $type; | ||||
93 | } | ||||||
94 | |||||||
95 | sub force_type { | ||||||
96 | 2 | 2 | 1 | 5 | my ($self, $force ) = @_; | ||
97 | 2 | 8 | $self->{force_type} = $force; | ||||
98 | } | ||||||
99 | |||||||
100 | sub type { | ||||||
101 | 5 | 5 | 0 | 14 | my ($self, $type ) = @_; | ||
102 | 5 | 50 | 66 | 31 | unless ( ($type eq 'html') || | ||
103 | ($type eq 'xhtml') ) { | ||||||
104 | 0 | 0 | Carp::croak( "Type '$type' not supported" ); | ||||
105 | } | ||||||
106 | |||||||
107 | 5 | 34 | $self->{type} = $type; | ||||
108 | } | ||||||
109 | |||||||
110 | sub br { | ||||||
111 | 2 | 2 | 1 | 4 | my ($self, $br ) = @_; | ||
112 | 2 | 10 | $self->{br} = $br; | ||||
113 | } | ||||||
114 | |||||||
115 | sub collapse_inline { | ||||||
116 | 1 | 1 | 1 | 2 | my ($self, $collapse_inline ) = @_; | ||
117 | 1 | 3 | $self->{collapse_inline} = $collapse_inline; | ||||
118 | } | ||||||
119 | |||||||
120 | sub indent_level { | ||||||
121 | 1 | 1 | 0 | 2 | my ($self, $indent_level ) = @_; | ||
122 | 1 | 3 | $self->{indent_level} = $indent_level; | ||||
123 | } | ||||||
124 | |||||||
125 | # HANDLERS | ||||||
126 | |||||||
127 | sub start_document { | ||||||
128 | 3 | 3 | 1 | 427 | my $self = shift; | ||
129 | |||||||
130 | # reset html tag stack | ||||||
131 | 3 | 12 | $self->{stack} = []; | ||||
132 | |||||||
133 | # set type to default in case we don't encounter a DTD | ||||||
134 | 3 | 15 | $self->type( $self->{default_type} ); | ||||
135 | |||||||
136 | # header on: turn off output initially | ||||||
137 | 3 | 50 | 14 | $self->{silent} = $self->{header} ? 0 : 1; | |||
138 | 3 | 5 | $self->{threshold} = 0; | ||||
139 | 3 | 6 | $self->{past_first_line} = 0; | ||||
140 | |||||||
141 | 3 | 9 | $self->{out_func}->( '' ); |
||||
142 | } | ||||||
143 | |||||||
144 | sub end_document { | ||||||
145 | 3 | 3 | 1 | 163 | my $self = shift; | ||
146 | |||||||
147 | 3 | 11 | $self->{out_func}->( '' ); | ||||
148 | } | ||||||
149 | |||||||
150 | sub start { | ||||||
151 | 24 | 24 | 1 | 52 | my ($self, $tagname, $attr, $attrseq) = @_; | ||
152 | 24 | 54 | my $indent = $self->mk_indent(); | ||||
153 | 24 | 32 | my ($output, $error); | ||||
154 | |||||||
155 | 24 | 1914 | my $type = sel_type($tagname); | ||||
156 | 24 | 50 | 66 | 2751 | if( exists( $attr->{'/'} ) ) { | ||
50 | 33 | ||||||
33 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
157 | # standalone xhtml tag, e.g. ' ' |
||||||
158 | } elsif( ($self->{type} eq 'html') && | ||||||
159 | ($tagname eq 'br') || | ||||||
160 | ($tagname eq 'hr') || | ||||||
161 | ($tagname eq 'img') || | ||||||
162 | ($tagname eq 'input') || | ||||||
163 | ($tagname eq 'link') || | ||||||
164 | ($tagname eq 'meta') || | ||||||
165 | ($tagname eq 'area') || | ||||||
166 | ($tagname eq 'col') || | ||||||
167 | ($tagname eq 'base') || | ||||||
168 | ($tagname eq 'param') ) { | ||||||
169 | # allowable standalone tag in html | ||||||
170 | } else { | ||||||
171 | # check for commonly unclosed tags | ||||||
172 | 24 | 50 | 66 | 569 | if( ($tagname eq 'p') || | ||
66 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
173 | ($tagname eq 'select') || | ||||||
174 | ($tagname eq 'li') || | ||||||
175 | ($tagname eq 'td') || | ||||||
176 | ($tagname eq 'th') || | ||||||
177 | ($tagname eq 'tr') ) { | ||||||
178 | 3 | 8 | my $close = $self->{stack}->[-1]; | ||||
179 | 3 | 50 | 8 | if( $close eq $tagname ) { | |||
180 | # tag is same as the one above, and can't be | ||||||
181 | # assume missing closed tag, go up a level | ||||||
182 | # unless it looks like we have a missing open tag too (ugh!) | ||||||
183 | 0 | 0 | 0 | if( $close ne $self->{last_block} ) { | |||
184 | 0 | 0 | pop @{$self->{stack}}; | ||||
0 | 0 | ||||||
185 | 0 | 0 | $indent = $self->mk_indent(); | ||||
186 | 0 | 0 | 0 | if( $self->{debug} ) { | |||
187 | 0 | 0 | $output = gen_tag('X', "/$close", undef, undef, { error => "Missing closing '$close' tag" } ); | ||||
188 | 0 | 0 | $self->output( $indent, "$output" ); | ||||
189 | } | ||||||
190 | } | ||||||
191 | } | ||||||
192 | } | ||||||
193 | # one level deeper | ||||||
194 | 24 | 38 | push @{$self->{stack}}, $tagname; | ||||
24 | 75 | ||||||
195 | } | ||||||
196 | |||||||
197 | 24 | 50 | 66 | 90 | if( ($type eq 'B') && !$self->block_allowed ) { | ||
198 | 0 | 0 | $error = "Block-level element '$tagname' within illegal inline element '$self->{stack}->[-1]'"; | ||||
199 | 0 | 0 | $type = 'X'; | ||||
200 | } | ||||||
201 | |||||||
202 | 24 | 50 | 33 | 708 | $output = gen_tag($type, $tagname, $attr, $attrseq, | ||
203 | ($error && $self->{debug}) ? { error => $error } : () | ||||||
204 | ); | ||||||
205 | |||||||
206 | 24 | 50 | 66 | if( $self->{collapse_inline} ) { | |||
207 | 0 | 0 | 0 | 0 | if( ($type ne 'I') or is_element($tagname) or is_row($tagname) or $self->in_head() ) { | ||
0 | |||||||
0 | |||||||
208 | 0 | 0 | $self->{no_indent} = 0; | ||||
209 | } | ||||||
210 | } | ||||||
211 | |||||||
212 | # header off: no line break before first line of body | ||||||
213 | 24 | 33 | my $nobr; | ||||
214 | 24 | 50 | 33 | 82 | if( !$self->{header} && !$self->{past_first_line} && ($self->{stack}->[-2] eq 'body') ) { | ||
33 | |||||||
215 | 0 | 0 | $nobr = 1; | ||||
216 | 0 | 0 | $self->{past_first_line} = 1; | ||||
217 | } | ||||||
218 | |||||||
219 | 24 | 191 | $self->output( $indent, $output, $nobr ); | ||||
220 | |||||||
221 | 24 | 50 | 83 | if( $self->{collapse_inline} ) { | |||
222 | 0 | 0 | 0 | 0 | if( ($type eq 'I') and !is_script($tagname) ) { | ||
223 | 0 | 0 | $self->{no_indent} = 1; | ||||
224 | } | ||||||
225 | } | ||||||
226 | |||||||
227 | # header off: turn on output as we enter the body | ||||||
228 | 24 | 50 | 33 | 68 | if( !$self->{header} && ($tagname eq 'body') ) { | ||
229 | 0 | 0 | $self->{silent} = 0; | ||||
230 | 0 | 0 | $self->{threshold} = scalar( @{$self->{stack}} ); | ||||
0 | 0 | ||||||
231 | } | ||||||
232 | |||||||
233 | 24 | 100 | 254 | $self->{last_block} = undef if $type eq 'B'; | |||
234 | } | ||||||
235 | |||||||
236 | sub end { | ||||||
237 | 24 | 24 | 1 | 41 | my ($self, $tagname) = @_; | ||
238 | 24 | 23 | my $start = pop @{$self->{stack}}; | ||||
24 | 49 | ||||||
239 | 24 | 37 | my ($output, $error); | ||||
240 | |||||||
241 | 24 | 14597 | my $type = sel_type($tagname); | ||||
242 | 24 | 50 | 66 | if( $start ne $tagname ) { | |||
243 | # mismatched tags | ||||||
244 | # check if tag is on the level above if we're using block-level components | ||||||
245 | # if so, go up a level. if close tag same as the last, assume missing open tag | ||||||
246 | 0 | 0 | $error = "Mismatched tag '$start' / '$tagname'"; | ||||
247 | |||||||
248 | 0 | 0 | 0 | if( $type eq 'B') { | |||
249 | 0 | 0 | 0 | if( $self->{stack}->[-1] eq $tagname ) { | |||
0 | |||||||
250 | 0 | 0 | my $up = pop @{$self->{stack}}; | ||||
0 | 0 | ||||||
251 | 0 | 0 | $error .= ", going up a level to '$up'"; | ||||
252 | } elsif( $self->{last_block} eq $tagname ) { | ||||||
253 | 0 | 0 | push @{$self->{stack}}, $tagname; | ||||
0 | 0 | ||||||
254 | 0 | 0 | $error .= ", assuming missing open '$self->{last_block}' tag"; | ||||
255 | } | ||||||
256 | } | ||||||
257 | |||||||
258 | 0 | 0 | 0 | $type = 'X' if( $self->{debug} ); | |||
259 | } | ||||||
260 | |||||||
261 | 24 | 54 | my $indent = $self->mk_indent(); | ||||
262 | |||||||
263 | # header off: turn off output as we leave the body | ||||||
264 | 24 | 50 | 33 | 70 | $self->{silent} = 1 if !$self->{header} && ($tagname eq 'body'); | ||
265 | |||||||
266 | 24 | 50 | 33 | 102 | $output = gen_tag($type, "/$tagname", undef, undef, | ||
267 | ($error && $self->{debug}) ? { error => $error } : () | ||||||
268 | ); | ||||||
269 | |||||||
270 | 24 | 50 | 64 | if( $self->{no_indent} ) { | |||
271 | 0 | 0 | 0 | 0 | if( ($type ne 'I') or is_row($tagname) ) { | ||
272 | 0 | 0 | $self->{no_indent} = 0; | ||||
273 | } | ||||||
274 | } | ||||||
275 | |||||||
276 | 24 | 56 | $self->output( $indent, $output ); | ||||
277 | |||||||
278 | # store tagname for missing open tag checking | ||||||
279 | 24 | 100 | 519 | $self->{last_block} = $tagname if $type eq 'B'; | |||
280 | } | ||||||
281 | |||||||
282 | sub text { | ||||||
283 | 48 | 48 | 1 | 508 | my ($self, $origtext) = @_; | ||
284 | 48 | 95 | my $indent = $self->mk_indent(); | ||||
285 | 48 | 58 | my $output; | ||||
286 | |||||||
287 | 48 | 251 | my $text = encode_entities($origtext); | ||||
288 | |||||||
289 | 48 | 100 | 2264 | if( $text =~ /\S/ ) { | |||
290 | # different formatting for the contents of 'script' and 'style' tags | ||||||
291 | 21 | 46 | my $parent = $self->{stack}->[-1]; | ||||
292 | 21 | 50 | 557 | if( is_script($parent) ) { | |||
293 | 0 | 0 | $text =~ s/^\n//; | ||||
294 | 0 | 0 | $text =~ s/\n\s*$//; | ||||
295 | 0 | 0 | $output = qq[$text]; | ||||
296 | 0 | 0 | $self->output( '', $output ); | ||||
297 | } else { | ||||||
298 | 21 | 77 | $text =~ s/\n//g; | ||||
299 | 21 | 78 | $text =~ s/^\s+//; | ||||
300 | 21 | 203 | $text =~ s/\s+$//; | ||||
301 | |||||||
302 | # header off: no line break before first line of body | ||||||
303 | 21 | 26 | my $nobr; | ||||
304 | 21 | 50 | 33 | 87 | if( !$self->{header} && !$self->{past_first_line} && ($self->{stack}->[-1] eq 'body') ) { | ||
33 | |||||||
305 | 0 | 0 | $nobr = 1; | ||||
306 | 0 | 0 | $self->{past_first_line} = 1; | ||||
307 | } | ||||||
308 | |||||||
309 | 21 | 39 | $output = qq[$text]; | ||||
310 | 21 | 45 | $self->output( $indent, $output, $nobr ); | ||||
311 | |||||||
312 | 21 | 50 | 3767 | if( $self->{collapse_inline} ) { | |||
313 | 0 | 0 | $self->{no_indent} = 1; | ||||
314 | } | ||||||
315 | } | ||||||
316 | } | ||||||
317 | } | ||||||
318 | |||||||
319 | sub comment { | ||||||
320 | 0 | 0 | 1 | 0 | my ($self, $origtext) = @_; | ||
321 | 0 | 0 | my $indent = $self->mk_indent(); | ||||
322 | 0 | 0 | my $output; | ||||
323 | |||||||
324 | 0 | 0 | my $text = encode_entities($origtext); | ||||
325 | 0 | 0 | $output = qq[$text]; | ||||
326 | 0 | 0 | $self->output( $indent, $output ); | ||||
327 | } | ||||||
328 | |||||||
329 | sub declaration { | ||||||
330 | 3 | 3 | 1 | 5 | my $self = shift; | ||
331 | 3 | 5 | my @tokens = @{shift()}; | ||||
3 | 21 | ||||||
332 | 3 | 28 | my $output; | ||||
333 | |||||||
334 | 3 | 12 | $output = qq[<]; | ||||
335 | 3 | 10 | map { s!^"(.*)"$!"$1"! } @tokens; | ||||
15 | 93 | ||||||
336 | 3 | 14 | $output .= join ' ', @tokens; | ||||
337 | 3 | 6 | $output .= qq[>]; | ||||
338 | 3 | 15 | $self->output( '', $output, 1 ); | ||||
339 | |||||||
340 | 3 | 100 | 28 | unless( $self->{force_type} ) { | |||
341 | 2 | 50 | 8 | if( my $identifier = $tokens[3] ){ | |||
342 | 2 | 50 | 16 | if( $identifier =~ m!(X?HTML)! ) { | |||
343 | 2 | 8 | my $type = lc( $1 ); | ||||
344 | 2 | 7 | $self->type( $type ); | ||||
345 | } | ||||||
346 | } | ||||||
347 | } | ||||||
348 | } | ||||||
349 | |||||||
350 | # OTHER METHODS | ||||||
351 | |||||||
352 | sub block_allowed { | ||||||
353 | 6 | 6 | 0 | 10 | my $self = shift; | ||
354 | 6 | 15 | my $tag = $self->{stack}->[-1]; | ||||
355 | 6 | 50 | 33 | 11 | if( (sel_type( $tag ) ne 'I' ) || | ||
33 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
356 | ($tag eq 'li') || | ||||||
357 | ($tag eq 'dd') || | ||||||
358 | ($tag eq 'td') || | ||||||
359 | ($tag eq 'th') || | ||||||
360 | ($tag eq 'object') || | ||||||
361 | ($tag eq 'ins') || | ||||||
362 | ($tag eq 'del') || | ||||||
363 | ($tag eq 'ins') || | ||||||
364 | ($tag eq 'button') ) { | ||||||
365 | 6 | 30 | return 1; | ||||
366 | } else { | ||||||
367 | 0 | 0 | return 0; | ||||
368 | } | ||||||
369 | } | ||||||
370 | |||||||
371 | sub is_element { | ||||||
372 | 0 | 0 | 0 | 0 | my $tag = shift; | ||
373 | 0 | 0 | 0 | 0 | if( ($tag eq 'li') || | ||
0 | |||||||
0 | |||||||
0 | |||||||
374 | ($tag eq 'dt') || | ||||||
375 | ($tag eq 'dd') || | ||||||
376 | ($tag eq 'td') || | ||||||
377 | ($tag eq 'th') ) { | ||||||
378 | 0 | 0 | return 1; | ||||
379 | } else { | ||||||
380 | 0 | 0 | return 0; | ||||
381 | } | ||||||
382 | } | ||||||
383 | |||||||
384 | sub is_row { | ||||||
385 | 0 | 0 | 0 | 0 | my $tag = shift; | ||
386 | 0 | 0 | 0 | 0 | if( ($tag eq 'tr') || | ||
0 | |||||||
0 | |||||||
387 | ($tag eq 'thead') || | ||||||
388 | ($tag eq 'tbody') || | ||||||
389 | ($tag eq 'tfoot') ) { | ||||||
390 | 0 | 0 | return 1; | ||||
391 | } else { | ||||||
392 | 0 | 0 | return 0; | ||||
393 | } | ||||||
394 | } | ||||||
395 | |||||||
396 | sub is_script { | ||||||
397 | 21 | 21 | 0 | 30 | my $tag = shift; | ||
398 | 21 | 50 | 33 | 101 | if( ($tag eq 'script') || | ||
399 | ($tag eq 'style') ) { | ||||||
400 | 0 | 0 | return 1; | ||||
401 | } else { | ||||||
402 | 21 | 62 | return 0; | ||||
403 | } | ||||||
404 | } | ||||||
405 | |||||||
406 | sub in_head { | ||||||
407 | 0 | 0 | 0 | 0 | my $self = shift; | ||
408 | 0 | 0 | my $doc_level = $self->{stack}[1]; | ||||
409 | 0 | 0 | 0 | if( ($doc_level eq 'head') ) { | |||
410 | 0 | 0 | return 1; | ||||
411 | } else { | ||||||
412 | 0 | 0 | return 0; | ||||
413 | } | ||||||
414 | } | ||||||
415 | |||||||
416 | sub output { | ||||||
417 | 72 | 72 | 0 | 1948 | my ($self, $indent, $output, $nobr ) = @_; | ||
418 | 72 | 50 | 165 | if( !$self->{no_indent} ) { | |||
419 | 72 | 132 | $output = $indent . $output; | ||||
420 | 72 | 100 | 802 | $output = $self->{br} . $output unless $nobr; | |||
421 | } | ||||||
422 | 72 | 50 | 241 | $self->{out_func}->( $output ) unless $self->{silent}; | |||
423 | } | ||||||
424 | |||||||
425 | sub gen_tag { | ||||||
426 | 48 | 48 | 0 | 88 | my ($type, $tagname, $attr, $attrseq, $opts) = @_; | ||
427 | 48 | 58 | my $output; | ||||
428 | |||||||
429 | 48 | 50 | 105 | if( defined $opts->{error} ) { | |||
430 | 0 | 0 | $output = qq[<$tagname]; | ||||
431 | } else { | ||||||
432 | 48 | 711 | $output = qq[<$tagname]; | ||||
433 | } | ||||||
434 | |||||||
435 | 48 | 49 | foreach ( @{$attrseq} ) { | ||||
48 | 367 | ||||||
436 | 3 | 50 | 11 | if( $attr->{$_} ne $_ ) { | |||
437 | 3 | 16 | $output .= qq[ $_="$attr->{$_}"]; | ||||
438 | } else { | ||||||
439 | 0 | 0 | $output .= " $_"; | ||||
440 | } | ||||||
441 | } | ||||||
442 | 48 | 66 | $output .= '>'; | ||||
443 | 48 | 140 | return $output; | ||||
444 | } | ||||||
445 | |||||||
446 | sub sel_type { | ||||||
447 | 54 | 54 | 0 | 74 | my $tag = shift; | ||
448 | 54 | 100 | 100 | 2281 | if( ($tag eq 'html') || | ||
100 | 100 | ||||||
33 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
66 | |||||||
66 | |||||||
66 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
33 | |||||||
66 | |||||||
449 | ($tag eq 'body') || | ||||||
450 | ($tag eq 'head') ) { | ||||||
451 | 18 | 60 | return 'H'; | ||||
452 | } elsif( ($tag eq 'address') || | ||||||
453 | ($tag eq 'blockquote') || | ||||||
454 | ($tag eq 'center') || # deprecated, but people are still (unfortunately) going to use it | ||||||
455 | ($tag eq 'div') || | ||||||
456 | ($tag eq 'dl') || | ||||||
457 | ($tag eq 'form') || | ||||||
458 | ($tag eq 'ol') || | ||||||
459 | ($tag eq 'p') || | ||||||
460 | ($tag eq 'pre') || | ||||||
461 | ($tag eq 'table') || | ||||||
462 | ($tag eq 'ul') || | ||||||
463 | ($tag eq 'noscript') || | ||||||
464 | ($tag eq 'noframes') || | ||||||
465 | ($tag eq 'fieldset') || | ||||||
466 | ($tag =~ /^h[1-6]$/) ) { | ||||||
467 | 18 | 69 | return 'B'; | ||||
468 | } else { | ||||||
469 | 18 | 46 | return 'I'; | ||||
470 | } | ||||||
471 | } | ||||||
472 | |||||||
473 | sub mk_indent { | ||||||
474 | 96 | 96 | 0 | 119 | my $self = shift; | ||
475 | 96 | 105 | my $i = scalar( @{$self->{stack}} ) - $self->{threshold}; | ||||
96 | 254 | ||||||
476 | 96 | 321 | return ' ' x ($i * $self->{indent_level}); | ||||
477 | } | ||||||
478 | |||||||
479 | # Autoload methods go after =cut, and are processed by the autosplit program. | ||||||
480 | |||||||
481 | 1; | ||||||
482 | __END__ |