lib/Text/Wrap.pm

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