Initial bulk commit for "Git on MSys"
[msysgit/historical-msysgit.git] / lib / perl5 / 5.6.1 / Benchmark.pm
blobb557be3cc7a6b900d168c10f2caf49422b08c004
1 package Benchmark;
3 =head1 NAME
5 Benchmark - benchmark running times of Perl code
7 =head1 SYNOPSIS
9 timethis ($count, "code");
11 # Use Perl code in strings...
12 timethese($count, {
13 'Name1' => '...code1...',
14 'Name2' => '...code2...',
15 });
17 # ... or use subroutine references.
18 timethese($count, {
19 'Name1' => sub { ...code1... },
20 'Name2' => sub { ...code2... },
21 });
23 # cmpthese can be used both ways as well
24 cmpthese($count, {
25 'Name1' => '...code1...',
26 'Name2' => '...code2...',
27 });
29 cmpthese($count, {
30 'Name1' => sub { ...code1... },
31 'Name2' => sub { ...code2... },
32 });
34 # ...or in two stages
35 $results = timethese($count,
37 'Name1' => sub { ...code1... },
38 'Name2' => sub { ...code2... },
40 'none'
42 cmpthese( $results ) ;
44 $t = timeit($count, '...other code...')
45 print "$count loops of other code took:",timestr($t),"\n";
47 $t = countit($time, '...other code...')
48 $count = $t->iters ;
49 print "$count loops of other code took:",timestr($t),"\n";
51 =head1 DESCRIPTION
53 The Benchmark module encapsulates a number of routines to help you
54 figure out how long it takes to execute some code.
56 timethis - run a chunk of code several times
58 timethese - run several chunks of code several times
60 cmpthese - print results of timethese as a comparison chart
62 timeit - run a chunk of code and see how long it goes
64 countit - see how many times a chunk of code runs in a given time
67 =head2 Methods
69 =over 10
71 =item new
73 Returns the current time. Example:
75 use Benchmark;
76 $t0 = new Benchmark;
77 # ... your code here ...
78 $t1 = new Benchmark;
79 $td = timediff($t1, $t0);
80 print "the code took:",timestr($td),"\n";
82 =item debug
84 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
86 debug Benchmark 1;
87 $t = timeit(10, ' 5 ** $Global ');
88 debug Benchmark 0;
90 =item iters
92 Returns the number of iterations.
94 =back
96 =head2 Standard Exports
98 The following routines will be exported into your namespace
99 if you use the Benchmark module:
101 =over 10
103 =item timeit(COUNT, CODE)
105 Arguments: COUNT is the number of times to run the loop, and CODE is
106 the code to run. CODE may be either a code reference or a string to
107 be eval'd; either way it will be run in the caller's package.
109 Returns: a Benchmark object.
111 =item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
113 Time COUNT iterations of CODE. CODE may be a string to eval or a
114 code reference; either way the CODE will run in the caller's package.
115 Results will be printed to STDOUT as TITLE followed by the times.
116 TITLE defaults to "timethis COUNT" if none is provided. STYLE
117 determines the format of the output, as described for timestr() below.
119 The COUNT can be zero or negative: this means the I<minimum number of
120 CPU seconds> to run. A zero signifies the default of 3 seconds. For
121 example to run at least for 10 seconds:
123 timethis(-10, $code)
125 or to run two pieces of code tests for at least 3 seconds:
127 timethese(0, { test1 => '...', test2 => '...'})
129 CPU seconds is, in UNIX terms, the user time plus the system time of
130 the process itself, as opposed to the real (wallclock) time and the
131 time spent by the child processes. Less than 0.1 seconds is not
132 accepted (-0.01 as the count, for example, will cause a fatal runtime
133 exception).
135 Note that the CPU seconds is the B<minimum> time: CPU scheduling and
136 other operating system factors may complicate the attempt so that a
137 little bit more time is spent. The benchmark output will, however,
138 also tell the number of C<$code> runs/second, which should be a more
139 interesting number than the actually spent seconds.
141 Returns a Benchmark object.
143 =item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
145 The CODEHASHREF is a reference to a hash containing names as keys
146 and either a string to eval or a code reference for each value.
147 For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
148 call
150 timethis(COUNT, VALUE, KEY, STYLE)
152 The routines are called in string comparison order of KEY.
154 The COUNT can be zero or negative, see timethis().
156 Returns a hash of Benchmark objects, keyed by name.
158 =item timediff ( T1, T2 )
160 Returns the difference between two Benchmark times as a Benchmark
161 object suitable for passing to timestr().
163 =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
165 Returns a string that formats the times in the TIMEDIFF object in
166 the requested STYLE. TIMEDIFF is expected to be a Benchmark object
167 similar to that returned by timediff().
169 STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows
170 each of the 5 times available ('wallclock' time, user time, system time,
171 user time of children, and system time of children). 'noc' shows all
172 except the two children times. 'nop' shows only wallclock and the
173 two children times. 'auto' (the default) will act as 'all' unless
174 the children times are both zero, in which case it acts as 'noc'.
175 'none' prevents output.
177 FORMAT is the L<printf(3)>-style format specifier (without the
178 leading '%') to use to print the times. It defaults to '5.2f'.
180 =back
182 =head2 Optional Exports
184 The following routines will be exported into your namespace
185 if you specifically ask that they be imported:
187 =over 10
189 =item clearcache ( COUNT )
191 Clear the cached time for COUNT rounds of the null loop.
193 =item clearallcache ( )
195 Clear all cached times.
197 =item cmpthese ( COUT, CODEHASHREF, [ STYLE ] )
199 =item cmpthese ( RESULTSHASHREF )
201 Optionally calls timethese(), then outputs comparison chart. This
202 chart is sorted from slowest to fastest, and shows the percent
203 speed difference between each pair of tests. Can also be passed
204 the data structure that timethese() returns:
206 $results = timethese( .... );
207 cmpthese( $results );
209 Returns the data structure returned by timethese() (or passed in).
211 =item countit(TIME, CODE)
213 Arguments: TIME is the minimum length of time to run CODE for, and CODE is
214 the code to run. CODE may be either a code reference or a string to
215 be eval'd; either way it will be run in the caller's package.
217 TIME is I<not> negative. countit() will run the loop many times to
218 calculate the speed of CODE before running it for TIME. The actual
219 time run for will usually be greater than TIME due to system clock
220 resolution, so it's best to look at the number of iterations divided
221 by the times that you are concerned with, not just the iterations.
223 Returns: a Benchmark object.
225 =item disablecache ( )
227 Disable caching of timings for the null loop. This will force Benchmark
228 to recalculate these timings for each new piece of code timed.
230 =item enablecache ( )
232 Enable caching of timings for the null loop. The time taken for COUNT
233 rounds of the null loop will be calculated only once for each
234 different COUNT used.
236 =item timesum ( T1, T2 )
238 Returns the sum of two Benchmark times as a Benchmark object suitable
239 for passing to timestr().
241 =back
243 =head1 NOTES
245 The data is stored as a list of values from the time and times
246 functions:
248 ($real, $user, $system, $children_user, $children_system, $iters)
250 in seconds for the whole loop (not divided by the number of rounds).
252 The timing is done using time(3) and times(3).
254 Code is executed in the caller's package.
256 The time of the null loop (a loop with the same
257 number of rounds but empty loop body) is subtracted
258 from the time of the real loop.
260 The null loop times can be cached, the key being the
261 number of rounds. The caching can be controlled using
262 calls like these:
264 clearcache($key);
265 clearallcache();
267 disablecache();
268 enablecache();
270 Caching is off by default, as it can (usually slightly) decrease
271 accuracy and does not usually noticably affect runtimes.
273 =head1 EXAMPLES
275 For example,
277 use Benchmark;$x=3;cmpthese(-5,{a=>sub{$x*$x},b=>sub{$x**2}})
279 outputs something like this:
281 Benchmark: running a, b, each for at least 5 CPU seconds...
282 a: 10 wallclock secs ( 5.14 usr + 0.13 sys = 5.27 CPU) @ 3835055.60/s (n=20210743)
283 b: 5 wallclock secs ( 5.41 usr + 0.00 sys = 5.41 CPU) @ 1574944.92/s (n=8520452)
284 Rate b a
285 b 1574945/s -- -59%
286 a 3835056/s 144% --
288 while
290 use Benchmark;
291 $x=3;
292 $r=timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}},'none');
293 cmpthese($r);
295 outputs something like this:
297 Rate b a
298 b 1559428/s -- -62%
299 a 4152037/s 166% --
302 =head1 INHERITANCE
304 Benchmark inherits from no other class, except of course
305 for Exporter.
307 =head1 CAVEATS
309 Comparing eval'd strings with code references will give you
310 inaccurate results: a code reference will show a slightly slower
311 execution time than the equivalent eval'd string.
313 The real time timing is done using time(2) and
314 the granularity is therefore only one second.
316 Short tests may produce negative figures because perl
317 can appear to take longer to execute the empty loop
318 than a short test; try:
320 timethis(100,'1');
322 The system time of the null loop might be slightly
323 more than the system time of the loop with the actual
324 code and therefore the difference might end up being E<lt> 0.
326 =head1 SEE ALSO
328 L<Devel::DProf> - a Perl code profiler
330 =head1 AUTHORS
332 Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
334 =head1 MODIFICATION HISTORY
336 September 8th, 1994; by Tim Bunce.
338 March 28th, 1997; by Hugo van der Sanden: added support for code
339 references and the already documented 'debug' method; revamped
340 documentation.
342 April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
343 functionality.
345 September, 1999; by Barrie Slaymaker: math fixes and accuracy and
346 efficiency tweaks. Added cmpthese(). A result is now returned from
347 timethese(). Exposed countit() (was runfor()).
349 =cut
351 # evaluate something in a clean lexical environment
352 sub _doeval { eval shift }
355 # put any lexicals at file scope AFTER here
358 use Carp;
359 use Exporter;
360 @ISA=(Exporter);
361 @EXPORT=qw(timeit timethis timethese timediff timestr);
362 @EXPORT_OK=qw(timesum cmpthese countit
363 clearcache clearallcache disablecache enablecache);
365 $VERSION = 1.00;
367 &init;
369 sub init {
370 $debug = 0;
371 $min_count = 4;
372 $min_cpu = 0.4;
373 $defaultfmt = '5.2f';
374 $defaultstyle = 'auto';
375 # The cache can cause a slight loss of sys time accuracy. If a
376 # user does many tests (>10) with *very* large counts (>10000)
377 # or works on a very slow machine the cache may be useful.
378 &disablecache;
379 &clearallcache;
382 sub debug { $debug = ($_[1] != 0); }
384 # The cache needs two branches: 's' for strings and 'c' for code. The
385 # emtpy loop is different in these two cases.
386 sub clearcache { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
387 sub clearallcache { %cache = (); }
388 sub enablecache { $cache = 1; }
389 sub disablecache { $cache = 0; }
391 # --- Functions to process the 'time' data type
393 sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
394 print "new=@t\n" if $debug;
395 bless \@t; }
397 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
398 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
399 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
400 sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
401 sub iters { $_[0]->[5] ; }
403 sub timediff {
404 my($a, $b) = @_;
405 my @r;
406 for (my $i=0; $i < @$a; ++$i) {
407 push(@r, $a->[$i] - $b->[$i]);
409 bless \@r;
412 sub timesum {
413 my($a, $b) = @_;
414 my @r;
415 for (my $i=0; $i < @$a; ++$i) {
416 push(@r, $a->[$i] + $b->[$i]);
418 bless \@r;
421 sub timestr {
422 my($tr, $style, $f) = @_;
423 my @t = @$tr;
424 warn "bad time value (@t)" unless @t==6;
425 my($r, $pu, $ps, $cu, $cs, $n) = @t;
426 my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
427 $f = $defaultfmt unless defined $f;
428 # format a time in the required style, other formats may be added here
429 $style ||= $defaultstyle;
430 $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
431 my $s = "@t $style"; # default for unknown style
432 $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
433 $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';
434 $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
435 $r,$pu,$ps,$pt) if $style eq 'noc';
436 $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
437 $r,$cu,$cs,$ct) if $style eq 'nop';
438 $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n && $pu+$ps;
442 sub timedebug {
443 my($msg, $t) = @_;
444 print STDERR "$msg",timestr($t),"\n" if $debug;
447 # --- Functions implementing low-level support for timing loops
449 sub runloop {
450 my($n, $c) = @_;
452 $n+=0; # force numeric now, so garbage won't creep into the eval
453 croak "negative loopcount $n" if $n<0;
454 confess "Usage: runloop(number, [string | coderef])" unless defined $c;
455 my($t0, $t1, $td); # before, after, difference
457 # find package of caller so we can execute code there
458 my($curpack) = caller(0);
459 my($i, $pack)= 0;
460 while (($pack) = caller(++$i)) {
461 last if $pack ne $curpack;
464 my ($subcode, $subref);
465 if (ref $c eq 'CODE') {
466 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
467 $subref = eval $subcode;
469 else {
470 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
471 $subref = _doeval($subcode);
473 croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
474 print STDERR "runloop $n '$subcode'\n" if $debug;
476 # Wait for the user timer to tick. This makes the error range more like
477 # -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This
478 # may not seem important, but it significantly reduces the chances of
479 # getting a too low initial $n in the initial, 'find the minimum' loop
480 # in &countit. This, in turn, can reduce the number of calls to
481 # &runloop a lot, and thus reduce additive errors.
482 my $tbase = Benchmark->new(0)->[1];
483 while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
484 &$subref;
485 $t1 = Benchmark->new($n);
486 $td = &timediff($t1, $t0);
487 timedebug("runloop:",$td);
488 $td;
492 sub timeit {
493 my($n, $code) = @_;
494 my($wn, $wc, $wd);
496 printf STDERR "timeit $n $code\n" if $debug;
497 my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
498 if ($cache && exists $cache{$cache_key} ) {
499 $wn = $cache{$cache_key};
500 } else {
501 $wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
502 # Can't let our baseline have any iterations, or they get subtracted
503 # out of the result.
504 $wn->[5] = 0;
505 $cache{$cache_key} = $wn;
508 $wc = &runloop($n, $code);
510 $wd = timediff($wc, $wn);
511 timedebug("timeit: ",$wc);
512 timedebug(" - ",$wn);
513 timedebug(" = ",$wd);
515 $wd;
519 my $default_for = 3;
520 my $min_for = 0.1;
523 sub countit {
524 my ( $tmax, $code ) = @_;
526 if ( not defined $tmax or $tmax == 0 ) {
527 $tmax = $default_for;
528 } elsif ( $tmax < 0 ) {
529 $tmax = -$tmax;
532 die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
533 if $tmax < $min_for;
535 my ($n, $tc);
537 # First find the minimum $n that gives a significant timing.
538 for ($n = 1; ; $n *= 2 ) {
539 my $td = timeit($n, $code);
540 $tc = $td->[1] + $td->[2];
541 last if $tc > 0.1;
544 my $nmin = $n;
546 # Get $n high enough that we can guess the final $n with some accuracy.
547 my $tpra = 0.1 * $tmax; # Target/time practice.
548 while ( $tc < $tpra ) {
549 # The 5% fudge is to keep us from iterating again all
550 # that often (this speeds overall responsiveness when $tmax is big
551 # and we guess a little low). This does not noticably affect
552 # accuracy since we're not couting these times.
553 $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
554 my $td = timeit($n, $code);
555 my $new_tc = $td->[1] + $td->[2];
556 # Make sure we are making progress.
557 $tc = $new_tc > 1.2 * $tc ? $new_tc : 1.2 * $tc;
560 # Now, do the 'for real' timing(s), repeating until we exceed
561 # the max.
562 my $ntot = 0;
563 my $rtot = 0;
564 my $utot = 0.0;
565 my $stot = 0.0;
566 my $cutot = 0.0;
567 my $cstot = 0.0;
568 my $ttot = 0.0;
570 # The 5% fudge is because $n is often a few % low even for routines
571 # with stable times and avoiding extra timeit()s is nice for
572 # accuracy's sake.
573 $n = int( $n * ( 1.05 * $tmax / $tc ) );
575 while () {
576 my $td = timeit($n, $code);
577 $ntot += $n;
578 $rtot += $td->[0];
579 $utot += $td->[1];
580 $stot += $td->[2];
581 $cutot += $td->[3];
582 $cstot += $td->[4];
583 $ttot = $utot + $stot;
584 last if $ttot >= $tmax;
586 $ttot = 0.01 if $ttot < 0.01;
587 my $r = $tmax / $ttot - 1; # Linear approximation.
588 $n = int( $r * $ntot );
589 $n = $nmin if $n < $nmin;
592 return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
595 # --- Functions implementing high-level time-then-print utilities
597 sub n_to_for {
598 my $n = shift;
599 return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
602 sub timethis{
603 my($n, $code, $title, $style) = @_;
604 my($t, $for, $forn);
606 if ( $n > 0 ) {
607 croak "non-integer loopcount $n, stopped" if int($n)<$n;
608 $t = timeit($n, $code);
609 $title = "timethis $n" unless defined $title;
610 } else {
611 $fort = n_to_for( $n );
612 $t = countit( $fort, $code );
613 $title = "timethis for $fort" unless defined $title;
614 $forn = $t->[-1];
616 local $| = 1;
617 $style = "" unless defined $style;
618 printf("%10s: ", $title) unless $style eq 'none';
619 print timestr($t, $style, $defaultfmt),"\n" unless $style eq 'none';
621 $n = $forn if defined $forn;
623 # A conservative warning to spot very silly tests.
624 # Don't assume that your benchmark is ok simply because
625 # you don't get this warning!
626 print " (warning: too few iterations for a reliable count)\n"
627 if $n < $min_count
628 || ($t->real < 1 && $n < 1000)
629 || $t->cpu_a < $min_cpu;
633 sub timethese{
634 my($n, $alt, $style) = @_;
635 die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
636 unless ref $alt eq HASH;
637 my @names = sort keys %$alt;
638 $style = "" unless defined $style;
639 print "Benchmark: " unless $style eq 'none';
640 if ( $n > 0 ) {
641 croak "non-integer loopcount $n, stopped" if int($n)<$n;
642 print "timing $n iterations of" unless $style eq 'none';
643 } else {
644 print "running" unless $style eq 'none';
646 print " ", join(', ',@names) unless $style eq 'none';
647 unless ( $n > 0 ) {
648 my $for = n_to_for( $n );
649 print ", each for at least $for CPU seconds" unless $style eq 'none';
651 print "...\n" unless $style eq 'none';
653 # we could save the results in an array and produce a summary here
654 # sum, min, max, avg etc etc
655 my %results;
656 foreach my $name (@names) {
657 $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
660 return \%results;
663 sub cmpthese{
664 my $results = ref $_[0] ? $_[0] : timethese( @_ );
666 return $results
667 if defined $_[2] && $_[2] eq 'none';
669 # Flatten in to an array of arrays with the name as the first field
670 my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
672 for (@vals) {
673 # The epsilon fudge here is to prevent div by 0. Since clock
674 # resolutions are much larger, it's below the noise floor.
675 my $rate = $_->[6] / ( $_->[2] + $_->[3] + 0.000000000000001 );
676 $_->[7] = $rate;
679 # Sort by rate
680 @vals = sort { $a->[7] <=> $b->[7] } @vals;
682 # If more than half of the rates are greater than one...
683 my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
685 my @rows;
686 my @col_widths;
688 my @top_row = (
689 '',
690 $display_as_rate ? 'Rate' : 's/iter',
691 map { $_->[0] } @vals
694 push @rows, \@top_row;
695 @col_widths = map { length( $_ ) } @top_row;
697 # Build the data rows
698 # We leave the last column in even though it never has any data. Perhaps
699 # it should go away. Also, perhaps a style for a single column of
700 # percentages might be nice.
701 for my $row_val ( @vals ) {
702 my @row;
704 # Column 0 = test name
705 push @row, $row_val->[0];
706 $col_widths[0] = length( $row_val->[0] )
707 if length( $row_val->[0] ) > $col_widths[0];
709 # Column 1 = performance
710 my $row_rate = $row_val->[7];
712 # We assume that we'll never get a 0 rate.
713 my $a = $display_as_rate ? $row_rate : 1 / $row_rate;
715 # Only give a few decimal places before switching to sci. notation,
716 # since the results aren't usually that accurate anyway.
717 my $format =
718 $a >= 100 ?
719 "%0.0f" :
720 $a >= 10 ?
721 "%0.1f" :
722 $a >= 1 ?
723 "%0.2f" :
724 $a >= 0.1 ?
725 "%0.3f" :
726 "%0.2e";
728 $format .= "/s"
729 if $display_as_rate;
730 # Using $b here due to optimizing bug in _58 through _61
731 my $b = sprintf( $format, $a );
732 push @row, $b;
733 $col_widths[1] = length( $b )
734 if length( $b ) > $col_widths[1];
736 # Columns 2..N = performance ratios
737 my $skip_rest = 0;
738 for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) {
739 my $col_val = $vals[$col_num];
740 my $out;
741 if ( $skip_rest ) {
742 $out = '';
744 elsif ( $col_val->[0] eq $row_val->[0] ) {
745 $out = "--";
746 # $skip_rest = 1;
748 else {
749 my $col_rate = $col_val->[7];
750 $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 );
752 push @row, $out;
753 $col_widths[$col_num+2] = length( $out )
754 if length( $out ) > $col_widths[$col_num+2];
756 # A little wierdness to set the first column width properly
757 $col_widths[$col_num+2] = length( $col_val->[0] )
758 if length( $col_val->[0] ) > $col_widths[$col_num+2];
760 push @rows, \@row;
763 # Equalize column widths in the chart as much as possible without
764 # exceeding 80 characters. This does not use or affect cols 0 or 1.
765 my @sorted_width_refs =
766 sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
767 my $max_width = ${$sorted_width_refs[-1]};
769 my $total = @col_widths - 1 ;
770 for ( @col_widths ) { $total += $_ }
772 STRETCHER:
773 while ( $total < 80 ) {
774 my $min_width = ${$sorted_width_refs[0]};
775 last
776 if $min_width == $max_width;
777 for ( @sorted_width_refs ) {
778 last
779 if $$_ > $min_width;
780 ++$$_;
781 ++$total;
782 last STRETCHER
783 if $total >= 80;
787 # Dump the output
788 my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n";
789 substr( $format, 1, 0 ) = '-';
790 for ( @rows ) {
791 printf $format, @$_;
794 return $results;