File Coverage

blib/lib/HTML/Formatter.pm
Criterion Covered Total %
statement 171 375 45.6
branch 26 64 40.6
condition 7 33 21.2
subroutine 54 153 35.2
pod 6 146 4.1
total 264 771 34.2


line stmt bran cond sub pod time code
1             package HTML::Formatter;
2              
3             # ABSTRACT: Base class for HTML formatters
4              
5              
6 5     5   688 use 5.006_001;
  5         19  
7 5     5   46 use strict;
  5         9  
  5         113  
8 5     5   22 use warnings;
  5         8  
  5         116  
9              
10 5     5   38 use Carp;
  5         7  
  5         388  
11 5     5   7224 use HTML::Element 3.15 ();
  5         129959  
  5         23916  
12              
13             # We now use Smart::Comments in place of the old DEBUG framework.
14             # this should be commented out in release versions....
15             ##use Smart::Comments;
16              
17             our $VERSION = '2.14'; # VERSION
18             our $AUTHORITY = 'cpan:NIGELM'; # AUTHORITY
19              
20             #
21             # A typical formatter will not use all of the features of this
22             # class. But it will use some, as best fits the mapping
23             # of HTML to the particular output format.
24             #
25              
26             # ------------------------------------------------------------------------
27              
28              
29             sub new {
30 21     21 1 6990 my ( $class, %arg ) = @_;
31              
32 21         85 my $self = bless { $class->default_values }, $class;
33 21 100       124 $self->configure( \%arg ) if keys %arg;
34              
35 21         64 return $self;
36             }
37              
38             # ------------------------------------------------------------------------
39             sub default_values {
40 21     21 0 135 ();
41             }
42              
43             # ------------------------------------------------------------------------
44             sub configure {
45 0     0 0 0 my ( $self, $arg ) = @_;
46              
47 0         0 for ( keys %$arg ) {
48 0 0       0 warn "Unknown configure argument '$_'" if $^W;
49             }
50              
51 0         0 return $self;
52             }
53              
54             # ------------------------------------------------------------------------
55             sub massage_tree {
56 17     17 0 32 my ( $self, $html ) = @_;
57              
58 17 50       55 return if $html->tag eq 'p'; # sanity
59              
60             ### Before massaging: $html->dump()
61              
62 17         172 $html->simplify_pres();
63              
64             # Does anything else need doing?
65             ### After massaging: $html->dump()
66              
67 17         1868 return;
68             }
69              
70             # ------------------------------------------------------------------------
71              
72              
73 0     0 1 0 sub format_from_file { return shift->format_file(@_); }
74              
75             sub format_file {
76 4     4 1 7123 my ( $self, $filename, @params ) = @_;
77              
78 4 50       28 $self = $self->new(@params) unless ref $self;
79              
80 4 50 33     36 croak "What filename to format from?"
81             unless ( defined($filename) and length($filename) );
82              
83 4         30 my $tree = $self->_default_tree();
84 4         32 $tree->parse_file($filename);
85              
86 4         32827 my $out = $self->format($tree);
87 4         23 $tree->delete;
88              
89 4         1964 return $out;
90             }
91              
92             # ------------------------------------------------------------------------
93              
94              
95             # ------------------------------------------------------------------------
96 8     8 1 49 sub format_from_string { shift->format_string(@_) }
97              
98             sub format_string {
99 13     13 1 9688 my ( $self, $content, @params ) = @_;
100              
101 13 50       38 $self = $self->new(@params) unless ref $self;
102              
103 13 50       34 croak "What string to format?" unless defined $content;
104              
105 13         35 my $tree = $self->_default_tree();
106 13         102 $tree->parse($content);
107 13         5547 $tree->eof();
108 13         1116 undef $content;
109              
110 13         39 my $out = $self->format($tree);
111 13         48 $tree->delete;
112              
113 13         1063 return $out;
114             }
115              
116             # ------------------------------------------------------------------------
117             sub _default_tree {
118 17     17   4681 require HTML::TreeBuilder;
119 17         33051 my $t = HTML::TreeBuilder->new;
120              
121             # If nothing else works, try using these parser options:s
122             #$t->implicit_body_p_tag(1);
123             #$t->p_strict(1);
124              
125 17         3589 return $t;
126             }
127              
128             # ------------------------------------------------------------------------
129              
130              
131             sub format {
132 17     17 1 35 my ( $self, $html ) = @_;
133              
134 17 50 33     244 croak "Usage: \$formatter->format(\$tree)" unless ( defined($html) and ref($html) and $html->can('tag') );
      33        
135              
136             #### Tree to format: $html->dump
137              
138 17         68 $self->set_version_tag($html);
139 17         111 $self->massage_tree($html);
140 17         68 $self->begin($html);
141 17         74 $html->number_lists();
142              
143             # Per-iteration scratch:
144 17         1673 my ( $node, $start, $depth, $tag, $func );
145             $html->traverse(
146             sub {
147 431     431   6961 ( $node, $start, $depth ) = @_;
148 431 100       930 if ( ref $node ) {
149 334         837 $tag = $node->tag;
150 334 100       2213 $func = $tag . '_' . ( $start ? "start" : "end" );
151              
152             # Use ->can so that we can recover if
153             # a handler is not defined for the tag.
154 334 100       1484 if ( $self->can($func) ) {
155             ### Calling : (' ' x $depth) . $func
156 333         884 return $self->$func($node);
157             }
158             else {
159             ### Skipping: (' ' x $depth) . $func
160 1         3 return 1;
161             }
162             }
163             else {
164 97         247 $self->textflow($node);
165             }
166 97         417 1;
167             }
168 17         122 );
169              
170 17         324 $self->end($html);
171              
172 17         24 return join( '', @{ $self->{output} } );
  17         227  
173             }
174              
175             # ------------------------------------------------------------------------
176             sub begin {
177 17     17 0 25 my $self = shift;
178              
179             # Flags
180 17         38 $self->{anchor} = 0;
181 17         33 $self->{underline} = 0;
182 17         33 $self->{bold} = 0;
183 17         27 $self->{italic} = 0;
184 17         41 $self->{center} = 0;
185              
186 17         34 $self->{superscript} = 0;
187 17         25 $self->{subscript} = 0;
188 17         30 $self->{strikethrough} = 0;
189              
190 17         33 $self->{center_stack} = []; # push and pop 'center' states to it
191 17         34 $self->{nobr} = 0;
192              
193 17         36 $self->{'font_size'} = [3]; # last element is current size
194 17         35 $self->{basefont_size} = [3];
195              
196 17         42 $self->{vspace} = undef; # vertical space (dimension)
197              
198 17         49 $self->{output} = [];
199             }
200              
201             # ------------------------------------------------------------------------
202       0 0   sub end { }
203              
204             # ------------------------------------------------------------------------
205             sub set_version_tag {
206 17     17 0 34 my ( $self, $html ) = @_;
207              
208 17 50       46 if ($html) {
    0          
209 17 50 50     403 $self->{'version_tag'} = sprintf(
      50        
210             "%s (v%s, using %s v%s%s)",
211             ref($self), $self->VERSION || '?',
212             ref($html),
213             $html->VERSION || '?',
214             $HTML::Parser::VERSION ? ", and HTML::Parser v$HTML::Parser::VERSION" : ''
215             );
216             }
217             elsif ($HTML::Parser::VERSION) {
218 0   0     0 $self->{'version_tag'} =
219             sprintf( "%s (v%s, using %s)", ref($self), $self->VERSION || "?", "HTML::Parser v$HTML::Parser::VERSION", );
220             }
221             else {
222 0   0     0 $self->{'version_tag'} = sprintf( "%s (v%s)", ref($self), $self->VERSION || '?', );
223             }
224             }
225              
226             # ------------------------------------------------------------------------
227 7     7 0 34 sub version_tag { shift->{'version_tag'} }
228              
229             # ------------------------------------------------------------------------
230 17     17 0 82 sub html_start { 1; }
231       17 0   sub html_end { }
232 17     17 0 41 sub body_start { 1; }
233       17 0   sub body_end { }
234 11     11 0 29 sub head_start { 0; }
235 0     0 0 0 sub script_start { 0; }
236 0     0 0 0 sub style_start { 0; }
237 0     0 0 0 sub frameset_start { 0; }
238              
239             # ------------------------------------------------------------------------
240             sub header_start {
241 0     0 0 0 my ( $self, undef, $node ) = @_;
242              
243 0         0 my $align = $node->attr('align');
244 0 0 0     0 if ( defined($align) && lc($align) eq 'center' ) {
245 0         0 $self->{center}++;
246             }
247 0         0 1;
248             }
249              
250             # ------------------------------------------------------------------------
251             sub header_end {
252 0     0 0 0 my ( $self, undef, $node ) = @_;
253              
254 0         0 my $align = $node->attr('align');
255 0 0 0     0 if ( defined($align) && lc($align) eq 'center' ) {
256 0         0 $self->{center}--;
257             }
258             }
259              
260             # ------------------------------------------------------------------------
261 4     4 0 23 sub h1_start { shift->header_start( 1, @_ ) }
262 4     4 0 34 sub h2_start { shift->header_start( 2, @_ ) }
263 0     0 0 0 sub h3_start { shift->header_start( 3, @_ ) }
264 0     0 0 0 sub h4_start { shift->header_start( 4, @_ ) }
265 0     0 0 0 sub h5_start { shift->header_start( 5, @_ ) }
266 0     0 0 0 sub h6_start { shift->header_start( 6, @_ ) }
267              
268             # ------------------------------------------------------------------------
269 4     4 0 22 sub h1_end { shift->header_end( 1, @_ ) }
270 4     4 0 20 sub h2_end { shift->header_end( 2, @_ ) }
271 0     0 0 0 sub h3_end { shift->header_end( 3, @_ ) }
272 0     0 0 0 sub h4_end { shift->header_end( 4, @_ ) }
273 0     0 0 0 sub h5_end { shift->header_end( 5, @_ ) }
274 0     0 0 0 sub h6_end { shift->header_end( 6, @_ ) }
275              
276 0     0 0 0 sub br_start { my $self = shift; $self->vspace( 0, 1 ); }
  0         0  
