]> git.donarmstrong.com Git - term-progressbar.git/blob - lib/Term/ProgressBar.pm
Document the term_width argument to the constructor.
[term-progressbar.git] / lib / Term / ProgressBar.pm
1 package Term::ProgressBar;
2
3 #XXX TODO Redo original test with count=20
4 #         Amount Output
5 #         Amount Prefix/Suffix
6 #         Tinker with $0?
7 #         Test use of last_update (with update(*undef*)) with scales
8 #         Choice of FH other than STDERR
9 #         If no term, output no progress bar; just progress so far
10 #         Use of simple term with v2.0 bar
11 #         If name is wider than term, trim name
12 #         Don't update progress bar on new?
13
14 =head1 NAME
15
16 Term::ProgressBar - provide a progress meter on a standard terminal
17
18 =head1 SYNOPSIS
19
20   use Term::ProgressBar;
21
22   $progress = Term::ProgressBar->new ({count => $count});
23   $progress->update ($so_far);
24
25 =head1 DESCRIPTION
26
27 Term::ProgressBar provides a simple progress bar on the terminal, to let the
28 user know that something is happening, roughly how much stuff has been done,
29 and maybe an estimate at how long remains.
30
31 A typical use sets up the progress bar with a number of items to do, and then
32 calls L<update|"update"> to update the bar whenever an item is processed.
33
34 Often, this would involve updating the progress bar many times with no
35 user-visible change.  To avoid uneccessary work, the update method returns a
36 value, being the update value at which the user will next see a change.  By
37 only calling update when the current value exceeds the next update value, the
38 call overhead is reduced.
39
40 Remember to call the C<< $progress->update($max_value) >> when the job is done
41 to get a nice 100% done bar.
42
43 A progress bar by default is simple; it just goes from left-to-right, filling
44 the bar with '=' characters.  These are called B<major> characters.  For
45 long-running jobs, this may be too slow, so two additional features are
46 available: a linear completion time estimator, and/or a B<minor> character:
47 this is a character that I<moves> from left-to-right on the progress bar (it
48 does not fill it as the major character does), traversing once for each
49 major-character added.  This exponentially increases the granularity of the
50 bar for the same width.
51
52 =head1 EXAMPLES
53
54 =head2 A really simple use
55
56   #!/usr/bin/perl
57
58   use Term::ProgressBar 2.00;
59
60   use constant MAX => 100_000;
61
62   my $progress = Term::ProgressBar->new(MAX);
63
64   for (0..MAX) {
65     my $is_power = 0;
66     for(my $i = 0; 2**$i <= $_; $i++) {
67       $is_power = 1
68         if 2**$i == $_;
69     }
70
71     if ( $is_power ) {
72       $progress->update($_);
73     }
74   }
75
76 see eg/simle_use.pl
77
78 Here is a simple example.  The process considers all the numbers between 0 and
79 MAX, and updates the progress bar whenever it finds one.  Note that the
80 progress bar update will be very erratic.  See below for a smoother example.
81 Note also that the progress bar will never complete; see below to solve this.
82
83 The complete text of this example is in F<examples/powers> in the
84 distribution set (it is not installed as part of the module).
85
86 =head2 A smoother bar update
87
88   my $progress = Term::ProgressBar->new($max);
89
90   for (0..$max) {
91     my $is_power = 0;
92     for(my $i = 0; 2**$i <= $_; $i++) {
93       $is_power = 1
94         if 2**$i == $_;
95     }
96
97     $progress->update($_)
98   }
99
100 See eg/smooth_bar.pl
101
102 This example calls update for each value considered.  This will result in a
103 much smoother progress update, but more program time is spent updating the bar
104 than doing the "real" work.  See below to remedy this.  This example does
105 I<not> call C<< $progress->update($max); >> at the end, since it is
106 unnecessary, and ProgressBar will throw an exception at an attempt to update a
107 finished bar.
108
109 The complete text of this example is in F<examples/powers2> in the
110 distribution set (it is not installed as part of the module.
111
112 =head2 A (much) more efficient update
113
114   my $progress = Term::ProgressBar->new({name => 'Powers', count => $max, remove => 1});
115   $progress->minor(0);
116   my $next_update = 0;
117
118   for (0..$max) {
119     my $is_power = 0;
120     for(my $i = 0; 2**$i <= $_; $i++) {
121       $is_power = 1
122         if 2**$i == $_;
123     }
124
125     $next_update = $progress->update($_)
126       if $_ >= $next_update;
127   }
128   $progress->update($max)
129     if $max >= $next_update;
130
131 This example does two things to improve efficiency: firstly, it uses the value
132 returned by L<update|"update"> to only call it again when needed; secondly, it
133 switches off the use of minor characters to update a lot less frequently (C<<
134 $progress->minor(0); >>.  The use of the return value of L<update|"update">
135 means that the call of C<< $progress->update($max); >> at the end is required
136 to ensure that the bar ends on 100%, which gives the user a nice feeling.
137
138 This example also sets the name of the progress bar.
139
140 This example also demonstrates the use of the 'remove' flag, which removes the
141 progress bar from the terminal when done.
142
143 The complete text of this example is in F<examples/powers3> in the
144 distribution set (it is not installed as part of the module.
145
146 =head2 Using Completion Time Estimation
147
148   my $progress = Term::ProgressBar->new({name  => 'Powers',
149                                          count => $max,
150                                          ETA   => 'linear', });
151   $progress->max_update_rate(1);
152   my $next_update = 0;
153
154   for (0..$max) {
155     my $is_power = 0;
156     for(my $i = 0; 2**$i <= $_; $i++) {
157       if ( 2**$i == $_ ) {
158         $is_power = 1;
159         $progress->message(sprintf "Found %8d to be 2 ** %2d", $_, $i);
160       }
161     }
162
163     $next_update = $progress->update($_)
164       if $_ > $next_update;
165   }
166   $progress->update($max)
167       if $max >= $next_update;
168
169 This example uses the L<ETA|"ETA"> option to switch on completion estimation.
170 Also, the update return is tuned to try to update the bar approximately once
171 per second, with the L<max_update_rate|"max_update_rate"> call.  See the
172 documentation for the L<new|new> method for details of the format(s) used.
173
174 This example also provides an example of the use of the L<message|"message">
175 function to output messages to the same filehandle whilst keeping the progress bar intact
176
177 The complete text of this example is in F<examples/powers5> in the
178 distribution set (it is not installed as part of the module.
179
180 =cut
181
182 # ----------------------------------------------------------------------
183
184 # Pragmas --------------------------
185
186 use strict;
187
188 # Inheritance ----------------------
189
190 use base qw( Exporter );
191 use vars '@EXPORT_OK';
192 @EXPORT_OK = qw( $PACKAGE $VERSION );
193
194 # Utility --------------------------
195
196 use Carp                    qw( croak );
197 use Class::MethodMaker 1.02 qw( );
198 use Fatal                   qw( open sysopen close seek );
199 use POSIX                   qw( ceil strftime );
200
201 # ----------------------------------------------------------------------
202
203 # CLASS METHODS --------------------------------------------------------
204
205 # ----------------------------------
206 # CLASS CONSTANTS
207 # ----------------------------------
208
209 =head1 CLASS CONSTANTS
210
211 Z<>
212
213 =cut
214
215 use constant MINUTE => 60;
216 use constant HOUR   => 60 * MINUTE;
217 use constant DAY    => 24 * HOUR;
218
219 # The point past which to give ETA of just date, rather than time
220 use constant ETA_DATE_CUTOFF => 3 * DAY;
221 # The point past which to give ETA of time, rather time left
222 use constant ETA_TIME_CUTOFF => 10 * MINUTE;
223 # The ratio prior to which to not dare any estimates
224 use constant PREDICT_RATIO => 0.01;
225
226 use constant DEFAULTS => {
227                           lbrack     => '[',
228                           rbrack     => ']',
229                           minor_char => '*',
230                           major_char => '=',
231                           fh         => \*STDERR,
232                           name       => undef,
233                           ETA        => undef,
234                           max_update_rate => 0.5,
235
236                           # The following defaults are never used, but the keys
237                           # are valuable for error checking
238                           count      => undef,
239                           bar_width  => undef,
240                           term_width => undef,
241                           term       => undef,
242                           remove     => 0,
243                          };
244
245 use constant ETA_TYPES => { map { $_ => 1 } qw( linear ) };
246
247 use constant ALREADY_FINISHED => 'progress bar already finished';
248
249 use constant DEBUG => 0;
250
251 # -------------------------------------
252
253 use vars qw($PACKAGE $VERSION);
254 $PACKAGE = 'Term-ProgressBar';
255 $VERSION = '2.14';
256
257 # ----------------------------------
258 # CLASS CONSTRUCTION
259 # ----------------------------------
260
261 # ----------------------------------
262 # CLASS COMPONENTS
263 # ----------------------------------
264
265 # This is here to allow testing to redirect away from the terminal but still
266 # see terminal output, IYSWIM
267 my $__FORCE_TERM = 0;
268
269 # ----------------------------------
270 # CLASS HIGHER-LEVEL FUNCTIONS
271 # ----------------------------------
272
273 # ----------------------------------
274 # CLASS HIGHER-LEVEL PROCEDURES
275 # ----------------------------------
276
277 sub __force_term {
278   my $class = shift;
279   ($__FORCE_TERM) = @_;
280 }
281
282 # ----------------------------------
283 # CLASS UTILITY FUNCTIONS
284 # ----------------------------------
285
286 sub term_size {
287   my ($fh) = @_;
288
289   eval {
290     require Term::ReadKey;
291   }; if ($@) {
292     warn "Guessing terminal width due to problem with Term::ReadKey\n";
293     return 50;
294   }
295
296   my $result;
297   eval {
298     $result = (Term::ReadKey::GetTerminalSize($fh))[0];
299     $result-- if ($^O eq "MSWin32");
300   }; if ( $@ ) {
301     warn "error from Term::ReadKey::GetTerminalSize(): $@";
302   }
303
304   # If GetTerminalSize() failed it should (according to its docs)
305   # return an empty list.  It doesn't - that's why we have the eval {}
306   # above - but also it may appear to succeed and return a width of
307   # zero.
308   #
309   if ( ! $result ) {
310     $result = 50;
311     warn "guessing terminal width $result\n";
312   }
313
314   return $result;
315 }
316
317
318 # INSTANCE METHODS -----------------------------------------------------
319
320 # ----------------------------------
321 # INSTANCE CONSTRUCTION
322 # ----------------------------------
323
324 =head1 INSTANCE CONSTRUCTION
325
326 Z<>
327
328 =cut
329
330 # Don't document hash keys until tested that the give the desired affect!
331
332 =head2 new
333
334 Create & return a new Term::ProgressBar instance.
335
336 =over 4
337
338 =item ARGUMENTS
339
340 If one argument is provided, and it is a hashref, then the hash is treated as
341 a set of key/value pairs, with the following keys; otherwise, it is treated as
342 a number, being equivalent to the C<count> key.
343
344 =over 4
345
346 =item count
347
348 The item count.  The progress is marked at 100% when update I<count> is
349 invoked, and proportionally until then.
350
351 =item name
352
353 A name to prefix the progress bar with.
354
355 =item fh
356
357 The filehandle to output to.  Defaults to stderr.  Do not try to use
358 *foo{THING} syntax if you want Term capabilities; it does not work.  Pass in a
359 globref instead.
360
361 =item term_width
362
363 Sometimes we can't correctly determine the terminal width. You can use this
364 parameter to force a term width of a particular size. Use a positive integer,
365 please :)
366
367 =item ETA
368
369 A total time estimation to use.  If enabled, a time finished estimation is
370 printed on the RHS (once sufficient updates have been performed to make such
371 an estimation feasible).  Naturally, this is an I<estimate>; no guarantees are
372 made.  The format of the estimate
373
374 Note that the format is intended to be as compact as possible while giving
375 over the relevant information.  Depending upon the time remaining, the format
376 is selected to provide some resolution whilst remaining compact.  Since the
377 time remaining decreases, the format typically changes over time.
378
379 As the ETA approaches, the format will state minutes & seconds left.  This is
380 identifiable by the word C<'Left'> at the RHS of the line.  If the ETA is
381 further away, then an estimate time of completion (rather than time left) is
382 given, and is identifiable by C<'ETA'> at the LHS of the ETA box (on the right
383 of the progress bar).  A time or date may be presented; these are of the form
384 of a 24 hour clock, e.g. C<'13:33'>, a time plus days (e.g., C<' 7PM+3'> for
385 around in over 3 days time) or a day/date, e.g. C<' 1Jan'> or C<'27Feb'>.
386
387 If ETA is switched on, the return value of L<update|"update"> is also
388 affected: the idea here is that if the progress bar seems to be moving quicker
389 than the eye would normally care for (and thus a great deal of time is spent
390 doing progress updates rather than "real" work), the next value is increased
391 to slow it.  The maximum rate aimed for is tunable via the
392 L<max_update_rate|"max_update_rate"> component.
393
394 The available values for this are:
395
396 =over 4
397
398 =item undef
399
400 Do not do estimation.  The default.
401
402 =item linear
403
404 Perform linear estimation.  This is simply that the amount of time between the
405 creation of the progress bar and now is divided by the current amount done,
406 and completion estimated linearly.
407
408 =back
409
410 =back
411
412 =item EXAMPLES
413
414   my $progress = Term::ProgressBar->new(100); # count from 1 to 100
415   my $progress = Term::ProgressBar->new({ count => 100 }); # same
416
417   # Count to 200 thingies, outputting to stdout instead of stderr,
418   # prefix bar with 'thingy'
419   my $progress = Term::ProgressBar->new({ count => 200,
420                                           fh    => \*STDOUT,
421                                           name  => 'thingy' });
422
423 =back
424
425 =cut
426
427 Class::MethodMaker->import (new_with_init => 'new',
428                             new_hash_init => 'hash_init',);
429
430 sub init {
431   my $self = shift;
432
433   # V1 Compatibility
434   return $self->init({count      => $_[1], name => $_[0],
435                       term_width => 50,    bar_width => 50,
436                       major_char => '#',   minor_char => '',
437                       lbrack     => '',    rbrack     => '',
438                       term       => '0 but true', })
439     if @_ == 2;
440
441   my $target;
442
443   croak
444     sprintf("Term::ProgressBar::new We don't handle this many arguments: %d",
445             scalar @_)
446     if @_ != 1;
447
448   my %config;
449
450   if ( UNIVERSAL::isa ($_[0], 'HASH') ) {
451     ($target) = @{$_[0]}{qw(count)};
452     %config = %{$_[0]}; # Copy in, so later playing does not tinker externally
453   } else {
454     ($target) = @_;
455   }
456
457   if ( my @bad = grep ! exists DEFAULTS->{$_}, keys %config )  {
458     croak sprintf("Input parameters (%s) to %s not recognized\n",
459                   join(':', @bad), 'Term::ProgressBar::new');
460   }
461
462   croak "Target count required for Term::ProgressBar new\n"
463     unless defined $target;
464
465   $config{$_} = DEFAULTS->{$_}
466     for grep ! exists $config{$_}, keys %{DEFAULTS()};
467   delete $config{count};
468
469   $config{term} = -t $config{fh}
470     unless defined $config{term};
471
472   if ( $__FORCE_TERM ) {
473     $config{term} = 1;
474     $config{term_width} = $__FORCE_TERM;
475     die "term width $config{term_width} (from __force_term) too small"
476       if $config{term_width} < 5;
477   } elsif ( $config{term} and ! defined $config{term_width}) {
478     $config{term_width} = term_size($config{fh});
479     die if $config{term_width} < 5;
480   }
481
482   unless ( defined $config{bar_width} ) {
483     if ( defined $config{term_width} ) {
484       # 5 for the % marker
485       $config{bar_width}  = $config{term_width} - 5;
486       $config{bar_width} -= $_
487         for map(( defined $config{$_} ? length($config{$_}) : 0),
488                   qw( lbrack rbrack name ));
489       $config{bar_width} -= 2 # Extra for ': '
490         if defined $config{name};
491       $config{bar_width} -= 10
492         if defined $config{ETA};
493       if ( $config{bar_width} < 1 ) {
494         warn "terminal width $config{term_width} too small for bar; defaulting to 10\n";
495         $config{bar_width} = 10;
496       }
497 #    } elsif ( ! $config{term} ) {
498 #      $config{bar_width}  = 1;
499 #      $config{term_width} = defined $config{ETA} ? 12 : 5;
500     } else {
501       $config{bar_width}  = $target;
502       die "configured bar_width $config{bar_width} < 1"
503       if $config{bar_width} < 1;
504     }
505   }
506
507   $config{start} = time;
508
509   select(((select $config{fh}), $| = 1)[0]);
510
511   $self->ETA(delete $config{ETA});
512
513   $self->hash_init (%config,
514
515                     offset        => 0,
516                     scale         => 1,
517
518                     last_update   => 0,
519                     last_position => 0,
520                    );
521   $self->target($target);
522   $self->minor($config{term} && $target > $config{bar_width} ** 1.5);
523
524   $self->update(0); # Initialize the progress bar
525 }
526
527
528 # ----------------------------------
529 # INSTANCE FINALIZATION
530 # ----------------------------------
531
532 # ----------------------------------
533 # INSTANCE COMPONENTS
534 # ----------------------------------
535
536 =head1 INSTANCE COMPONENTS
537
538 =cut
539
540 =head2 Scalar Components.
541
542 See L<Class::MethodMaker/get_set> for usage.
543
544 =over 4
545
546 =item target
547
548 The final target.  Updates are measured in terms of this.  Changes will have
549 no effect until the next update, but the next update value should be relative
550 to the new target.  So
551
552   $p = Term::ProgressBar({count => 20});
553   # Halfway
554   $p->update(10);
555   # Double scale
556   $p->target(40)
557   $p->update(21);
558
559 will cause the progress bar to update to 52.5%
560
561 =item max_update_rate
562
563 This value is taken as being the maximum speed between updates to aim for.
564 B<It is only meaningful if ETA is switched on.> It defaults to 0.5, being the
565 number of seconds between updates.
566
567 =back
568
569 =head2 Boolean Components
570
571 See L<Class::MethodMaker/get_set> for usage.
572
573 =over 4
574
575 =item minor
576
577 Default: set.  If unset, no minor scale will be calculated or updated.
578
579 Minor characters are used on the progress bar to give the user the idea of
580 progress even when there are so many more tasks than the terminal is wide that
581 the granularity would be too great.  By default, Term::ProgressBar makes a
582 guess as to when minor characters would be valuable.  However, it may not
583 always guess right, so this method may be called to force it one way or the
584 other.  Of course, the efficiency saving is minimal unless the client is
585 utilizing the return value of L<update|"update">.
586
587 See F<examples/powers4> and F<examples/powers3> to see minor characters in
588 action, and not in action, respectively.
589
590 =back
591
592 =head2 Configuration
593
594 =over 4
595
596 =item lbrack
597
598 Left bracket ( defaults to [ )
599
600  $progress->lbrack('<');
601
602 =item rbrack
603
604 Right bracket ( defaults to ] )
605
606  $progress->rbrack('>');
607
608 =back
609
610 =cut
611
612 # Private Scalar Components
613 #  offset    ) Default: 0.       Added to any value supplied to update.
614 #  scale     ) Default: 1.       Any value supplied to update is multiplied by
615 #                                this.
616 #  major_char) Default: '='.     The character printed for the major scale.
617 #  minor_char) Default: '*'.     The character printed for the minor scale.
618 #  name      ) Default: undef.   The name to print to the side of the bar.
619 #  fh        ) Default: STDERR.  The filehandle to output progress to.
620
621 # Private Counter Components
622 #  last_update  ) Default: 0.    The so_far value last time update was invoked.
623 #  last_position) Default: 0.    The number of the last progress mark printed.
624
625 # Private Boolean Components
626 #  term      ) Default: detected (by C<Term::ReadKey>).
627 #              If unset, we assume that we are not connected to a terminal (or
628 #              at least, not a suitably intelligent one).  Then, we attempt
629 #              minimal functionality.
630
631 Class::MethodMaker->import
632   (
633    get_set       => [qw/ major_units major_char
634                          minor_units minor_char
635                          lbrack      rbrack
636                          name
637                          offset      scale
638                          fh          start
639                          max_update_rate
640                      /],
641    counter       => [qw/ last_position last_update /],
642    boolean       => [qw/ minor name_printed pb_ended remove /],
643    # let it be boolean to handle 0 but true
644    get_set       => [qw/ term /],
645   );
646
647 # We generate these by hand since we want to check the values.
648 sub bar_width {
649     my $self = shift;
650     return $self->{bar_width} if not @_;
651     croak 'wrong number of arguments' if @_ != 1;
652     croak 'bar_width < 1' if $_[0] < 1;
653     $self->{bar_width} = $_[0];
654 }
655 sub term_width {
656     my $self = shift;
657     return $self->{term_width} if not @_;
658     croak 'wrong number of arguments' if @_ != 1;
659     croak 'term_width must be at least 5' if $self->term and $_[0] < 5;
660     $self->{term_width} = $_[0];
661 }
662
663 sub target {
664   my $self = shift;
665
666   if ( @_ ) {
667     my ($target) = @_;
668
669     if ( $target ) {
670       $self->major_units($self->bar_width / $target);
671       $self->minor_units($self->bar_width ** 2 / $target);
672       $self->minor      ( defined $self->term_width   and
673                           $self->term_width < $target );
674     }
675     $self->{target}  = $target;
676   }
677
678   return $self->{target};
679 }
680
681 sub ETA {
682   my $self = shift;
683
684   if (@_) {
685     my ($type) = @_;
686     croak "Invalid ETA type: $type\n"
687       if defined $type and ! exists ETA_TYPES->{$type};
688     $self->{ETA} = $type;
689   }
690
691   return $self->{ETA};
692 }
693
694 # ----------------------------------
695 # INSTANCE HIGHER-LEVEL FUNCTIONS
696 # ----------------------------------
697
698 # ----------------------------------
699 # INSTANCE HIGHER-LEVEL PROCEDURES
700 # ----------------------------------
701
702 =head1 INSTANCE HIGHER-LEVEL PROCEDURES
703
704 Z<>
705
706 =cut
707
708 sub no_minor {
709   warn sprintf("%s: This method is deprecated.  Please use %s instead\n",
710                (caller (0))[3], '$x->minor (0)',);
711   $_[0]->clear_minor (0);
712 }
713
714 # -------------------------------------
715
716 =head2 update
717
718 Update the progress bar.
719
720 =over 4
721
722 =item ARGUMENTS
723
724 =over 4
725
726 =item so_far
727
728 Current progress point, in whatever units were passed to C<new>.
729
730 If not defined, assumed to be 1+ whatever was the value last time C<update>
731 was called (starting at 0).
732
733 =back
734
735 =item RETURNS
736
737 =over 4
738
739 =item next_call
740
741 The next value of so_far at which to call C<update>.
742
743 =back
744
745 =back
746
747 =cut
748
749 sub update {
750   my $self = shift;
751   my ($so_far) = @_;
752
753   if ( ! defined $so_far ) {
754     $so_far = $self->last_update + 1;
755   }
756
757   my $input_so_far = $so_far;
758   $so_far *= $self->scale
759     unless $self->scale == 1;
760   $so_far += $self->offset;
761
762   my $target = my $next = $self->target;
763   my $name = $self->name;
764   my $fh = $self->fh;
765
766   if ( $target < 1 ) {
767     print $fh "\r";
768     printf $fh "$name: "
769       if defined $name;
770     print $fh "(nothing to do)\n";
771     return 2**32-1;
772   }
773
774   my $biggies     = $self->major_units * $so_far;
775   my @chars = (' ') x $self->bar_width;
776   $chars[$_] = $self->major_char
777     for 0..$biggies-1;
778
779   if ( $self->minor ) {
780     my $smally      = $self->minor_units * $so_far % $self->bar_width;
781     $chars[$smally] = $self->minor_char
782       unless $so_far == $target;
783     $next *= ($self->minor_units * $so_far + 1) / ($self->bar_width ** 2);
784   } else {
785     $next *= ($self->major_units * $so_far + 1) / $self->bar_width;
786   }
787
788   local $\ = undef;
789
790   if ( $self->term > 0 ) {
791     local $\ = undef;
792     my $to_print = "\r";
793     $to_print .= "$name: "
794       if defined $name;
795     my $ratio = $so_far / $target;
796     # Rounds down %
797     $to_print .= (sprintf ("%3d%% %s%s%s",
798                         $ratio * 100,
799                         $self->lbrack, join ('', @chars), $self->rbrack));
800     my $ETA = $self->ETA;
801     if ( defined $ETA and $ratio > 0 ) {
802       if ( $ETA eq 'linear' ) {
803         if ( $ratio == 1 ) {
804           my $taken = time - $self->start;
805           my $ss    = $taken % 60;
806           my $mm    = int(($taken % 3600) / 60);
807           my $hh    = int($taken / 3600);
808           if ( $hh > 99 ) {
809             $to_print .= sprintf('D %2dh%02dm', $hh, $mm, $ss);
810           } else {
811             $to_print .= sprintf('D%2dh%02dm%02ds', $hh, $mm, $ss);
812           }
813         } elsif ( $ratio < PREDICT_RATIO ) {
814           # No safe prediction yet
815           $to_print .= 'ETA ------';
816         } else {
817           my $time = time;
818           my $left = (($time - $self->start) * ((1 - $ratio) / $ratio));
819           if ( $left  < ETA_TIME_CUTOFF ) {
820             $to_print .= sprintf '%1dm%02ds Left', int($left / 60), $left % 60;
821           } else {
822             my $eta  = $time + $left;
823             my $format;
824             if ( $left < DAY ) {
825               $format = 'ETA  %H:%M';
826             } elsif ( $left < ETA_DATE_CUTOFF ) {
827               $format = sprintf('ETA %%l%%p+%d',$left/DAY);
828             } else {
829               $format = 'ETA %e%b';
830             }
831             $to_print .= strftime($format, localtime $eta);
832           }
833           # Calculate next to be at least SEC_PER_UPDATE seconds away
834           if ( $left > 0 ) {
835             my $incr = ($target - $so_far) / ($left / $self->max_update_rate);
836             $next = $so_far + $incr
837               if $so_far + $incr > $next;
838           }
839         }
840       } else {
841         croak "Bad ETA type: $ETA\n";
842       }
843     }
844     for ($self->{last_printed}) {
845         unless (defined and $_ eq $to_print) {
846             print $fh $to_print;
847         }
848         $_ = $to_print;
849     }
850
851     $next -= $self->offset;
852     $next /= $self->scale
853       unless $self->scale == 1;
854
855     if ( $so_far >= $target and $self->remove and ! $self->pb_ended) {
856       print $fh "\r", ' ' x $self->term_width, "\r";
857       $self->pb_ended;
858     }
859
860   } else {
861     local $\ = undef;
862
863     if ( $self->term ) { # special case for backwards compat.
864      if ( $so_far == 0 and defined $name and ! $self->name_printed ) {
865        print $fh "$name: ";
866        $self->set_name_printed;
867      }
868
869       my $position = int($self->bar_width * ($input_so_far / $target));
870       my $add      = $position - $self->last_position;
871       $self->last_position_incr ($add)
872         if $add;
873
874      print $fh $self->major_char x $add;
875
876      $next -= $self->offset;
877      $next /= $self->scale
878        unless $self->scale == 1;
879     } else {
880       my $pc = int(100*$input_so_far/$target);
881       printf $fh "[%s] %s: %3d%%\n", scalar(localtime), $name, $pc;
882
883       $next = ceil($target * ($pc+1)/100);
884     }
885
886     if ( $input_so_far >= $target ) {
887       if ( $self->pb_ended ) {
888         croak ALREADY_FINISHED;
889       } else {
890         if ( $self->term ) {
891           print $fh "\n"
892         }
893         $self->set_pb_ended;
894       }
895     }
896   }
897
898
899   $next = $target if $next > $target;
900
901   $self->last_update($input_so_far);
902   return $next;
903 }
904
905 # -------------------------------------
906
907 =head2 message
908
909 Output a message.  This is very much like print, but we try not to disturb the
910 terminal.
911
912 =over 4
913
914 =item ARGUMENTS
915
916 =over 4
917
918 =item string
919
920 The message to output.
921
922 =back
923
924 =back
925
926 =cut
927
928 sub message {
929   my $self = shift;
930   my ($string) = @_;
931   chomp ($string);
932
933   my $fh = $self->fh;
934   local $\ = undef;
935   if ( $self->term ) {
936     print $fh "\r", ' ' x $self->term_width;
937     print $fh "\r$string\n";
938   } else {
939     print $fh "\n$string\n";
940     print $fh $self->major_char x $self->last_position;
941   }
942   undef $self->{last_printed};
943   $self->update($self->last_update);
944 }
945
946
947 # ----------------------------------------------------------------------
948
949 =head1 REPORTING BUGS
950
951 via RT: L<https://rt.cpan.org/Dist/Display.html?Name=Pipe>
952
953 =head1 COMPATIBILITY
954
955 If exactly two arguments are provided, then L<new|"new"> operates in v1
956 compatibility mode: the arguments are considered to be name, and item count.
957 Various other defaults are set to emulate version one (e.g., the major output
958 character is '#', the bar width is set to 50 characters and the output
959 filehandle is not treated as a terminal). This mode is deprecated.
960
961 =head1 AUTHOR
962
963 Martyn J. Pearce fluffy@cpan.org
964
965 Significant contributions from Ed Avis, amongst others.
966
967 =head1 MAINTAINER
968
969 Gabor Szabo L<http://szabgab.com/>
970
971 =head1 COPYRIGHT
972
973 Copyright (c) 2001, 2002, 2003, 2004, 2005 Martyn J. Pearce.  This program is
974 free software; you can redistribute it and/or modify it under the same terms
975 as Perl itself.
976
977 =cut
978
979 1; # keep require happy.
980
981 __END__