lib/Text/Wrap.pm

   1 package Text::Wrap;
   2
   3 require Exporter;
   4
   5 @ISA = qw(Exporter);
   6 @EXPORT = qw(wrap fill);
   7 @EXPORT_OK = qw($columns $break $huge);
   8
   9 $VERSION = 2006.0711;
  10
  11 use vars qw($VERSION $columns $debug $break $huge $unexpand $tabstop
  12         $separator $separator2);
  13 use strict;
  14
  15 BEGIN   {
  16         $columns = 76;  # <= screen width
  17         $debug = 0;
  18         $break = '\s';
  19         $huge = 'wrap'; # alternatively: 'die' or 'overflow'
  20         $unexpand = 1;
  21         $tabstop = 8;
  22         $separator = "\n";
  23         $separator2 = undef;
  24 }
  25
  26 use Text::Tabs qw(expand unexpand);
  27
  28 sub wrap
  29 {
  30         my ($ip, $xp, @t) = @_;
  31
  32         local($Text::Tabs::tabstop) = $tabstop;
  33         my $r = "";
  34         my $tail = pop(@t);
  35         my $t = expand(join("", (map { /\s+\z/ ? ( $_ ) : ($_, ' ') } @t), $tail));
  36         my $lead = $ip;
  37         my $ll = $columns - length(expand($ip)) - 1;
  38         $ll = 0 if $ll < 0;
  39         my $nll = $columns - length(expand($xp)) - 1;
  40         my $nl = "";
  41         my $remainder = "";
  42
  43         use re 'taint';
  44
  45         pos($t) = 0;
  46         while ($t !~ /\G(?:$break)*\Z/gc) {
  47                 if ($t =~ /\G([^\n]{0,$ll})($break|\n+|\z)/xmgc) {
  48                         $r .= $unexpand
  49                                 ? unexpand($nl . $lead . $1)
  50                                 : $nl . $lead . $1;
  51                         $remainder = $2;
  52                 } elsif ($huge eq 'wrap' && $t =~ /\G([^\n]{$ll})/gc) {
  53                         $r .= $unexpand
  54                                 ? unexpand($nl . $lead . $1)
  55                                 : $nl . $lead . $1;
  56                         $remainder = defined($separator2) ? $separator2 : $separator;
  57                 } elsif ($huge eq 'overflow' && $t =~ /\G([^\n]*?)($break|\n+|\z)/xmgc) {
  58                         $r .= $unexpand
  59                                 ? unexpand($nl . $lead . $1)
  60                                 : $nl . $lead . $1;
  61                         $remainder = $2;
  62                 } elsif ($huge eq 'die') {
  63                         die "couldn't wrap '$t'";
  64                 } elsif ($columns < 2) {
  65                         warn "Increasing \$Text::Wrap::columns from $columns to 2";
  66                         $columns = 2;
  67                         return ($ip, $xp, @t);
  68                 } else {
  69                         die "This shouldn't happen";
  70                 }
  71
  72                 $lead = $xp;
  73                 $ll = $nll;
  74                 $nl = defined($separator2)
  75                         ? ($remainder eq "\n"
  76                                 ? "\n"
  77                                 : $separator2)
  78                         : $separator;
  79         }
  80         $r .= $remainder;
  81
  82         print "-----------$r---------\n" if $debug;
  83
  84         print "Finish up with '$lead'\n" if $debug;
  85
  86         $r .= $lead . substr($t, pos($t), length($t)-pos($t))
  87                 if pos($t) ne length($t);
  88
  89         print "-----------$r---------\n" if $debug;;
  90
  91         return $r;
  92 }
  93
  94 sub fill
  95 {
  96         my ($ip, $xp, @raw) = @_;
  97         my @para;
  98         my $pp;
  99
 100         for $pp (split(/\n\s+/, join("\n",@raw))) {
 101                 $pp =~ s/\s+/ /g;
 102                 my $x = wrap($ip, $xp, $pp);
 103                 push(@para, $x);
 104         }
 105
 106         # if paragraph_indent is the same as line_indent,
 107         # separate paragraphs with blank lines
 108
 109         my $ps = ($ip eq $xp) ? "\n\n" : "\n";
 110         return join ($ps, @para);
 111 }
 112
 113 1;
 114 __END__
 115
 116 =head1 NAME
 117
 118 Text::Wrap - line wrapping to form simple paragraphs
 119
 120 =head1 SYNOPSIS
 121
 122 B<Example 1>
 123
 124         use Text::Wrap
 125
 126         $initial_tab = "\t";    # Tab before first line
 127         $subsequent_tab = "";   # All other lines flush left
 128
 129         print wrap($initial_tab, $subsequent_tab, @text);
 130         print fill($initial_tab, $subsequent_tab, @text);
 131
 132         $lines = wrap($initial_tab, $subsequent_tab, @text);
 133
 134         @paragraphs = fill($initial_tab, $subsequent_tab, @text);
 135
 136 B<Example 2>
 137
 138         use Text::Wrap qw(wrap $columns $huge);
 139
 140         $columns = 132;         # Wrap at 132 characters
 141         $huge = 'die';
 142         $huge = 'wrap';
 143         $huge = 'overflow';
 144
 145 B<Example 3>
 146
 147         use Text::Wrap
 148
 149         $Text::Wrap::columns = 72;
 150         print wrap('', '', @text);
 151
 152 =head1 DESCRIPTION
 153
 154 C<Text::Wrap::wrap()> is a very simple paragraph formatter.  It formats a
 155 single paragraph at a time by breaking lines at word boundaries.
 156 Indentation is controlled for the first line (C<$initial_tab>) and
 157 all subsequent lines (C<$subsequent_tab>) independently.  Please note:
 158 C<$initial_tab> and C<$subsequent_tab> are the literal strings that will
 159 be used: it is unlikely you would want to pass in a number.
 160
 161 Text::Wrap::fill() is a simple multi-paragraph formatter.  It formats
 162 each paragraph separately and then joins them together when it's done.  It
 163 will destroy any whitespace in the original text.  It breaks text into
 164 paragraphs by looking for whitespace after a newline.  In other respects
 165 it acts like wrap().
 166
 167 Both C<wrap()> and C<fill()> return a single string.
 168
 169 =head1 OVERRIDES
 170
 171 C<Text::Wrap::wrap()> has a number of variables that control its behavior.
 172 Because other modules might be using C<Text::Wrap::wrap()> it is suggested
 173 that you leave these variables alone!  If you can't do that, then
 174 use C<local($Text::Wrap::VARIABLE) = YOURVALUE> when you change the
 175 values so that the original value is restored.  This C<local()> trick
 176 will not work if you import the variable into your own namespace.
 177
 178 Lines are wrapped at C<$Text::Wrap::columns> columns.  C<$Text::Wrap::columns>
 179 should be set to the full width of your output device.  In fact,
 180 every resulting line will have length of no more than C<$columns - 1>.
 181
 182 It is possible to control which characters terminate words by
 183 modifying C<$Text::Wrap::break>. Set this to a string such as
 184 C<'[\s:]'> (to break before spaces or colons) or a pre-compiled regexp
 185 such as C<qr/[\s']/> (to break before spaces or apostrophes). The
 186 default is simply C<'\s'>; that is, words are terminated by spaces.
 187 (This means, among other things, that trailing punctuation  such as
 188 full stops or commas stay with the word they are "attached" to.)
 189
 190 Beginner note: In example 2, above C<$columns> is imported into
 191 the local namespace, and set locally.  In example 3,
 192 C<$Text::Wrap::columns> is set in its own namespace without importing it.
 193
 194 C<Text::Wrap::wrap()> starts its work by expanding all the tabs in its
 195 input into spaces.  The last thing it does it to turn spaces back
 196 into tabs.  If you do not want tabs in your results, set
 197 C<$Text::Wrap::unexpand> to a false value.  Likewise if you do not
 198 want to use 8-character tabstops, set C<$Text::Wrap::tabstop> to
 199 the number of characters you do want for your tabstops.
 200
 201 If you want to separate your lines with something other than C<\n>
 202 then set C<$Text::Wrap::separator> to your preference.  This replaces
 203 all newlines with C<$Text::Wrap::separator>.  If you just to preserve
 204 existing newlines but add new breaks with something else, set
 205 C<$Text::Wrap::separator2> instead.
 206
 207 When words that are longer than C<$columns> are encountered, they
 208 are broken up.  C<wrap()> adds a C<"\n"> at column C<$columns>.
 209 This behavior can be overridden by setting C<$huge> to
 210 'die' or to 'overflow'.  When set to 'die', large words will cause
 211 C<die()> to be called.  When set to 'overflow', large words will be
 212 left intact.
 213
 214 Historical notes: 'die' used to be the default value of
 215 C<$huge>.  Now, 'wrap' is the default value.
 216
 217 =head1 EXAMPLES
 218
 219 Code:
 220
 221   print wrap("\t","",<<END);
 222   This is a bit of text that forms
 223   a normal book-style indented paragraph
 224   END
 225
 226 Result:
 227
 228   "     This is a bit of text that forms
 229   a normal book-style indented paragraph
 230   "
 231
 232 Code:
 233
 234   $Text::Wrap::columns=20;
 235   $Text::Wrap::separator="|";
 236   print wrap("","","This is a bit of text that forms a normal book-style paragraph");
 237
 238 Result:
 239
 240   "This is a bit of|text that forms a|normal book-style|paragraph"
 241
 242 =head1 LICENSE
 243
 244 David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
 245 many many others.  Copyright (C) 1996-2006 David Muir Sharnoff.
 246 This module may be modified, used, copied, and redistributed at
 247 your own risk.  Publicly redistributed modified versions must use
 248 a different name.
 249