277 0     0 0 0 sub hr_start { my $self = shift; $self->vspace(1); 1; }
  0         0  
  0         0  
278              
279             # ------------------------------------------------------------------------
280             sub img_start {
281 0     0 0 0 my ( $self, $node ) = @_;
282              
283 0         0 my $alt = $node->attr('alt');
284 0 0       0 $self->out( defined($alt) ? $alt : "[IMAGE]" );
285             }
286              
287             # ------------------------------------------------------------------------
288 3     3 0 7 sub a_start { shift->{anchor}++; 1; }
  3         10  
289 3     3 0 11 sub a_end { shift->{anchor}--; }
290 0     0 0 0 sub u_start { shift->{underline}++; 1; }
  0         0  
291 0     0 0 0 sub u_end { shift->{underline}--; }
292 3     3 0 8 sub b_start { shift->{bold}++; 1; }
  3         8  
293 3     3 0 11 sub b_end { shift->{bold}--; }
294 3     3 0 7 sub tt_start { shift->{teletype}++; 1; }
  3         41  
295 3     3 0 11 sub tt_end { shift->{teletype}--; }
296 3     3 0 17 sub i_start { shift->{italic}++; 1; }
  3         10  
297 3     3 0 12 sub i_end { shift->{italic}--; }
298 0     0 0 0 sub center_start { shift->{center}++; 1; }
  0         0  
