Lines 61-67
Link Here
|
61 |
use Sys::Hostname (); # don't import hostname() into this namespace! |
61 |
use Sys::Hostname (); # don't import hostname() into this namespace! |
62 |
use Fcntl; |
62 |
use Fcntl; |
63 |
use POSIX (); # don't import anything unless we ask explicitly! |
63 |
use POSIX (); # don't import anything unless we ask explicitly! |
64 |
use Text::Wrap (); |
|
|
65 |
use Errno qw(EEXIST); |
64 |
use Errno qw(EEXIST); |
66 |
|
65 |
|
67 |
########################################################################### |
66 |
########################################################################### |
Lines 478-531
Link Here
|
478 |
|
477 |
|
479 |
########################################################################### |
478 |
########################################################################### |
480 |
|
479 |
|
481 |
# This is a wrapper for the Text::Wrap::wrap routine which makes its usage |
480 |
# This used to be a wrapper for Text::Wrap. Now we do basically the same |
482 |
# a bit safer. It accepts values for almost all options which can be set |
481 |
# function as Text::Wrap::wrap(). See bug 5056 and 2165 for more information |
|
|
482 |
# about why things aren't using that function anymore. |
483 |
# |
484 |
# It accepts values for almost all options which can be set |
483 |
# in Text::Wrap. All parameters are optional (leaving away the first one |
485 |
# in Text::Wrap. All parameters are optional (leaving away the first one |
484 |
# probably doesn't make too much sense though), either a missing or a false |
486 |
# probably doesn't make too much sense though), either a missing or a false |
485 |
# value will fall back to the default. Note that the parameter order and |
487 |
# value will fall back to the default. |
486 |
# default values aren't always the isame as in Text::Wrap itself. |
|
|
487 |
# |
488 |
# |
488 |
# The parameters are: |
489 |
# The parameters are: |
489 |
# 1st: The string to wrap. Only one string is allowed (unlike the original |
490 |
# 1st: The string to wrap. Only one string is allowed. |
490 |
# wrap() routine). (default: "") |
491 |
# (default: "") |
491 |
# 2nd: The prefix to be put in front of all lines except the first one. |
492 |
# 2nd: The prefix to be put in front of all lines except the first one. |
492 |
# (default: "") |
493 |
# (default: "") |
493 |
# 3rd: The prefix for the first line. (default: "") |
494 |
# 3rd: The prefix for the first line. (default: "") |
494 |
# 4th: The number of columns available (no line will be longer than this |
495 |
# 4th: The number of columns available (no line will be longer than this |
495 |
# parameter minus one). See $Text::Wrap::columns. (default: 77) |
496 |
# unless overflow is set below). (default: 77) |
496 |
# 5th: Enable or disable overflow mode. A false value is 'overflow', a |
497 |
# 5th: Enable or disable overflow mode. (default: 0) |
497 |
# true one 'wrap'; see $Text::Wrap::huge. (default: 0) |
498 |
# 6th: The sequence/expression to wrap at. (default: '\s'); |
498 |
# 6th: The sequence/expression to wrap at. See $Text::Wrap::break |
499 |
# 7th: The string to join the lines again. (default: "\n") |
499 |
# (default: '\s'); |
|
|
500 |
# 7th: The string to join the lines again. See $Text::Wrap::separator. |
501 |
# (default: "\n") |
502 |
# 8th: All tabs (except any in the prefix strings) are first replaced |
503 |
# with 8 spaces. This parameter controls if any 8-space sequence |
504 |
# is replaced with tabs again later. See $Text::Wrap::unexpand but |
505 |
# note that we use a different default value. (default: 0) |
506 |
|
500 |
|
507 |
sub wrap { |
501 |
sub wrap { |
508 |
local($Text::Wrap::columns) = $_[3] || 77; |
502 |
my $string = shift || ''; |
509 |
local($Text::Wrap::huge) = $_[4] ? 'overflow' : 'wrap'; |
503 |
my $prefix = shift || ''; |
510 |
local($Text::Wrap::break) = $_[5] || '\s'; |
504 |
my $first = shift || ''; |
511 |
local($Text::Wrap::separator) = $_[6] || "\n"; |
505 |
my $length = shift || 77; |
512 |
local($Text::Wrap::unexpand) = $_[7] || 0; |
506 |
my $overflow = shift || 0; |
513 |
# There's a die() in there which "shouldn't happen", but better be |
507 |
my $break = shift || qr/\s/; |
514 |
# paranoid. We'll return the unwrapped string if anything went wrong. |
508 |
my $sep = "\n"; |
515 |
my $text = $_[0] || ""; |
|
|
516 |
|
509 |
|
517 |
# Text::Wrap produces spurious warnings: |
510 |
# go ahead and break apart the string, keeping the break chars |
518 |
# [23409] warn: (?:(?<=[\s,]))* matches null string many times in regex; marked by <-- HERE in m/\G(?:(?<=[\s,]))* <-- HERE \Z/ at /usr/local/perl594/lib/5.9.4/Text/Wrap.pm line 46. |
511 |
my @arr = split(/($break)/, $string); |
519 |
# trap and ignore them. Why do so many of the core modules do this |
|
|
520 |
# kind of crap? :( use a $SIG{__WARN__} to trap it. |
521 |
|
512 |
|
522 |
eval { |
513 |
# tack the first prefix line at the start |
523 |
local $SIG{__WARN__} = sub { |
514 |
splice @arr, 0, 0, $first; |
524 |
($_[0] =~ /matches null string many times/) or CORE::warn(@_); |
515 |
|
525 |
}; |
516 |
# go ahead and make up the lines in the array |
526 |
$text = Text::Wrap::wrap($_[2] || "", $_[1] || "", $text); |
517 |
my $pos = 0; |
527 |
}; |
518 |
while ($#arr > $pos) { |
528 |
return $text; |
519 |
my $len = length $arr[$pos]; |
|
|
520 |
|
521 |
# if we don't want to have lines > $length (overflow==0), we |
522 |
# need to verify what will happen with the next line. if we don't |
523 |
# care if a single line goes longer, don't care about the next |
524 |
# line. |
525 |
if ($overflow == 0) { |
526 |
$len += length $arr[$pos+1]; |
527 |
} |
528 |
|
529 |
if ($len <= $length) { |
530 |
# if the length determined above is within bounds, go ahead and |
531 |
# merge the next line with the current one |
532 |
$arr[$pos] .= splice @arr, $pos+1, 1; |
533 |
} |
534 |
else { |
535 |
# ok, the current line is the right length, but there's more text! |
536 |
# prep the current line and then go onto the next one |
537 |
|
538 |
# strip any trailing whitespace from the next line that's ready |
539 |
$arr[0] =~ s/\s+$//; |
540 |
|
541 |
# go to the next line |
542 |
$pos++; |
543 |
|
544 |
# put the appropriate prefix at the front of the line |
545 |
splice @arr, $pos, 0, $prefix; |
546 |
} |
547 |
} |
548 |
|
549 |
# go ahead and return the wrapped text, with the separator in between |
550 |
return join($sep, @arr); |
529 |
} |
551 |
} |
530 |
|
552 |
|
531 |
########################################################################### |
553 |
########################################################################### |