diff options
author | Todd C. Miller <millert@cvs.openbsd.org> | 2008-09-29 17:36:25 +0000 |
---|---|---|
committer | Todd C. Miller <millert@cvs.openbsd.org> | 2008-09-29 17:36:25 +0000 |
commit | 00dd722c5378e478eed4daa17120ab518ad2f0b8 (patch) | |
tree | daf0e090e9719c0407f3a6b208b46b6cc2645a55 /gnu/usr.bin/perl/lib/Text | |
parent | bfa863c83bfd01d72a748decaaf2676b800c60ff (diff) |
fix conflicts and merge in local changes to perl 5.10.0
Diffstat (limited to 'gnu/usr.bin/perl/lib/Text')
-rw-r--r-- | gnu/usr.bin/perl/lib/Text/Balanced.pm | 60 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Text/ParseWords.pm | 56 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Text/Soundex.pm | 153 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Text/Soundex.t | 143 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Text/Tabs.pm | 37 | ||||
-rw-r--r-- | gnu/usr.bin/perl/lib/Text/Wrap.pm | 53 |
6 files changed, 140 insertions, 362 deletions
diff --git a/gnu/usr.bin/perl/lib/Text/Balanced.pm b/gnu/usr.bin/perl/lib/Text/Balanced.pm index 362dc59b94e..6d000e1de81 100644 --- a/gnu/usr.bin/perl/lib/Text/Balanced.pm +++ b/gnu/usr.bin/perl/lib/Text/Balanced.pm @@ -10,7 +10,7 @@ use Exporter; use SelfLoader; use vars qw { $VERSION @ISA %EXPORT_TAGS }; -$VERSION = '1.95'; +use version; $VERSION = qv('2.0.0'); @ISA = qw ( Exporter ); %EXPORT_TAGS = ( ALL => [ qw( @@ -48,7 +48,7 @@ sub _fail { my ($wantarray, $textref, $message, $pos) = @_; _failmsg $message, $pos if $message; - return ("",$$textref,"") if $wantarray; + return (undef,$$textref,undef) if $wantarray; return undef; } @@ -57,7 +57,7 @@ sub _succeed $@ = undef; my ($wantarray,$textref) = splice @_, 0, 2; my ($extrapos, $extralen) = @_>18 ? splice(@_, -2, 2) : (0,0); - my ($startlen) = $_[5]; + my ($startlen, $oppos) = @_[5,6]; my $remainderpos = $_[2]; if ($wantarray) { @@ -67,7 +67,7 @@ sub _succeed push @res, substr($$textref,$from,$len); } if ($extralen) { # CORRECT FILLET - my $extra = substr($res[0], $extrapos-$startlen, $extralen, "\n"); + my $extra = substr($res[0], $extrapos-$oppos, $extralen, "\n"); $res[1] = "$extra$res[1]"; eval { substr($$textref,$remainderpos,0) = $extra; substr($$textref,$extrapos,$extralen,"\n")} ; @@ -266,7 +266,7 @@ sub _match_bracketed($$$$$$) # $textref, $pre, $ldel, $qdel, $quotelike, $rdel ); } -sub revbracket($) +sub _revbracket($) { my $brack = reverse $_[0]; $brack =~ tr/[({</])}>/; @@ -328,8 +328,8 @@ sub _match_tagged # ($$$$$$$) if (!defined $rdel) { - $rdelspec = $&; - unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". revbracket($1) /oes) + $rdelspec = substr($$textref, $-[0], $+[0] - $-[0]); + unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". _revbracket($1) /oes) { _failmsg "Unable to construct closing tag to match: $rdel", pos $$textref; @@ -748,8 +748,8 @@ sub _match_quotelike($$$$) # ($textref, $prepat, $allow_raw_match) } my $extrapos = pos($$textref); $$textref =~ m{.*\n}gc; - $str1pos = pos($$textref); - unless ($$textref =~ m{.*?\n(?=$label\n)}gc) { + $str1pos = pos($$textref)--; + unless ($$textref =~ m{.*?\n(?=\Q$label\E\n)}gc) { _failmsg qq{Missing here doc terminator ('$label') after "} . substr($$textref, $startpos, 20) . q{..."}, @@ -758,7 +758,7 @@ sub _match_quotelike($$$$) # ($textref, $prepat, $allow_raw_match) return; } $rd1pos = pos($$textref); - $$textref =~ m{$label\n}gc; + $$textref =~ m{\Q$label\E\n}gc; $ld2pos = pos($$textref); return ( $startpos, $oppos-$startpos, # PREFIX @@ -791,15 +791,17 @@ sub _match_quotelike($$$$) # ($textref, $prepat, $allow_raw_match) if ($ldel1 =~ /[[(<{]/) { $rdel1 =~ tr/[({</])}>/; - _match_bracketed($textref,"",$ldel1,"","",$rdel1) + defined(_match_bracketed($textref,"",$ldel1,"","",$rdel1)) || do { pos $$textref = $startpos; return }; + $ld2pos = pos($$textref); + $rd1pos = $ld2pos-1; } else { - $$textref =~ /$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs + $$textref =~ /\G$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs || do { pos $$textref = $startpos; return }; + $ld2pos = $rd1pos = pos($$textref)-1; } - $ld2pos = $rd1pos = pos($$textref)-1; my $second_arg = $op =~ /s|tr|y/ ? 1 : 0; if ($second_arg) @@ -826,7 +828,7 @@ sub _match_quotelike($$$$) # ($textref, $prepat, $allow_raw_match) if ($ldel2 =~ /[[(<{]/) { pos($$textref)--; # OVERCOME BROKEN LOOKAHEAD - _match_bracketed($textref,"",$ldel2,"","",$rdel2) + defined(_match_bracketed($textref,"",$ldel2,"","",$rdel2)) || do { pos $$textref = $startpos; return }; } else @@ -919,18 +921,19 @@ sub extract_multiple (;$$$$) # ($text, $functions_ref, $max_fields, $ignoreunkno $class = $class[$i]; $lastpos = pos $$textref; if (ref($func) eq 'CODE') - { ($field,$rem,$pref) = @bits = $func->($$textref); - # print "[$field|$rem]" if $field; - } + { ($field,$rem,$pref) = @bits = $func->($$textref) } elsif (ref($func) eq 'Text::Balanced::Extractor') { @bits = $field = $func->extract($$textref) } elsif( $$textref =~ m/\G$func/gc ) - { @bits = $field = defined($1) ? $1 : $& } + { @bits = $field = defined($1) + ? $1 + : substr($$textref, $-[0], $+[0] - $-[0]) + } $pref ||= ""; if (defined($field) && length($field)) { if (!$igunk) { - $unkpos = pos $$textref + $unkpos = $lastpos if length($pref) && !defined($unkpos); if (defined $unkpos) { @@ -1126,9 +1129,9 @@ The substring to be extracted must appear at the current C<pos> location of the string's variable (or at index zero, if no C<pos> position is defined). In other words, the C<extract_...> subroutines I<don't> -extract the first occurance of a substring anywhere +extract the first occurrence of a substring anywhere in a string (like an unanchored regex would). Rather, -they extract an occurance of the substring appearing +they extract an occurrence of the substring appearing immediately at the current matching position in the string (like a C<\G>-anchored regex would). @@ -1144,7 +1147,7 @@ elements of which are always: =item [0] The extracted string, including the specified delimiters. -If the extraction fails an empty string is returned. +If the extraction fails C<undef> is returned. =item [1] @@ -1154,7 +1157,7 @@ extracted string). On failure, the entire string is returned. =item [2] The skipped prefix (i.e. the characters before the extracted string). -On failure, the empty string is returned. +On failure, C<undef> is returned. =back @@ -1394,7 +1397,7 @@ See also: C<"extract_quotelike"> and C<"extract_codeblock">. C<extract_variable> extracts any valid Perl variable or variable-involved expression, including scalars, arrays, hashes, array -accesses, hash look-ups, method calls through objects, subroutine calles +accesses, hash look-ups, method calls through objects, subroutine calls through subroutine references, etc. The subroutine takes up to two optional arguments: @@ -2053,7 +2056,7 @@ If none of the extractor subroutines succeeds, then one character is extracted from the start of the text and the extraction subroutines reapplied. Characters which are thus removed are accumulated and eventually become the next field (unless the fourth argument is true, in which -case they are disgarded). +case they are discarded). For example, the following extracts substrings that are valid Perl variables: @@ -2140,9 +2143,10 @@ If more delimiters than escape chars are specified, the last escape char is used for the remaining delimiters. If no escape char is specified for a given specified delimiter, '\' is used. -Note that -C<gen_delimited_pat> was previously called -C<delimited_pat>. That name may still be used, but is now deprecated. +=head2 C<delimited_pat> + +Note that C<gen_delimited_pat> was previously called C<delimited_pat>. +That name may still be used, but is now deprecated. =head1 DIAGNOSTICS diff --git a/gnu/usr.bin/perl/lib/Text/ParseWords.pm b/gnu/usr.bin/perl/lib/Text/ParseWords.pm index 2f6812ade80..6235d3cb904 100644 --- a/gnu/usr.bin/perl/lib/Text/ParseWords.pm +++ b/gnu/usr.bin/perl/lib/Text/ParseWords.pm @@ -1,7 +1,7 @@ package Text::ParseWords; use vars qw($VERSION @ISA @EXPORT $PERL_SINGLE_QUOTE); -$VERSION = "3.24"; +$VERSION = "3.26"; require 5.000; @@ -12,9 +12,17 @@ use Exporter; sub shellwords { - my(@lines) = @_; - $lines[$#lines] =~ s/\s+$//; - return(quotewords('\s+', 0, @lines)); + my (@lines) = @_; + my @allwords; + + foreach my $line (@lines) { + $line =~ s/^\s+//; + my @words = parse_line('\s+', 0, $line); + pop @words if (@words and !defined $words[-1]); + return() unless (@words || !length($line)); + push(@allwords, @words); + } + return(@allwords); } @@ -53,15 +61,35 @@ sub parse_line { no warnings 'uninitialized'; # we will be testing undef strings while (length($line)) { - $line =~ s/^(["']) # a $quote - ((?:\\.|(?!\1)[^\\])*) # and $quoted text - \1 # followed by the same quote - | # --OR-- - ^((?:\\.|[^\\"'])*?) # an $unquoted text - (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["'])) - # plus EOL, delimiter, or quote - //xs or return; # extended layout - my($quote, $quoted, $unquoted, $delim) = ($1, $2, $3, $4); + # This pattern is optimised to be stack conservative on older perls. + # Do not refactor without being careful and testing it on very long strings. + # See Perl bug #42980 for an example of a stack busting input. + $line =~ s/^ + (?: + # double quoted string + (") # $quote + ((?>[^\\"]*(?:\\.[^\\"]*)*))" # $quoted + | # --OR-- + # singe quoted string + (') # $quote + ((?>[^\\']*(?:\\.[^\\']*)*))' # $quoted + | # --OR-- + # unquoted string + ( # $unquoted + (?:\\.|[^\\"'])*? + ) + # followed by + ( # $delim + \Z(?!\n) # EOL + | # --OR-- + (?-x:$delimiter) # delimiter + | # --OR-- + (?!^)(?=["']) # a quote + ) + )//xs or return; # extended layout + my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6); + + return() unless( defined($quote) || length($unquoted) || length($delim)); if ($keep) { @@ -125,7 +153,7 @@ sub old_shellwords { Carp::carp("Unmatched single quote: $_"); return(); } - elsif (s/\A\\(.)//s) { + elsif (s/\A\\(.?)//s) { $snippet = $1; } elsif (s/\A([^\s\\'"]+)//) { diff --git a/gnu/usr.bin/perl/lib/Text/Soundex.pm b/gnu/usr.bin/perl/lib/Text/Soundex.pm deleted file mode 100644 index 94f80c65865..00000000000 --- a/gnu/usr.bin/perl/lib/Text/Soundex.pm +++ /dev/null @@ -1,153 +0,0 @@ -package Text::Soundex; -require 5.000; -require Exporter; - -@ISA = qw(Exporter); -@EXPORT = qw(&soundex $soundex_nocode); - -$VERSION = '1.01'; - -# $Id: Soundex.pm,v 1.7 2003/12/03 03:02:41 millert Exp $ -# -# Implementation of soundex algorithm as described by Knuth in volume -# 3 of The Art of Computer Programming, with ideas stolen from Ian -# Phillipps <ian@pipex.net>. -# -# Mike Stok <Mike.Stok@meiko.concord.ma.us>, 2 March 1994. -# -# Knuth's test cases are: -# -# Euler, Ellery -> E460 -# Gauss, Ghosh -> G200 -# Hilbert, Heilbronn -> H416 -# Knuth, Kant -> K530 -# Lloyd, Ladd -> L300 -# Lukasiewicz, Lissajous -> L222 -# -# $Log: Soundex.pm,v $ -# Revision 1.7 2003/12/03 03:02:41 millert -# Resolve conflicts for perl 5.8.2, remove old files, and add OpenBSD-specific scaffolding -# -# Revision 1.2 1994/03/24 00:30:27 mike -# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu> -# in the way I handles leasing characters which were different but had -# the same soundex code. This showed up comparing it with Oracle's -# soundex output. -# -# Revision 1.1 1994/03/02 13:01:30 mike -# Initial revision -# -# -############################################################################## - -# $soundex_nocode is used to indicate a string doesn't have a soundex -# code, I like undef other people may want to set it to 'Z000'. - -$soundex_nocode = undef; - -sub soundex -{ - local (@s, $f, $fc, $_) = @_; - - push @s, '' unless @s; # handle no args as a single empty string - - foreach (@s) - { - $_ = uc $_; - tr/A-Z//cd; - - if ($_ eq '') - { - $_ = $soundex_nocode; - } - else - { - ($f) = /^(.)/; - tr/AEHIOUWYBFPVCGJKQSXZDTLMNR/00000000111122222222334556/; - ($fc) = /^(.)/; - s/^$fc+//; - tr///cs; - tr/0//d; - $_ = $f . $_ . '000'; - s/^(.{4}).*/$1/; - } - } - - wantarray ? @s : shift @s; -} - -1; - -__END__ - -=head1 NAME - -Text::Soundex - Implementation of the Soundex Algorithm as Described by Knuth - -=head1 SYNOPSIS - - use Text::Soundex; - - $code = soundex $string; # get soundex code for a string - @codes = soundex @list; # get list of codes for list of strings - - # set value to be returned for strings without soundex code - - $soundex_nocode = 'Z000'; - -=head1 DESCRIPTION - -This module implements the soundex algorithm as described by Donald Knuth -in Volume 3 of B<The Art of Computer Programming>. The algorithm is -intended to hash words (in particular surnames) into a small space using a -simple model which approximates the sound of the word when spoken by an English -speaker. Each word is reduced to a four character string, the first -character being an upper case letter and the remaining three being digits. - -If there is no soundex code representation for a string then the value of -C<$soundex_nocode> is returned. This is initially set to C<undef>, but -many people seem to prefer an I<unlikely> value like C<Z000> -(how unlikely this is depends on the data set being dealt with.) Any value -can be assigned to C<$soundex_nocode>. - -In scalar context C<soundex> returns the soundex code of its first -argument, and in list context a list is returned in which each element is the -soundex code for the corresponding argument passed to C<soundex> e.g. - - @codes = soundex qw(Mike Stok); - -leaves C<@codes> containing C<('M200', 'S320')>. - -=head1 EXAMPLES - -Knuth's examples of various names and the soundex codes they map to -are listed below: - - Euler, Ellery -> E460 - Gauss, Ghosh -> G200 - Hilbert, Heilbronn -> H416 - Knuth, Kant -> K530 - Lloyd, Ladd -> L300 - Lukasiewicz, Lissajous -> L222 - -so: - - $code = soundex 'Knuth'; # $code contains 'K530' - @list = soundex qw(Lloyd Gauss); # @list contains 'L300', 'G200' - -=head1 LIMITATIONS - -As the soundex algorithm was originally used a B<long> time ago in the US -it considers only the English alphabet and pronunciation. - -As it is mapping a large space (arbitrary length strings) onto a small -space (single letter plus 3 digits) no inference can be made about the -similarity of two strings which end up with the same soundex code. For -example, both C<Hilbert> and C<Heilbronn> end up with a soundex code -of C<H416>. - -=head1 AUTHOR - -This code was implemented by Mike Stok (C<stok@cybercom.net>) from the -description given by Knuth. Ian Phillipps (C<ian@pipex.net>) and Rich Pinder -(C<rpinder@hsc.usc.edu>) supplied ideas and spotted mistakes. diff --git a/gnu/usr.bin/perl/lib/Text/Soundex.t b/gnu/usr.bin/perl/lib/Text/Soundex.t deleted file mode 100644 index d35f264c7a6..00000000000 --- a/gnu/usr.bin/perl/lib/Text/Soundex.t +++ /dev/null @@ -1,143 +0,0 @@ -#!./perl -# -# $Id: soundex.t,v 1.2 1994/03/24 00:30:27 mike Exp $ -# -# test module for soundex.pl -# -# $Log: soundex.t,v $ -# Revision 1.2 1994/03/24 00:30:27 mike -# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu> -# in the way I handles leasing characters which were different but had -# the same soundex code. This showed up comparing it with Oracle's -# soundex output. -# -# Revision 1.1 1994/03/02 13:03:02 mike -# Initial revision -# -# - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - -use Text::Soundex; - -$test = 0; -print "1..13\n"; - -while (<DATA>) -{ - chop; - next if /^\s*;?#/; - next if /^\s*$/; - - ++$test; - $bad = 0; - - if (/^eval\s+/) - { - ($try = $_) =~ s/^eval\s+//; - - eval ($try); - if ($@) - { - $bad++; - print "not ok $test\n"; - print "# eval '$try' returned $@"; - } - } - elsif (/^\(/) - { - ($in, $out) = split (':'); - - $try = "\@expect = $out; \@got = &soundex $in;"; - eval ($try); - - if (@expect != @got) - { - $bad++; - print "not ok $test\n"; - print "# expected ", scalar @expect, " results, got ", scalar @got, "\n"; - print "# expected (", join (', ', @expect), - ") got (", join (', ', @got), ")\n"; - } - else - { - while (@got) - { - $expect = shift @expect; - $got = shift @got; - - if ($expect ne $got) - { - $bad++; - print "not ok $test\n"; - print "# expected $expect, got $got\n"; - } - } - } - } - else - { - ($in, $out) = split (':'); - - $try = "\$expect = $out; \$got = &soundex ($in);"; - eval ($try); - - if ($expect ne $got) - { - $bad++; - print "not ok $test\n"; - print "# expected $expect, got $got\n"; - } - } - - print "ok $test\n" unless $bad; -} - -__END__ -# -# 1..6 -# -# Knuth's test cases, scalar in, scalar out -# -'Euler':'E460' -'Gauss':'G200' -'Hilbert':'H416' -'Knuth':'K530' -'Lloyd':'L300' -'Lukasiewicz':'L222' -# -# 7..8 -# -# check default bad code -# -'2 + 2 = 4':undef -undef:undef -# -# 9 -# -# check array in, array out -# -('Ellery', 'Ghosh', 'Heilbronn', 'Kant', 'Ladd', 'Lissajous'):('E460', 'G200', 'H416', 'K530', 'L300', 'L222') -# -# 10 -# -# check array with explicit undef -# -('Mike', undef, 'Stok'):('M200', undef, 'S320') -# -# 11..12 -# -# check setting $Text::Soundex::noCode -# -eval $soundex_nocode = 'Z000'; -('Mike', undef, 'Stok'):('M200', 'Z000', 'S320') -# -# 13 -# -# a subtle difference between me & oracle, spotted by Rich Pinder -# <rpinder@hsc.usc.edu> -# -CZARKOWSKA:C622 diff --git a/gnu/usr.bin/perl/lib/Text/Tabs.pm b/gnu/usr.bin/perl/lib/Text/Tabs.pm index 36107fcfe3e..610e870c11f 100644 --- a/gnu/usr.bin/perl/lib/Text/Tabs.pm +++ b/gnu/usr.bin/perl/lib/Text/Tabs.pm @@ -7,7 +7,7 @@ require Exporter; @EXPORT = qw(expand unexpand $tabstop); use vars qw($VERSION $tabstop $debug); -$VERSION = 2005.0824; +$VERSION = 2007.1117; use strict; @@ -44,15 +44,17 @@ sub unexpand my $line; my @lines; my $lastbit; + my $ts_as_space = " "x$tabstop; for $x (@l) { @lines = split("\n", $x, -1); for $line (@lines) { $line = expand($line); @e = split(/(.{$tabstop})/,$line,-1); $lastbit = pop(@e); - $lastbit = '' unless defined $lastbit; + $lastbit = '' + unless defined $lastbit; $lastbit = "\t" - if $lastbit eq " "x$tabstop; + if $lastbit eq $ts_as_space; for $_ (@e) { if ($debug) { my $x = $_; @@ -95,26 +97,39 @@ Text::Tabs -- expand and unexpand tabs per the unix expand(1) and unexpand(1) use Text::Tabs; - $tabstop = 4; + $tabstop = 4; # default = 8 @lines_without_tabs = expand(@lines_with_tabs); @lines_with_tabs = unexpand(@lines_without_tabs); =head1 DESCRIPTION -Text::Tabs does about what the unix utilities expand(1) and unexpand(1) +Text::Tabs does about what the unix utilities expand(1) and unexpand(1) do. Given a line with tabs in it, expand will replace the tabs with the appropriate number of spaces. Given a line with or without tabs in -it, unexpand will add tabs when it can save bytes by doing so. Invisible -compression with plain ascii! +it, unexpand will add tabs when it can save bytes by doing so (just +like C<unexpand -a>). Invisible compression with plain ASCII! -=head1 BUGS +=head1 EXAMPLE -expand doesn't handle newlines very quickly -- do not feed it an -entire document in one string. Instead feed it an array of lines. + #!perl + # unexpand -a + use Text::Tabs; + + while (<>) { + print unexpand $_; + } + +Instead of the C<expand> comand, use: + + perl -MText::Tabs -n -e 'print expand $_' + +Instead of the C<unexpand -a> command, use: + + perl -MText::Tabs -n -e 'print unexpand $_' =head1 LICENSE -Copyright (C) 1996-2002,2005 David Muir Sharnoff. +Copyright (C) 1996-2002,2005,2006 David Muir Sharnoff. Copyright (C) 2005 Aristotle Pagaltzis This module may be modified, used, copied, and redistributed at your own risk. Publicly redistributed modified versions must use a different name. diff --git a/gnu/usr.bin/perl/lib/Text/Wrap.pm b/gnu/usr.bin/perl/lib/Text/Wrap.pm index d364cfc1195..4f41acf9eeb 100644 --- a/gnu/usr.bin/perl/lib/Text/Wrap.pm +++ b/gnu/usr.bin/perl/lib/Text/Wrap.pm @@ -1,12 +1,13 @@ package Text::Wrap; +use warnings::register; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(wrap fill); @EXPORT_OK = qw($columns $break $huge); -$VERSION = 2005.0824_01; +$VERSION = 2006.1117; use vars qw($VERSION $columns $debug $break $huge $unexpand $tabstop $separator $separator2); @@ -43,8 +44,8 @@ sub wrap use re 'taint'; pos($t) = 0; - while ($t !~ /\G\s*\Z/gc) { - if ($t =~ /\G([^\n]{0,$ll})($break|\n*\z)/xmgc) { + while ($t !~ /\G(?:$break)*\Z/gc) { + if ($t =~ /\G([^\n]{0,$ll})($break|\n+|\z)/xmgc) { $r .= $unexpand ? unexpand($nl . $lead . $1) : $nl . $lead . $1; @@ -54,13 +55,17 @@ sub wrap ? unexpand($nl . $lead . $1) : $nl . $lead . $1; $remainder = defined($separator2) ? $separator2 : $separator; - } elsif ($huge eq 'overflow' && $t =~ /\G([^\n]*?)($break|\z)/xmgc) { + } elsif ($huge eq 'overflow' && $t =~ /\G([^\n]*?)($break|\n+|\z)/xmgc) { $r .= $unexpand ? unexpand($nl . $lead . $1) : $nl . $lead . $1; $remainder = $2; } elsif ($huge eq 'die') { die "couldn't wrap '$t'"; + } elsif ($columns < 2) { + warnings::warnif "Increasing \$Text::Wrap::columns from $columns to 2"; + $columns = 2; + return ($ip, $xp, @t); } else { die "This shouldn't happen"; } @@ -117,7 +122,7 @@ Text::Wrap - line wrapping to form simple paragraphs B<Example 1> - use Text::Wrap + use Text::Wrap; $initial_tab = "\t"; # Tab before first line $subsequent_tab = ""; # All other lines flush left @@ -139,8 +144,8 @@ B<Example 2> $huge = 'overflow'; B<Example 3> - - use Text::Wrap + + use Text::Wrap; $Text::Wrap::columns = 72; print wrap('', '', @text); @@ -148,11 +153,11 @@ B<Example 3> =head1 DESCRIPTION C<Text::Wrap::wrap()> is a very simple paragraph formatter. It formats a -single paragraph at a time by breaking lines at word boundries. +single paragraph at a time by breaking lines at word boundaries. Indentation is controlled for the first line (C<$initial_tab>) and all subsequent lines (C<$subsequent_tab>) independently. Please note: C<$initial_tab> and C<$subsequent_tab> are the literal strings that will -be used: it is unlikley you would want to pass in a number. +be used: it is unlikely you would want to pass in a number. Text::Wrap::fill() is a simple multi-paragraph formatter. It formats each paragraph separately and then joins them together when it's done. It @@ -160,6 +165,8 @@ will destroy any whitespace in the original text. It breaks text into paragraphs by looking for whitespace after a newline. In other respects it acts like wrap(). +Both C<wrap()> and C<fill()> return a single string. + =head1 OVERRIDES C<Text::Wrap::wrap()> has a number of variables that control its behavior. @@ -208,15 +215,35 @@ left intact. Historical notes: 'die' used to be the default value of C<$huge>. Now, 'wrap' is the default value. -=head1 EXAMPLE +=head1 EXAMPLES + +Code: + + print wrap("\t","",<<END); + This is a bit of text that forms + a normal book-style indented paragraph + END + +Result: + + " This is a bit of text that forms + a normal book-style indented paragraph + " + +Code: + + $Text::Wrap::columns=20; + $Text::Wrap::separator="|"; + print wrap("","","This is a bit of text that forms a normal book-style paragraph"); + +Result: - print wrap("\t","","This is a bit of text that forms - a normal book-style paragraph"); + "This is a bit of|text that forms a|normal book-style|paragraph" =head1 LICENSE David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and -many many others. Copyright (C) 1996-2002 David Muir Sharnoff. +many many others. Copyright (C) 1996-2006 David Muir Sharnoff. This module may be modified, used, copied, and redistributed at your own risk. Publicly redistributed modified versions must use a different name. |