File Coverage

blib/lib/Time/Progress.pm
Criterion Covered Total %
statement 80 102 78.4
branch 17 34 50.0
condition 10 36 27.7
subroutine 8 15 53.3
pod 10 11 90.9
total 125 198 63.1


line stmt bran cond sub pod time code
1             package Time::Progress;
2              
3 1     1   19724 use 5.006;
  1         4  
4 1     1   4 use strict;
  1         2  
  1         24  
5 1     1   2 use warnings;
  1         6  
  1         26  
6 1     1   5 use Carp;
  1         2  
  1         1406  
7              
8             our $VERSION = '2.12';
9              
10             our $SMOOTHING_DELTA_DEFAULT = '0.1';
11             our %ATTRS = (
12             min => 1,
13             max => 1,
14             format => 1,
15             smoothing => 1,
16             smoothing_delta => 1,
17             );
18              
19             sub new
20             {
21 2     2 1 655 my $class = shift;
22 2         10 my $self = { min => 0, max => 100, smoothing => 0, smoothing_delta => $SMOOTHING_DELTA_DEFAULT };
23 2         3 bless $self;
24 2         4 $self->attr( @_ );
25 2         7 $self->restart();
26 2         3 return $self;
27             }
28              
29             sub attr
30             {
31 4     4 1 5 my $self = shift;
32 4 50 66     15 croak "bad number of attribute/value pairs" unless @_ == 0 or @_ % 2 == 0;
33 4         4 my @ret;
34 4         9 my %h = @_;
35 4         9 for( keys %h )
36             {
37 4 50       11 croak "invalid attribute name: $_" unless $ATTRS{ $_ };
38 4 50       14 $self->{ $_ } = $h{ $_ } if defined $h{ $_ };
39 4         6 push @ret, $self->{ $_ };
40             }
41 4         10 return @ret;
42             }
43              
44             sub restart
45             {
46 2     2 1 2 my $self = shift;
47 2         4 my @ret = $self->attr( @_ );
48 2         8 $self->{ 'start' } = time();
49 2         4 $self->{ 'stop' } = undef;
50 2         2 return @ret;
51             }
52              
53             sub stop
54             {
55 0     0 1 0 my $self = shift;
56 0         0 $self->{ 'stop' } = time();
57             }
58              
59             sub continue
60             {
61 0     0 1 0 my $self = shift;
62 0         0 $self->{ 'stop' } = undef;
63             }
64              
65             sub report
66             {
67 11     11 1 64 my $self = shift;
68 11   33     24 my $format = shift || $self->{ 'format' };
69 11         59 my $cur = shift;
70              
71 11         15 my $start = $self->{ 'start' };
72              
73 11   33     45 my $now = $self->{ 'stop' } || time();
74              
75 11 50       23 croak "use restart() first" unless $start > 0;
76 11 50       18 croak "time glitch (running backwards?)" if $now < $start;
77 11 50       16 croak "empty format, use format() first" unless $format;
78              
79 11         11 my $l = $now - $start;
80 11         48 my $L = sprintf "%3d:%02d", int( $l / 60 ), ( $l % 60 );
81              
82 11         11 my $min = $self->{ 'min' };
83 11         8 my $max = $self->{ 'max' };
84 11         12 my $last_e = $self->{ 'last_e' };
85 11         11 my $sdelta = $self->{ 'smoothing_delta' };
86            
87 11 50       15 $cur = $min unless defined $cur;
88 11 50 33     55 $sdelta = $SMOOTHING_DELTA_DEFAULT unless $sdelta > 0 and $sdelta < 1;
89              
90 11         11 my $b = 'n/a';
91 11         9 my $bl = 79;
92              
93 11 100       53 if ( $format =~ /%(\d*)[bB]/ )
94             {
95 5         14 $bl = $1;
96 5 50 33     37 $bl = 79 if $bl eq '' or $bl < 1;
97             }
98              
99 11         22 my $e = "n/a";
100 11         7 my $E = "n/a";
101 11         10 my $f = "n/a";
102 11         8 my $p = "n/a";
103              
104 11 50 33     38 if ( (($min <= $cur and $cur <= $max) or ($min >= $cur and $cur >= $max)) )
      0        
      33        
105             {
106 11 100       29 if ( $cur - $min == 0 )
107             {
108 2         3 $e = 0;
109             }
110             else
111             {
112 9         12 $e = $l * ( $max - $min ) / ( $cur - $min );
113 9         8 $e = int( $e - $l );
114 9 0 33     26 if ( $self->{ 'smoothing' } && $last_e && $last_e < $e && ( ( $e - $last_e ) / $last_e ) < $sdelta )
      33        
      0        
115             {
116 0         0 $e = $last_e;
117             }
118 9 50       13 $e = 0 if $e < 0;
119 9 50       15 $self->{last_e} = $e if $self->{ 'smoothing' };
120             }
121 11         32 $E = sprintf "%3d:%02d", int( $e / 60 ), ( $e % 60 );
122              
123 11         7 $f = $now + $e;
124 11         515 $f = localtime( $f );
125              
126 11 50       26 if ( $max - $min != 0 )
127             {
128 11         17 $p = 100 * ( $cur - $min ) / ( $max - $min );
129 11         39 $b = '#' x int( $bl * $p / 100 ) . '.' x $bl;
130 11         15 $b = substr $b, 0, $bl;
131 11         76 $p = sprintf "%5.1f%%", $p;
132             }
133             }
134              
135 11         35 $format =~ s/%(\d*)l/$self->sp_format( $l, $1 )/ge;
  0         0  
136 11         11 $format =~ s/%(\d*)L/$self->sp_format( $L, $1 )/ge;
  0         0  
137 11         10 $format =~ s/%(\d*)e/$self->sp_format( $e, $1 )/ge;
  0         0  
138 11         12 $format =~ s/%(\d*)E/$self->sp_format( $E, $1 )/ge;
  0         0  
139 11         20 $format =~ s/%p/$p/g;
140 11         11 $format =~ s/%f/$f/g;
141 11         33 $format =~ s/%\d*[bB]/$b/g;
142              
143 11         37 return $format;
144             }
145              
146             sub sp_format
147             {
148 0     0 0   my $self = shift;
149              
150 0           my $val = shift;
151 0           my $len = shift;
152              
153 0 0 0       return $val unless $len ne '' and $len > 0;
154 0           return sprintf( "%${len}s", $val );
155             }
156              
157             sub elapsed
158 0     0 1   { my $self = shift; return $self->report("%l",@_); }
  0            
