Upgrade Text::Tabs+Text::Wrap to version 2009.0305
authorSteffen Mueller <smueller@cpan.org>
Fri, 6 Mar 2009 13:56:03 +0000 (14:56 +0100)
committerSteffen Mueller <smueller@cpan.org>
Fri, 6 Mar 2009 13:56:03 +0000 (14:56 +0100)
lib/Text/Tabs.pm
lib/Text/TabsWrap/CHANGELOG
lib/Text/TabsWrap/t/Jacobson.t
lib/Text/TabsWrap/t/Jacobson2.t
lib/Text/TabsWrap/t/dandv.t [new file with mode: 0644]
lib/Text/TabsWrap/t/dnsparks.t [new file with mode: 0755]
lib/Text/TabsWrap/t/fill.t
lib/Text/TabsWrap/t/tabs.t
lib/Text/TabsWrap/t/wrap.t
lib/Text/TabsWrap/t/wrap_separator2.t [new file with mode: 0644]
lib/Text/Wrap.pm

index 610e870..d3c06a0 100644 (file)
@@ -7,7 +7,7 @@ require Exporter;
 @EXPORT = qw(expand unexpand $tabstop);
 
 use vars qw($VERSION $tabstop $debug);
-$VERSION = 2007.1117;
+$VERSION = 2009.0305;
 
 use strict;
 
index 8d4171e..df83979 100644 (file)
@@ -1,4 +1,13 @@
 
+= 2009/03/05
+
+Test improvements from Dave Mitchel sent back in 2005...
+
+Added code to increase $columns if it's not big enough to accommodate
+the subsequent tab.
+
+Minor documentation fixes from David Landgren <david at landgren.net>.
+
 Use warnings::warnif instead of just warn for columns < 2.  Appled per
 request of Rafael Garcia-Suarez <rgarciasuarez at gmail.com>.
 