299 0     0 0 0 sub center_end { shift->{center}--; }
300              
301             # ------------------------------------------------------------------------
302             sub div_start { # interesting only for its 'align' attribute
303 0     0 0 0 my ( $self, $node ) = @_;
304              
305 0         0 my $align = $node->attr('align');
306 0 0 0     0 if ( defined($align) && lc($align) eq 'center' ) {
307 0         0 return $self->center_start;
308             }
309 0         0 1;
310             }
311              
312             # ------------------------------------------------------------------------
313             sub div_end {
314 0     0 0 0 my ( $self, $node ) = @_;
315              
316 0         0 my $align = $node->attr('align');
317 0 0 0     0 if ( defined($align) && lc($align) eq 'center' ) {
318 0         0 return $self->center_end;
319             }
320             }
321              
322             # ------------------------------------------------------------------------
323 0     0 0 0 sub nobr_start { shift->{nobr}++; 1; }
  0         0  
324 0     0 0 0 sub nobr_end { shift->{nobr}--; }
325 0     0 0 0 sub wbr_start { 1; }
326              
327             # ------------------------------------------------------------------------
328             sub font_start {
329 0     0 0 0 my ( $self, $elem ) = @_;
330              
331 0         0 my $size = $elem->attr('size');
332 0 0       0 return 1 unless ( defined($size) );
333 0 0       0 if ( $size =~ /^\s*[+\-]/ ) {
334 0         0 my $base = $self->{basefont_size}[-1];
335              
336             # yes, base it on the most recent one
337 0         0 $size = $base + $size;
338             }
339 0         0 push @{ $self->{'font_size'} }, $size;
  0         0  
340 0         0 $self->new_font_size($size);
341 0         0 1;
342             }
343              
344             # ------------------------------------------------------------------------
345             sub font_end {
346 0     0 0 0 my ( $self, $elem ) = @_;
347 0         0 my $size = $elem->attr('size');
348 0 0       0 return unless defined $size;
349 0         0 pop @{ $self->{'font_size'} };
  0         0  
350 0         0 $self->restore_font_size( $self->{'font_size'}[-1] );
351             }
352              
353             # ------------------------------------------------------------------------
354             sub big_start {
355 0     0 0 0 my $self = $_[0];
356 0         0 push @{ $self->{'font_size'} }, $self->{basefont_size}[-1] + 1; # same as font size="+1"
  0         0  
357 0         0 $self->new_font_size( $self->{'font_size'}[-1] );
358 0         0 1;
359             }
360              
361             # ------------------------------------------------------------------------
362             sub small_start {
363 0     0 0 0 my $self = $_[0];
364 0         0 push @{ $self->{'font_size'} }, $self->{basefont_size}[-1] - 1, # same as font size="-1"
  0         0  
365             ;
366 0         0 $self->new_font_size( $self->{'font_size'}[-1] );
367 0         0 1;
368             }
369              
370             # ------------------------------------------------------------------------
371             sub big_end {
372 0     0 0 0 my $self = $_[0];
373 0         0 pop @{ $self->{'font_size'} };
  0         0  
374 0         0 $self->restore_font_size( $self->{'font_size'}[-1] );
375 0         0 1;
376             }
377              
378             # ------------------------------------------------------------------------
379             sub small_end {
380 0     0 0 0 my $self = $_[0];
381 0         0 pop @{ $self->{'font_size'} };
  0         0  
382 0         0 $self->restore_font_size( $self->{'font_size'}[-1] );
383 0         0 1;
384             }
385              
386             # ------------------------------------------------------------------------
387             sub basefont_start {
388 0     0 0 0 my ( $self, $elem ) = @_;
389 0         0 my $size = $elem->attr('size');
390 0 0       0 return unless defined $size;
391 0         0 push( @{ $self->{basefont_size} }, $size );
  0         0  
392 0         0 1;
393             }
394              
395             # ------------------------------------------------------------------------
396             sub basefont_end {
397 0     0 0 0 my ( $self, $elem ) = @_;
398 0         0 my $size = $elem->attr('size');
399 0 0       0 return unless defined $size;
400 0         0 pop( @{ $self->{basefont_size} } );
  0         0  
401             }
402              
403             # ------------------------------------------------------------------------
404             #
405             # Override in subclasses, if you like.
406             #
407       0 0   sub new_font_size { } #my( $self, $font_size_number ) = @_;
408       0 0   sub restore_font_size { } #my( $self, $font_size_number ) = @_;
409              
410             # ------------------------------------------------------------------------
411 0     0 0 0 sub q_start { shift->out(q<">); 1; }
  0         0  
412 0     0 0 0 sub q_end { shift->out(q<">); 1; }
  0         0  
413 0     0 0 0 sub sup_start { shift->{superscript}++; 1; }
  0         0  
414 0     0 0 0 sub sup_end { shift->{superscript}--; 1; }
  0         0  
415 0     0 0 0 sub sub_start { shift->{subscript}++; 1; }
  0         0  
416 0     0 0 0 sub sub_end { shift->{subscript}--; 1; }
  0         0  
417 0     0 0 0 sub strike_start { shift->{strikethrough}++; 1; }
  0         0  
418 0     0 0 0 sub strike_end { shift->{strikethrough}--; 1; }
  0         0  
419 0     0 0 0 sub s_start { shift->strike_start(@_); }
420 0     0 0 0 sub s_end { shift->strike_end(@_); }
421 0     0 0 0 sub dfn_start { 1; }
422 0     0 0 0 sub dfn_end { 1; }
423 0     0 0 0 sub abbr_start { 1; }
424 0     0 0 0 sub abbr_end { 1; }
425 0     0 0 0 sub acronym_start { 1; }
426 0     0 0 0 sub acronym_end { 1; }
427 0     0 0 0 sub span_start { 1; }
428 0     0 0 0 sub span_end { 1; }
429 0     0 0 0 sub ins_start { 1; }
430 0     0 0 0 sub ins_end { 1; }
431 0     0 0 0 sub del_start { 0; } # Don't render the del'd bits
432 0     0 0 0 sub del_end { 0; }
433              
434             # ------------------------------------------------------------------------
435             my @Size_magic_numbers = (
436             0.60, 0.75, 0.89, 1, 1.20, 1.50, 2.00, 3.00
437              
438             # #0 #1 #2 #3 #4 #5 #6 #7
439             #________________ - | + _________________________
440             # -3 -2 -1 0 +1 +2 +3 +4
441             );
442              
443             # ------------------------------------------------------------------------
444             sub scale_font_for {
445 0     0 0 0 my ( $self, $reference_size ) = @_;
446              
447             # Mozilla's source, at
448             # http://lxr.mozilla.org/seamonkey/source/content/html/style/src/nsStyleUtil.cpp#299
449             # says:
450             # static PRInt32 sFontSizeFactors[8] = { 60,75,89,100,120,150,200,300 };
451             #
452             # For comparison, Gisle's earlier HTML::FormatPS has:
453             # | # size 0 1 2 3 4 5 6 7
454             # | @FontSizes = ( 5, 6, 8, 10, 12, 14, 18, 24, 32);
455             # ...and gets different sizing via just a scaling factor.
456              
457 0 0       0 my $size_number = int( defined( $_[2] ) ? $_[2] : $self->{'font_size'}[-1] );
458              
459             # force the size_number into range:
460 0 0       0 $size_number =
    0          
461             ( $size_number < 0 ) ? 0
462             : ( $size_number > $#Size_magic_numbers ) ? $#Size_magic_numbers
463             : int($size_number);
464              
465 0         0 my $result = int( .5 + $reference_size * $Size_magic_numbers[$size_number] );
466              
467             ### Scale Font: sprintf("reference %s, size %s => %s", $reference_size, $size_number, $result);
468              
469 0         0 return $result;
470             }
471              
472             # ------------------------------------------------------------------------
473             # Aliases for logical markup:
474 5     5 0 29 sub strong_start { shift->b_start(@_) }
475 5     5 0 28 sub strong_end { shift->b_end(@_) }
476 0     0 0 0 sub cite_start { shift->i_start(@_) }
477 0     0 0 0 sub cite_end { shift->i_end(@_) }
478 5     5 0 28 sub em_start { shift->i_start(@_) }
479 5     5 0 26 sub em_end { shift->i_end(@_) }
480 0     0 0 0 sub code_start { shift->tt_start(@_) }
481 0     0 0 0 sub code_end { shift->tt_end(@_) }
482 0     0 0 0 sub kbd_start { shift->tt_start(@_) }
483 0     0 0 0 sub kbd_end { shift->tt_end(@_) }
484 0     0 0 0 sub samp_start { shift->tt_start(@_) }
485 0     0 0 0 sub samp_end { shift->tt_end(@_) }
486 0     0 0 0 sub var_start { shift->tt_start(@_) }
487 0     0 0 0 sub var_end { shift->tt_end(@_) }
488              
489             # ------------------------------------------------------------------------
490             sub p_start {
491 52     52 0 67 my $self = shift;
492              
493             #$self->adjust_lm(0); # assert new paragraph
494 52         116 $self->vspace(1);
495              
496             # assert one line's worth of vertical space at para-start
497 52         144 $self->out('');
498 52         133 1;
499             }
500              
501             # ------------------------------------------------------------------------
502             sub p_end {
503 52     52 0 116 shift->vspace(1); # assert one line's worth of vertical space at para-end
504             }
505              
506             # ------------------------------------------------------------------------
507             sub pre_start {
508 4     4 0 9 my $self = shift;
509              
510 4         18 $self->{pre}++;
511 4         14 $self->vspace(1); # assert one line's worth of vertical space at pre-start
512 4         10 1;
513             }
514              
515             # ------------------------------------------------------------------------
516             sub pre_end {
517 4     4 0 7 my $self = shift;
518              
519 4         10 $self->{pre}--; # assert one line's worth of vertical space at pre-end
520 4         14 $self->vspace(1);
521             }
522              
523             # ------------------------------------------------------------------------
524 0     0 0 0 sub listing_start { shift->pre_start(@_) }
525 0     0 0 0 sub listing_end { shift->pre_end(@_) }
526 0     0 0 0 sub xmp_start { shift->pre_start(@_) }
527 0     0 0 0 sub xmp_end { shift->pre_end(@_) }
528              
529             # ------------------------------------------------------------------------
530             sub blockquote_start {
531 3     3 0 8 my $self = shift;
532              
533 3         10 $self->vspace(1); # assert one line's worth of vertical space at blockquote-start
534 3         11 $self->adjust_lm(+2);
535 3         13 $self->adjust_rm(-2);
536 3         7 1;
537             }
538              
539             # ------------------------------------------------------------------------
540             sub blockquote_end {
541 3     3 0 15 my $self = shift;
542              
543 3         13 $self->vspace(1); # assert one line's worth of vertical space at blockquote-end
544 3         12 $self->adjust_lm(-2);
545 3         11 $self->adjust_rm(+2);
546             }
547              
548             # ------------------------------------------------------------------------
549             sub address_start {
550 0     0 0 0 my $self = shift;
551              
552 0         0 $self->vspace(1); # assert one line's worth of vertical space at address-para-start
553 0         0 $self->i_start(@_);
554 0         0 1;
555             }
556              
557             # ------------------------------------------------------------------------
558             sub address_end {
559 0     0 0 0 my $self = shift;
560              
561 0         0 $self->i_end(@_); # assert one line's worth of vertical space at address-para-end
562 0         0 $self->vspace(1);
563             }
564              
565             # ------------------------------------------------------------------------
566             # Handling of list elements
567             sub ul_start {
568 5     5 0 14 my $self = shift;
569              
570 5         15 $self->vspace(1); # assert one line's worth of vertical space at ul-start
571 5         21 $self->adjust_lm(+2);
572 5         14 1;
573             }
574              
575             # ------------------------------------------------------------------------
576             sub ul_end {
577 5     5 0 11 my $self = shift;
578              
579 5         19 $self->adjust_lm(-2); # assert one line's worth of vertical space at ul-end
580 5         14 $self->vspace(1);
581             }
582              
583             # ------------------------------------------------------------------------
584             sub li_start {
585 22     22 0 32 my $self = shift;
586              
587 22   50     66 $self->bullet( shift->attr('_bullet') || '' );
588 22         65 $self->adjust_lm(+2);
589 22         57 1;
590             }
591              
592             # ------------------------------------------------------------------------
593 14     14 0 43 sub bullet { shift->out(@_); }
594              
595             # ------------------------------------------------------------------------
596             sub li_end {
597 22     22 0 31 my $self = shift;
598              
599 22         52 $self->vspace(1);
600 22         75 $self->adjust_lm(-2);
601             }
602              
603             # ------------------------------------------------------------------------
604 0     0 0 0 sub menu_start { shift->ul_start(@_) }
605 0     0 0 0 sub menu_end { shift->ul_end(@_) }
606 0     0 0 0 sub dir_start { shift->ul_start(@_) }
607 0     0 0 0 sub dir_end { shift->ul_end(@_) }
608              
609             # ------------------------------------------------------------------------
610             sub ol_start {
611 5     5 0 41 my $self = shift;
612              
613 5         16 $self->vspace(1);
614 5         22 $self->adjust_lm(+2);
615 5         15 1;
616             }
617              
618             # ------------------------------------------------------------------------
619             sub ol_end {
620 5     5 0 10 my $self = shift;
621              
622 5         18 $self->adjust_lm(-2);
623 5         15 $self->vspace(1);
624             }
625              
626             # ------------------------------------------------------------------------
627             sub dl_start {
628 0     0 0 0 my $self = shift;
629              
630             # $self->adjust_lm(+2);
631 0         0 $self->vspace(1); # assert one line's worth of vertical space at dl-start
632 0         0 1;
633             }
634              
635             # ------------------------------------------------------------------------
636             sub dl_end {
637 0     0 0 0 my $self = shift;
638              
639             # $self->adjust_lm(-2);
640 0         0 $self->vspace(1); # assert one line's worth of vertical space at dl-end
641             }
642              
643             # ------------------------------------------------------------------------
644             sub dt_start {
645 0     0 0 0 my $self = shift;
646              
647 0         0 $self->vspace(1); # assert one line's worth of vertical space at dt-start
648 0         0 1;
649             }
650              
651             # ------------------------------------------------------------------------
652       0 0   sub dt_end { }
653              
654             # ------------------------------------------------------------------------
655             sub dd_start {
656 0     0 0 0 my $self = shift;
657              
658 0         0 $self->adjust_lm(+6);
659 0         0 $self->vspace(0); # hm, what's that do? nothing?
660 0         0 1;
661             }
662              
663             # ------------------------------------------------------------------------
664             sub dd_end {
665 0     0 0 0 my $self = shift;
666              
667 0         0 $self->vspace(1); # assert one line's worth of vertical space at dd-end
668 0         0 $self->adjust_lm(-6);
669             }
670              
671             # ------------------------------------------------------------------------
672              
673             # And now some things that are basically sane fall-throughs for classes
674             # that don't really handle tables or forms specially...
675              
676             # Things not formatted at all
677 0     0 0 0 sub input_start { 0; }
678 0     0 0 0 sub textarea_start { 0; }
679 0     0 0 0 sub select_start { 0; }
680 0     0 0 0 sub option_start { 0; }
681              
682             # ------------------------------------------------------------------------
683             sub td_start {
684 0     0 0 0 my $self = shift;
685              
686 0         0 push @{ $self->{'center_stack'} }, $self->{'center'};
  0         0  
687 0         0 $self->{center} = 0;
688              
689 0         0 $self->p_start(@_);
690             }
691              
692             # ------------------------------------------------------------------------
693             sub td_end {
694 0     0 0 0 my $self = shift;
695              
696 0         0 $self->{'center'} = pop @{ $self->{'center_stack'} };
  0         0  
697 0         0 $self->p_end(@_);
698             }
699              
700             # ------------------------------------------------------------------------
701             sub th_start {
702 0     0 0 0 my $self = shift;
703              
704 0         0 push @{ $self->{'center_stack'} }, $self->{'center'};
  0         0  
705 0         0 $self->{center} = 0;
706              
707 0         0 $self->p_start(@_);
708 0         0 $self->b_start(@_);
709             }
710              
711             # ------------------------------------------------------------------------
712             sub th_end {
713 0     0 0 0 my $self = shift;
714              
715 0         0 $self->b_end(@_);
716 0         0 $self->{'center'} = pop @{ $self->{'center_stack'} };
  0         0  
717 0         0 $self->p_end(@_);
718             }
719              
720             # But if you wanted to just SKIP tables and forms, you'd do this:
721             # sub table_start { shift->out('[TABLE NOT SHOWN]'); 0; }
722             # sub form_start { shift->out('[FORM NOT SHOWN]'); 0; }
723              
724             # ------------------------------------------------------------------------
725             sub textflow {
726 97     97 0 122 my $self = shift;
727              
728 97 100       262 if ( $self->{pre} ) {
    100          
729              
730             # Strip one leading and one trailing newline so that a
 
731             # tag can be placed on a line of its own without causing extra
732             # vertical space as part of the preformatted text.
733 4         23 $_[0] =~ s/\n$//;
734 4         17 $_[0] =~ s/^\n//;
735 4         43 $self->pre_out( $_[0] );
736             }
737             elsif ( $self->{blockquote} ) {
738 1         5 $_[0] =~ s/\A\s//;
739 1         6 $self->blockquote_out( $_[0] );
740             }
741             else {
742 92         1314 for ( split( /(\s+)/, $_[0] ) ) {
743 2983 100       5635 next unless length $_;
744 2970         7095 $self->out($_);
745             }
746             }
747             }
748              
749             # ------------------------------------------------------------------------
750             sub vspace {
751 189     189 0 286 my ( $self, $min, $add ) = @_;
752              
753             # This method sets the vspace attribute. When vspace is
754             # defined, then a new line should be started. If vspace
755             # is a nonzero value, then that should be taken as the
756             # number of lines to be skipped before following text
757             # is written out.
758             #
759             # You may think it odd to conflate the two concepts of
760             # ending this paragraph, and asserting how much space should
761             # follow; but it happens to work out pretty well.
762              
763 189         270 my $old = $self->{vspace};
764 189 100       342 if ( defined $old ) {
765 84         102 my $new = $old;
766 84   50     303 $new += $add || 0;
767 84 100       169 $new = $min if $new < $min;
768 84         141 $self->{vspace} = $new;
769             }
770             else {
771 105         151 $self->{vspace} = $min;
772             }
773             ### vspace: $self->{vspace}
774 189         406 $old;
775             }
776              
777             # ------------------------------------------------------------------------
778 1831     1831 0 2086 sub collect { push( @{ shift->{output} }, @_ ); }
  1831         5128  
779              
780             # ------------------------------------------------------------------------
781 0     0 0   sub out { confess "Must be overridden by subclass"; } # Output a word
782 0     0 0   sub pre_out { confess "Must be overridden by subclass"; }
783 0     0 0   sub adjust_lm { confess "Must be overridden by subclass"; }
784 0     0 0   sub adjust_rm { confess "Must be overridden by subclass"; }
785              
786             # ------------------------------------------------------------------------
787              
788              
789             1;
790              
791             __END__