blib/lib/HTML/Clean.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 183 | 202 | 90.5 |
branch | 52 | 94 | 55.3 |
condition | 8 | 12 | 66.6 |
subroutine | 20 | 22 | 90.9 |
pod | 7 | 7 | 100.0 |
total | 270 | 337 | 80.1 |
line | stmt | bran | cond | sub | pod | time | code | |
---|---|---|---|---|---|---|---|---|
1 | package HTML::Clean; | |||||||
2 | ||||||||
3 | 2 | 2 | 918 | use Carp; | ||||
2 | 8 | |||||||
2 | 172 | |||||||
4 | 2 | 2 | 754 | use IO::File; | ||||
2 | 13686 | |||||||
2 | 183 | |||||||
5 | 2 | 2 | 12 | use Fcntl; | ||||
2 | 3 | |||||||
2 | 502 | |||||||
6 | 2 | 2 | 11 | use strict; | ||||
2 | 2 | |||||||
2 | 71 | |||||||
7 | require 5.004; | |||||||
8 | ||||||||
9 | 2 | 2 | 9 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); | ||||
2 | 4 | |||||||
2 | 1798 | |||||||
10 | ||||||||
11 | require Exporter; | |||||||
12 | require AutoLoader; | |||||||
13 | ||||||||
14 | # Items to export to callers namespace | |||||||
15 | @EXPORT = qw(); | |||||||
16 | ||||||||
17 | $VERSION = '1.4'; | |||||||
18 | ||||||||
19 | =pod | |||||||
20 | ||||||||
21 | =head1 NAME | |||||||
22 | ||||||||
23 | HTML::Clean - Cleans up HTML code for web browsers, not humans | |||||||
24 | ||||||||
25 | =head1 SYNOPSIS | |||||||
26 | ||||||||
27 | use HTML::Clean; | |||||||
28 | $h = HTML::Clean->new($filename); # or.. | |||||||
29 | $h = HTML::Clean->new($htmlcode); | |||||||
30 | ||||||||
31 | $h->compat(); | |||||||
32 | $h->strip(); | |||||||
33 | $data = $h->data(); | |||||||
34 | print $$data; | |||||||
35 | ||||||||
36 | =head1 DESCRIPTION | |||||||
37 | ||||||||
38 | The HTML::Clean module encapsulates a number of common techniques for | |||||||
39 | minimizing the size of HTML files. You can typically save between | |||||||
40 | 10% and 50% of the size of a HTML file using these methods. | |||||||
41 | It provides the following features: | |||||||
42 | ||||||||
43 | =over 8 | |||||||
44 | ||||||||
45 | =item Remove unneeded whitespace (begining of line, etc) | |||||||
46 | ||||||||
47 | =item Remove unneeded META elements. | |||||||
48 | ||||||||
49 | =item Remove HTML comments (except for styles, javascript and SSI) | |||||||
50 | ||||||||
51 | =item Replace tags with equivilant shorter tags ( --> ) | |||||||
52 | ||||||||
53 | =item etc. | |||||||
54 | ||||||||
55 | =back | |||||||
56 | ||||||||
57 | The entire proces is configurable, so you can pick and choose what you want | |||||||
58 | to clean. | |||||||
59 | ||||||||
60 | =cut | |||||||
61 | ||||||||
62 | =head1 THE HTML::Clean CLASS | |||||||
63 | ||||||||
64 | =head2 $h = HTML::Clean->new($dataorfile, [$level]); | |||||||
65 | ||||||||
66 | This creates a new HTML::Clean object. A Prerequisite for all other | |||||||
67 | functions in this module. | |||||||
68 | ||||||||
69 | The $dataorfile parameter supplies the input HTML, either a filename, | |||||||
70 | or a reference to a scalar value holding the HTML, for example: | |||||||
71 | ||||||||
72 | $h = HTML::Clean->new("/htdocs/index.html"); | |||||||
73 | $html = "Hello!"; | |||||||
74 | $h = HTML::Clean->new(\$html); | |||||||
75 | ||||||||
76 | An optional 'level' parameter controls the level of optimization | |||||||
77 | performed. Levels range from 1 to 9. Level 1 includes only simple | |||||||
78 | fast optimizations. Level 9 includes all optimizations. | |||||||
79 | ||||||||
80 | =cut | |||||||
81 | ||||||||
82 | sub new { | |||||||
83 | 10 | 10 | 1 | 7953 | my $this = shift; | |||
84 | 10 | 33 | 144 | my $class = ref($this) || $this; | ||||
85 | 10 | 20 | my $self = {}; | |||||
86 | 10 | 18 | bless $self, $class; | |||||
87 | ||||||||
88 | 10 | 14 | my $data = shift; | |||||
89 | 10 | 12 | my $level = shift; | |||||
90 | ||||||||
91 | 10 | 50 | 25 | if ($self->initialize($data)) { | ||||
92 | # set the default level | |||||||
93 | 10 | 50 | 40 | $level = 9 if (!$level); | ||||
94 | 10 | 56 | $self->level($level); | |||||
95 | 10 | 29 | return $self; | |||||
96 | } else { | |||||||
97 | 0 | 0 | undef $self; | |||||
98 | 0 | 0 | return undef; | |||||
99 | } | |||||||
100 | } | |||||||
101 | ||||||||
102 | ||||||||
103 | # | |||||||
104 | # Set up the data in the self hash.. | |||||||
105 | # | |||||||
106 | ||||||||
107 | =head2 $h->initialize($dataorfile) | |||||||
108 | ||||||||
109 | This function allows you to reinitialize the HTML data used by the | |||||||
110 | current object. This is useful if you are processing many files. | |||||||
111 | ||||||||
112 | $dataorfile has the same usage as the new method. | |||||||
113 | ||||||||
114 | Return 0 for an error, 1 for success. | |||||||
115 | ||||||||
116 | =cut | |||||||
117 | ||||||||
118 | sub initialize { | |||||||
119 | 13 | 13 | 1 | 80 | my($self, $data) = @_; | |||
120 | 13 | 35 | $self->{'DATA'} = undef; | |||||
121 | ||||||||
122 | # Not defined? Just return true. | |||||||
123 | 13 | 100 | 25 | return(1) if (!$data); | ||||
124 | ||||||||
125 | # Check if it's a ref | |||||||
126 | 12 | 100 | 20 | if (ref($data)) { | ||||
127 | 4 | 4 | $self->{DATA} = $data; | |||||
128 | 4 | 8 | return(1); | |||||
129 | } | |||||||
130 | ||||||||
131 | # Newline char, really an error, but just go with it.. | |||||||
132 | 8 | 50 | 39 | if ($data =~ /\n/) { | ||||
133 | 0 | 0 | $self->{'DATA'} = \$data; | |||||
134 | } | |||||||
135 | ||||||||
136 | # No newline? Must be a filename | |||||||
137 | 8 | 50 | 172 | if (-f $data) { | ||||
138 | 8 | 14 | my $storage; | |||||
139 | ||||||||
140 | 8 | 50 | 231 | sysopen(IN, "$data", O_RDONLY) || return(0); | ||||
141 | 8 | 278 | while ( |
|||||
142 | 2759 | 4423 | $storage .= $_; | |||||
143 | } | |||||||
144 | 8 | 55 | close(IN); | |||||
145 | 8 | 22 | $self->{'DATA'} = \$storage; | |||||
146 | 8 | 28 | return(1); | |||||
147 | } | |||||||
148 | ||||||||
149 | 0 | 0 | return(0); # file not found? | |||||
150 | } | |||||||
151 | ||||||||
152 | ||||||||
153 | =head2 $h->level([$level]) | |||||||
154 | ||||||||
155 | Get/set the optimization level. $level is a number from 1 to 9. | |||||||
156 | ||||||||
157 | =cut | |||||||
158 | ||||||||
159 | sub level { | |||||||
160 | 13 | 13 | 1 | 65 | my($self, $level) = @_; | |||
161 | ||||||||
162 | 13 | 50 | 66 | 115 | if (defined($level) && ($level > 0) && ($level < 10)) { | |||
66 | ||||||||
163 | 12 | 19 | $self->{'LEVEL'} = $level | |||||
164 | } | |||||||
165 | 13 | 20 | return($self->{'LEVEL'}); | |||||
166 | } | |||||||
167 | ||||||||
168 | =head2 $myref = $h->data() | |||||||
169 | ||||||||
170 | Returns the current HTML data as a scalar reference. | |||||||
171 | ||||||||
172 | =cut | |||||||
173 | ||||||||
174 | sub data { | |||||||
175 | 8 | 8 | 1 | 608 | my($self) = @_; | |||
176 | ||||||||
177 | 8 | 382 | return $self->{'DATA'}; | |||||
178 | } | |||||||
179 | ||||||||
180 | ||||||||
181 | # Junk HTML comments (INTERNAL) | |||||||
182 | ||||||||
183 | sub _commentcheck($) { | |||||||
184 | 174 | 174 | 261 | my($comment) = @_; | ||||
185 | ||||||||
186 | 174 | 175 | $_ = $comment; | |||||
187 | ||||||||
188 | # Server side include | |||||||
189 | 174 | 50 | 232 | return($comment) if (m,^$,si); | ||||
197 | 162 | 50 | 221 | return($comment) if (m,navigator\.app(name|version),si); | ||||
198 | ||||||||
199 | # Stylesheet | |||||||
200 | 162 | 100 | 233 | return($comment) if (m,[A-z0-9]+\:[A-z0-9]+\s*\{.*\},si); | ||||
201 | 161 | 506 | return(''); | |||||
202 | } | |||||||
203 | ||||||||
204 | ||||||||
205 | # Remove javascript comments (INTERNAL) | |||||||
206 | ||||||||
207 | sub _jscomments { | |||||||
208 | 12 | 12 | 32 | my($js) = @_; | ||||
209 | ||||||||
210 | 12 | 80 | $js =~ s,\n\s*//.*?\n,\n,sig; | |||||
211 | 12 | 119 | $js =~ s,\s+//.*?\n,\n,sig; | |||||
212 | ||||||||
213 | # insure javascript is hidden | |||||||
214 | ||||||||
215 | 12 | 100 | 36 | if ($js =~ m,\n,si; | ||||
217 | } | |||||||
218 | 12 | 446 | return($js); | |||||
219 | } | |||||||
220 | ||||||||
221 | # Clean up other javascript stuff.. | |||||||
222 | ||||||||
223 | sub _javascript { | |||||||
224 | 12 | 12 | 28 | my($js) = @_; | ||||
225 | ||||||||
226 | # remove excess whitespace at the beginning and end of lines | |||||||
227 | 12 | 824 | $js =~ s,\s*\n+\s*,\n,sig; | |||||
228 | ||||||||
229 | # braces/semicolon at end of line, join next line | |||||||
230 | 12 | 168 | $js =~ s,([;{}])\n,$1,sig; | |||||
231 | ||||||||
232 | # What else is safe to do? | |||||||
233 | ||||||||
234 | 12 | 524 | return($js); | |||||
235 | } | |||||||
236 | ||||||||
237 | # replace #000000 -> black, etc.. | |||||||
238 | # Does the browser render faster with RGB? You would think so.. | |||||||
239 | ||||||||
240 | sub _defcolorcheck ($) { | |||||||
241 | 238 | 238 | 404 | my($c) = @_; | ||||
242 | ||||||||
243 | 238 | 370 | $c =~ s/\#000000/black/; | |||||
244 | 238 | 288 | $c =~ s/\#c0c0c0/silver/i; | |||||
245 | 238 | 239 | $c =~ s/\#808080/gray/; | |||||
246 | 238 | 339 | $c =~ s/\#ffffff/white/i; | |||||
247 | 238 | 247 | $c =~ s/\#800000/maroon/; | |||||
248 | 238 | 278 | $c =~ s/\#ff0000/red/i; | |||||
249 | 238 | 232 | $c =~ s/\#800080/purple/; | |||||
250 | 238 | 237 | $c =~ s/\#ff00ff/fuchsia/i; | |||||
251 | 238 | 238 | $c =~ s/\#ff00ff/fuchsia/i; | |||||
252 | 238 | 233 | $c =~ s/\#008000/green/; | |||||
253 | 238 | 265 | $c =~ s/\#00ff00/lime/i; | |||||
254 | 238 | 230 | $c =~ s/\#808000/olive/; | |||||
255 | 238 | 245 | $c =~ s/\#ffff00/yellow/i; | |||||
256 | 238 | 222 | $c =~ s/\#000080/navy/; | |||||
257 | 238 | 256 | $c =~ s/\#0000ff/blue/i; | |||||
258 | 238 | 218 | $c =~ s/\#008080/teal/i; | |||||
259 | 238 | 248 | $c =~ s/\#00ffff/aqua/i; | |||||
260 | 238 | 2824 | return($c); | |||||
261 | } | |||||||
262 | ||||||||
263 | # For replacing entities with numerics | |||||||
264 | 2 | 2 | 24 | use vars qw/ %_ENTITIES/; | ||||
2 | 3 | |||||||
2 | 284 | |||||||
265 | %_ENTITIES = ( | |||||||
266 | 'Agrave' => 192, | |||||||
267 | 'Aacute' => 193, | |||||||
268 | 'Acirc' => 194, | |||||||
269 | 'Atilde' => 195, | |||||||
270 | 'Auml' => 196, | |||||||
271 | 'Aring' => 197, | |||||||
272 | 'AElig' => 198, | |||||||
273 | 'Ccedil' => 199, | |||||||
274 | 'Egrave' => 200, | |||||||
275 | 'Eacute' => 201, | |||||||
276 | 'Ecirc' => 202, | |||||||
277 | 'Euml' => 203, | |||||||
278 | 'Igrave' => 204, | |||||||
279 | 'Iacute' => 205, | |||||||
280 | 'Icirc' => 206, | |||||||
281 | 'Iuml' => 207, | |||||||
282 | 'ETH' => 208, | |||||||
283 | 'Ntilde' => 209, | |||||||
284 | 'Ograve' => 210, | |||||||
285 | 'Oacute' => 211, | |||||||
286 | 'Ocirc' => 212, | |||||||
287 | 'Otilde' => 213, | |||||||
288 | 'Ouml' => 214, | |||||||
289 | 'Oslash' => 216, | |||||||
290 | 'Ugrave' => 217, | |||||||
291 | 'Uacute' => 218, | |||||||
292 | 'Ucirc' => 219, | |||||||
293 | 'Uuml' => 220, | |||||||
294 | 'Yacute' => 221, | |||||||
295 | 'THORN' => 222, | |||||||
296 | 'szlig' => 223, | |||||||
297 | 'agrave' => 224, | |||||||
298 | 'aacute' => 225, | |||||||
299 | 'acirc' => 226, | |||||||
300 | 'atilde' => 227, | |||||||
301 | 'auml' => 228, | |||||||
302 | 'aring' => 229, | |||||||
303 | 'aelig' => 230, | |||||||
304 | 'ccedil' => 231, | |||||||
305 | 'egrave' => 232, | |||||||
306 | 'eacute' => 233, | |||||||
307 | 'ecirc' => 234, | |||||||
308 | 'euml' => 235, | |||||||
309 | 'igrave' => 236, | |||||||
310 | 'iacute' => 237, | |||||||
311 | 'icirc' => 238, | |||||||
312 | 'iuml' => 239, | |||||||
313 | 'eth' => 240, | |||||||
314 | 'ntilde' => 241, | |||||||
315 | 'ograve' => 242, | |||||||
316 | 'oacute' => 243, | |||||||
317 | 'ocirc' => 244, | |||||||
318 | 'otilde' => 245, | |||||||
319 | 'ouml' => 246, | |||||||
320 | 'oslash' => 248, | |||||||
321 | 'ugrave' => 249, | |||||||
322 | 'uacute' => 250, | |||||||
323 | 'ucirc' => 251, | |||||||
324 | 'uuml' => 252, | |||||||
325 | 'yacute' => 253, | |||||||
326 | 'thorn' => 254, | |||||||
327 | 'yuml' => 255 | |||||||
328 | ); | |||||||
329 | ||||||||
330 | =head2 strip(\%options); | |||||||
331 | ||||||||
332 | Removes excess space from HTML | |||||||
333 | ||||||||
334 | You can control the optimizations used by specifying them in the | |||||||
335 | %options hash reference. | |||||||
336 | ||||||||
337 | The following options are recognized: | |||||||
338 | ||||||||
339 | =over 8 | |||||||
340 | ||||||||
341 | =item boolean values (0 or 1 values) | |||||||
342 | ||||||||
343 | whitespace Remove excess whitespace | |||||||
344 | shortertags -> , etc.. | |||||||
345 | blink No blink tags. | |||||||
346 | contenttype Remove default contenttype. | |||||||
347 | comments Remove excess comments. | |||||||
348 | entities " -> ", etc. | |||||||
349 | dequote remove quotes from tag parameters where possible. | |||||||
350 | defcolor recode colors in shorter form. (#ffffff -> white, etc.) | |||||||
351 | javascript remove excess spaces and newlines in javascript code. | |||||||
352 | htmldefaults remove default values for some html tags | |||||||
353 | lowercasetags translate all HTML tags to lowercase | |||||||
354 | ||||||||
355 | =item parameterized values | |||||||
356 | ||||||||
357 | meta Takes a space separated list of meta tags to remove, | |||||||
358 | default "GENERATOR FORMATTER" | |||||||
359 | ||||||||
360 | emptytags Takes a space separated list of tags to remove when there is no | |||||||
361 | content between the start and end tag, like this: . | |||||||
362 | The default is 'b i font center' | |||||||
363 | ||||||||
364 | =back | |||||||
365 | ||||||||
366 | =cut | |||||||
367 | ||||||||
368 | 2 | 404 | use vars qw/ | |||||
369 | $do_whitespace | |||||||
370 | $do_shortertags | |||||||
371 | $do_meta | |||||||
372 | $do_blink | |||||||
373 | $do_contenttype | |||||||
374 | $do_comments | |||||||
375 | $do_entities | |||||||
376 | $do_dequote | |||||||
377 | $do_defcolor | |||||||
378 | $do_emptytags | |||||||
379 | $do_javascript | |||||||
380 | $do_htmldefaults | |||||||
381 | $do_lowercasetags | |||||||
382 | $do_defbaseurl | |||||||
383 | 2 | 2 | 10 | /; | ||||
2 | 4 | |||||||
384 | ||||||||
385 | $do_whitespace = 1; | |||||||
386 | $do_shortertags = 1; | |||||||
387 | $do_meta = "generator formatter"; | |||||||
388 | $do_blink = 1; | |||||||
389 | $do_contenttype = 1; | |||||||
390 | $do_comments = 1; | |||||||
391 | $do_entities = 1; | |||||||
392 | $do_dequote = 1; | |||||||
393 | $do_defcolor = 1; | |||||||
394 | $do_emptytags = 'b i font center'; | |||||||
395 | $do_javascript = 1; | |||||||
396 | $do_htmldefaults = 1; | |||||||
397 | $do_lowercasetags = 1; | |||||||
398 | $do_defbaseurl = ''; | |||||||
399 | ||||||||
400 | sub strip { | |||||||
401 | 11 | 11 | 1 | 111 | my($self, $options) = @_; | |||
402 | ||||||||
403 | 11 | 16 | my $h = $self->{'DATA'}; | |||||
404 | 11 | 12 | my $level = $self->{'LEVEL'}; | |||||
405 | ||||||||
406 | # Select a set of options based on $level, and then modify based on | |||||||
407 | # user supplied options. | |||||||
408 | ||||||||
409 | 11 | 66 | _level_defaults($level); | |||||
410 | ||||||||
411 | 11 | 50 | 20 | if(defined($options)) { | ||||
412 | 2 | 2 | 11 | no strict 'refs'; | ||||
2 | 3 | |||||||
2 | 3180 | |||||||
413 | 0 | 0 | for (keys(%$options)) { | |||||
414 | 0 | 0 | 0 | ${"do_" . lc($_)} = $options->{$_} if defined ${"do_" . lc($_)}; | ||||
0 | 0 | |||||||
0 | 0 | |||||||
415 | } | |||||||
416 | } | |||||||
417 | ||||||||
418 | 11 | 50 | 17 | if ($do_shortertags) { | ||||
419 | 11 | 863 | $$h =~ s,,,sgi; | |||||
420 | 11 | 550 | $$h =~ s,,,sgi; | |||||
421 | 11 | 471 | $$h =~ s,,,sgi; | |||||
422 | 11 | 454 | $$h =~ s,,,sgi; | |||||
423 | } | |||||||
424 | ||||||||
425 | 11 | 50 | 18 | if ($do_whitespace) { | ||||
426 | 11 | 1345 | $$h =~ s,[\r\n]+,\n,sg; # Carriage/LF -> LF | |||||
427 | 11 | 1585 | $$h =~ s,\s+\n,\n,sg; # empty line | |||||
428 | 11 | 743 | $$h =~ s,\n\s+<,\n<,sg; # space before tag | |||||
429 | 11 | 455 | $$h =~ s,\n\s+,\n ,sg; # other spaces | |||||
430 | ||||||||
431 | 11 | 967 | $$h =~ s,>\n\s*<,><,sg; # LF/spaces between tags.. | |||||
432 | ||||||||
433 | # Remove excess spaces within tags.. note, we could parse out the elements | |||||||
434 | # and rewrite for excess spaces between elements. perhaps next version. | |||||||
435 | # removed due to problems with > and < in tag elements.. | |||||||
436 | #$$h =~ s,\s+>,>,sg; | |||||||
437 | #$$h =~ s,<\s+,<,sg; | |||||||
438 | # do this again later.. | |||||||
439 | } | |||||||
440 | ||||||||
441 | 11 | 50 | 25 | if ($do_entities) { | ||||
442 | 11 | 53 | $$h =~ s,",\",sg; | |||||
443 | # Simplify long entity names if using default charset... | |||||||
444 | 11 | 109 | $$h =~ m,charset=([^\"]+)\",; | |||||
445 | 11 | 100 | 100 | 92 | if (!defined($1) || ($1 eq 'iso-8859-1')) { | |||
446 | 10 | 100 | 92 | $$h =~ s,&([A-z]+);,($_ENTITIES{$1}) ? chr($_ENTITIES{$1}) : $&,sige; | ||||
307 | 1187 | |||||||
447 | } | |||||||
448 | } | |||||||
449 | ||||||||
450 | 11 | 50 | 38 | if ($do_meta) { | ||||
451 | 11 | 69 | foreach my $m (split(/\s+/, $do_meta)) { | |||||
452 | 22 | 2001 | $$h =~ s,]*?>,,sig; | |||||
453 | } | |||||||
454 | } | |||||||
455 | 11 | 50 | 45 | if ($do_contenttype) { | ||||
456 | # Don't need this, since it is the default for most web servers | |||||||
457 | # Also gets rid of 'blinking pages' in older versions of netscape. | |||||||
458 | 11 | 503 | $$h =~ s,,,sig; | |||||
459 | } | |||||||
460 | ||||||||
461 | 11 | 50 | 15 | if ($do_defcolor) { | ||||
462 | 11 | 433 | $$h =~ s,(<[^<]+?color=['"]?\#[0-9A-Fa-f]+["']?),_defcolorcheck($&),sige; | |||||
238 | 354 | |||||||
463 | } | |||||||
464 | 11 | 50 | 33 | if ($do_comments) { | ||||
465 | # don't strip server side includes.. | |||||||
466 | # try not to get javascript, or styles... | |||||||
467 | 11 | 69 | $$h =~ s,,_commentcheck($&),sige; | |||||
174 | 231 | |||||||
468 | ||||||||
469 | # Remove javascript comments | |||||||
470 | 11 | 376 | $$h =~ s, | |||||
12 | 31 | |||||||
471 | } | |||||||
472 | ||||||||
473 | 11 | 50 | 21 | if ($do_javascript) { | ||||
474 | # | |||||||
475 | 11 | 339 | $$h =~ s, | |||||
12 | 35 | |||||||
476 | } | |||||||
477 | ||||||||
478 | 11 | 50 | 32 | if ($do_blink) { | ||||
479 | 11 | 403 | $$h =~ s, | |||||
480 | 11 | 395 | $$h =~ s,,,sgi; | |||||
481 | } | |||||||
482 | ||||||||
483 | 11 | 50 | 29 | if ($do_dequote) { | ||||
484 | 11 | 3067 | while ($$h =~ s,<([A-z]+ [A-z]+=)(['"])([A-z0-9]+)\2(\s*?[^>]*?>),<$1$3$4,sig) | |||||
485 | { | |||||||
486 | # Remove alphanumeric quotes. Note, breaks DTD.. | |||||||
487 | ; | |||||||
488 | } | |||||||
489 | } | |||||||
490 | # remove , etc.. | |||||||
491 | 11 | 50 | 29 | if ($do_emptytags) { | ||||
492 | 11 | 14 | my $pat = $do_emptytags; | |||||
493 | 11 | 100 | $pat =~ s/\s+/|/g; | |||||
494 | ||||||||
495 | 11 | 1850 | while ($$h =~ s,<($pat)(\s+[^>]*?)?>\s*,,siog){} | |||||
496 | ||||||||
497 | } | |||||||
498 | 11 | 50 | 25 | if ($do_htmldefaults) { | ||||
499 | # Tables | |||||||
500 | # seems to break things.. | |||||||
501 | #$$h =~ s,( |
|||||||
502 | 11 | 884 | $$h =~ s,( | ]*)\s+rowspan=1([^>]*>),$1$2,sig; | ||||
503 | 11 | 945 | $$h =~ s,( | ]*)\s+colspan=1([^>]*>),$1$2,sig; | ||||
504 | ||||||||
505 | # | |||||||
506 | ||||||||
507 | # P, TABLE tags are default left aligned.. | |||||||
508 | # lynx is inconsistent in this manner though.. | |||||||
509 | ||||||||
510 | 11 | 1026 | $$h =~ s,<(P|table|td)( [^>]*)align=\"?left\"?([^>]*)>,<$1$2$3>,sig; | |||||
511 | ||||||||
512 | # OL start=1 | |||||||
513 | 11 | 539 | $$h =~ s,(
|
|||||
514 | ||||||||
515 | # FORM | |||||||
516 | 11 | 725 | $$h =~ s,( | |||||
517 | 11 | 545 | $$h =~ s,(]*)enctype=\"application/x-www-form-urlencoded\"([^>]*>),$1$2,sig; | |||||
518 | ||||||||
519 | # hr | |||||||
520 | 11 | 600 | $$h =~ s,( ]*)align=\"?center\"?([^>]*>),$1$2,sig; |
|||||
521 | 11 | 195 | $$h =~ s,( ]*)width=\"?100%\"?([^>]*>),$1$2,sig; |
|||||
522 | ||||||||
523 | # URLs | |||||||
524 | 11 | 135 | $$h =~ s,(href|src)(=\"?http://[^/:]+):80/,$1$2/,sig; | |||||
525 | } | |||||||
526 | ||||||||
527 | 11 | 50 | 25 | if ($do_whitespace) { | ||||
528 | # remove space within tags |
|||||||
529 | 11 | 1211 | $$h =~ s,\s+>,>,sg; | |||||
530 | 11 | 598 | $$h =~ s,<\s+,<,sg; | |||||
531 | # join lines with a space at the beginning/end of the line | |||||||
532 | # and a line that begins with a tag | |||||||
533 | 11 | 250 | $$h =~ s,>\n ,> ,sig; | |||||
534 | 11 | 117 | $$h =~ s, \n<, <,sig; | |||||
535 | } | |||||||
536 | ||||||||
537 | 11 | 50 | 19 | if ($do_lowercasetags) { | ||||
538 | # translate tags to lowercase to (hopefully) improve compressability.. | |||||||
539 | ||||||||
540 | # simple tags ,etc. |
|||||||
541 | 11 | 3157 | $$h =~ s,(<[/]?[a-zA-Z][a-zA-Z0-9_-]*\s*>),\L$1\E,sg; | |||||
542 | ||||||||
543 | # the rest.. | |||||||
544 | 11 | 68 | $$h =~ s/(<[a-zA-Z][a-zA-Z0-9_-]*)(\s+.*?>)/_lowercasetag($1,$2)/sge; | |||||
2101 | 2903 | |||||||
545 | } | |||||||
546 | } | |||||||
547 | ||||||||
548 | sub _lowercasetag { | |||||||
549 | 2101 | 2101 | 3791 | my($prefix, $body) = @_; | ||||
550 | 2101 | 5599 | $prefix =~ s/^(.+)$/\L$1\E/; | |||||
551 | 2101 | 10685 | $body =~ s/(\s+[a-zA-Z][a-zA-Z0-9_-]*)(\s*=\s*[^"\s]+|\s*=\s*"[^"]*"|>|\s)/\L$1\E$2/sg; | |||||
552 | 2101 | 7838 | return $prefix.$body; | |||||
553 | } | |||||||
554 | ||||||||
555 | # set options based on the level provided.. INTERNAL | |||||||
556 | ||||||||
557 | sub _level_defaults($) { | |||||||
558 | 11 | 11 | 39 | my ($level) = @_; | ||||
559 | ||||||||
560 | 11 | 17 | $do_whitespace = 1; # always do this... | |||||
561 | ||||||||
562 | # level 2 | |||||||
563 | 11 | 50 | 15 | $do_shortertags = ($level > 1) ? 1 : 0; | ||||
564 | 11 | 50 | 50 | $do_meta = ($level > 1) ? "generator formatter" : ""; | ||||
565 | 11 | 50 | 19 | $do_contenttype = ($level > 1) ? 1 : 0; | ||||
566 | ||||||||
567 | # level 3 | |||||||
568 | 11 | 50 | 15 | $do_entities = ($level > 2) ? 1 : 0; | ||||
569 | 11 | 50 | 16 | $do_blink = ($level > 2) ? 1 : 0; | ||||
570 | ||||||||
571 | # level 4 | |||||||
572 | 11 | 50 | 32 | $do_comments = ($level > 3) ? 1 : 0; | ||||
573 | 11 | 50 | 21 | $do_dequote = ($level > 3) ? 1 : 0; | ||||
574 | 11 | 50 | 18 | $do_defcolor = ($level > 3) ? 1 : 0; | ||||
575 | 11 | 50 | 43 | $do_emptytags = ($level > 3) ? 'b i font center' : 0; | ||||
576 | 11 | 50 | 33 | $do_javascript = ($level > 3) ? 1 : 0; | ||||
577 | 11 | 50 | 17 | $do_htmldefaults = ($level > 3) ? 1 : 0; | ||||
578 | 11 | 50 | 14 | $do_lowercasetags = ($level > 3) ? 1 : 0; | ||||
579 | ||||||||
580 | # higher levels reserved for more intensive optimizations. | |||||||
581 | } | |||||||
582 | ||||||||
583 | ###################################################################### | |||||||
584 | ||||||||
585 | =head2 compat() | |||||||
586 | ||||||||
587 | This function improves the cross-platform compatibility of your HTML. | |||||||
588 | Currently checks for the following problems: | |||||||
589 | ||||||||
590 | =over 8 | |||||||
591 | ||||||||
592 | =item Insuring all IMG tags have ALT elements. | |||||||
593 | ||||||||
594 | =item Use of Arial, Futura, or Verdana as a font face. | |||||||
595 | ||||||||
596 | =item Positioning the |
|||||||
614 | 0 | 0 | my $title = $1; | |||||
615 | 0 | 0 | $$h =~ s,, |
|||||
616 | } | |||||||
617 | ||||||||
618 | # Look for IMG without ALT tags. | |||||||
619 | 3 | 7 | $$h =~ s/( |
|||||
0 | ||||||||
620 | } | |||||||
621 | ||||||||
622 | sub _imgalt { | |||||||
623 | 0 | 0 | my($tag) = @_; | |||||
624 | ||||||||
625 | 0 | 0 | $tag =~ s/>/ alt="">/ if ($tag !~ /alt=/i); | |||||
626 | 0 | return($tag); | ||||||
627 | } | |||||||
628 | ||||||||
629 | =head2 defrontpage(); | |||||||
630 | ||||||||
631 | This function converts pages created with Microsoft Frontpage to | |||||||
632 | something a Unix server will understand a bit better. This function | |||||||
633 | currently does the following: | |||||||
634 | ||||||||
635 | =over 8 | |||||||
636 | ||||||||
637 | =item Converts Frontpage 'hit counters' into a unix specific format. | |||||||
638 | ||||||||
639 | =item Removes some frontpage specific html comments | |||||||
640 | ||||||||
641 | =back | |||||||
642 | ||||||||
643 | =cut | |||||||
644 | ||||||||
645 | ||||||||
646 | sub defrontpage { | |||||||
647 | 0 | 0 | 1 | my($self) = @_; | ||||
648 | ||||||||
649 | 0 | my $h = $self->{'DATA'}; | ||||||
650 | ||||||||
651 | 0 | while ($$h =~ s, |
||||||
652 | 0 | print "Converted a Hitcounter.. $1, $2, $3\n"; | ||||||
653 | } | |||||||
654 | 0 | $$h =~ s,,,sgx; | ||||||
655 | } | |||||||
656 | ||||||||
657 | ||||||||
658 | =head1 SEE ALSO | |||||||
659 | ||||||||
660 | =head2 Modules | |||||||
661 | ||||||||
662 | FrontPage::Web, FrontPage::File | |||||||
663 | ||||||||
664 | =head2 Web Sites | |||||||
665 | ||||||||
666 | =over 6 | |||||||
667 | ||||||||
668 | =item Distribution Site - http://people.itu.int/~lindner/ | |||||||
669 | ||||||||
670 | =back | |||||||
671 | ||||||||
672 | =head1 AUTHORS and CO-AUTHORS | |||||||
673 | ||||||||
674 | Paul Lindner for the International Telecommunication Union (ITU) | |||||||
675 | ||||||||
676 | Pavel Kuptsov |
|||||||
677 | ||||||||
678 | =head1 COPYRIGHT | |||||||
679 | ||||||||
680 | The HTML::Strip module is Copyright (c) 1998,99 by the ITU, Geneva Switzerland. | |||||||
681 | All rights reserved. | |||||||
682 | ||||||||
683 | You may distribute under the terms of either the GNU General Public | |||||||
684 | License or the Artistic License, as specified in the Perl README file. | |||||||
685 | ||||||||
686 | =cut | |||||||
687 | ||||||||
688 | 1; | |||||||
689 | __END__ |