"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/Text/Wrap.pm" (26 Apr 2015, 9018 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    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 = 2013.0523;
   11 $SUBVERSION = 'modern';
   12 
   13 use 5.010_000;
   14 
   15 use vars qw($VERSION $SUBVERSION $columns $debug $break $huge $unexpand $tabstop $separator $separator2);
   16 use strict;
   17 
   18 BEGIN   {
   19     $columns = 76;  # <= screen width
   20     $debug = 0;
   21     $break = '(?=\s)\X';
   22     $huge = 'wrap'; # alternatively: 'die' or 'overflow'
   23     $unexpand = 1;
   24     $tabstop = 8;
   25     $separator = "\n";
   26     $separator2 = undef;
   27 }
   28 
   29 my $CHUNK = qr/\X/;
   30 
   31 sub _xlen(_) { scalar(() = $_[0] =~ /$CHUNK/g) }
   32 
   33 sub _xpos(_) { _xlen( substr( $_[0], 0, pos($_[0]) ) ) }
   34 
   35 use Text::Tabs qw(expand unexpand);
   36 
   37 sub wrap
   38 {
   39     my ($ip, $xp, @t) = @_;
   40 
   41     local($Text::Tabs::tabstop) = $tabstop;
   42     my $r = "";
   43     my $tail = pop(@t);
   44     my $t = expand(join("", (map { /\s+\z/ ? ( $_ ) : ($_, ' ') } @t), $tail));
   45     my $lead = $ip;
   46     my $nll = $columns - _xlen(expand($xp)) - 1;
   47     if ($nll <= 0 && $xp ne '') {
   48         my $nc = _xlen(expand($xp)) + 2;
   49         warnings::warnif "Increasing \$Text::Wrap::columns from $columns to $nc to accommodate length of subsequent tab";
   50         $columns = $nc;
   51         $nll = 1;
   52     }
   53     my $ll = $columns - _xlen(expand($ip)) - 1;
   54     $ll = 0 if $ll < 0;
   55     my $nl = "";
   56     my $remainder = "";
   57 
   58     use re 'taint';
   59 
   60     pos($t) = 0;
   61     while ($t !~ /\G(?:$break)*\Z/gc) {
   62         if ($t =~ /\G((?:(?=[^\n])\X){0,$ll})($break|\n+|\z)/xmgc) {
   63             $r .= $unexpand 
   64                 ? unexpand($nl . $lead . $1)
   65                 : $nl . $lead . $1;
   66             $remainder = $2;
   67         } elsif ($huge eq 'wrap' && $t =~ /\G((?:(?=[^\n])\X){$ll})/gc) {
   68             $r .= $unexpand 
   69                 ? unexpand($nl . $lead . $1)
   70                 : $nl . $lead . $1;
   71             $remainder = defined($separator2) ? $separator2 : $separator;
   72         } elsif ($huge eq 'overflow' && $t =~ /\G((?:(?=[^\n])\X)*?)($break|\n+|\z)/xmgc) {
   73             $r .= $unexpand 
   74                 ? unexpand($nl . $lead . $1)
   75                 : $nl . $lead . $1;
   76             $remainder = $2;
   77         } elsif ($huge eq 'die') {
   78             die "couldn't wrap '$t'";
   79         } elsif ($columns < 2) {
   80             warnings::warnif "Increasing \$Text::Wrap::columns from $columns to 2";
   81             $columns = 2;
   82             return ($ip, $xp, @t);
   83         } else {
   84             die "This shouldn't happen";
   85         }
   86             
   87         $lead = $xp;
   88         $ll = $nll;
   89         $nl = defined($separator2)
   90             ? ($remainder eq "\n"
   91                 ? "\n"
   92                 : $separator2)
   93             : $separator;
   94     }
   95     $r .= $remainder;
   96 
   97     print "-----------$r---------\n" if $debug;
   98 
   99     print "Finish up with '$lead'\n" if $debug;
  100 
  101     my($opos) = pos($t);
  102 
  103     $r .= $lead . substr($t, pos($t), length($t) - pos($t))
  104         if pos($t) ne length($t);
  105 
  106     print "-----------$r---------\n" if $debug;;
  107 
  108     return $r;
  109 }
  110 
  111 sub fill 
  112 {
  113     my ($ip, $xp, @raw) = @_;
  114     my @para;
  115     my $pp;
  116 
  117     for $pp (split(/\n\s+/, join("\n",@raw))) {
  118         $pp =~ s/\s+/ /g;
  119         my $x = wrap($ip, $xp, $pp);
  120         push(@para, $x);
  121     }
  122 
  123     # if paragraph_indent is the same as line_indent, 
  124     # separate paragraphs with blank lines
  125 
  126     my $ps = ($ip eq $xp) ? "\n\n" : "\n";
  127     return join ($ps, @para);
  128 }
  129 
  130 1;
  131 __END__
  132 
  133 =head1 NAME
  134 
  135 Text::Wrap - line wrapping to form simple paragraphs
  136 
  137 =head1 SYNOPSIS 
  138 
  139 B<Example 1>
  140 
  141     use Text::Wrap;
  142 
  143     $initial_tab = "\t";    # Tab before first line
  144     $subsequent_tab = "";   # All other lines flush left
  145 
  146     print wrap($initial_tab, $subsequent_tab, @text);
  147     print fill($initial_tab, $subsequent_tab, @text);
  148 
  149     $lines = wrap($initial_tab, $subsequent_tab, @text);
  150 
  151     @paragraphs = fill($initial_tab, $subsequent_tab, @text);
  152 
  153 B<Example 2>
  154 
  155     use Text::Wrap qw(wrap $columns $huge);
  156 
  157     $columns = 132;     # Wrap at 132 characters
  158     $huge = 'die';
  159     $huge = 'wrap';
  160     $huge = 'overflow';
  161 
  162 B<Example 3>
  163 
  164     use Text::Wrap;
  165 
  166     $Text::Wrap::columns = 72;
  167     print wrap('', '', @text);
  168 
  169 =head1 DESCRIPTION
  170 
  171 C<Text::Wrap::wrap()> is a very simple paragraph formatter.  It formats a
  172 single paragraph at a time by breaking lines at word boundaries.
  173 Indentation is controlled for the first line (C<$initial_tab>) and
  174 all subsequent lines (C<$subsequent_tab>) independently.  Please note: 
  175 C<$initial_tab> and C<$subsequent_tab> are the literal strings that will
  176 be used: it is unlikely you would want to pass in a number.
  177 
  178 C<Text::Wrap::fill()> is a simple multi-paragraph formatter.  It formats
  179 each paragraph separately and then joins them together when it's done.  It
  180 will destroy any whitespace in the original text.  It breaks text into
  181 paragraphs by looking for whitespace after a newline.  In other respects,
  182 it acts like wrap().
  183 
  184 C<wrap()> compresses trailing whitespace into one newline, and C<fill()>
  185 deletes all trailing whitespace.
  186 
  187 Both C<wrap()> and C<fill()> return a single string.
  188 
  189 Unlike the old Unix fmt(1) utility, this module correctly accounts for
  190 any Unicode combining characters (such as diacriticals) that may occur
  191 in each line for both expansion and unexpansion.  These are overstrike
  192 characters that do not increment the logical position.  Make sure
  193 you have the appropriate Unicode settings enabled.
  194 
  195 =head1 OVERRIDES
  196 
  197 C<Text::Wrap::wrap()> has a number of variables that control its behavior.
  198 Because other modules might be using C<Text::Wrap::wrap()> it is suggested
  199 that you leave these variables alone!  If you can't do that, then 
  200 use C<local($Text::Wrap::VARIABLE) = YOURVALUE> when you change the
  201 values so that the original value is restored.  This C<local()> trick
  202 will not work if you import the variable into your own namespace.
  203 
  204 Lines are wrapped at C<$Text::Wrap::columns> columns (default value: 76).
  205 C<$Text::Wrap::columns> should be set to the full width of your output
  206 device.  In fact, every resulting line will have length of no more than
  207 C<$columns - 1>.
  208 
  209 It is possible to control which characters terminate words by
  210 modifying C<$Text::Wrap::break>. Set this to a string such as
  211 C<'[\s:]'> (to break before spaces or colons) or a pre-compiled regexp
  212 such as C<qr/[\s']/> (to break before spaces or apostrophes). The
  213 default is simply C<'\s'>; that is, words are terminated by spaces.
  214 (This means, among other things, that trailing punctuation  such as
  215 full stops or commas stay with the word they are "attached" to.)
  216 Setting C<$Text::Wrap::break> to a regular expression that doesn't
  217 eat any characters (perhaps just a forward look-ahead assertion) will
  218 cause warnings.
  219 
  220 Beginner note: In example 2, above C<$columns> is imported into
  221 the local namespace, and set locally.  In example 3,
  222 C<$Text::Wrap::columns> is set in its own namespace without importing it.
  223 
  224 C<Text::Wrap::wrap()> starts its work by expanding all the tabs in its
  225 input into spaces.  The last thing it does it to turn spaces back
  226 into tabs.  If you do not want tabs in your results, set 
  227 C<$Text::Wrap::unexpand> to a false value.  Likewise if you do not
  228 want to use 8-character tabstops, set C<$Text::Wrap::tabstop> to
  229 the number of characters you do want for your tabstops.
  230 
  231 If you want to separate your lines with something other than C<\n>
  232 then set C<$Text::Wrap::separator> to your preference.  This replaces
  233 all newlines with C<$Text::Wrap::separator>.  If you just want to 
  234 preserve existing newlines but add new breaks with something else, set
  235 C<$Text::Wrap::separator2> instead.
  236 
  237 When words that are longer than C<$columns> are encountered, they
  238 are broken up.  C<wrap()> adds a C<"\n"> at column C<$columns>.
  239 This behavior can be overridden by setting C<$huge> to
  240 'die' or to 'overflow'.  When set to 'die', large words will cause
  241 C<die()> to be called.  When set to 'overflow', large words will be
  242 left intact.  
  243 
  244 Historical notes: 'die' used to be the default value of
  245 C<$huge>.  Now, 'wrap' is the default value.
  246 
  247 =head1 EXAMPLES
  248 
  249 Code:
  250 
  251   print wrap("\t","",<<END);
  252   This is a bit of text that forms 
  253   a normal book-style indented paragraph
  254   END
  255 
  256 Result:
  257 
  258   " This is a bit of text that forms
  259   a normal book-style indented paragraph   
  260   "
  261 
  262 Code:
  263 
  264   $Text::Wrap::columns=20;
  265   $Text::Wrap::separator="|";
  266   print wrap("","","This is a bit of text that forms a normal book-style paragraph");
  267 
  268 Result:
  269 
  270   "This is a bit of|text that forms a|normal book-style|paragraph"
  271 
  272 =head1 SUBVERSION
  273 
  274 This module comes in two flavors: one for modern perls (5.10 and above)
  275 and one for ancient obsolete perls.  The version for modern perls has
  276 support for Unicode.  The version for old perls does not.  You can tell
  277 which version you have installed by looking at C<$Text::Wrap::SUBVERSION>:
  278 it is C<old> for obsolete perls and C<modern> for current perls.
  279 
  280 This man page is for the version for modern perls and so that's probably
  281 what you've got.
  282 
  283 =head1 SEE ALSO
  284 
  285 For correct handling of East Asian half- and full-width characters, 
  286 see L<Text::WrapI18N>.  For more detailed controls: L<Text::Format>.
  287 
  288 =head1 AUTHOR
  289 
  290 David Muir Sharnoff <cpan@dave.sharnoff.org> with help from Tim Pierce and
  291 many many others.  
  292 
  293 =head1 LICENSE
  294 
  295 Copyright (C) 1996-2009 David Muir Sharnoff.  
  296 Copyright (C) 2012-2013 Google, Inc.
  297 This module may be modified, used, copied, and redistributed at your own risk.
  298 Although allowed by the preceding license, please do not publicly
  299 redistribute modified versions of this code with the name "Text::Wrap"
  300 unless it passes the unmodified Text::Wrap test suite.