home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / HTML / Formatter.pm < prev    next >
Text File  |  1997-10-12  |  8KB  |  539 lines

  1. package HTML::Formatter;
  2.  
  3. # $Id: Formatter.pm,v 1.17 1997/10/12 20:27:13 aas Exp $
  4.  
  5. =head1 NAME
  6.  
  7. HTML::Formatter - Base class for HTML formatters
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.  package HTML::FormatXX;
  12.  require HTML::Formatter;
  13.  @ISA=qw(HTML::Formatter);
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. HTML formatters are able to format a HTML syntax tree into various
  18. printable formats.  Different formatters produce output for different
  19. output media.  Common for all formatters are that they will return the
  20. formatted output when the format() method is called.  Format() takes a
  21. HTML::Element as parameter.
  22.  
  23. =head1 SEE ALSO
  24.  
  25. L<HTML::FormatText>, L<HTML::FormatPS>, L<HTML::Element>
  26.  
  27. =head1 COPYRIGHT
  28.  
  29. Copyright (c) 1995-1997 Gisle Aas. All rights reserved.
  30.  
  31. This library is free software; you can redistribute it and/or
  32. modify it under the same terms as Perl itself.
  33.  
  34. =head1 AUTHOR
  35.  
  36. Gisle Aas <aas@oslonett.no>
  37.  
  38. =cut
  39.  
  40.  
  41. require HTML::Element;
  42.  
  43. use strict;
  44. use Carp;
  45. use UNIVERSAL qw(can);
  46.  
  47. sub new
  48. {
  49.     my($class,%arg) = @_;
  50.     my $self = bless { $class->default_values }, $class;
  51.     $self->configure(\%arg) if scalar(%arg);
  52.     $self;
  53. }
  54.  
  55. sub default_values
  56. {
  57.     ();
  58. }
  59.  
  60. sub configure
  61. {
  62.     my($self, $arg) = @_;
  63.     for (keys %$arg) {
  64.     warn "Unknown configure argument '$_'" if $^W;
  65.     }
  66.     $self;
  67. }
  68.  
  69. sub format
  70. {
  71.     my($self, $html) = @_;
  72.     $self->begin();
  73.     $html->traverse(
  74.     sub {
  75.         my($node, $start, $depth) = @_;
  76.         if (ref $node) {
  77.         my $tag = $node->tag;
  78.         my $func = $tag . '_' . ($start ? "start" : "end");
  79.         # Use UNIVERSAL::can so that we can recover if
  80.         # a handler is not defined for the tag.
  81.         if (can($self, $func)) {
  82.             return $self->$func($node);
  83.         } else {
  84.             return 1;
  85.         }
  86.         } else {
  87.         $self->textflow($node);
  88.         }
  89.         1;
  90.     }
  91.      );
  92.     $self->end();
  93.     join('', @{$self->{output}});
  94. }
  95.  
  96. sub begin
  97. {
  98.     my $self = shift;
  99.  
  100.     # Flags
  101.     $self->{anchor}    = 0;
  102.     $self->{underline} = 0;
  103.     $self->{bold}      = 0;
  104.     $self->{italic}    = 0;
  105.     $self->{center}    = 0;
  106.     $self->{nobr}      = 0;
  107.  
  108.     $self->{font_size}     = [3];   # last element is current size
  109.     $self->{basefont_size} = [3];
  110.  
  111.     $self->{markers} = [];          # last element is current marker
  112.     $self->{vspace} = undef;        # vertical space (dimension)
  113.  
  114.     $self->{output} = [];
  115. }
  116.  
  117. sub end
  118. {
  119. }
  120.  
  121. sub html_start { 1; }  sub html_end {}
  122. sub head_start { 0; }
  123. sub body_start { 1; }  sub body_end {}
  124.  
  125. sub header_start
  126. {
  127.     my($self, $level, $node) = @_;
  128.     my $align = $node->attr('align');
  129.     if (defined($align) && lc($align) eq 'center') {
  130.     $self->{center}++;
  131.     }
  132.     1,
  133. }
  134.  
  135. sub header_end
  136. {
  137.     my($self, $level, $node) = @_;
  138.     my $align = $node->attr('align');
  139.     if (defined($align) && lc($align) eq 'center') {
  140.     $self->{center}--;
  141.     }
  142. }
  143.  
  144. sub h1_start { shift->header_start(1, @_) }
  145. sub h2_start { shift->header_start(2, @_) }
  146. sub h3_start { shift->header_start(3, @_) }
  147. sub h4_start { shift->header_start(4, @_) }
  148. sub h5_start { shift->header_start(5, @_) }
  149. sub h6_start { shift->header_start(6, @_) }
  150.  
  151. sub h1_end   { shift->header_end(1, @_) }
  152. sub h2_end   { shift->header_end(2, @_) }
  153. sub h3_end   { shift->header_end(3, @_) }
  154. sub h4_end   { shift->header_end(4, @_) }
  155. sub h5_end   { shift->header_end(5, @_) }
  156. sub h6_end   { shift->header_end(6, @_) }
  157.  
  158. sub br_start
  159. {
  160.     my $self = shift;
  161.     $self->vspace(0);
  162.  
  163. }
  164.  
  165. sub hr_start
  166. {
  167.     my $self = shift;
  168.     $self->vspace(1);
  169. }
  170.  
  171. sub img_start
  172. {
  173.     shift->out(shift->attr('alt') || "[IMAGE]");
  174. }
  175.  
  176. sub a_start
  177. {
  178.     shift->{anchor}++;
  179.     1;
  180. }
  181.  
  182. sub a_end
  183. {
  184.     shift->{anchor}--;
  185. }
  186.  
  187. sub u_start
  188. {
  189.     shift->{underline}++;
  190.     1;
  191. }
  192.  
  193. sub u_end
  194. {
  195.     shift->{underline}--;
  196. }
  197.  
  198. sub b_start
  199. {
  200.     shift->{bold}++;
  201.     1;
  202. }
  203.  
  204. sub b_end
  205. {
  206.     shift->{bold}--;
  207. }
  208.  
  209. sub tt_start
  210. {
  211.     shift->{teletype}++;
  212.     1;
  213. }
  214.  
  215. sub tt_end
  216. {
  217.     shift->{teletype}--;
  218. }
  219.  
  220. sub i_start
  221. {
  222.     shift->{italic}++;
  223.     1;
  224. }
  225.  
  226. sub i_end
  227. {
  228.     shift->{italic}--;
  229. }
  230.  
  231. sub center_start
  232. {
  233.     shift->{center}++;
  234.     1;
  235. }
  236.  
  237. sub center_end
  238. {
  239.     shift->{center}--;
  240. }
  241.  
  242. sub nobr_start
  243. {
  244.     shift->{nobr}++;
  245.     1;
  246. }
  247.  
  248. sub nobr_end
  249. {
  250.     shift->{nobr}--;
  251. }
  252.  
  253. sub wbr_start
  254. {
  255.     1;
  256. }
  257.  
  258. sub font_start
  259. {
  260.     my($self, $elem) = @_;
  261.     my $size = $elem->attr('size');
  262.     return 1 unless defined $size;
  263.     if ($size =~ /^\s*[+\-]/) {
  264.     my $base = $self->{basefont_size}[-1];
  265.     $size = $base + $size;
  266.     }
  267.     push(@{$self->{font_size}}, $size);
  268.     1;
  269. }
  270.  
  271. sub font_end
  272. {
  273.     my($self, $elem) = @_;
  274.     my $size = $elem->attr('size');
  275.     return unless defined $size;
  276.     pop(@{$self->{font_size}});
  277. }
  278.  
  279. sub basefont_start
  280. {
  281.     my($self, $elem) = @_;
  282.     my $size = $elem->attr('size');
  283.     return unless defined $size;
  284.     push(@{$self->{basefont_size}}, $size);
  285.     1;
  286. }
  287.  
  288. sub basefont_end
  289. {
  290.     my($self, $elem) = @_;
  291.     my $size = $elem->attr('size');
  292.     return unless defined $size;
  293.     pop(@{$self->{basefont_size}});
  294. }
  295.  
  296. # Aliases for logical markup
  297. BEGIN {
  298.     *cite_start   = \&i_start;
  299.     *cite_end     = \&i_end;
  300.     *code_start   = \&tt_start;
  301.     *code_end     = \&tt_end;
  302.     *em_start     = \&i_start;
  303.     *em_end       = \&i_end;
  304.     *kbd_start    = \&tt_start;
  305.     *kbd_end      = \&tt_end;
  306.     *samp_start   = \&tt_start;
  307.     *samp_end     = \&tt_end;
  308.     *strong_start = \&b_start;
  309.     *strong_end   = \&b_end;
  310.     *var_start    = \&tt_start;
  311.     *var_end      = \&tt_end;
  312. }
  313.  
  314. sub p_start
  315. {
  316.     my $self = shift;
  317.     $self->vspace(1);
  318.     1;
  319. }
  320.  
  321. sub p_end
  322. {
  323.     shift->vspace(1);
  324. }
  325.  
  326. sub pre_start
  327. {
  328.     my $self = shift;
  329.     $self->{pre}++;
  330.     $self->vspace(1);
  331.     1;
  332. }
  333.  
  334. sub pre_end
  335. {
  336.     my $self = shift;
  337.     $self->{pre}--;
  338.     $self->vspace(1);
  339. }
  340.  
  341. BEGIN {
  342.     *listing_start = \&pre_start;
  343.     *listing_end   = \&pre_end;
  344.     *xmp_start     = \&pre_start;
  345.     *xmp_end       = \&pre_end;
  346. }
  347.  
  348. sub blockquote_start
  349. {
  350.     my $self = shift;
  351.     $self->vspace(1);
  352.     $self->adjust_lm( +2 );
  353.     $self->adjust_rm( -2 );
  354.     1;
  355. }
  356.  
  357. sub blockquote_end
  358. {
  359.     my $self = shift;
  360.     $self->vspace(1);
  361.     $self->adjust_lm( -2 );
  362.     $self->adjust_rm( +2 );
  363. }
  364.  
  365. sub address_start
  366. {
  367.     my $self = shift;
  368.     $self->vspace(1);
  369.     $self->i_start(@_);
  370.     1;
  371. }
  372.  
  373. sub address_end
  374. {
  375.     my $self = shift;
  376.     $self->i_end(@_);
  377.     $self->vspace(1);
  378. }
  379.  
  380. # Handling of list elements
  381.  
  382. sub ul_start
  383. {
  384.     my $self = shift;
  385.     $self->vspace(1);
  386.     push(@{$self->{markers}}, "*");
  387.     $self->adjust_lm( +2 );
  388.     1;
  389. }
  390.  
  391. sub ul_end
  392. {
  393.     my $self = shift;
  394.     pop(@{$self->{markers}});
  395.     $self->adjust_lm( -2 );
  396.     $self->vspace(1);
  397. }
  398.  
  399. sub li_start
  400. {
  401.     my $self = shift;
  402.     $self->bullet($self->{markers}[-1]);
  403.     $self->adjust_lm(+2);
  404.     1;
  405. }
  406.  
  407. sub bullet
  408. {
  409.     shift->out(@_);
  410. }
  411.  
  412. sub li_end
  413. {
  414.     my $self = shift;
  415.     $self->vspace(1);
  416.     $self->adjust_lm( -2);
  417.     my $markers = $self->{markers};
  418.     if ($markers->[-1] =~ /^\d+/) {
  419.     # increment ordered markers
  420.     $markers->[-1]++;
  421.     }
  422. }
  423.  
  424. BEGIN {
  425.     *menu_start = \&ul_start;
  426.     *menu_end   = \&ul_end;
  427.     *dir_start  = \&ul_start;
  428.     *dir_end    = \&ul_end;
  429. }
  430.  
  431. sub ol_start
  432. {
  433.     my $self = shift;
  434.  
  435.     $self->vspace(1);
  436.     push(@{$self->{markers}}, 1);
  437.     $self->adjust_lm(+2);
  438.     1;
  439. }
  440.  
  441. sub ol_end
  442. {
  443.     my $self = shift;
  444.     $self->adjust_lm(-2);
  445.     pop(@{$self->{markers}});
  446.     $self->vspace(1);
  447. }
  448.  
  449.  
  450. sub dl_start
  451. {
  452.     my $self = shift;
  453.     $self->adjust_lm(+2);
  454.     $self->vspace(1);
  455.     1;
  456. }
  457.  
  458. sub dl_end
  459. {
  460.     my $self = shift;
  461.     $self->adjust_lm(-2);
  462.     $self->vspace(1);
  463. }
  464.  
  465. sub dt_start
  466. {
  467.     my $self = shift;
  468.     $self->vspace(1);
  469.     1;
  470. }
  471.  
  472. sub dt_end
  473. {
  474. }
  475.  
  476. sub dd_start
  477. {
  478.     my $self = shift;
  479.     $self->adjust_lm(+6);
  480.     $self->vspace(0);
  481.     1;
  482. }
  483.  
  484. sub dd_end
  485. {
  486.     shift->adjust_lm(-6);
  487. }
  488.  
  489.  
  490. # Things not formated at all
  491. sub table_start { shift->out('[TABLE NOT SHOWN]'); 0; }
  492. sub form_start  { shift->out('[FORM NOT SHOWN]');  0; }
  493.  
  494.  
  495.  
  496. sub textflow
  497. {
  498.     my $self = shift;
  499.     if ($self->{pre}) {
  500.     # strip leading and trailing newlines so that the <pre> tags 
  501.     # may be placed on lines of their own without causing extra
  502.     # vertical space as part of the preformatted text
  503.     $_[0] =~ s/\n$//;
  504.     $_[0] =~ s/^\n//;
  505.     $self->pre_out($_[0]);
  506.     } else {
  507.     for (split(/(\s+)/, $_[0])) {
  508.         next unless length $_;
  509.         $self->out($_);
  510.     }
  511.     }
  512. }
  513.  
  514.  
  515.  
  516. sub vspace
  517. {
  518.     my($self, $new) = @_;
  519.     return if defined $self->{vspace} and $self->{vspace} > $new;
  520.     $self->{vspace} = $new;
  521. }
  522.  
  523. sub collect
  524. {
  525.     push(@{shift->{output}}, @_);
  526. }
  527.  
  528. sub out
  529. {
  530.     confess "Must be overridden my subclass";
  531. }
  532.  
  533. sub pre_out
  534. {
  535.     confess "Must be overridden my subclass";
  536. }
  537.  
  538. 1;
  539.