home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _93a479049c639c46767a1d78dc5fcf51 < prev    next >
Text File  |  2000-03-15  |  5KB  |  241 lines

  1. package HTML::FormatText;
  2.  
  3. # $Id: FormatText.pm,v 1.16 1998/03/26 20:31:30 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 = HTML::FormatText->new(leftmargin => 0, rightmargin => 50);
  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. You might specify the following parameters when constructing the
  23. formatter:
  24.  
  25. =over 4
  26.  
  27. =item I<leftmargin> (alias I<lm>)
  28.  
  29. The column of the left margin. The default is 3.
  30.  
  31. =item I<rightmargin> (alias I<rm>)
  32.  
  33. The column of the right margin. The default is 72.
  34.  
  35. =back
  36.  
  37. =head1 SEE ALSO
  38.  
  39. L<HTML::Formatter>
  40.  
  41. =head1 COPYRIGHT
  42.  
  43. Copyright (c) 1995-1998 Gisle Aas. All rights reserved.
  44.  
  45. This library is free software; you can redistribute it and/or
  46. modify it under the same terms as Perl itself.
  47.  
  48. =head1 AUTHOR
  49.  
  50. Gisle Aas <aas@sn.no>
  51.  
  52. =cut
  53.  
  54. use strict;
  55. use vars qw(@ISA $VERSION);
  56.  
  57. require HTML::Formatter;
  58. @ISA = qw(HTML::Formatter);
  59.  
  60. $VERSION = sprintf("%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/);
  61.  
  62.  
  63. sub default_values
  64. {
  65.     (
  66.      lm =>  3, # left margin
  67.      rm => 72, # right margin (actually, maximum text width)
  68.     );
  69. }
  70.  
  71. sub configure
  72. {
  73.     my($self,$hash) = @_;
  74.     my $lm = $self->{lm};
  75.     my $rm = $self->{rm};
  76.  
  77.     $lm = delete $hash->{lm} if exists $hash->{lm};
  78.     $lm = delete $hash->{leftmargin} if exists $hash->{leftmargin};
  79.     $rm = delete $hash->{rm} if exists $hash->{rm};
  80.     $rm = delete $hash->{rightmargin} if exists $hash->{rightmargin};
  81.  
  82.     my $width = $rm - $lm;
  83.     if ($width < 1) {
  84.     warn "Bad margins, ignored" if $^W;
  85.     return;
  86.     }
  87.     if ($width < 20) {
  88.     warn "Page probably too narrow" if $^W;
  89.     }
  90.  
  91.     for (keys %$hash) {
  92.     warn "Unknown configure option '$_'" if $^W;
  93.     }
  94.  
  95.     $self->{lm} = $lm;
  96.     $self->{rm} = $rm;
  97.     $self;
  98. }
  99.  
  100.  
  101. sub begin
  102. {
  103.     my $self = shift;
  104.     $self->HTML::Formatter::begin;
  105.     $self->{curpos} = 0;  # current output position.
  106.     $self->{maxpos} = 0;  # highest value of $pos (used by header underliner)
  107.     $self->{hspace} = 0;  # horizontal space pending flag
  108. }
  109.  
  110.  
  111. sub end
  112. {
  113.     shift->collect("\n");
  114. }
  115.  
  116.  
  117. sub header_start
  118. {
  119.     my($self, $level, $node) = @_;
  120.     $self->vspace(1 + (6-$level) * 0.4);
  121.     $self->{maxpos} = 0;
  122.     1;
  123. }
  124.  
  125. sub header_end
  126. {
  127.     my($self, $level, $node) = @_;
  128.     if ($level <= 2) {
  129.     my $line;
  130.     $line = '=' if $level == 1;
  131.     $line = '-' if $level == 2;
  132.     $self->vspace(0);
  133.     $self->out($line x ($self->{maxpos} - $self->{lm}));
  134.     }
  135.     $self->vspace(1);
  136.     1;
  137. }
  138.  
  139.  
  140. sub hr_start
  141. {
  142.     my $self = shift;
  143.     $self->vspace(1);
  144.     $self->out('-' x ($self->{rm} - $self->{lm}));
  145.     $self->vspace(1);
  146. }
  147.  
  148.  
  149. sub pre_out
  150. {
  151.     my $self = shift;
  152.     # should really handle bold/italic etc.
  153.     if (defined $self->{vspace}) {
  154.     if ($self->{out}) {
  155.         $self->nl() while $self->{vspace}-- >= 0;
  156.         $self->{vspace} = undef;
  157.     }
  158.     }
  159.     my $indent = ' ' x $self->{lm};
  160.     my $pre = shift;
  161.     $pre =~ s/^/$indent/mg;
  162.     $self->collect($pre);
  163.     $self->{out}++;
  164. }
  165.  
  166.  
  167. sub out
  168. {
  169.     my $self = shift;
  170.     my $text = shift;
  171.  
  172.     if ($text =~ /^\s*$/) {
  173.     $self->{hspace} = 1;
  174.     return;
  175.     }
  176.  
  177.     if (defined $self->{vspace}) {
  178.     if ($self->{out}) {
  179.         $self->nl while $self->{vspace}-- >= 0;
  180.         }
  181.     $self->goto_lm;
  182.     $self->{vspace} = undef;
  183.     $self->{hspace} = 0;
  184.     }
  185.  
  186.     if ($self->{hspace}) {
  187.     if ($self->{curpos} + length($text) > $self->{rm}) {
  188.         # word will not fit on line; do a line break
  189.         $self->nl;
  190.         $self->goto_lm;
  191.     } else {
  192.         # word fits on line; use a space
  193.         $self->collect(' ');
  194.         ++$self->{curpos};
  195.     }
  196.     $self->{hspace} = 0;
  197.     }
  198.  
  199.     $self->collect($text);
  200.     my $pos = $self->{curpos} += length $text;
  201.     $self->{maxpos} = $pos if $self->{maxpos} < $pos;
  202.     $self->{'out'}++;
  203. }
  204.  
  205.  
  206. sub goto_lm
  207. {
  208.     my $self = shift;
  209.     my $pos = $self->{curpos};
  210.     my $lm  = $self->{lm};
  211.     if ($pos < $lm) {
  212.     $self->{curpos} = $lm;
  213.     $self->collect(" " x ($lm - $pos));
  214.     }
  215. }
  216.  
  217.  
  218. sub nl
  219. {
  220.     my $self = shift;
  221.     $self->{'out'}++;
  222.     $self->{curpos} = 0;
  223.     $self->collect("\n");
  224. }
  225.  
  226.  
  227. sub adjust_lm
  228. {
  229.     my $self = shift;
  230.     $self->{lm} += $_[0];
  231.     $self->goto_lm;
  232. }
  233.  
  234.  
  235. sub adjust_rm
  236. {
  237.     shift->{rm} += $_[0];
  238. }
  239.  
  240. 1;
  241.