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