home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / HTML / FormatText.pm < prev    next >
Text File  |  1996-08-01  |  3KB  |  179 lines

  1. package HTML::FormatText;
  2.  
  3. # $Id: FormatText.pm,v 1.12 1996/06/09 14:49:58 aas Exp $
  4.  
  5. =head1 NAME
  6.  
  7. HTML::FormatText - Format HTML as text
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.  require HTML::FormatText;
  12.  $html = parse_htmlfile("test.html");
  13.  $formatter = new HTML::FormatText;
  14.  print $formatter->format($html);
  15.  
  16. =head1 DESCRIPTION
  17.  
  18. The HTML::FormatText is a formatter that outputs plain latin1 text.
  19. All character attributes (bold/italic/underline) are ignored.
  20. Formatting of HTML tables and forms is not implemented.
  21.  
  22. =head1 SEE ALSO
  23.  
  24. L<HTML::Formatter>
  25.  
  26. =head1 COPYRIGHT
  27.  
  28. Copyright (c) 1995 Gisle Aas. All rights reserved.
  29.  
  30. This library is free software; you can redistribute it and/or
  31. modify it under the same terms as Perl itself.
  32.  
  33. =head1 AUTHOR
  34.  
  35. Gisle Aas <aas@oslonett.no>
  36.  
  37. =cut
  38.  
  39. require HTML::Formatter;
  40.  
  41. @ISA = qw(HTML::Formatter);
  42.  
  43. use strict;
  44.  
  45. sub begin
  46. {
  47.     my $self = shift;
  48.     $self->HTML::Formatter::begin;
  49.     $self->{lm}  =    3;  # left margin
  50.     $self->{rm}  =   70;  # right margin
  51.     $self->{curpos} = 0;  # current output position.
  52.     $self->{maxpos} = 0;  # highest value of $pos (used by header underliner)
  53. }
  54.  
  55. sub end
  56. {
  57.     shift->collect("\n");
  58. }
  59.  
  60.  
  61. sub header_start
  62. {
  63.     my($self, $level, $node) = @_;
  64.     $self->vspace(1 + (6-$level) * 0.4);
  65.     $self->{maxpos} = 0;
  66.     $self->eat_leading_space;
  67.     1;
  68. }
  69.  
  70. sub header_end
  71. {
  72.     my($self, $level, $node) = @_;
  73.     if ($level <= 2) {
  74.     my $line;
  75.     $line = '=' if $level == 1;
  76.     $line = '-' if $level == 2;
  77.     $self->vspace(0);
  78.     $self->out($line x ($self->{maxpos} - $self->{lm}));
  79.     }
  80.     $self->vspace(1);
  81.     1;
  82. }
  83.  
  84. sub hr_start
  85. {
  86.     my $self = shift;
  87.     $self->vspace(1);
  88.     $self->out('-' x ($self->{rm} - $self->{lm}));
  89.     $self->vspace(1);
  90. }
  91.  
  92. sub pre_out
  93. {
  94.     my $self = shift;
  95.     # should really handle bold/italic etc.
  96.     if (defined $self->{vspace}) {
  97.     if ($self->{out}) {
  98.         $self->nl() while $self->{vspace}-- > -0.5;
  99.         $self->{vspace} = undef;
  100.     }
  101.     }
  102.     my $indent = ' ' x $self->{lm};
  103.     my $pre = shift;
  104.     $pre =~ s/\n/\n$indent/g;
  105.     $self->collect($pre);
  106.     $self->{out}++;
  107. }
  108.  
  109. sub out
  110. {
  111.     my $self = shift;
  112.     my $text = shift;
  113.  
  114.     if (defined $self->{vspace}) {
  115.     if ($self->{out}) {
  116.         $self->nl while $self->{vspace}-- >= 0;
  117.         $self->goto_lm;
  118.     } else {
  119.         $self->goto_lm;
  120.     }
  121.     $self->{vspace} = undef;
  122.     }
  123.  
  124.     if ($self->{curpos} > $self->{rm}) { # line is too long, break it
  125.     return if $text =~ /^\s*$/;  # white space at eol is ok
  126.     $self->nl;
  127.     $self->goto_lm;
  128.     }
  129.  
  130.     if ($self->{pending_space}) {
  131.     $self->{pending_space} = 0;
  132.     $self->collect(' ');
  133.     my $pos = ++$self->{curpos};
  134.     $self->{maxpos} = $pos if $self->{maxpos} < $pos;
  135.     }
  136.  
  137.     $self->{pending_space} = 1 if $text =~ s/\s+$//;
  138.     return unless length $text;
  139.  
  140.     $self->collect($text);
  141.     my $pos = $self->{curpos} += length $text;
  142.     $self->{maxpos} = $pos if $self->{maxpos} < $pos;
  143.     $self->{'out'}++;
  144. }
  145.  
  146. sub goto_lm
  147. {
  148.     my $self = shift;
  149.     my $pos = $self->{curpos};
  150.     my $lm  = $self->{lm};
  151.     if ($pos < $lm) {
  152.     $self->{curpos} = $lm;
  153.     $self->collect(" " x ($lm - $pos));
  154.     }
  155. }
  156.  
  157. sub nl
  158. {
  159.     my $self = shift;
  160.     $self->{'out'}++;
  161.     $self->{pending_space} = 0;
  162.     $self->{curpos} = 0;
  163.     $self->collect("\n");
  164. }
  165.  
  166. sub adjust_lm
  167. {
  168.     my $self = shift;
  169.     $self->{lm} += $_[0];
  170.     $self->goto_lm;
  171. }
  172.  
  173. sub adjust_rm
  174. {
  175.     shift->{rm} += $_[0];
  176. }
  177.  
  178. 1;
  179.