index 22d42e4..d2727e4 100644 (file)
@@ -10,7 +10,7 @@ $huge='overflow';
 $Text::Wrap::columns=9;
 $break="(?<=[,.])";
 eval {
-$a=wrap('','',
+$a=$a=wrap('','',
 "mmmm,n,ooo,ppp.qqqq.rrrrr,sssssssssssss,ttttttttt,uu,vvv wwwwwwwww####\n");
 };
 
index 5874e0e..b7b06fa 100644 (file)
@@ -8,7 +8,7 @@ $huge='overflow';
 $Text::Wrap::columns=9;
 $break="(?<=[,.])";
 eval {
-$a=wrap('','',
+$a=$a=wrap('','',
 "mmmm,n,ooo,ppp.qqqq.rrrrr.adsljasdf\nlasjdflajsdflajsdfljasdfl\nlasjdflasjdflasf,sssssssssssss,ttttttttt,uu,vvv wwwwwwwww####\n");
 };
 
diff --git a/lib/Text/TabsWrap/t/dandv.t b/lib/Text/TabsWrap/t/dandv.t
new file mode 100644 (file)
index 0000000..b6ee69a
--- /dev/null
@@ -0,0 +1,8 @@
+
+use Text::Wrap;
+use Test::More tests => 2;
+$Text::Wrap::columns = 4;
+eval { $x = Text::Wrap::wrap('', '123', 'some text'); };
+is($@, '');
+is($x, "some\n123t\n123e\n123x\n123t");
+
diff --git a/lib/Text/TabsWrap/t/dnsparks.t b/lib/Text/TabsWrap/t/dnsparks.t
new file mode 100755 (executable)
index 0000000..d4b9ed6
--- /dev/null
@@ -0,0 +1,143 @@
+#!/usr/bin/perl -I. -w
+
+BEGIN {
+       if ($ENV{HARNESS_ACTIVE}) {
+               print "1..0 # Skipped: not a standard regression test\n";
+               exit;
+       }
+       unless (eval { require Benchmark; }) {
+               print "1..0 # Skipped: this test requires Benchmark.pm\n";
+               exit;
+       }
+}
+
+#From:     dnsparks@juno.com
+#Subject:  Text::Wrap suggestions
+#To:       muir@idiom.com
+#Date:     Sat, 10 Feb 2001 21:50:29 -0500
+#
+#David,
+#
+#I had a "word wrapping" problem to solve at work the other week.
+#Text::Wrap would have done exactly what I needed, but at work we use
+#Smalltalk. :-) (I ended up thinking about it at home, where I don't have
+#Smalltalk, so I first coded it in Perl and then "translated" my solution
+#at work.)
+#
+#I must admit that I was dealing with a specialized case; I didn't want to
+#prepend any strings on the first or subsequent lines of the paragraph
+#begin created. In other words, had we been using Perl at work, I would
+#have done something like this:
+#
+#   use Text::Wrap qw(wrap $columns);
+#   # ... set $columns, $string, etc. ...
+#   return wrap("", "", $string);
+#
+#By the way, the copy of Wrap.pm came with the IndigoPerl distribution I
+#recently downloaded. This is the version string: $VERSION = 98.112902; I
+#don't know if that's the most recent.
+#
+#When I had some time, I was curious to see how my solution compared to
+#using your module. So, I threw together the following script:
+#
+#The interesting thing, which really surprised me, was that the results
+#seemed to indicate that my version ran faster. I was surprised because
+#I'm used to thinking that the standard Perl modules would always present
+#a better solution than "reinventing the wheel".
+#
+#  mine: 24 wallclock secs (18.49 usr +  0.00 sys = 18.49 CPU) @ 54.09/s
+#(n=1000)
+#  module: 58 wallclock secs (56.44 usr +  0.02 sys = 56.46 CPU) @ 17.71/s
+#(n=1000)
+#
+#Then, it occurred to me that the diffrence may be attributable to my
+#using substr() vs. the module relying on s///. (I recall reading
+#something on perlmonks.org a while back that indicated that substr() is
+#often faster than s///.)
+#
+#I realize that my solution has its problems (doesn't include ability to
+#specify first/subsequent line prefixes, and the possibility that it may
+#recurse itself out of memory, given a big enough input string). But I
+#though you might be interested in my findings.
+#
+#Dan
+#(perlmonks.org nick: t'mo)
+
+
+use strict;
+use Text::Wrap qw(wrap $columns);
+use Benchmark;
+
+my $testString = 'a;kjdf;ldsjf afkjad;fkjafkjafkj; dsfljasdfkjasfj;dThis
+is a test. It is only a test. Do not be alarmed, as the test should only
+take several seconds to run. Yadda yadda yadda...a;kjdf;ldsjf
+afkjad;fkjafkjafkj; dsfljasdfkjasfj;dThis is a test. It is only a test.
+Do not be alarmed, as the test should only take several seconds to run.
+Yadda yadda yadda...a;kjdf;ldsjf afkjad;fkjafkjafkj;
+dsfljasdfkjasfj;dThis is a test. It is only a test. Do not be alarmed, as
+the test should only take several seconds to run. Yadda yadda
+yadda...a;kjdf;ldsjf afkjad;fkjafkjafkj; dsfljasdfkjasfj;dThis is a test.
+It is only a test. Do not be alarmed, as the test should only take
+several seconds to run. Yadda yadda yadda...' x 5;
+
+$columns = 55;
+
+sub prefix {
+       my $length = shift;
+       my $string = shift;
+
+       return "" if( ! $string );
+
+       return prefix($length, substr($string, 1))
+               if( $string =~ /^\s/ );
+
+       if( length $string <= $length ) {
+               chop($string) while( $string =~ /\s$/ );
+               return $string . "\n";
+       }
+
+       my $pre = substr($string, 0, $length);
+       my $post = substr($string, $length);
+
+       if( $pre =~ /\s$/ ) {
+               chop($pre) while( $pre =~ /\s$/ );
+               return $pre . "\n" . prefix($length, $post);
+       }
+       else {
+               if( $post =~ /^\s/ ) {
+                       return $pre . "\n" . prefix($length, $post);
+               }
+               else {
+                       if( $pre !~ /\s/ ) {
+                               return $pre . "\n" . prefix($length, $post);
+                       }
+                       else {
+                               $pre =~ /(.*)\s+([^\s]*)/;
+                               $post = $2 . $post;
+                               return $1 . "\n" . prefix($length, $post);
+                       }
+               }
+       }
+}
+
+my $x = prefix($columns, $testString);
+my $y = wrap("", "", $testString);
+
+unless ($x ne $y) {
+       print "1..0 # Skipped: dnspark's module doesn't give the same answer\n";
+       exit;
+}
+
+my $cnt = -T STDOUT ? 200 : 40;
+my $results = timethese($cnt, {
+       mine => sub { my $res = prefix($columns, $testString) },
+       module => sub { my $res = wrap("", "", $testString) },
+});
+
+if ($results->{module}[1] < $results->{mine}[1]) {
+       print "1..1\nok 1\n";
+} else {
+       print "1..0 # Skipped: Dan's implmentation is faster\n";
+}
+
+
index 8af4a0e..dab0432 100755 (executable)
@@ -49,8 +49,9 @@ DONE
 
 $| = 1;
 
-my $numtests = scalar(@tests) / 2;
-print "1..$numtests\n";
+print "1..";
+print @tests/2;
+print "\n";
 
 use Text::Wrap;
 
index cd6f32c..1bba9a6 100755 (executable)
@@ -86,8 +86,9 @@ DONE
 
 $| = 1;
 
-my $numtests = scalar(@tests) / 2;
-print "1..$numtests\n";
+print "1..";
+print @tests/2;
+print "\n";
 
 use Text::Tabs;
 
index 37ffbb5..b9d51f2 100755 (executable)
@@ -1,6 +1,6 @@
-#!/usr/bin/perl5.00502
+#!/usr/bin/perl
 
-@tests = (split(/\nEND\n/s, <<DONE));
+@tests = (split(/\nEND\n/s, <<'DONE'));
 TEST1
 This 
 is
@@ -112,6 +112,17 @@ END
  Lines
 
 END
+TEST13 break=\d
+I saw 3 ships come sailing in
+END
+   I saw 3 ships come sailing in
+END
+TEST14 break=\d
+the.quick.brown.fox.jumps.over.the.9.lazy.dogs.for.no.good.reason.whatsoever.apparently
+END
+   the.quick.brown.fox.jumps.over.the.
+ .lazy.dogs.for.no.good.reason.whatsoever.apparently
+END
 DONE
 
 
@@ -130,7 +141,9 @@ while (@st) {
        my $in = shift(@st);
        my $out = shift(@st);
 
-       $in =~ s/^TEST(\d+)?\n//;
+       $in =~ s/^TEST(\d+)( break=(.*))?\n//
+           or die "bad TEST header line: $in\n";
+       local $Text::Wrap::break = $3 if defined $3;
 
        my $back = wrap('   ', ' ', $in);
 
@@ -164,7 +177,9 @@ while(@st) {
        my $in = shift(@st);
        my $out = shift(@st);
 
-       $in =~ s/^TEST(\d+)?\n//;
+       $in =~ s/^TEST(\d+)( break=(.*))?\n//
+           or die "bad TEST header line: $in\n";
+       local $Text::Wrap::break = $3 if defined $3;
 
        my @in = split("\n", $in, -1);
        @in = ((map { "$_\n" } @in[0..$#in-1]), $in[-1]);
diff --git a/lib/Text/TabsWrap/t/wrap_separator2.t b/lib/Text/TabsWrap/t/wrap_separator2.t
new file mode 100644 (file)
index 0000000..b31864f
--- /dev/null
@@ -0,0 +1,13 @@
+#!/usr/local/bin/perl -w
+#Author: Dan Dascalescu
+use strict;
+use Test::More tests => 1;
+
+use Text::Wrap;
+
+local $Text::Wrap::columns = 15;
+local $Text::Wrap::separator2 = '[N]';
+
+is(wrap('','','some long text here that should be wrapped on at least three lines'),
+"some long text[N]here that[N]should be[N]wrapped on at[N]least three[N]lines",
+'If you just to preserve existing newlines but add new breaks with something else, set $Text::Wrap::separator2 instead.');
index 3dee92f..de86202 100644 (file)
@@ -7,7 +7,7 @@ require Exporter;
 @EXPORT = qw(wrap fill);
 @EXPORT_OK = qw($columns $break $huge);
 
-$VERSION = 2006.1117;
+$VERSION = 2009.0305;
 
 use vars qw($VERSION $columns $debug $break $huge $unexpand $tabstop
        $separator $separator2);
@@ -35,9 +35,15 @@ sub wrap
        my $tail = pop(@t);
        my $t = expand(join("", (map { /\s+\z/ ? ( $_ ) : ($_, ' ') } @t), $tail));
        my $lead = $ip;
+       my $nll = $columns - length(expand($xp)) - 1;
+       if ($nll <= 0 && $xp ne '') {
+               my $nc = length(expand($xp)) + 2;
+               warnings::warnif "Increasing \$Text::Wrap::columns from $columns to $nc to accommodate length of subsequent tab";
+               $columns = $nc;
+               $nll = 1;
+       }
        my $ll = $columns - length(expand($ip)) - 1;
        $ll = 0 if $ll < 0;
-       my $nll = $columns - length(expand($xp)) - 1;
        my $nl = "";
        my $remainder = "";
 
@@ -176,9 +182,10 @@ use C<local($Text::Wrap::VARIABLE) = YOURVALUE> when you change the
 values so that the original value is restored.  This C<local()> trick
 will not work if you import the variable into your own namespace.
 
-Lines are wrapped at C<$Text::Wrap::columns> columns.  C<$Text::Wrap::columns>
-should be set to the full width of your output device.  In fact,
-every resulting line will have length of no more than C<$columns - 1>.  
+Lines are wrapped at C<$Text::Wrap::columns> columns (default value: 76).
+C<$Text::Wrap::columns> should be set to the full width of your output
+device.  In fact, every resulting line will have length of no more than
+C<$columns - 1>.
 
 It is possible to control which characters terminate words by
 modifying C<$Text::Wrap::break>. Set this to a string such as
@@ -187,6 +194,9 @@ such as C<qr/[\s']/> (to break before spaces or apostrophes). The
 default is simply C<'\s'>; that is, words are terminated by spaces.
 (This means, among other things, that trailing punctuation  such as
 full stops or commas stay with the word they are "attached" to.)
+Setting C<$Text::Wrap::break> to a regular expression that doesn't
+eat any characters (perhaps just a forward look-ahead assertion) will
+cause warnings.
 
 Beginner note: In example 2, above C<$columns> is imported into
 the local namespace, and set locally.  In example 3,
@@ -201,8 +211,8 @@ the number of characters you do want for your tabstops.
 
 If you want to separate your lines with something other than C<\n>
 then set C<$Text::Wrap::separator> to your preference.  This replaces
-all newlines with C<$Text::Wrap::separator>.  If you just want to
-preserve existing newlines but add new breaks with something else, set 
+all newlines with C<$Text::Wrap::separator>.  If you just want to 
+preserve existing newlines but add new breaks with something else, set
 C<$Text::Wrap::separator2> instead.
 
 When words that are longer than C<$columns> are encountered, they
@@ -240,11 +250,16 @@ Result:
 
   "This is a bit of|text that forms a|normal book-style|paragraph"
 
+=head1 SEE ALSO
+
+For wrapping multi-byte characters: L<Text::WrapI18N>.
+For more detailed controls: L<Text::Format>.
+
 =head1 LICENSE
 
-David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
-many many others.  Copyright (C) 1996-2006 David Muir Sharnoff.  
+David Muir Sharnoff <muir@idiom.org> with help from Tim Pierce and
+many many others.  Copyright (C) 1996-2009 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.
+your own risk.  Publicly redistributed versions that are modified 
+must use a different name.