lib/Automake/Wrap.pm

   1 # Copyright (C) 2003-2018 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2, or (at your option)
   6 # any later version.
   7
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 package Automake::Wrap;
  17
  18 use 5.006;
  19 use strict;
  20
  21 require Exporter;
  22 use vars '@ISA', '@EXPORT_OK';
  23 @ISA = qw/Exporter/;
  24 @EXPORT_OK = qw/wrap makefile_wrap/;
  25
  26 =head1 NAME
  27
  28 Automake::Wrap - a paragraph formatter
  29
  30 =head1 SYNOPSIS
  31
  32   use Automake::Wrap 'wrap', 'makefile_wrap';
  33
  34   print wrap ($first_ident, $next_ident, $end_of_line, $max_length,
  35               @values);
  36
  37   print makefile_wrap ("VARIABLE = ", "    ", @values);
  38
  39 =head1 DESCRIPTION
  40
  41 This modules provide facility to format list of strings.  It is
  42 comparable to Perl's L<Text::Wrap>, however we can't use L<Text::Wrap>
  43 because some versions will abort when some word to print exceeds the
  44 maximum length allowed.  (Ticket #17141, fixed in Perl 5.8.0.)
  45
  46 =head2 Functions
  47
  48 =over 4
  49
  50 =cut
  51
  52 # _tab_length ($TXT)
  53 # ------------------
  54 # Compute the length of TXT, counting tab characters as 8 characters.
  55 sub _tab_length($)
  56 {
  57   my ($txt) = @_;
  58   my $len = length ($txt);
  59   $len += 7 * ($txt =~ tr/\t/\t/);
  60   return $len;
  61 }
  62
  63 =item C<wrap ($head, $fill, $eol, $max_len, @values)>
  64
  65 Format C<@values> as a block of text that starts with C<$head>,
  66 followed by the strings in C<@values> separated by spaces or by
  67 C<"$eol\n$fill"> so that the length of each line never exceeds
  68 C<$max_len>.
  69
  70 The C<$max_len> constraint is ignored for C<@values> items which
  71 are too big to fit alone one a line.
  72
  73 The constructed paragraph is C<"\n">-terminated.
  74
  75 =cut
  76
  77 sub wrap($$$$@)
  78 {
  79   my ($head, $fill, $eol, $max_len, @values) = @_;
  80
  81   my $result = $head;
  82   my $column = _tab_length ($head);
  83
  84   my $fill_len = _tab_length ($fill);
  85   my $eol_len = _tab_length ($eol);
  86
  87   my $not_first_word = 0;
  88
  89   foreach (@values)
  90     {
  91       my $len = _tab_length ($_);
  92
  93       # See if the new variable fits on this line.
  94       # (The + 1 is for the space we add in front of the value.).
  95       if ($column + $len + $eol_len + 1 > $max_len
  96           # Do not break before the first word if it does not fit on
  97           # the next line anyway.
  98           && ($not_first_word || $fill_len + $len + $eol_len + 1 <= $max_len))
  99         {
 100           # Start a new line.
 101           $result .= "$eol\n" . $fill;
 102           $column = $fill_len;
 103         }
 104       elsif ($not_first_word)
 105         {
 106           # Add a space only if result does not already end
 107           # with a space.
 108           $_ = " $_" if $result =~ /\S\z/;
 109           ++$len;
 110         }
 111       $result .= $_;
 112       $column += $len;
 113       $not_first_word = 1;
 114     }
 115
 116   $result .= "\n";
 117   return $result;
 118 }
 119
 120
 121 =item C<makefile_wrap ($head, $fill, @values)>
 122
 123 Format C<@values> in a way which is suitable for F<Makefile>s.
 124 This is comparable to C<wrap>, except C<$eol> is known to
 125 be C<" \\">, and the maximum length has been hardcoded to C<72>.
 126
 127 A space is appended to C<$head> when this is not already
 128 the case.
 129
 130 This can be used to format variable definitions or dependency lines.
 131
 132   makefile_wrap ('VARIABLE =', "\t", @values);
 133   makefile_wrap ('rule:', "\t", @dependencies);
 134
 135 =cut
 136
 137 sub makefile_wrap ($$@)
 138 {
 139   my ($head, $fill, @values) = @_;
 140   if (@values)
 141     {
 142       $head .= ' ' if $head =~ /\S\z/;
 143       return wrap $head, $fill, " \\", 72, @values;
 144     }
 145   return "$head\n";
 146 }
 147
 148
 149 1;