159              
160             sub elapsed_str
161 0     0 1   { my $self = shift; return $self->report("elapsed time is %L min.\n",@_); }
  0            
162              
163             sub estimate
164 0     0 1   { my $self = shift; return $self->report("%e",@_); }
  0            
165              
166             sub estimate_str
167 0     0 1   { my $self = shift; return $self->report("remaining time is %E min.\n",@_); }
  0            
168              
169             1;
170              
171             =pod
172              
173             =head1 NAME
174              
175             Time::Progress - Elapsed and estimated finish time reporting.
176              
177             =head1 SYNOPSIS
178              
179             use Time::Progress;
180              
181             my ($min, $max) = (0, 4);
182             my $p = Time::Progress->new(min => $min, max => $max);
183              
184             for (my $c = $min; $c <= $max; $c++) {
185             print STDERR $p->report("\r%20b ETA: %E", $c);
186             # do some work
187             }
188             print STDERR "\n";
189              
190             =head1 DESCRIPTION
191              
192             This module displays progress information for long-running processes.
193             This can be percentage complete, time elapsed, estimated time remaining,
194             an ASCII progress bar, or any combination of those.
195              
196             It is useful for code where you perform a number of steps,
197             or iterations of a loop,
198             where the number of iterations is known before you start the loop.
199              
200             The typical usage of this module is:
201              
202             =over 4
203              
204             =item *
205             Create an instance of C, specifying min and max count values.
206              
207             =item *
208             At the head of the loop, you call the C method with
209             a format specifier and the iteration count,
210             and get back a string that should be displayed.
211              
212             =back
213              
214             If you include a carriage return character (\r) in the format string,
215             then the message will be over-written at each step.
216             Putting \r at the start of the format string,
217             as in the SYNOPSIS,
218             results in the cursor sitting at the end of the message.
219              
220             If you display to STDOUT, then remember to enable auto-flushing:
221              
222             use IO::Handle;
223             STDOUT->autoflush(1);
224              
225             The shortest time interval that can be measured is 1 second.
226              
227             =head1 METHODS
228              
229             =head2 new
230              
231             my $p = Time::Progress->new(%options);
232              
233             Returns new object of Time::Progress class and starts the timer.
234             It also sets min and max values to 0 and 100,
235             so the next B calls will default to percents range.
236              
237             You can configure the instance with the following parameters:
238              
239             =over 4
240              
241             =item min
242              
243             Sets the B attribute, as described in the C section below.
244              
245             =item max
246              
247             Sets the B attribute, as described in the C section below.
248              
249             =item smoothing
250              
251             If set to a true value, then the estimated time remaining is smoothed
252             in a simplistic way: if the time remaining ever goes up, by less than
253             10% of the previous estimate, then we just stick with the previous
254             estimate. This prevents flickering estimates.
255             By default this feature is turned off.
256              
257             =item smoothing_delta
258              
259             Sets smoothing delta parameter. Default value is 0.1 (i.e. 10%).
260             See 'smoothing' parameter for more details.
261              
262             =back
263              
264             =head2 restart
265              
266             Restarts the timer and clears the stop mark.
267             Optionally restart() may act also
268             as attr() for setting attributes:
269              
270             $p->restart( min => 1, max => 5 );
271              
272             is the same as:
273              
274             $p->attr( min => 1, max => 5 );
275             $p->restart();
276              
277             If you need to count things, you can set just 'max' attribute since 'min' is
278             already set to 0 when object is constructed by new():
279              
280             $p->restart( max => 42 );
281              
282             =head2 stop
283              
284             Sets the stop mark. This is only useful if you do some work, then finish,
285             then do some work that shouldn't be timed and finally report. Something
286             like:
287              
288             $p->restart;
289             # do some work here...
290             $p->stop;
291             # do some post-work here
292             print $p->report;
293             # `post-work' will not be timed
294              
295             Stop is useless if you want to report time as soon as work is finished like:
296              
297             $p->restart;
298             # do some work here...
299             print $p->report;
300              
301             =head2 continue
302              
303             Clears the stop mark. (mostly useless, perhaps you need to B?)
304              
305             =head2 attr
306              
307             Sets and returns internal values for attributes. Available attributes are:
308              
309             =over 4
310              
311             =item min
312              
313             This is the min value of the items that will follow (used to calculate
314             estimated finish time)
315              
316             =item max
317              
318             This is the max value of all items in the even (also used to calculate
319             estimated finish time)
320              
321             =item format
322              
323             This is the default B format. It is used if B is called
324             without parameters.
325              
326             =back
327              
328             B returns array of the set attributes:
329              
330             my ( $new_min, $new_max ) = $p->attr( min => 1, max => 5 );
331              
332             If you want just to get values use undef:
333              
334             my $old_format = $p->attr( format => undef );
335              
336             This way of handling attributes is a bit heavy but saves a lot
337             of attribute handling functions. B will complain if you pass odd number
338             of parameters.
339              
340             =head2 report
341              
342             This is the most complex method in this package :)
343              
344             The expected arguments are:
345              
346             $p->report( format, [current_item] );
347              
348             I is string that will be used for the result string. Recognized
349             special sequences are:
350              
351             =over 4
352              
353             =item %l
354              
355             elapsed seconds
356              
357             =item %L
358              
359             elapsed time in minutes in format MM:SS
360              
361             =item %e
362              
363             remaining seconds
364              
365             =item %E
366              
367             remaining time in minutes in format MM:SS
368              
369             =item %p
370              
371             percentage done in format PPP.P%
372              
373             =item %f
374              
375             estimated finish time in format returned by B
376              
377             =item %b
378              
379             =item %B
380              
381             progress bar which looks like:
382              
383             ##############......................
384              
385             %b takes optional width:
386              
387             %40b -- 40-chars wide bar
388             %9b -- 9-chars wide bar
389             %b -- 79-chars wide bar (default)
390              
391             =back
392              
393             Parameters can be ommited and then default format set with B will
394             be used.
395              
396             Sequences 'L', 'l', 'E' and 'e' can have width also:
397              
398             %10e
399             %5l
400             ...
401              
402             Estimate time calculations can be used only if min and max values are set
403             (see B method) and current item is passed to B! if you want
404             to use the default format but still have estimates use it like this:
405              
406             $p->format( undef, 45 );
407              
408             If you don't give current item (step) or didn't set proper min/max value
409             then all estimate sequences will have value `n/a'.
410              
411             You can freely mix reports during the same event.
412              
413              
414             =head2 elapsed($item)
415              
416             Returns the time elapsed, in seconds.
417             This help function, and those described below,
418             take one argument: the current item number.
419              
420              
421             =head2 estimate($item)
422              
423             Returns an estimate of the time remaining, in seconds.
424              
425              
426             =head2 elapsed_str($item)
427              
428             Returns elapsed time as a formatted string:
429              
430             "elapsed time is MM:SS min.\n"
431              
432             =head2 estimate_str($item)
433              
434             Returns estimated remaining time, as a formatted string:
435              
436             "remaining time is MM:SS min.\n"
437              
438              
439              
440             =head1 FORMAT EXAMPLES
441              
442             # $c is current element (step) reached
443             # for the examples: min = 0, max = 100, $c = 33.3
444              
445             print $p->report( "done %p elapsed: %L (%l sec), ETA %E (%e sec)\n", $c );
446             # prints:
447             # done 33.3% elapsed time 0:05 (5 sec), ETA 0:07 (7 sec)
448              
449             print $p->report( "%45b %p\r", $c );
450             # prints:
451             # ###############.............................. 33.3%
452              
453             print $p->report( "done %p ETA %f\n", $c );
454             # prints:
455             # done 33.3% ETA Sun Oct 21 16:50:57 2001
456              
457              
458             =head1 SEE ALSO
459              
460             The first thing you need to know about L is that
461             it was written by Damian Conway, so you should expect to be a little
462             bit freaked out by it. It looks for certain format comments in your
463             code, and uses them to display progress messages. Includes support
464             for progress meters.
465              
466             L separates the calculation of stats from the display
467             of those stats, so you can have different back-ends which display
468             progress is different ways. There are a number of separate back-ends
469             on CPAN.
470              
471             L displays a progress meter to a standard terminal.
472              
473             L uses C if your code
474             is running in a terminal. If not running interactively, then no progress bar
475             is shown.
476              
477             L provides a simple interface where you
478             get a C<$progress> object that you can just increment in a long-running loop.
479             It builds on C, so displays nothing
480             when not running interactively.
481              
482             L displays a progress meter with timing information,
483             and two different skins.
484              
485             L is another customisable progress meter,
486             which comes with a number of 'widgets' for display progress
487             information in different ways.
488              
489             L handles the case where a long-running process
490             has a number of sub-processes, and you want to record progress
491             of those too.
492              
493             L provides a simple progress bar,
494             which shows progress using a bar of ASCII characters,
495             and the percentage complete.
496              
497             L is simpler than most of the other modules listed here,
498             as it just displays a 'spinner' to the terminal. This is useful if you
499             just want to show that something is happening, but can't predict how many
500             more operations will be required.
501              
502             L shows a pulsed progress bar in your terminal,
503             using a child process to pulse the progress bar until your job is complete.
504              
505             L a fork of C.
506              
507             L is another progress bar module, but it hasn't
508             seen a release in the last 12 years.
509              
510             =head1 GITHUB REPOSITORY
511              
512             L
513              
514              
515             =head1 AUTHOR
516              
517             Vladi Belperchinov-Shabanski "Cade"
518              
519             Ecade@biscom.netE Ecade@datamax.bgE Ecade@cpan.orgE
520              
521             L
522              
523             =head1 COPYRIGHT AND LICENSE
524              
525             This software is copyright (c) 2001-2015 by Vladi Belperchinov-Shabanski
526             Ecade@cpan.orgE.
527              
528             This is free software; you can redistribute it and/or modify it under
529             the same terms as the Perl 5 programming language system itself.
530              
531             =cut
532