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