lib/Text/Wrap.pm

   1 package Text::Wrap;
   2
   3 require Exporter;
   4
   5 @ISA = (Exporter);
   6 @EXPORT = qw(wrap);
   7 @EXPORT_OK = qw($columns);
   8
   9 $VERSION = 97.011701;
  10
  11 use vars qw($VERSION $columns $debug);
  12 use strict;
  13
  14 BEGIN   {
  15         $columns = 76;  # <= screen width
  16         $debug = 0;
  17 }
  18
  19 use Text::Tabs qw(expand unexpand);
  20
  21 sub wrap
  22 {
  23         my ($ip, $xp, @t) = @_;
  24
  25         my $r = "";
  26         my $t = expand(join(" ",@t));
  27         my $lead = $ip;
  28         my $ll = $columns - length(expand($lead)) - 1;
  29         my $nl = "";
  30
  31         # remove up to a line length of things that aren't
  32         # new lines and tabs.
  33
  34         if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm) {
  35
  36                 # accept it.
  37                 $r .= unexpand($lead . $1);
  38
  39                 # recompute the leader
  40                 $lead = $xp;
  41                 $ll = $columns - length(expand($lead)) - 1;
  42                 $nl = $2;
  43
  44                 # repeat the above until there's none left
  45                 while ($t) {
  46                         if ( $t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm ) {
  47                                 print "\$2 is '$2'\n" if $debug;
  48                                 $nl = $2;
  49                                 $r .= unexpand("\n" . $lead . $1);
  50                         } elsif ($t =~ s/^([^\n]{$ll})//) {
  51                                 $nl = "\n";
  52                                 $r .= unexpand("\n" . $lead . $1);
  53                         }
  54                 }
  55                 $r .= $nl;
  56         }
  57
  58         die "couldn't wrap '$t'"
  59                 if length($t) > $ll;
  60
  61         print "-----------$r---------\n" if $debug;
  62
  63         print "Finish up with '$lead', '$t'\n" if $debug;
  64
  65         $r .= $lead . $t if $t ne "";
  66
  67         print "-----------$r---------\n" if $debug;;
  68         return $r;
  69 }
  70
  71 1;
  72 __END__
  73
  74 =head1 NAME
  75
  76 Text::Wrap - line wrapping to form simple paragraphs
  77
  78 =head1 SYNOPSIS
  79
  80         use Text::Wrap
  81
  82         print wrap($initial_tab, $subsequent_tab, @text);
  83
  84         use Text::Wrap qw(wrap $columns);
  85
  86         $columns = 132;
  87
  88 =head1 DESCRIPTION
  89
  90 Text::Wrap::wrap() is a very simple paragraph formatter.  It formats a
  91 single paragraph at a time by breaking lines at word boundries.
  92 Indentation is controlled for the first line ($initial_tab) and
  93 all subsquent lines ($subsequent_tab) independently.  $Text::Wrap::columns
  94 should be set to the full width of your output device.
  95
  96 =head1 EXAMPLE
  97
  98         print wrap("\t","","This is a bit of text that forms
  99                 a normal book-style paragraph");
 100
 101 =head1 BUGS
 102
 103 It's not clear what the correct behavior should be when Wrap() is
 104 presented with a word that is longer than a line.  The previous
 105 behavior was to die.  Now the word is split at line-length.
 106
 107 =head1 AUTHOR
 108
 109 David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
 110 others.
 111
 112 =cut
 113
 114 Latest change by Andreas Koenig <k@anna.in-berlin.de> - 1/17/97
 115
 116         print fill($initial_tab, $subsequent_tab, @text);
 117
 118         print fill("", "", `cat book`);
 119
 120 Text::Wrap::fill() is a simple multi-paragraph formatter.  It formats
 121 each paragraph separately and then joins them together when it's done.  It
 122 will destory any whitespace in the original text.  It breaks text into
 123 paragraphs by looking for whitespace after a newline.  In other respects
 124 it acts like wrap().
 125
 126 # Tim Pierce did a faster version of this:
 127
 128 sub fill
 129 {
 130         my ($ip, $xp, @raw) = @_;
 131         my @para;
 132         my $pp;
 133
 134         for $pp (split(/\n\s+/, join("\n",@raw))) {
 135                 $pp =~ s/\s+/ /g;
 136                 my $x = wrap($ip, $xp, $pp);
 137                 push(@para, $x);
 138         }
 139
 140         # if paragraph_indent is the same as line_indent,
 141         # separate paragraphs with blank lines
 142
 143         return join ($ip eq $xp ? "\n\n" : "\n", @para);
 144 }
 145