summaryrefslogtreecommitdiff
path: root/cpan/Text-Tabs/t/dnsparks.t
blob: 2e6e6aeaa2040f99f8ff378e0b5cdb60d8e1dfd9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
use strict; use warnings;

BEGIN {
	if ($ENV{HARNESS_ACTIVE}) {
		print "1..0 # Skipped: not a 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 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) },
}, 'none');

if ($results->{module}[1] < $results->{mine}[1]) {
	print "1..1\nok 1\n";
} else {
	print "1..0 # Skipped: Dan's implmentation is faster\n";
}